惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

Google DeepMind News
Google DeepMind News
Stack Overflow Blog
Stack Overflow Blog
Hugging Face - Blog
Hugging Face - Blog
博客园_首页
T
The Blog of Author Tim Ferriss
博客园 - 叶小钗
N
Netflix TechBlog - Medium
腾讯CDC
C
Check Point Blog
P
Proofpoint News Feed
Engineering at Meta
Engineering at Meta
GbyAI
GbyAI
S
SegmentFault 最新的问题
F
Fortinet All Blogs
美团技术团队
U
Unit 42
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More
博客园 - 司徒正美
F
Full Disclosure
Recorded Future
Recorded Future
D
DataBreaches.Net
博客园 - 【当耐特】
Martin Fowler
Martin Fowler
J
Java Code Geeks
I
InfoQ
Y
Y Combinator Blog
A
About on SuperTechFans
AI
AI
爱范儿
爱范儿
Exploit-DB.com RSS Feed
Exploit-DB.com RSS Feed
Forbes - Security
Forbes - Security
W
WeLiveSecurity
M
MIT News - Artificial intelligence
雷峰网
雷峰网
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
Simon Willison's Weblog
Simon Willison's Weblog
Schneier on Security
Schneier on Security
The GitHub Blog
The GitHub Blog
Security Archives - TechRepublic
Security Archives - TechRepublic
aimingoo的专栏
aimingoo的专栏
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
G
GRAHAM CLULEY
Know Your Adversary
Know Your Adversary
Latest news
Latest news
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
D
Docker
Recent Commits to openclaw:main
Recent Commits to openclaw:main
量子位
V2EX - 技术
V2EX - 技术
Project Zero
Project Zero

博客园 - qevan

把字体保存到注册表或流中 structures显示的模块的bpl - qevan - 博客园 delphi跟踪调试vcl代码的方法 QTrayIcon v1.0B 根据delphi版本进行编译 在气泡式提示窗口中显示关闭按钮 zz 中国共享软件注册提供商的比较 Delphi中资源文件使用详解 zz ShowBalloonTips @ TrayIcon 如何在DELPHI程序中顯示Balloon工具提示﹖ zz 分割人名的代码 电话薄的AT指令 zz 读取中文电话簿 AT+CPMS指令的意义以及AT+CNMI自动接收短信时的方法 一篇短信at指令介绍的文章, 摘过来 短信相关文章的连接 16进制字符转换为10进制 delphi c#的PDU-SMS编程代码 zz Delphi 2005纯WIN32开发环境
QCanvasTextWriter
qevan · 2006-06-07 · via 博客园 - qevan

unit QCanvasTextWriter;

//QCanvasTextWriter V1.0
//qevan(郭栋) 2005-3-31
//introduction:
//  QCanvasTextWriter can help u write text infomations on a canvas
//feathers:
//support different fonts styles
//support line break
//
//examples:
// Canvas.FillRect(rect);
// rtw:=TCanvasTextWriter.create(Canvas, Rect.TopLeft);
// rtw.writeln('Thank u for using QCanvasTextWriter',clBlack,[fsBold]);
// rtw.writeln(' Author: qevan',clLtGray,[]);
// rtw.writeln('http://cnblogs.com/qevan',clBlue,[fsUnderline,fsItalic]);
// rtw.free;

interface

uses Graphics,windows;

const endl=#$D#$A;

type
TCanvasTextWriter = class
private
       FCanvas:TCanvas;
       FCurrent:TPoint;
       FLineMaxHeight:integer;
    function getFont: TFont;
    procedure setFont(const Value: TFont);
    procedure newLine;

public
      constructor create(canvas:TCanvas;StartPosition:TPoint);
      procedure write(s:string;color:TColor;Style:TFontStyles);overload;
      procedure write(s:string);overload;
      procedure writeln(s:string;color:TColor;Style:TFontStyles);overload;
      procedure writeln(s:string='');overload;
      property Font:TFont read getFont write setFont;

end;

implementation

{ TRectTextWriter }

function TCanvasTextWriter.getFont: TFont;
begin
     result:=FCanvas.Font;
end;

procedure TCanvasTextWriter.setFont(const Value: TFont);
begin
     FCanvas.Font:=value;
end;

procedure TCanvasTextWriter.write(s: string);
begin
     FCanvas.TextOut(FCurrent.X,FCurrent.Y,s);
     inc(FCurrent.X,FCanvas.TextWidth(s));
     if FCanvas.TextHeight(s)>FLineMaxHeight then
        FLineMaxHeight:=FCanvas.TextHeight(s);
end;

procedure TCanvasTextWriter.write(s: string; color:TColor; Style: TFontStyles);
var oldcolor:TColor;
    oldStyle:TFontStyles;
begin
     OldColor:=FCanvas.Font.Color;
     OldStyle:=FCanvas.Font.Style;
     FCanvas.Font.Color:=Color;
     FCanvas.Font.Style:=Style;
     write(s);
     FCanvas.Font.Color:=OldColor;
     FCanvas.Font.Style:=oldStyle;
end;

constructor TCanvasTextWriter.create(canvas: TCanvas;StartPosition: TPoint);
begin
     FCanvas:=Canvas;
     FCurrent:=StartPosition;
     FLineMaxHeight:=0;
end;

procedure TCanvasTextWriter.writeln(s: string='');
begin
     write(s);
     newLine;
end;

procedure TCanvasTextWriter.writeln(s: string; color:TColor;Style: TFontStyles);
begin
     write(s,color,style);
     newLine;
end;

procedure TCanvasTextWriter.newLine;
begin
     inc(FCurrent.Y,FLineMaxHeight);
     FCurrent.X:=0;
     FLineMaxHeight:=0;
end;

end.