Текущий архив: 2006.04.30;
Скачать: CL | DM;

Вниз

Класс для хранения шрифта и его настроек в файле   Найти похожие ветки 

← →
Дмитрий_177   (2006-04-12 11:58) [0]

Подскажите пожалуйста как сохранять шрифт TFont в файле? Но так что вдруг на компъютере пользователя не окажется такого шрифта, вот я решил еще в файл записывать сам файл шрифта. Я что-то такое сделал подскажите пожалуйста если я что-то делаю не так... А еще как отображать например в Label уже сохраненный ttf-файл шрифта в потоке не сохраняя его на диск? (В коде программы я показал где, там понятнее наверно будет):

type
TFSFont = class
 private
   FColor: TColor;
   FSize: Integer;
   FName: ShortString;
   FBold: Boolean;
   FItalic: Boolean;
   FUnderline: Boolean;
   FStrikeOut: Boolean;
   FFileFont: TMemoryStream;
   procedure SetColor(Value: TColor);
   procedure SetSize(Value: Integer);
   procedure SetName(Value: ShortString);
   procedure SetBold(Value: Boolean);
   procedure SetItalic(Value: Boolean);
   procedure SetUnderline(Value: Boolean);
   procedure SetStrikeOut(Value: Boolean);
   procedure SetFileFont(const Value: TMemoryStream);
 protected
   procedure SaveToStream(AStream: TStream);
   procedure LoadFromStream(AStream: TStream);
 public
   constructor Create;
   destructor Destroy; override;
   property Color: TColor read FColor write SetColor;
   property Size: Integer read FSize write SetSize;
   property Name: ShortString read FName write SetName;
   property Bold: Boolean read FBold write SetBold;
   property Italic: Boolean read FItalic write SetItalic;
   property Underline: Boolean read FUnderline write SetUnderline;
   property StrikeOut: Boolean read FStrikeOut write SetStrikeOut;
   property FileFont: TMemoryStream read FFileFont write SetFileFont;
 end;

implementation

constructor TFSFont.Create;
begin
 inherited;
 FFileFont := TMemoryStream.Create;
end;

destructor TFSFont.Destroy;
begin
 FFileFont.Free;
 inherited;
end;

procedure TFSFont.SetColor(Value: TColor);
begin
 FColor := Value
end;

procedure TFSFont.SetSize(Value: Integer);
begin
 FSize := Value
end;

procedure TFSFont.SetName(Value: ShortString);
begin
 FName := Value
end;

procedure TFSFont.SetBold(Value: Boolean);
begin
 FBold := Value
end;

procedure TFSFont.SetItalic(Value: Boolean);
begin
 FItalic := Value
end;

procedure TFSFont.SetUnderline(Value: Boolean);
begin
 FUnderline := Value
end;

procedure TFSFont.SetStrikeOut(Value: Boolean);
begin
 FStrikeOut := Value
end;

procedure TFSFont.SetFileFont(const Value: TMemoryStream);
begin
FFileFont.LoadFromStream(Value)
end;

procedure TFSFont.SaveToStream(AStream: TStream);
var
 Cnt: Int64;
begin
 AStream.Write(FColor, SizeOf(TColor));
 AStream.Write(FSize, SizeOf(Integer));
 AStream.Write(FName, SizeOf(ShortString));
 AStream.Write(FBold, SizeOf(Boolean));
 AStream.Write(FItalic, SizeOf(Boolean));
 AStream.Write(FUnderline, SizeOf(Boolean));
 AStream.Write(FStrikeOut, SizeOf(Boolean));

 FFileFont.Position := 0;
 Cnt := FFileFont.Size;
 AStream.Write(Cnt, SizeOf(Cnt));
 AStream.CopyFrom(FFileFont, Cnt);
end;

procedure TFSFont.LoadFromStream(AStream: TStream);
var
 Cnt: Int64;
begin
 AStream.Read(FColor, SizeOf(FColor));
 AStream.Read(FSize, SizeOf(FSize));
 AStream.Read(FName, SizeOf(FName));
 AStream.Read(FBold, SizeOf(FBold));
 AStream.Read(FItalic, SizeOf(FItalic));
 AStream.Read(FUnderline, SizeOf(FUnderline));
 AStream.Read(FStrikeOut, SizeOf(FStrikeOut));

 AStream.Read(Cnt, SizeOf(Cnt));
 FFileFont.CopyFrom(AStream, Cnt);
end;

procedure TFSFont.SaveToFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmCreate);
 try
   SaveToStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TFSFont.LoadFromFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName, fmOpenRead);
 try
   LoadFromStream(Fs);
 finally
   Fs.Free;
 end;
end;


Использование в программе:


var
Font: TFont;  // сохраняемый и загружаемый шрифт

// кнопка "сохранить"
procedure TForm1.Button1Click(Sender: TObject);
var
 FSFont: TFSFont;
 Fs: TFileStream;
begin
 FSFont := TFSFont.Create;
 try
   Fs := TFileStream.Create("c:\Fonts\crystal.ttf", fmOpenRead);
   try
     FSFont.FileFont.LoadFromStream(Fs);
   finally
     Fs.Free;
   end;

   FSFont.Color := Font.Color;
   FSFont.Size := Font.Size;
   FSFont.Name := Font.Name;
   if fsBold in Font.Style then FSFont.Bold := true;
   if fsItalic in Font.Style then FSFont.Italic := true;
   if fsUnderline in Font.Style then FSFont.Underline := true;
   if fsStrikeOut in Font.Style then FSFont.StrikeOut := true;

   FSFont.SaveToFile("c:\test.font");
 finally
   FSFont.Free;
 end;
end;

// кнопка "загрузить"
procedure TForm1.Button2Click(Sender: TObject);
var
 FSFont: TFSFont;
 Fs: TFileStream;
begin
 FSFont := TFSFont.Create;
 try
   FSFont.LoadFromFile("c:\test.font");

   //  вот как здесь считать поток шрифта FSFont.FileFont и отобразить его например в Label не сохраняя на диск я не знаю...=((( Поскажите плиз!!!

   Font.Color :=  FSFont.Color;
   Font.Size := FSFont.Size;
   Font.Name := FSFont.Name;
   if FSFont.Bold then Font.Style := Font.Style + [fsBold];
   if FSFont.Italic then Font.Style := Font.Style + [fsItalic];
   if FSFont.Underline then Font.Style := Font.Style + [fsUnderline];
   if FSFont.StrikeOut then Font.Style := Font.Style + [fsStrikeOut];
 finally
   FSFont.Free;
 end;
end;


---

← →
Игорь Шевченко ©   (2006-04-12 12:05) [1]

> );
>
>    //  вот как здесь считать поток шрифта FSFont.FileFont
> и отобразить его например в Label не сохраняя на диск я
> не знаю...=((( Поскажите плиз!!!
>
>    Font.Color :=  FSFont.Color;
>    Font.Size := FSFont.Size;
>    Font.Name := FSFont.Name;
>    


Label1.Font.Color := ...
Label1.Font.Size := ...
....

---

← →
Дмитрий_177   (2006-04-12 12:12) [2]

да нет.. я имел ввиду сам ttf-файл, который находится в потоке

---

← →
Игорь Шевченко ©   (2006-04-12 12:40) [3]

> я имел ввиду сам ttf-файл, который находится в потоке


То есть, ты сохраняешь сами глифы, которых в системе возможно не будет ?
Тогда AddFontResource(Ex) наверное тебе поможет.

---

← →
Дмитрий_177   (2006-04-12 12:45) [4]

да... но...  AddFontResourceEx работает с файлом шрифта а не с его потоком =(((

---

← →
Desdechado ©   (2006-04-12 12:52) [5]

> вдруг на компъютере пользователя не окажется такого шрифта
система подставит наиболее подходящий по другим параметрам

или же просто тиражируй этот экзотический шрифт вместе с программой, регистрируя его в системе на время работы программы через AddFontResource

---

← →
Игорь Шевченко ©   (2006-04-12 12:53) [6]

> AddFontResourceEx работает с файлом шрифта а не с его потоком
> =(((


Никто же не мешает сохранить глифы из потока в файл.

---

← →
Дмитрий_177   (2006-04-12 12:54) [7]

> или же просто тиражируй этот экзотический шрифт вместе с
> программой, регистрируя его в системе на время работы программы
> через AddFontResource


Да нет... в этом то вся и фишка что ненадо так... я бы уже давно сделал так...

---

← →
Дмитрий_177   (2006-04-12 12:56) [8]

> Никто же не мешает сохранить глифы из потока в файл.


Это понятно... а вот без этого никак нельзя? не сохраняя в файле а работать только с потоком...

---

← →
Desdechado ©   (2006-04-12 13:03) [9]

а зачем такие махинации?
засунь в ресурс EXE

---

← →
Дмитрий_177   (2006-04-12 13:08) [10]

> засунь в ресурс EXE


И так тоже ненадо...

Буду тогда поток сохранять во временный файл... А сам код правильный?

---

← →
Leonid Troyanovsky ©   (2006-04-12 13:08) [11]

> Дмитрий_177   (12.04.06 11:58)  

> Подскажите пожалуйста как сохранять шрифт TFont в файле?
>  Но так что вдруг на компъютере пользователя не окажется
> такого шрифта, вот я решил еще в файл записывать сам файл
> шрифта. Я что-то такое сделал подскажите пожалуйста если
> я что-то делаю не так...


msdn: AddFontResource(Ex)

--
Regards, LVT.

---

← →
begin...end ©   (2006-04-12 13:10) [12]

> Дмитрий_177   (12.04.06 12:56) [8]

AddFontMemResourceEx ?

---

← →
Leonid Troyanovsky ©   (2006-04-12 13:16) [13]

> Дмитрий_177   (12.04.06 13:08) [10]

> > засунь в ресурс EXE

> И так тоже ненадо...


Лучше уж в ресурс, чем в левый стрим.

--
Regards, LVT.

---

← →
Дмитрий_177   (2006-04-12 13:26) [14]

Ненадо мне в ресурс... Я бы так сделал бы уже... а именно так как я спросил

---

← →
Дмитрий_177   (2006-04-12 13:27) [15]

> begin...end


AddFontMemResourceEx попробую с этой функцие чтонибудь сделать, никогда не слышал о такой раньше...

---

← →
Дмитрий_177   (2006-04-12 17:56) [16]

AddFontMemResourceEx(@FSFont.FileFont, SizeOf(FSFont.FileFont), 0, 0);   не работает =(((

---

← →
Дмитрий_177   (2006-04-12 18:15) [17]

AddFontMemResourceEx(Pointer(FSFont.FileFont), SizeOf(FSFont.FileFont), 0, 0); и так пробовал, тоже не работает =(((

---

← →
Дмитрий_177   (2006-04-12 22:33) [18]

Попробовал сделать так:

var
F: File;

...

Fs := TFileStream.Create(TFileRec(F).Handle);
Fs.CopyFrom(FSFont.FileFont, FSFont.FileFont.Size);
Fs.Free;

AddFontResource(TFileRec(F).Name);

Выскакивает ошибка "Stream read Error" =(((

---

← →
Дмитрий_177   (2006-04-13 01:47) [19]

Кстати без строки "AddFontResource(TFileRec(F).Name);" всеравно ошибка выскакивает... почему-то поток неправильно записывается чтоли... и даже незнаю в чем ошибка =((((

---

Страницы: 1 вся ветка

Текущий архив: 2006.04.30;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.038 c