Fontを文字列化する時
テクニックを掲載してるくせに
その事に関して質問するのも変なのですが
フォント情報を文字列と相互変換する
http://delfusa.main.jp/delfusafloor/technic/technic/005_FontToStr-StrToFont.html
ここに書かせてもらっている記述について
FontのNameとColorとSizeとPitchとstyleを取得しています。
TFontには他の属性としてオブジェクトインスペクタで見える分
Charset、Orientation、Heightがあります。
全ての属性を文字列化すべきかと思いますが
HeightはSizeと連動しているようですし
Orientationはこの10年は0しかセットしたことがないので
今後100年後もOrientationは0のままだと思います。
…試しに設定してみたら、すごい事になった
※環境WinXPのLuna。
そこで、
『このテクニックにプラスしてCharsetを
文字列化して変換するようにすれば問題ない！』
と思いたいのですが、自信ありません。
問題ないでしょうか？
テクニック情報の品質を上げたいという
視点になりますが、識者の方、アドバイスや
『俺ならこういう実装する』というようなご意見教えてください。
『俺ならこういう実装する』の方で
TMemoryStreamに一旦詰め込むとコードがすっきりしますZE！
もちろん文字列化された情報は人間には読めませんが。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
FontDialog1: TFontDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.dfm}
function StreamToString(aStream:TMemoryStream):String;
var
i:Longint;
b:Byte;
begin
aStream.Position:=0;
for i:=0 to aStream.Size-1 do
begin
aStream.Read(b,SizeOf(b));
Result:= Result + IntToHex(b,2);
end;
end;
function HexCharToInt(aChar:Char):byte;
begin
Result:=Word(aChar);
case Result of
48..58: Result:= Result-48;
65..70: Result:= Result-65+10;
else Result:=0;
end;
end;
procedure StringToStream(str:String; var aStream:TMemoryStream);
var
i:Longint;
b:Byte;
begin
aStream.Position:=0;
aStream.Size:=0;
for i:=1 to Length(str) div 2 do
begin
b := HexCharToInt(str[i*2-1])*16 +
HexCharToInt(str[i*2 ]);
aStream.Write(b,SizeOf(b));
end;
end;
function FontToString(aFont:TFont):String;
var
mStream:TMemoryStream;
i:Integer;
aFontCharset: TFontCharset;
aColor:TColor;
aHeight:Integer;
aName:TFontName;
aPitch:TFontPitch;
aSize:Integer;
aStyle:TFontStyles;
begin
mStream:=TMemoryStream.Create;
mStream.Position:=0;
// String型だけ特殊
// property Name: TFontName read GetName write SetName;
aName:=aFont.Name;
i:=Length(aName);
mStream.Write(i ,SizeOf(i));
mStream.Write(aName[1] ,i);
// property Charset: TFontCharset read GetCharset write SetCharset;
aFontCharset:=aFont.Charset;
mStream.Write(aFontCharset ,SizeOf(aFontCharset));
// property Color: TColor read FColor write SetColor;
aColor:=aFont.Color;
mStream.Write(aColor ,SizeOf(aColor));
// property Height: Integer read GetHeight write SetHeight;
aHeight:=aFont.Height;
mStream.Write(aHeight ,SizeOf(aHeight));
// property Pitch: TFontPitch read GetPitch write SetPitch default fpDefault;
aPitch:=aFont.Pitch;
mStream.Write(aPitch ,SizeOf(aPitch));
// property Size: Integer read GetSize write SetSize stored False;
aSize:=aFont.Size;
mStream.Write(aSize ,SizeOf(aSize));
// property Style: TFontStyles read GetStyle write SetStyle;
aStyle:= aFont.Style;
mStream.Write(aStyle ,SizeOf(aStyle));
Result:=StreamToString(mStream);
mStream.Free;
end;
procedure StrToFont(aFont: TFont; FontStr: string);
var
mStream:TMemoryStream;
i:Integer;
aFontCharset: TFontCharset;
aColor:TColor;
aHeight:Integer;
aName:TFontName;
aPitch:TFontPitch;
aSize:Integer;
aStyle:TFontStyles;
begin
mStream:=TMemoryStream.Create;
StringToStream(FontStr,mStream);
mStream.Position:=0;
// String型だけ特殊
// property Name: TFontName read GetName write SetName;
mStream.Read(i ,SizeOf(i));
SetLength(aName,i);
mStream.Read(aName[1] ,i);
aFont.Name := aName;
// property Charset: TFontCharset read GetCharset write SetCharset;
mStream.Read(aFontCharset ,SizeOf(aFontCharset));
aFont.Charset:=aFontCharset;
// property Color: TColor read FColor write SetColor;
mStream.Read(aColor ,SizeOf(aColor));
aFont.Color:=aColor;
// property Height: Integer read GetHeight write SetHeight;
mStream.Read(aHeight ,SizeOf(aHeight));
aFont.Height:=aHeight;
// property Pitch: TFontPitch read GetPitch write SetPitch default fpDefault;
mStream.Read(aPitch ,SizeOf(aPitch));
aFont.Pitch:=aPitch;
// property Size: Integer read GetSize write SetSize stored False;
mStream.Read(aSize ,SizeOf(aSize));
aFont.Size:=aSize;
// property Style: TFontStyles read GetStyle write SetStyle;
mStream.Read(aStyle ,SizeOf(aStyle));
aFont.Style:=aStyle;
mStream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
If FontDialog1.Execute then
begin
Label1.Font:=FontDialog1.Font;
caption:= FontToString(Label1.Font);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StrToFont(Label2.Font,caption);
FontDialog1.Font:=Label2.Font;
FontDialog1.Execute;
end;
end.
TypInfo使用なら。。面倒だから大体これｗ
コンポーネントとか渡すとイベントとかも出力するから
Kindとかも見る？
procedure SetFontIniEx(o:TObject;Item:TStrings);
var
p:PPropList;
i,l :integer;
begin
l := GetPropList(o,p);
for i := 0 to l -1 do
SetPropValue(o,p[i]^.Name,Item.Values[p[i]^.Name]);
FreeMem(p);
end;
procedure GetFontIniEx(o:TObject;Item:TStrings);
var
p:PPropList;
i,l :integer;
begin
l := GetPropList(o,p);
for i := 0 to l -1 do
Item.Values[p[i]^.Name] := GetPropValue(o,p[i]^.Name,True);
FreeMem(p);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
GetFontIniEx(memo1.Font,memo1.Lines);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetFontIniEx(Memo1.Font,memo1.Lines);
end;
文字列化とは違うけど フォント情報 をファイルに保存するなら
こんなのどうよ？
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TFontComponent = class(TComponent)
private
FFont:TFont;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Font:TFont read FFont write FFont;
end;
TForm5 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form5: TForm5;
FontComponent: TFontComponent;
MemoryStream: TMemoryStream;
implementation
{$R *.dfm}
constructor TFontComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFont := TFont.Create;
end;
destructor TFontComponent.Destroy;
begin
FFont.Free;
inherited Destroy;
end;
procedure TForm5.Button1Click(Sender: TObject);
begin
FontComponent.Font.Assign(Button1.Font);
MemoryStream.Position := 0;
MemoryStream.WriteComponent(FontComponent);
MemoryStream.SaveToFile('FONT.DAT');
end;
procedure TForm5.Button2Click(Sender: TObject);
begin
MemoryStream.LoadFromFile('FONT.DAT');
MemoryStream.Position := 0;
MemoryStream.ReadComponent(FontComponent);
Button2.Font.Assign(FontComponent.Font);
end;
procedure TForm5.FormCreate(Sender: TObject);
begin
MemoryStream := TMemoryStream.Create;
FontComponent := TFontComponent.Create(Self);
end;
procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FontComponent.Free;
MemoryStream.Free;
end;
end.
みなさん、ありがとうございます。
試してからお返事してみます。
| ツイート |  |