...implement an animated gradient?

Author: rainer

Category: Forms

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
I have taken two tipps from this site to work together:
   1. to draw a gradient from David Johannes Rieger
   2. the unit anithread form P. Below

what's coming out is a animated gradient. You know it maybe from
programms like VCDEasy.

There is nothing from me - all from this site!

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Ich habe zwei Tipps von dieser Seite zusammengefügt:
   1. to draw a gradient from David Johannes Rieger
   2. the unit anithread form P. Below

Dadurch erhält man einen animierten Gradienten wie Bsp. in VCDEasy zu sehen.

Der Quelltext ist nicht von mir, alles ist von dieser Seite!

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}



unit anithread;

interface

uses
  
Classes, Windows, Controls, Graphics;

type
  
TAnimationThread = class(TThread)
  private
    
{ Private declarations }
    
FWnd: HWND;
    FPaintRect: TRect;
    FbkColor, FfgColor: TColor;
    FInterval: Integer;
    procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean;
      Colors: array of TColor);
  protected
    procedure 
Execute; override;
  public
    constructor 
Create(paintsurface: TWinControl; {Control to paint on }
      
paintrect: TRect;          {area for animation bar }
      
bkColor, barcolor: TColor; {colors to use }
      
interval: Integer);       {wait in msecs between
paints}
  
end;

implementation

constructor 
TAnimationThread.Create(paintsurface: TWinControl;
  paintrect: TRect; bkColor, barcolor: TColor; interval: Integer);
begin
  inherited 
Create(True);
  FWnd       := paintsurface.Handle;
  FPaintRect := paintrect;
  FbkColor   := bkColor;
  FfgColor   := barColor;
  FInterval  := interval;
  FreeOnterminate := True;
  Resume;
end{ TAnimationThread.Create }

procedure TAnimationThread.Execute;
var
  
image: TBitmap;
  DC: HDC;
  Left, Right: Integer;
  increment: Integer;
  imagerect: TRect;
  state: (incRight, decRight);
begin
  
Image := TBitmap.Create;
  try
    with 
Image do
    begin
      
Width     := FPaintRect.Right - FPaintRect.Left;
      Height    := FPaintRect.Bottom - FPaintRect.Top;
      imagerect := Rect(0, 0, Width, Height);
    end{ with }
    
Left      := 0;
    Right     := 0;
    increment := imagerect.Right div 50;
    state     := Low(State);
    while not Terminated do
    begin
      with 
Image.Canvas do
      begin
        
Brush.Color := FbkColor;

        //FillRect(imagerect); original!

        
DrawGradient(Image.Canvas, imagerect, True, [clBtnShadow, clBtnFace]);

        case state of
          
incRight:
            begin
              
Inc(Right, increment);
              if Right > imagerect.Right then
              begin
                
Right := imagerect.Right;
                Inc(state);
              end// if
            
end// Case incRight }
          
decRight:
            begin
              
Dec(Right, increment);
              if Right <= 0 then
              begin
                
Right := 0;
                state := incRight;
              end// if
            
end// Case decLeft
        
end{ Case }
        
Brush.Color := FfgColor;

        //FillRect(Rect(left, imagerect.top, right, imagerect.bottom)); original!

        
DrawGradient(Image.Canvas, Rect(Left, imagerect.Top, Right, imagerect.Bottom),
          True, [clBtnFace, clBtnShadow]);
      end{ with }
      
DC := GetDC(FWnd);
      if DC <> 0 then
        try
          
BitBlt(DC,
            FPaintRect.Left,
            FPaintRect.Top,
            imagerect.Right,
            imagerect.Bottom,
            Image.Canvas.Handle,
            0, 0,
            SRCCOPY);
        finally
          
ReleaseDC(FWnd, DC);
        end;
      Sleep(FInterval);
    end{ While }
  
finally
    
Image.Free;
  end;
  InvalidateRect(FWnd, nil, True);
end{ TAnimationThread.Execute }

procedure TAnimationThread.DrawGradient(ACanvas: TCanvas; Rect: TRect;
  Horicontal: Boolean; Colors: array of TColor);
type
  
RGBArray = array[0..2] of Byte;
var
  
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
  Faktor: Double;
  A: RGBArray;
  B: array of RGBArray;
  merkw: Integer;
  merks: TPenStyle;
  merkp: TColor;
begin
  
mx := High(Colors);
  if mx > 0 then
  begin
    if 
Horicontal then
      
mass := Rect.Right - Rect.Left
    else
      
mass := Rect.Bottom - Rect.Top;
    SetLength(b, mx + 1);
    for x := 0 to mx do
    begin
      
Colors[x] := ColorToRGB(Colors[x]);
      b[x][0]   := GetRValue(Colors[x]);
      b[x][1]   := GetGValue(Colors[x]);
      b[x][2]   := GetBValue(Colors[x]);
    end;
    merkw     := ACanvas.Pen.Width;
    merks     := ACanvas.Pen.Style;
    merkp     := ACanvas.Pen.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Pen.Style := psSolid;
    faColorsh := Round(mass / mx);
    for y := 0 to mx - 1 do
    begin
      if 
y = mx - 1 then
        
bis := mass - y * faColorsh - 1
      else
        
bis := faColorsh;
      for x := 0 to bis do
      begin
        
Stelle := x + y * faColorsh;
        faktor := x / bis;
        for z := 0 to do
          
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
        ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
        if Horicontal then
        begin
          
ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
          ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
        end
        else
        begin
          
ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
          ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
        end;
      end;
    end;
    b := nil;
    ACanvas.Pen.Width := merkw;
    ACanvas.Pen.Style := merks;
    ACanvas.Pen.Color := merkp;
  end;
  {else
    // Please specify at least two colors
    raise EMathError.Create('Es müssen mindestens zwei Farben angegeben werden.');


    In diesem Fallnicht mehr als zwei Farben!
    Here not more than two colors!
    }
end;


end.



{Usage:
 Place a TPanel on a form, size it as appropriate.Create an instance of the
 TanimationThread call like this: procedure TForm1.Button1Click(Sender : TObject);
}

procedure TForm1.Button1Click(Sender: TObject);
var
  
ani: TAnimationThread;
  r: TRect;
  begin  r := panel1.ClientRect;
  InflateRect(r, - panel1.bevelwidth, - panel1.bevelwidth);
  ani := TanimationThread.Create(panel1, r, panel1.Color, clBlue, 25);
  Button1.Enabled := False;
  Application.ProcessMessages;
  Sleep(30000);  // replace with query.Open or such
  
Button1.Enabled := True;
  ani.Terminate;
  ShowMessage('Done');
  end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base