Главная » Delphi » Графика » Градиентная заливка.

Градиентная заливка.

15:28
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.