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

推荐订阅源

博客园 - 【当耐特】
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
Y
Y Combinator Blog
D
DataBreaches.Net
Google DeepMind News
Google DeepMind News
H
Hackread – Cybersecurity News, Data Breaches, AI and More
云风的 BLOG
云风的 BLOG
Recorded Future
Recorded Future
I
InfoQ
L
LangChain Blog
Stack Overflow Blog
Stack Overflow Blog
Recent Announcements
Recent Announcements
宝玉的分享
宝玉的分享
Martin Fowler
Martin Fowler
J
Java Code Geeks
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More
让小产品的独立变现更简单 - ezindie.com
让小产品的独立变现更简单 - ezindie.com
CTFtime.org: upcoming CTF events
CTFtime.org: upcoming CTF events
A
About on SuperTechFans
人人都是产品经理
人人都是产品经理
G
Google Developers Blog
大猫的无限游戏
大猫的无限游戏
C
Cybersecurity and Infrastructure Security Agency CISA
Know Your Adversary
Know Your Adversary
MongoDB | Blog
MongoDB | Blog
T
Tor Project blog
The Register - Security
The Register - Security
H
Help Net Security
Cisco Talos Blog
Cisco Talos Blog
P
Privacy & Cybersecurity Law Blog
NISL@THU
NISL@THU
P
Palo Alto Networks Blog
B
Blog RSS Feed
Latest news
Latest news
T
Threat Research - Cisco Blogs
The Hacker News
The Hacker News
C
Cisco Blogs
P
Privacy International News Feed
T
The Exploit Database - CXSecurity.com
V
Vulnerabilities – Threatpost
S
Schneier on Security
P
Proofpoint News Feed
Schneier on Security
Schneier on Security
www.infosecurity-magazine.com
www.infosecurity-magazine.com
cs.AI updates on arXiv.org
cs.AI updates on arXiv.org
AI
AI
Google Online Security Blog
Google Online Security Blog
H
Hacker News: Front Page
N
News and Events Feed by Topic
W
WeLiveSecurity

博客园 - qevan

QCanvasTextWriter 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开发环境
把字体保存到注册表或流中
qevan · 2005-04-18 · via 博客园 - qevan
把字体保存到注册表或流中
[ 作者:hubdog    转贴自:本站原创    点击数:201    更新时间:2004-7-7    文章录入:delphilxh
type 
  FontRec = packed record 
    Color: TColor; 
    LogFont: TLogFont; 
  end; 

// Save a font to the registry 保存到注册表
procedure SaveFontToReg(reg: TRegistry; const key, id: string; Font: TFont); 
var 
  fRec: FontRec; 
begin 
  if Windows.GetObject(Font.Handle, SizeOf(fRec.LogFont), @fRec.LogFont) > 0 then 
  begin 
    if reg.OpenKey(key, True) then 
      try 
        fRec.Color := Font.Color; 
        reg.WriteBinaryData(id, fRec, SizeOf(fRec)); 
      finally 
        reg.CloseKey; 
      end; 
  end; 
end; 

// Load a font from the registry 读取注册表
procedure LoadFont(reg: TRegistry; const key, id: string; Font: TFont); 
var 
  fRec: FontRec; 
begin 
  if reg.OpenKey(key, False) then 
    try 
      if reg.ReadBinaryData(id, frec, SizeOf(fRec)) = SizeOf(fRec) then 
        Font.Handle := CreateFontIndirect(fRec.LogFont); 
      Font.Color := fRec.Color; 
    finally 
      reg.CloseKey; 
    end; 
end; 

// Save a font to a stream 保存到流
procedure WriteFontToStream(s: TStream; Font: TFont); 
var 
  fRec: FontRec; 
  sz: integer; 
begin 
  sz := SizeOf(fRec.LogFont); 
  if Windows.GetObject(Font.Handle, sz, @fRec.LogFont) > 0 then 
  begin 
    s.Write(sz, SizeOf(Integer)); 
    fRec.Color := Font.Color; 
    s.Write(fRec, SizeOf(fRec)); 
  end 
  else 
  begin 
    sz := 0; 
    s.Write(sz, SizeOf(Integer)); 
  end; 
end; 

// Read a font from a stream 从流中读出
procedure ReadFont(s: TStream; Font: TFont); 
var 
  fRec: FontRec; 
  sz: integer; 
begin 
  s.read(sz, SizeOf(Integer)); 
  if sz = SizeOf(fRec.LogFont) then 
  begin 
    s.read(fRec, SizeOf(fRec)); 
    Font.Handle := CreateFontIndirect(fRec.LogFont); 
    Font.Color  := fRec.Color; 
  end; 
end;