☆Obaby's H4cking W0rld☆

Hack-Crack==Backdoors - RATs - Trojans // Binders-Packers - Rootkits

破解-黑客-零日漏洞-灰鸽子/上兴/PCShare-木马免杀-网站入侵-信息安全

2009年1月13日星期二

Delphi中实现对字体的存储


看看下面的代码:
function FontToString(Font: TFont): string;
begin
  with Font do
    Result := Format('%.8x%.8x%.4x%.4x%.1x%.2x%.1x%.4x%s', [Color, Height, Size,
      PixelsPerInch, Byte(Pitch), CharSet, Byte(Style), Length(Name), Name]);
end;

procedure StringToFont(Str: string; Font: TFont);
var
  Buff: string;
begin
  if Length(Str) <>
  Buff := Copy(Str, 1, 8);
  Font.Color := StrToInt('$' + Buff);

  Buff := Copy(Str, 9, 8);
  Font.Height := StrToInt('$' + Buff);

  Buff := Copy(Str, 17, 4);
  Font.Size := StrToInt('$' + Buff);

  Buff := Copy(Str, 21, 4);
  Font.PixelsPerInch := StrToInt('$' + Buff);

  Buff := Copy(Str, 25, 1);
  Font.Pitch := TFontPitch(StrToInt('$' + Buff));

  Buff := Copy(Str, 26, 2);
  Font.Charset := TFontCharSet(StrToInt('$' + Buff));

  Buff := Copy(Str, 28, 1);
  Font.Style := TFontStyles(Byte(StrToInt('$' + Buff)));

  Buff := Copy(Str, 29, 4);
  Font.Name := Copy(Str, 33, StrToInt('$' + Buff));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := FontToString(Memo1.Font);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if FontDialog1.Execute then
    Memo1.Font := FontDialog1.Font;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  StringToFont(Memo1.Text, Memo1.Font);
end;

当然也可以用RTTI,不过不推荐那样做。

0 评论:

发表评论