Tips (1539)

Tip Rating (14):

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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 2 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;