K210.ORG

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls;

 

type

  COLOR16 = Word;

 

  PTriVertex = ^TTriVertex;

  _TRIVERTEX = packed record

    x: Longint;

    y: Longint;

    Red: COLOR16;

    Green: COLOR16;

    Blue: COLOR16;

    Alpha: COLOR16;

  end;

  TTriVertex = _TRIVERTEX;

  TRIVERTEX = _TRIVERTEX;

 

type

  TForm1 = class(TForm)

    Timer1: TTimer;

    procedure Timer1Timer(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    { Private declarations }

    i: integer;

    buf: TBitmap;

    procedure Drawbar(prc: integer);

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

function GradientFill(DC: HDC; var p2: TTriVertex;

  p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL; stdcall;

external 'msimg32.dll' name 'GradientFill';

 

implementation

 

{$R *.dfm}

 

procedure GradientRect(DC: HDC; const Rect: TRect;

  StartColor, EndColor: TColor; HorizDir: Boolean);

var

  vert: array[0..1] of TRIVERTEX;

  gRect: GRADIENT_RECT;

const

  Direction: array[Boolean] of DWORD =

  (GRADIENT_FILL_RECT_V, GRADIENT_FILL_RECT_H);

begin

  StartColor := ColorToRGB(StartColor);

  EndColor := ColorToRGB(EndColor);

 

  vert[0].x := Rect.Left;

  vert[0].y := Rect.Top;

  vert[0].Red := GetRValue(StartColor) shl 8;

  vert[0].Green := GetGValue(StartColor) shl 8;

  vert[0].Blue := GetBValue(StartColor) shl 8;

  vert[0].Alpha := $0000;

 

  vert[1].x := Rect.Right;

  vert[1].y := Rect.Bottom;

  vert[1].Red := GetRValue(EndColor) shl 8;

  vert[1].Green := GetGValue(EndColor) shl 8;

  vert[1].Blue := GetBValue(EndColor) shl 8;

  vert[1].Alpha := $0000;

 

  gRect.UpperLeft := 0;

  gRect.LowerRight := 1;

  GradientFill(DC, vert[0], 2, @gRect, 1, Direction[HorizDir]);

end;

 

procedure TForm1.Drawbar(prc: integer);

var

  r: trect;

begin

  r := rect(0, 0, 300, 40);

  GradientRect(buf.canvas.Handle, r, $00FFAAAA, clwhite, false);

  frame3d(buf.canvas, r, clBtnShadow, clBtnHighlight, 1);

  r.Right := r.Left + prc * 3;

  GradientRect(buf.canvas.Handle, r, clwhite, clnavy, false);

  canvas.CopyRect(rect(10, 10, 310, 50), buf.canvas, rect(0, 0, 300, 40));

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

  Drawbar(i);

  inc(i);

  if i > 100 then i := 0;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  buf := TBitmap.Create;

  with buf do begin

    Canvas.Brush.Color := clBtnFace;

    Width := 300;

    Height := 20;

  end;

  Timer1.Interval := 40;

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

  buf.Free;

end;

 

end.