再学 GDI+[42]: 文本输出 - 字号单位

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls, ComCtrls;



type

  TForm1 = class(TForm)

    RadioGroup1: TRadioGroup;

    TrackBar1: TTrackBar;

    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure RadioGroup1Click(Sender: TObject);

    procedure TrackBar1Change(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses GDIPOBJ,GDIPAPI,TypInfo;



procedure TForm1.FormCreate(Sender: TObject);

var

  i: Integer;

begin

  for i := 0 to 6 do

    RadioGroup1.Items.Add(GetEnumName(TypeInfo(TUnit), i));

  RadioGroup1.ItemIndex := 2;



  RadioGroup1.Buttons[0].Enabled := False;

  RadioGroup1.Buttons[1].Enabled := False;

  RadioGroup1.Buttons[4].Enabled := False;

  RadioGroup1.Buttons[5].Enabled := False;



  TrackBar1.ShowSelRange := False;

  TrackBar1.Min := 1;

  TrackBar1.Max := 100;

  TrackBar1.Position := 22;

end;



procedure TForm1.FormPaint(Sender: TObject);

var

  g: TGPGraphics;

  b: TGPBrush;

  font: TGPFont;

begin

  g := TGPGraphics.Create(Canvas.Handle);

  b := TGPSolidBrush.Create(aclDarkOrange);



  font := TGPFont.Create('Arial Black',

                          TrackBar1.Position,

                          FontStyleBoldItalic,

                          TUnit(RadioGroup1.ItemIndex) {字号单位, 默认是像素: UnitPixel}

                        );

  g.DrawString('Delphi', -1, font, MakePoint(5.0, 5), b);



  b.Free;

  font.Free;

  g.Free;

end;



procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

  Repaint;

end;



procedure TForm1.TrackBar1Change(Sender: TObject);

begin

  Repaint;

  Text := IntToStr(TrackBar1.Position);

  TrackBar1.Refresh;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 147

  ClientWidth = 336

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  Position = poDesktopCenter

  OnCreate = FormCreate

  OnPaint = FormPaint

  PixelsPerInch = 96

  TextHeight = 13

  object RadioGroup1: TRadioGroup

    Left = 237

    Top = 0

    Width = 99

    Height = 147

    Align = alRight

    Caption = 'RadioGroup1'

    TabOrder = 0

    OnClick = RadioGroup1Click

    ExplicitLeft = 240

  end

  object TrackBar1: TTrackBar

    Left = 0

    Top = 126

    Width = 241

    Height = 45

    TabOrder = 1

    OnChange = TrackBar1Change

  end

end


 
   

坐标单位类型表:

Delphi	微软	说明
UnitWorld	World	将世界坐标系单位指定为度量单位。
UnitDisplay	Display	指定显示设备的度量单位。通常，视频显示使用的单位是像素；打印机使用的单位是 1/100 英寸。
UnitPixel	Pixel	将设备像素指定为度量单位。
UnitPoint	Point	将打印机点（1/72 英寸）指定为度量单位。
UnitInch	Inch	将英寸指定为度量单位。
UnitDocument	Document	将文档单位（1/300 英寸）指定为度量单位。
UnitMillimeter	Millimeter	将毫米指定为度量单位。

---