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

推荐订阅源

博客园_首页
Exploit-DB.com RSS Feed
Exploit-DB.com RSS Feed
P
Proofpoint News Feed
G
Google Developers Blog
B
Blog
Engineering at Meta
Engineering at Meta
阮一峰的网络日志
阮一峰的网络日志
The Register - Security
The Register - Security
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
博客园 - 叶小钗
The Cloudflare Blog
The Hacker News
The Hacker News
D
Darknet – Hacking Tools, Hacker News & Cyber Security
C
CXSECURITY Database RSS Feed - CXSecurity.com
雷峰网
雷峰网
F
Fortinet All Blogs
钛媒体:引领未来商业与生活新知
钛媒体:引领未来商业与生活新知
H
Hackread – Cybersecurity News, Data Breaches, AI and More
酷 壳 – CoolShell
酷 壳 – CoolShell
Last Week in AI
Last Week in AI
T
Threat Research - Cisco Blogs
A
About on SuperTechFans
量子位
Recorded Future
Recorded Future
博客园 - 三生石上(FineUI控件)
H
Help Net Security
Help Net Security
Help Net Security
P
Palo Alto Networks Blog
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
T
Troy Hunt's Blog
W
WeLiveSecurity
V
Vulnerabilities – Threatpost
T
The Exploit Database - CXSecurity.com
Know Your Adversary
Know Your Adversary
Apple Machine Learning Research
Apple Machine Learning Research
Scott Helme
Scott Helme
N
News | PayPal Newsroom
AWS News Blog
AWS News Blog
D
DataBreaches.Net
Blog — PlanetScale
Blog — PlanetScale
MongoDB | Blog
MongoDB | Blog
B
Blog RSS Feed
腾讯CDC
J
Java Code Geeks
Microsoft Azure Blog
Microsoft Azure Blog
TaoSecurity Blog
TaoSecurity Blog
GbyAI
GbyAI
Y
Y Combinator Blog
Hacker News - Newest:
Hacker News - Newest: "LLM"
D
Docker

博客园 - 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.