Добро пожаловать! Это — архивная версия форумов на «Хакер.Ru». Она работает в режиме read-only.
 
журналы новости статьи video форум подписка на «Хакер»

Градиент в Delphi

Пользователи, просматривающие топик: none

Зашли как: Guest
Все форумы >> [Компилируемые языки] >> Градиент в Delphi
Имя
Сообщение << Старые топики   Новые топики >>
Градиент в Delphi - 2007-08-31 23:22:47.096666   
drunkshadow

Сообщений: 23
Оценки: 0
Присоединился: 2007-08-31 22:36:24.460000
 Подскажите, пожалуйста, почему этот код выводит в Image1 не градиент, а хренатень:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ColorDialog1: TColorDialog;
    Label2: TLabel;
    ColorDialog2: TColorDialog;
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  rvl, gvl, bvl, rvr, gvr, bvr: integer;
  cll, clr, dr, dg, db: longint;
  I: Integer;
  Y: Integer;
begin
  cll := Label1.Font.Color;
  clr := Label2.Font.Color;

  rvl := cll and $FF;
  gvl := (cll shr 8) and $FF;
  bvl := (cll shr 16) and $FF;

  rvr := clr and $FF;
  gvr := (clr shr 8) and $FF;
  bvr := (clr shr 16) and $FF;

  dr := (rvl - rvr) div Image1.Width;
  dg := (gvl - gvr) div Image1.Width;
  db := (bvl - bvr) div Image1.Width;

  for I := 0 to Image1.Width - 1 do
    begin
      rvl := rvl + dr;
      gvl := gvl + dg;
      bvl := bvl + db;
      for Y := 0 to Image1.Height - 1 do
        begin
          Image1.Canvas.Pixels[I,Y] := RGB(rvl, gvl, bvl);
        end;
    end;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
  if ColorDialog1.Execute then
    Label1.Font.Color := ColorDialog1.Color
      else
        exit;
end;

procedure TForm1.Label2Click(Sender: TObject);
begin
  if ColorDialog2.Execute then
    Label2.Font.Color := ColorDialog2.Color
    else
      exit;
end;

end.

Заранее благодарен
Post #: 1
RE: Градиент в Delphi - 2007-08-31 23:30:18.996666   
T

Сообщений: 1100
Оценки: 0
Присоединился: 2006-01-14 00:15:36
 Посморти на тип твоих приращений! Они целочесленные…
З.Ы. И вообще имеют ли знак? я забыл )))
Post #: 2
RE: Градиент в Delphi - 2007-08-31 23:34:02.973333   
drunkshadow

Сообщений: 23
Оценки: 0
Присоединился: 2007-08-31 22:36:24.460000
 И шо шо целочисленные?
Post #: 3
RE: Градиент в Delphi - 2007-08-31 23:36:12.616666   
T

Сообщений: 1100
Оценки: 0
Присоединился: 2006-01-14 00:15:36
 Попробуй так:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TForm1 = class(TForm) Label1: TLabel; ColorDialog1: TColorDialog; Label2: TLabel; ColorDialog2: TColorDialog; Button1: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); procedure Label2Click(Sender: TObject); procedure Label1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var rvl, gvl, bvl, rvr, gvr, bvr: integer; cll, clr: longint; dr, dg, db: real; I: Integer; Y: Integer; begin cll := Label1.Font.Color; clr := Label2.Font.Color; rvl := cll and $FF; gvl := (cll shr 8) and $FF; bvl := (cll shr 16) and $FF; rvr := clr and $FF; gvr := (clr shr 8) and $FF; bvr := (clr shr 16) and $FF; dr := (rvl - rvr)/Image1.Width; dg := (gvl - gvr)/Image1.Width; db := (bvl - bvr)/Image1.Width; for I := 0 to Image1.Width - 1 do begin rvl := trunc(rvl + dr); gvl := trunc(gvl + dg); bvl := trunc(bvl + db); for Y := 0 to Image1.Height - 1 do begin Image1.Canvas.Pixels[I,Y] := RGB(rvl, gvl, bvl); end; end; end; procedure TForm1.Label1Click(Sender: TObject); begin if ColorDialog1.Execute then Label1.Font.Color := ColorDialog1.Color else exit; end; procedure TForm1.Label2Click(Sender: TObject); begin if ColorDialog2.Execute then Label2.Font.Color := ColorDialog2.Color else exit; end; end.
Post #: 4
RE: Градиент в Delphi - 2007-08-31 23:37:15.666666   
drunkshadow

Сообщений: 23
Оценки: 0
Присоединился: 2007-08-31 22:36:24.460000
 А че такое trunc?
Post #: 5
RE: Градиент в Delphi - 2007-08-31 23:39:24.543333   
T

Сообщений: 1100
Оценки: 0
Присоединился: 2006-01-14 00:15:36
quote:

ORIGINAL: drunkshadow

И шо шо целочисленные?

А то ! Сам подумай !
Если у тебя число ступеней цвета меньше, чем длинна градиента! то? прирощение будет меньше 1…
Post #: 6
RE: Градиент в Delphi - 2007-08-31 23:40:20.513333   
T

Сообщений: 1100
Оценки: 0
Присоединился: 2006-01-14 00:15:36
quote:

ORIGINAL: drunkshadow

А че такое trunc?

я в дельфях неочень… если trunc нету, то пробуй round, это типа округления.
Post #: 7
RE: Градиент в Delphi - 2007-08-31 23:42:47.626666   
drunkshadow

Сообщений: 23
Оценки: 0
Присоединился: 2007-08-31 22:36:24.460000
 round пробовал… Не помогает [&o]
Post #: 8
RE: Градиент в Delphi - 2007-08-31 23:55:57.803333   
T

Сообщений: 1100
Оценки: 0
Присоединился: 2006-01-14 00:15:36
 ёлки… у тя ваще через Ж написан код… вот попробуй:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TForm1 = class(TForm) Label1: TLabel; ColorDialog1: TColorDialog; Label2: TLabel; ColorDialog2: TColorDialog; Button1: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); procedure Label2Click(Sender: TObject); procedure Label1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var rvl, gvl, bvl, rvr, gvr, bvr: integer; cll, clr: longint; dr, dg, db: real; I: Integer; Y: Integer; begin cll := Label1.Font.Color; clr := Label2.Font.Color; rvl := cll and $FF; gvl := (cll shr 8) and $FF; bvl := (cll shr 16) and $FF; rvr := clr and $FF; gvr := (clr shr 8) and $FF; bvr := (clr shr 16) and $FF; dr := (rvl - rvr)/Image1.Width; dg := (gvl - gvr)/Image1.Width; db := (bvl - bvr)/Image1.Width; for I := 0 to Image1.Width - 1 do begin rvl := trunc(dr*i); gvl := trunc(dg*i); bvl := trunc(db*i); for Y := 0 to Image1.Height - 1 do begin Image1.Canvas.Pixels[I,Y] := RGB(rvl, gvl, bvl); end; end; end; procedure TForm1.Label1Click(Sender: TObject); begin if ColorDialog1.Execute then Label1.Font.Color := ColorDialog1.Color else exit; end; procedure TForm1.Label2Click(Sender: TObject); begin if ColorDialog2.Execute then Label2.Font.Color := ColorDialog2.Color else exit; end; end. вместо трунк ф-ю округления вставь и должно пахать…
Post #: 9
RE: Градиент в Delphi - 2007-09-02 13:36:44.656666   
drunkshadow

Сообщений: 23
Оценки: 0
Присоединился: 2007-08-31 22:36:24.460000
 Мммм-да… Все черно…
Post #: 10
RE: Градиент в Delphi - 2007-09-02 15:34:33.853333   
blacksun

Сообщений: 2360
Оценки: 0
Присоединился: 2006-09-27 03:05:59.350000
 http://delphiworld.narod.ru/base/grad_fill.html
http://delphiworld.narod.ru/base/arbitrary_gradient.html
Post #: 11
Страниц:  [1]
Все форумы >> [Компилируемые языки] >> Градиент в Delphi







Связаться:
Вопросы по сайту / xakep@glc.ru

Предупреждение: использование полученных знаний в противозаконных целях преследуется по закону.