WinAPI: CreateFontIndirect - 根据字体结构建立逻辑字体
WinAPI: CreateFontIndirect - 根据字体结构建立逻辑字体
涂孟超 发表于3年前
WinAPI: CreateFontIndirect - 根据字体结构建立逻辑字体
  • 发表于 3年前
  • 阅读 1
  • 收藏 0
  • 点赞 0
  • 评论 0

腾讯云 新注册用户 域名抢购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;
//效果图:

//例2: 扁字
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;     
  FontInfo.lfWidth := 12;     {只修改了此处} 
  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);

  TextOut(Canvas.Handle, X, Y, str, Length(str));

  DeleteObject(FH1);
  DeleteObject(FH2);
end;

 
 
 
 
 

 

 

  
//效果图:

//例3: 长字
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  FontInfo: TLogFont; 
  FH1,FH2: HFONT;   
const
  str = '万一的 Delphi 博客';
begin
  FontInfo.lfHeight := 32;    {修改了此处}  
  FontInfo.lfWidth := 12;     
  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);

  TextOut(Canvas.Handle, X, Y, str, Length(str));

  DeleteObject(FH1);
  DeleteObject(FH2);
end;

 
 
 
 
 

 

 

  
//效果图:

//例4: 旋转
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;      
  FontInfo.lfWidth := 0;     
  FontInfo.lfEscapement := 450; {修改了此处}
  FontInfo.lfWeight := 500;   
  FontInfo.lfItalic := 0;     
  FontInfo.lfUnderline := 0;  
  FontInfo.lfStrikeOut := 0;  
  FontInfo.lfFaceName := '宋体';
  
  FH1 := CreateFontIndirect(FontInfo);
  FH2 := SelectObject(Canvas.Handle, FH1);

  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;

 
 
 
 
 

 

 

  
//效果图:

共有 人打赏支持
粉丝 13
博文 2004
码字总数 14107
×
涂孟超
如果觉得我的文章对您有用,请随意打赏。您的支持将鼓励我继续创作!
* 金额(元)
¥1 ¥5 ¥10 ¥20 其他金额
打赏人
留言
* 支付类型
微信扫码支付
打赏金额:
已支付成功
打赏金额: