本例效果圖:
代碼文件: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.
