Помогите пожалуйста с градиентом

[qivi]

Делал вот по этой статье http://www.kansoftware.ru/?tid=2231

Получил вот это:

Код: Выделить всё

  If Visible=true then
  begin
    r1:=Red(ColorToRGB(FColorStart));
    g1:=Green(ColorToRGB(FColorStart));
    b1:=Blue(ColorToRGB(FColorStart));
    r2:=Red(ColorToRGB(FColorStop));
    g2:=Green(ColorToRGB(FColorStop));
    b2:=Blue(ColorToRGB(FColorStop));
    h:=Height-1;

    with Canvas do
    begin
      Lock;
      Pen.Style:=psSolid;
      for i:=0 to h do
      begin
        Pen.Color:=RGB(r1-(r1-r2) div h*i,g1-(g1-g2) div h*i,b1-(b1-b2) div h*i);
        MoveTo(0,i);
        LineTo(Width-1,i);
      end;
      Unlock;
    end;
  end;


При допустим Height:=50 градиент отображается просто замечтательно, однако при увеличении Height градиент искажается а в районе 200 и выше весь канвас принимает цвет FColorStart. В чём дифект подскажите пожалуйста.

[vada]

Типы переменных в студию.

[qivi]

Код: Выделить всё

    FColorStart:TColor;
    FColorStop:TColor; 
~
procedure TGradient.Paint;
  var
    h,i:integer;
    r1,g1,b1,r2,g2,b2:integer;
begin
  If Visible=true then
  begin
    r1:=Red(ColorToRGB(FColorStart));
    g1:=Green(ColorToRGB(FColorStart));
    b1:=Blue(ColorToRGB(FColorStart));
    r2:=Red(ColorToRGB(FColorStop));
    g2:=Green(ColorToRGB(FColorStop));
    b2:=Blue(ColorToRGB(FColorStop));
    h:=Height-1;

    with Canvas do
    begin
      Lock;
      Pen.Style:=psSolid;
      for i:=0 to h do
      begin
        Pen.Color:=RGB(r1-(r1-r2) div h*i,g1-(g1-g2) div h*i,b1-(b1-b2) div h*i);
        MoveTo(0,i);
        LineTo(Width-1,i);
      end;
      Unlock;
    end;
  end;
  inherited Paint;
end;   

[vada]

Вот так работает.

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormActivate(Sender: TObject);
    procedure Image1Paint(Sender: TObject);
  private
    { private declarations }
    FColorStart:TColor;
    FColorStop:TColor;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Image1Paint(Sender: TObject);
var
  h,i:integer;
  r1,g1,b1,r2,g2,b2:integer;
  dr,dg,db: Double;
begin
  If Visible=true then
  begin
    r1:=Red(ColorToRGB(FColorStart));
    g1:=Green(ColorToRGB(FColorStart));
    b1:=Blue(ColorToRGB(FColorStart));
    r2:=Red(ColorToRGB(FColorStop));
    g2:=Green(ColorToRGB(FColorStop));
    b2:=Blue(ColorToRGB(FColorStop));
    h:=Image1.Height-1;

    with Image1.Canvas do
    begin
      Lock;
      Pen.Style:=psSolid;
      dr := (r2-r1) / h;
      dg := (g2-g1) / h;
      db := (b2-b1) / h;
      for i:=0 to h do
      begin
        Pen.Color:=RGBToColor(r2-Round(dr*i),g2-Round(dg*i),b2-Round(db*i));
        MoveTo(0,i);
        LineTo(Width-1,i);
      end;
      Unlock;
    end;
  end;
  inherited Paint;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  FColorStart := RGBToColor(32, 32, 32);
  FColorStop  := RGBToColor(250, 250, 250);
  Image1Paint(Sender);
end;

end.


У Вас проблема в (r1-r2) div h и в (g1-g2) div h и в (b1-b2) div h. Тут легко ноль получается. Ну и дальше ерунда всякая уже.

[qivi]

Огромное спасибо