selectclippathu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit SelectClipPathU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DrawRadial;
    procedure DrawGradient;
  end;

var
  Form1: TForm1;
  ThePalette: HPalette;   // a handle to the application defined palette

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  NewPalette: PLogPalette;    // a pointer to logical palette information
  iCount: Integer;            // a general loop counter
begin
  {initialize the form's font}
  Font.Name := 'Arial';
  Font.Size := 48;

  {retrieve enough memory to create a 75 entry palette}
  GetMem(NewPalette, SizeOf(TLogPalette)+75*SizeOf(TPaletteEntry));

  {initialize specific palette information}
  NewPalette^.palVersion := $300;
  NewPalette^.palNumEntries := 75;

  {retrieve the first 10 system palette entries}
  GetSystemPaletteEntries(Form1.Canvas.Handle, 0, 10, NewPalette^.palPalEntry);

  {create a gradient palette for the remaining entries}
  for iCount := 10 to 74 do
  begin
    NewPalette^.palPalEntry[iCount].peRed   := 255;
    NewPalette^.palPalEntry[iCount].peGreen := ((256 div 64)*(iCount-10));
    NewPalette^.palPalEntry[iCount].peBlue  := 0;
    NewPalette^.palPalEntry[iCount].peFlags := PC_NOCOLLAPSE;
  end;

  {create a new palette}
  ThePalette := CreatePalette(NewPalette^);

  {free the memory allocated for the logical palette information}
  FreeMem(NewPalette);
end;

{this draws gradient, radial lines originating from the center of the text}
procedure TForm1.DrawRadial;
var
  iCount: Integer;         // a general loop counter variable
  RayOrigin: TPoint;       // the origin of the radial lines
  Radius: Integer;         // the radius within which to draw the lines
  NewPen, OldPen: HPen;    // holds a new and old pen
begin
  {begin a path bracket within the form's device context}
  BeginPath(Canvas.Handle);

  {set the background mode to transparent. this is necessary so that the path
   will consist of the area inside of the text. without this, the path is
   defined as the area outside of the text}
  SetBkMode(Canvas.Handle, TRANSPARENT);

  {output a word onto the form. this is captured as part of the path}
  TextOut(Canvas.Handle, 50, 50, 'Delphi Rocks!', Length('Delphi Rocks!'));

  {end the path bracket}
  EndPath(Canvas.Handle);

  {select this path as a clipping region for the form's device context}
  SelectClipPath(Canvas.Handle, RGN_COPY);

  {the radial lines should originate from the center of the text}
  RayOrigin.X := (Canvas.TextWidth('Delphi Rocks!') div 2)+50;
  RayOrigin.Y := (Canvas.TextHeight('Delphi Rocks!') div 2)+50;

  {the radius of the circle within which the lines are drawn will be
   equal to the length of the text}
  Radius := Canvas.TextWidth('Delphi Rocks!');

  {draw lines in a 90 degree arc}
  for iCount := 0 to 89 do
  begin
    {create a new pen, specifying a color from the new palette}
    NewPen := CreatePen(PS_SOLID, 1, PaletteIndex(75-Trunc(iCount*(64/90)+10)));

    {select this pen into the device context}
    OldPen := SelectObject(Canvas.Handle, NewPen);

    {draw a line starting at the center of the text. these lines will radiate
     outwards in a circular fashion. the following code draws a line in the
     first quadrant of a circular area within the text, and then reflects that
     line to the other 3 quadrants}
    MoveToEx(Canvas.Handle, RayOrigin.X, RayOrigin.Y, NIL);
    LineTo(Canvas.Handle, RayOrigin.X+Trunc(Radius*cos(iCount/(180/PI))),
           RayOrigin.Y+Trunc(Radius*sin(iCount/(180/PI))));
    MoveToEx(Canvas.Handle, RayOrigin.X, RayOrigin.Y, NIL);
    LineTo(Canvas.Handle, RayOrigin.X+Trunc(Radius*cos(iCount/(180/PI))),
           RayOrigin.Y-Trunc(Radius*sin(iCount/(180/PI))));
    MoveToEx(Canvas.Handle, RayOrigin.X, RayOrigin.Y, NIL);
    LineTo(Canvas.Handle, RayOrigin.X-Trunc(Radius*cos(iCount/(180/PI))),
           RayOrigin.Y-Trunc(Radius*sin(iCount/(180/PI))));
    MoveToEx(Canvas.Handle, RayOrigin.X, RayOrigin.Y, NIL);
    LineTo(Canvas.Handle, RayOrigin.X-Trunc(Radius*cos(iCount/(180/PI))),
           RayOrigin.Y+Trunc(Radius*sin(iCount/(180/PI))));

    {delete the new pen}
    SelectObject(Canvas.Handle, OldPen);
    DeleteObject(NewPen);
  end;
end;

{this function draws gradient filled text}
procedure TForm1.DrawGradient;
var
  iCount: Integer;              // a general loop counter
  TempRect: TRect;              // holds a temporary rectangle
  NewBrush, OldBrush: HBrush;   // holds an old and new brush
begin
  {begin a path bracket within the form's device context}
  BeginPath(Canvas.Handle);

  {set the background mode to transparent. this is necessary so that the path
   will consist of the area inside of the text. without this, the path is
   defined as the area outside of the text}
  SetBkMode(Canvas.Handle, TRANSPARENT);

  {output a word onto the form. this is captured as part of the path}
  TextOut(Canvas.Handle, 50, 150, 'Delphi Rocks!', Length('Delphi Rocks!'));

  {end the path bracket}
  EndPath(Canvas.Handle);

  {select this path as a clipping region for the form's device context}
  SelectClipPath(Canvas.Handle, RGN_COPY);

  {draw a series of rectangles within the text, resulting in a gradient fill}
  for iCount := 0 to 64 do
  begin
    {create a new brush, specifying a color from the new palette}
    NewBrush := CreateSolidBrush(PaletteIndex(iCount+10));

    {select the brush into the device context}
    OldBrush := SelectObject(Form1.Canvas.Handle, NewBrush);

    {create a rectangle, incremented from the left side of the text}
    TempRect := Rect(Trunc(50+iCount*Canvas.TextWidth('Delphi Rocks!')/64), 150,
                     Trunc(50+(iCount*Canvas.TextWidth('Delphi Rocks!')/64)+
                     (Canvas.TextWidth('Delphi Rocks!')/64)),
                     150+Canvas.TextHeight('Delphi Rocks!'));

    {fill the rectangle with the brush. the final product will be the illusion
     of gradient filled text}
    FillRect(Canvas.Handle, TempRect, NewBrush);

    {delete the new brush}
    SelectObject(Form1.Canvas.Handle, OldBrush);
    DeleteObject(NewBrush);
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  {select and realize the new palette into the form's device context}
  SelectPalette(Form1.Canvas.Handle, ThePalette, FALSE);
  RealizePalette(Form1.Canvas.Handle);

  {draw radially filled text}
  DrawRadial;

  {draw gradient filled text}
  DrawGradient;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {the palette is no longer needed, so delete it}
  DeleteObject(ThePalette);
end;

end.