本例效果图:
代码文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CheckLst;
type
TForm1 = class(TForm)
CheckListBox1: TCheckListBox;
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses GDIPOBJ, GDIPAPI;
var fs: Integer;
procedure TForm1.CheckListBox1Click(Sender: TObject);
const
fsArr: array[0..5] of Integer = (FontStyleRegular,
FontStyleBold,
FontStyleItalic,
FontStyleBoldItalic,
FontStyleUnderline,
FontStyleStrikeout);
var
i: Integer;
begin
fs := 0;
for i := 0 to CheckListBox1.Items.Count - 1 do
if CheckListBox1.Checked[i] then
fs := fs or fsArr[i];
Repaint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckListBox1.Align := alLeft;
CheckListBox1.Items.CommaText := 'FontStyleRegular,' +
'FontStyleBold,' +
'FontStyleItalic,' +
'FontStyleBoldItalic,' +
'FontStyleUnderline,' +
'FontStyleStrikeout';
CheckListBox1.Checked[0] := True;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
g: TGPGraphics;
sb: TGPSolidBrush;
font: TGPFont;
begin
g := TGPGraphics.Create(Canvas.Handle);
sb := TGPSolidBrush.Create(aclRed);
font := TGPFont.Create('微软雅黑', 50, fs);
g.DrawString('Delphi', -1, font, MakePoint(CheckListBox1.Width + 0.0, 0), sb);
font.Free;
sb.Free;
g.Free;
end;
end.
窗体文件:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 98
ClientWidth = 367
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 CheckListBox1: TCheckListBox
Left = 8
Top = 8
Width = 113
Height = 148
ItemHeight = 13
TabOrder = 0
OnClick = CheckListBox1Click
end
end
文本样式的定义:
FontStyle = Integer;
const
FontStyleRegular = Integer(0); {普通文本}
FontStyleBold = Integer(1); {加粗文本}
FontStyleItalic = Integer(2); {倾斜文本}
FontStyleBoldItalic = Integer(3); {加粗并倾斜文本}
FontStyleUnderline = Integer(4); {带下划线的文本}
FontStyleStrikeout = Integer(8); {中间有直线通过的文本}
Type
TFontStyle = FontStyle;