Форум: "Начинающим";
Текущий архив: 2006.04.30;
Скачать: [xml.tar.bz2];
ВнизКласс для хранения шрифта и его настроек в файле Найти похожие ветки
← →
Дмитрий_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;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.009 c