Delphi字符串旋转任意角度


本文整理自网络,侵删。

 

例子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 根据邮箱地址分离出@前的内容

Delphi 控制滚动条

Delphi 关于内存数据与 json

Delphi 10分钟10行代码开发app(Delphi 应用案例)

Delphi tanimate组件

Delphi获取开机时间代码

Delphi trimright 删除字符串右边的空格

Delphi keydown与keyup、keypress的区别

Delphi 取得文件夹及下一级文件夹下的文件列表

Delphi jpeg压缩的两种方法

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...