createfontindirectu.pas

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

unit CreateFontIndirectU;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    procedure FormPaint(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormPaint(Sender: TObject);
var
  FontInfo: TLogFont;        // the logical font information
  NewFont, OldFont: HFont;   // holds the old and new fonts
begin
  {set the background mode for transparency}
  SetBkMode(Form1.Canvas.Handle, TRANSPARENT);

  {initialize the logical font information, setting the weight and escapement
   values to those specified by the trackbars.}
  with FontInfo do
  begin
    lfHeight := 24;
    lfWidth := 0;
    lfEscapement := TrackBar1.Position*10;
    lfOrientation := TrackBar1.Position*10;
    lfWeight := TrackBar2.Position;
    lfItalic := 0;
    lfUnderline := 0;
    lfStrikeOut := 0;
    lfFaceName := 'Arial';
  end;

  {create the new font}
  NewFont := CreateFontIndirect(FontInfo);

  {select the new font into the form's device context}
  OldFont := SelectObject(Form1.Canvas.Handle, NewFont);

  {output a string of rotated text}
  TextOut(Form1.Canvas.Handle, Form1.Width div 2, 140, 'Delphi Rocks!',
  Length('Delphi Rocks!'));

  {select the original font back into the device context,
   and delete the new one}
  SelectObject(Form1.Canvas.Handle, OldFont);
  DeleteObject(NewFont);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  {indicate the new trackbar positions}
  Label2.Caption := IntToStr(TrackBar1.Position);
  Label4.Caption := IntToStr(TrackBar2.Position);

  {redraw the font}
  Form1.Refresh;
end;

end.