Reply-To: "cworn" <cworn@pgcenter.de>
From: "cworn" <cworn@pgcenter.de>
Newsgroups: borland.public.delphi.graphics
References: <3b818506$1_1@dnews>
Subject: Re: Gradients
Date: Tue, 21 Aug 2001 08:33:25 +0200
Lines: 125
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.00.2919.6700
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2919.6700
NNTP-Posting-Host: 217.229.84.139
Message-ID: <3b8200fe_1@dnews>
X-Trace: dnews 998375678 217.229.84.139 (20 Aug 2001 23:34:38 -0700)
Path: dnews
Xref: dnews borland.public.delphi.graphics:41373

I have some Code for you

1. Write a class TGradient
-------------------------------------------
  type TDirection = (diHorizon, diVertical);
  type TGradient = class
  private
     function GetColorBetween(StartColor, EndColor: TColor; Pointvalue, Von,
Bis : Extended): TColor;
  public
     procedure FillGradient(Canvas : TCanvas; Width, Height : Integer;
                            Color1, Color2 : TColor;
                            Direction : TDirection);
  end;

procedure TGradient.FillGradient(Canvas : TCanvas; Width, Height : Integer;
                                 Color1, Color2 : TColor;
                                 Direction : TDirection);
  var i : Integer;
begin
     if (Width > 0) and (Height > 0) then
     begin
        case Direction of
             diHorizon:  for i := 0 to Width do
                         begin
                           Canvas.Pen.Color := GetColorBetween(Color1,
Color2, i, 0, Width);
                           Canvas.MoveTo(i, 0);
                           Canvas.LineTo(i, Height);
                         end;
             diVertical: for i := 0 to Height do
                         begin
                           Canvas.Pen.Color := GetColorBetween(Color1,
Color2, i, 0, Height);
                           Canvas.MoveTo(0, i);
                           Canvas.LineTo(Width, i);
                         end;
        end;
     end;
end;

//NOTE : The GetColorBetween function is not written by me, I found it
somewhere in the internet, but i dont
//remind who wrote this fast function. Sorry to the Author

function TGradient.GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
Von, Bis : Extended): TColor;
var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;
  function CalcColorBytes(fb1, fb2: Byte): Byte;
  begin
    result := fb1;
    if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1));
    if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2));
  end;
begin
  if Pointvalue <= Von then begin
    result := StartColor;
    exit;
  end;
  if Pointvalue >= Bis then begin
    result := EndColor;
    exit;
  end;
  F := (Pointvalue - von) / (Bis - Von);
  asm
     mov EAX, Startcolor
     cmp EAX, EndColor
     je @@exit
     mov r1, AL
     shr EAX,8
     mov g1, AL
     shr Eax,8
     mov b1, AL
     mov Eax, Endcolor
     mov r2, AL
     shr EAX,8
     mov g2, AL
     shr EAX,8
     mov b2, AL
     push ebp
     mov al, r1
     mov dl, r2
     call CalcColorBytes
     pop ecx
     push ebp
     Mov r3, al
     mov dL, g2
     mov al, g1
     call CalcColorBytes
     pop ecx
     push ebp
     mov g3, Al
     mov dL, B2
     mov Al, B1
     call CalcColorBytes
     pop ecx
     mov b3, al
     XOR EAX,EAX
     mov AL, B3
     SHL EAX,8
     mov AL, G3
     SHL EAX,8
     mov AL, R3
@@Exit:
     mov @result, eax
  end;

2. Use the Class in the Forms OnPaint-Event
-------------------------------------------
procedure TForm1.FormPaint(Sender: TObject);
  var Gradient : TGradient;
begin
     Gradient := TGradient.Create;
        Gradient.FillGradient(Canvas, Width, Height, clRed, clBlue,
diVertical);
     Gradient.Free;
end;

//3. Repaint the Form when its resized.
procedure TForm1.FormResize(Sender: TObject);
begin
        FormPaint(Sender);
end;