ذخیره کردن فونت ها در registry [بایگانی]

شنبه 21 تیر 1382, 23:57 عصر

سلام دوستان
اقایون میشه بگین چه جوری میشه یه فونت رو توی رجیستری ذخیره کرد؟؟؟

phantasm

یک شنبه 22 تیر 1382, 01:08 صبح

سلام
میتونی بیشتر توضیح بدی .منظورت اینه که اسم یه font تو registry ثبت بشه؟؟؟

یک شنبه 22 تیر 1382, 14:32 عصر

سلام
البته من زوری ندارم :wink:
ولی کلا میخام یه متغیر f:Tfont رو توی رجیستری ذخیره کنم
اسم فونت که ذخیره کردنش کاری نداره
مرسی

مهدی کرامتی

یک شنبه 22 تیر 1382, 15:05 عصر

خوب هدفت از انجام اینکار چیه؟

یک شنبه 22 تیر 1382, 15:41 عصر

من موردی مثال زدم
کلا اگه بخایم یه شی رو در رجیستری ذخیره کنیم چه باید کرد؟؟
حالا هدف از فونت خیلی همه نیست.

مهدی کرامتی

یک شنبه 22 تیر 1382, 16:15 عصر

<div dir=ltr>
Problem/Question/Abstract:
I was just wondering what the best way to save a particular font to the registry would be. Do I have to save each of its attributes separately? Is there an easier way than storing it to the registry, perhaps? Seems like such a simple issue, but other than saving and loading each attribute separately, I can't think of a way to do it at one time!

Answer:
You can do it by getting a TLogfont record filled and save that to a binary key:

var
lf: TLogfont;
begin
fillchar(lf, sizeof(lf), 0);
GetObject(font.handle, sizeof(lf), @lf);
registry.WriteBinarydata(valuename, lf, sizeof(lf));
end;
Reading it back would go like this:

registry.ReadBinarydata(valuename, lf, sizeof(lf));
font.handle := CreateFontIndirect(lf);
A probably more Kylix-compatible method would be to create a non-visual wrapper component for a TFont and stream that, e.g. to a memory stream. The streams content could then be saved to a binary registry key.

type
TFontWrapper = class(TComponent)
private
FFont: TFont;
procedure SetFont(f: TFont);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Font: TFont read FFont write SetFont;
end;

constructor TFontWrapper.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
FFont := TFont.Create;
end;

destructor TFontWrapper.Destroy;
begin
FFont.Free;
inherited Destroy;
end;

procedure TFontWrapper.SetFont(f: TFont);
begin
FFont.Assign(f);
end;

procedure TScratchMain.SpeedButton2Click(Sender: TObject);
const
b: Boolean = False;
var
fw: TFontWrapper;
st: TFileStream;
begin
if b then
begin
edit1.text := 'Loading font';
fw := nil;
st := TFileStream.Create('E:\A\test.str', fmOpenRead);
try
fw := TFontWrapper.Create(nil);
st.ReadComponent(fw);
memo1.font.assign(fw.font);
finally
fw.Free;
st.Free;
end;
end
else
begin
edit1.text := 'Saving font';
fw := nil;
st := TFileStream.Create('E:\A\test.str', fmCreate);
try
fw := TFontWrapper.Create(nil);
fw.Font := Font;
st.WriteComponent(fw);
finally
fw.Free;
st.Free;
end;
end;
b := not b;
end;
</div>