本文整理自网络，侵删。
例子1
//声明:
CreateFontIndirect(
const p1: TLogFont {字体结构}
): HFONT; {返回新字体指针}
//TLogFont 是 tagLOGFONTA 结构的重定义:
tagLOGFONTA = packed record
lfHeight: Longint; {字体高度}
lfWidth: Longint; {字体平均宽度}
lfEscapement: Longint; {角度, 单位是 1/10 度}
lfOrientation: Longint; {基线角度}
lfWeight: Longint; {粗体, 取值: 0-1000}
lfItalic: Byte; {斜体}
lfUnderline: Byte; {下划线}
lfStrikeOut: Byte; {删除线}
lfCharSet: Byte; {字符集}
lfOutPrecision: Byte; {输出精度}
lfClipPrecision: Byte; {剪裁精度}
lfQuality: Byte; {输出质量}
lfPitchAndFamily: Byte; {间距及字族}
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar; {字样名称}
end;
//例1:
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
FontInfo: TLogFont; {声明字体结构}
FH1,FH2: HFONT; {声明字体句柄}
const
str = '万一的 Delphi 博客';
begin
{定义字体特征}
FontInfo.lfHeight := 0; {赋值 0, 系统自动给一个值}
FontInfo.lfWidth := 0; {赋值 0, 系统自动给一个值}
FontInfo.lfEscapement := 0; {无角度}
FontInfo.lfWeight := 500; {中等加粗}
FontInfo.lfItalic := 0; {非斜体}
FontInfo.lfUnderline := 0; {无下划线}
FontInfo.lfStrikeOut := 0; {无删除线}
FontInfo.lfFaceName := '宋体';
FH1 := CreateFontIndirect(FontInfo);
FH2 := SelectObject(Canvas.Handle, FH1);
{用 CreateFontIndirect 建立逻辑字体; 用 SelectObject 选人设备; 并返回字体句柄}
TextOut(Canvas.Handle, X, Y, str, Length(str));
DeleteObject(FH1);
DeleteObject(FH2);
end;
//一个利用角度的示例:
procedure TForm1.FormPaint(Sender: TObject);
var
FontInfo: TLogFont;
FH1,FH2: HFONT;
x,y,i: Integer;
const
str = '万一的 Delphi 博客';
begin
FontInfo.lfHeight := 0;
FontInfo.lfWidth := 0;
FontInfo.lfEscapement := 0;
FontInfo.lfWeight := 1000;
FontInfo.lfItalic := 0;
FontInfo.lfUnderline := 0;
FontInfo.lfStrikeOut := 0;
FontInfo.lfFaceName := '宋体';
x := ClientWidth div 2;
y := ClientHeight div 2;
SetBkMode(Canvas.Handle, TRANSPARENT);
i := 0;
while i<360 do
begin
FontInfo.lfEscapement := i * 10;
FH1 := CreateFontIndirect(FontInfo);
FH2 := SelectObject(Canvas.Handle, FH1);
TextOut(Canvas.Handle, X, Y, str, Length(str));
Inc(i,10);
end;
DeleteObject(FH1);
DeleteObject(FH2);
end;
例子2
//自己测试的例子
procedure TForm1.RzButton1Click(Sender: TObject);
var
FontInfo: TLogFont; {声明字体结构}
FH1,FH2: HFONT; {声明字体句柄}
wstr: string;
begin
wstr := '0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 ';
Canvas.Font.Size := 5;
Canvas.brush.color:=$ffffffff;
Canvas.font.color:=$1200fff0;
{定义字体特征}
FontInfo.lfHeight := 0; {赋值 0, 系统自动给一个值}
FontInfo.lfWidth := 0; {赋值 0, 系统自动给一个值}
FontInfo.lfEscapement := 3150; {无角度}
FontInfo.lfWeight := 500; {中等加粗}
FontInfo.lfItalic := 0; {非斜体}
FontInfo.lfUnderline := 0; {无下划线}
FontInfo.lfStrikeOut := 0; {无删除线}
FontInfo.lfFaceName := 'Verdana';
FH1 := CreateFontIndirect(FontInfo);
while not Application.Terminated do
begin
FH2 := SelectObject(Canvas.Handle, FH1);
{用 CreateFontIndirect 建立逻辑字体; 用 SelectObject 选人设备; 并返回字体句柄}
TextOut(Canvas.Handle, 100, 100, pansichar(wstr), Length(wstr));
if wstr = '' then
wstr := '1 '
else if wstr[1]=' ' then
if wstr[2]='1' then
wstr := '0' + wstr
else
wstr := '1' + wstr
else
wstr := ' ' + wstr;
if length(wstr)>30 then
delete(wstr,60,2);
sleep(100);
Application.ProcessMessages;
end;
DeleteObject(FH1);
DeleteObject(FH2);
end;
例子3
procedure TForm1.FormPaint(Sender: TObject);
var
FLogFont : tagLogFontA; //逻辑字体--结构体类型
hTempFont, hPrevFont: HFONT; //字体句柄
hTempDC: HDC; //设备描述表或图形设备句柄
TempString: string; //输出的文字
begin
FLogFont.lfHeight := 10; //字高
FLogFont.lfWidth := 10; //字宽
FLogFont.lfWeight := 1; //字体笔划粗细程度
FLogFont.lfUnderline := 0; //没有下划线
FLogFont.lfStrikeOut := 0; //没有删除线
FLogFont.lfItalic := 0; //斜体效果否
FLogFont.lfCharSet := GB2312_CHARSET; //字符集
FLogfont.lfEscapement := 450; //倾斜度
FLogFont.lfOrientation := 450; //方向与倾斜度取值同
FLogFont.lfFaceName := '宋体'; //字体名称
//创建逻辑字体
hTempFont := CreateFontIndirect(FLogFont);
TempString := '测试';
//取得窗口的设备句柄
hTempDC := GetDC(Handle);
//取出窗口设备的当前字体，并替换为新字体
hPrevFont := SelectObject(hTempDC, hTempFont);
//设置设备窗口的文字色彩
SetTextColor(hTempDc, clRed);
//输出文字
TextOut(hTempDc, 200 , 200, PChar(TempString), Length(TempString));
//恢复原有的字体
SelectObject(hTempDc, hPrevFont);
//删除逻辑字体
DeleteObject(hTempFont);
//释放设备接口
ReleaseDC(Handle, hTempDC);
end;
相关阅读 >>
Delphi 2009 泛型容器单元(generics.collections)[4]: tdictionary<t>
Delphi winapi: gettopwindow - 获取指定窗口的子窗口中最顶层的窗口句柄
Delphi getprocessidentity 获取当前登录状态的管理员
Delphi getforegroundwindow 与 getactivewindow 的区别
更多相关阅读请进入《Delphi》频道 >>
