Форум: "Начинающим";
Текущий архив: 2006.10.22;
Скачать: [xml.tar.bz2];

Вниз

сохранить шрифт memo в ini файле   Найти похожие ветки 

← →
anton773 ©   (2006-09-30 21:14) [0]

здравствуйте как сохранить параметры шрифта memo в ini файле

---

← →
Anatoly Podgoretsky ©   (2006-09-30 21:25) [1]

Какие именно?

---

← →
Джо ©   (2006-09-30 21:26) [2]

> здравствуйте как сохранить параметры шрифта memo в ini файле

Да, в общем, так же, как и параметры чего-нибудь другого.

---

← →
anton773 ©   (2006-09-30 21:41) [3]

> Какие именно?

все
> Да, в общем, так же, как и параметры чего-нибудь другого

как сохранить строковое свойство понятно: Ini.writeString() числовое значение:Ini.writeinteger() , а вот запись типа Ini.writeFont не прокатит...

---

← →
Джо ©   (2006-09-30 21:43) [4]

> [3] anton773 ©   (30.09.06 21:41)

К каким именно свойством затруднение?

---

← →
Desdechado ©   (2006-09-30 21:43) [5]

Сохраняй нужные тебе свойства фонта (имя, размеры, зачеркивания/курсив/подчеркивания, цвет)

---

← →
Kolan ©   (2006-09-30 21:44) [6]

> anton773 ©   (30.09.06 21:41) [3]
>
>

Так не выйдет. Придется сохронять отдельно все параметры шрифта.

Хотя может можно используя Fake свойства и сериализацию...

http://www.rsdn.ru/article/delphi/serialization.xml

---

← →
anton773 ©   (2006-09-30 22:02) [7]

> К каким именно свойством затруднение?

чесно говоря лень сохранять каждое свойство по отдельности ;-) хочется все сразу. В ин-нете нашел способ : затолкать все свойства в строку ,а потом сохранить её методом WriteString , затем при чтении INI файла разобрать ее на запчасти. Нудно все это :-)

---

← →
Desdechado ©   (2006-09-30 22:05) [8]

> затолкать все свойства в строку
это имхо перректально, для особенных извращенцев

---

← →
anton773 ©   (2006-09-30 22:10) [9]

> это имхо перректально, для особенных извращенцев

Согласен. Поэтому я и обратился на форум для более изящных решений

---

← →
Anatoly Podgoretsky ©   (2006-09-30 22:16) [10]

Все, зачем сохранять - Handle, PixelsPerInch
Не могу понять.

---

← →
Kolan ©   (2006-09-30 22:18) [11]

> Все, зачем сохранять - Handle, PixelsPerInch
> Не могу понять.


Автору: Ну сохрани нужные их там штук 5...

---

← →
anton773 ©   (2006-09-30 22:21) [12]

> Автору: Ну сохрани нужные их там штук 5...

если других вариантов нет - так и поступлю

---

← →
Kolan ©   (2006-09-30 22:25) [13]

Да за это время ужо бы написал процедурку. Вот те интерфейс:
procedure SaveFontToIniFile(FileName: string; Font: TFont);
или
procedure SaveFontToIniFile(IniFile: TIniFile; Font: TFont);
но видимо первое поудобнее :)

---

← →
Loginov Dmitry ©   (2006-09-30 22:43) [14]

anton773 ©   (30.09.06 21:14)
как сохранить параметры шрифта memo в ini файле

Например так:

function FontToString(AFont: TFont): string;
begin
 Result := Format("%s,%d,%d,%d", [AFont.Name, AFont.Size,
   Byte(AFont.Style), AFont.Color]);
end;

---

← →
Loginov Dmitry ©   (2006-09-30 22:44) [15]

и не забыть SaveFontToIniFile

:)

---

← →
Джо ©   (2006-09-30 22:52) [16]

> [9] anton773 ©   (30.09.06 22:10)
>
> > это имхо перректально, для особенных извращенцев
>
> Согласен. Поэтому я и обратился на форум для более изящных
> решений

Вот изящно :)


uses TypInfo;

type
 TPropInfo = record
   Name: string;
   Kind: TTypeKind;
 end;

 TPropInfoArray = array of TPropInfo;

function GetPropertyNames (AClass: TClass): TPropInfoArray;
var
 I,Cnt: Integer;
 Pti: PTypeInfo;
 PPropLst: PPropList;
begin
 Pti := PTypeInfo(AClass.ClassInfo);

 GetMem (PPropLst,High(TPropList));
 try
   Cnt := GetPropList(
     Pti,
     [tkInteger, tkChar, tkEnumeration, tkFloat,
     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
     tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray],
     PPropLst
   );

   SetLength(Result,Cnt);

   for I := 0 to Cnt-1 do
   begin
     Result[I].Name := PPropLst^[I].Name;
     Result[I].Kind := PPropLst^[I].PropType^.Kind;
   end;

 finally
   FreeMem (PPropLst);
 end;
end;

procedure SavePublishedProperties (Obj: TObject; FileName, Section: string);
var
 I: Integer;
 Ini: TIniFile;
 Props: TPropInfoArray;
begin
 Props := GetPropertyNames(Obj.ClassType);

 Ini := TIniFile.Create(FileName);
 try
   for I := 0 to High(Props) do
   begin
     case Props[I].Kind of
       tkInteger:
         begin
           Ini.WriteInteger(Section,Props[I].Name,GetOrdProp(Obj,Props[I].Name));
         end;
       tkString,tkLString:
         begin
           Ini.WriteString(Section,Props[I].Name,GetStrProp(Obj,Props[I].Name));
         end;
       else
         begin
           //raise Exception.Create("Unsupported property type");
         end;
     end;
   end;
 finally
   Ini.Free;
 end;
end;



Пример использования:


procedure TForm1.Button1Click(Sender: TObject);
var
 Fnt: TFont;
begin
 Fnt := TFont.Create;
 try
   SavePublishedProperties(Fnt,"d:\font.ini","Font");
 finally
   Fnt.Free;
 end;
end;


Код, возможно, местами некорректен и, во всяком случае, неполон. Запись остальных типов свойств предоставляю в качестве ДЗ. Равно как и имплементацию SavePublishedProperties.
:)

---

← →
Джо ©   (2006-09-30 22:54) [17]

> [16]

Подходит, естественно, не только для TFont.

---

← →
Джо ©   (2006-09-30 22:55) [18]

> Равно как и имплементацию SavePublishedProperties.

Что ж за день такой?! Имел в виду: LoadPublishedProperties.

---

← →
RASkov   (2006-10-01 01:05) [19]

> anton773


Чуть и я добавлю....

uses ..., IniFiles;
.....
const
  FONTB: set of Byte=[2, 6, 10, 14];
  FONTI: set of Byte=[4, 6, 12, 14];
  FONTU: set of Byte=[8, 10, 12, 14];
......

implementation

{$R *.dfm}

function GetFontStyle(const N: Integer): TFontStyles;
begin
 Result:=[];
 if N in FONTB then Result:=Result+[fsBold];
 if N in FONTI then Result:=Result+[fsItalic];
 if N in FONTU then Result:=Result+[fsUnderline];
end;

function FontStyleToInt(const Fn: TFontStyles): Integer;
begin
 Result:=0;
 if fsBold in Fn then Result:=Result+2;
 if fsItalic in Fn then Result:=Result+4;
 if fsUnderLine in Fn then Result:=Result+8;
end;

procedure GetFontFromIni(const FlIni: String; Fnt: TFont);
var FIni: TIniFile;
begin
 FIni:= TIniFile.Create(FlIni);
 Fnt.Name :=FIni.ReadString("FONTDATA", "FName", "Courier New Cyr");
 Fnt.Color:=TColor(FIni.ReadInteger("FONTDATA", "FColor", clBlack));
 Fnt.Pitch:=TFontPitch(FIni.ReadInteger("FONTDATA", "FPitch", 0));
 Fnt.Size :=FIni.ReadInteger("FONTDATA", "FSize", 8);
 Fnt.Style:=GetFontStyle(FIni.ReadInteger("FONTDATA", "FStyle", 0));
 FIni.Free;
end;

procedure SetFontToIni(const FlIni: String; Fnt: TFont);
var FIni: TIniFile;
begin
 FIni:= TIniFile.Create(FlIni);
 FIni.WriteString ("FONTDATA", "FName", Fnt.Name);
 FIni.WriteInteger("FONTDATA", "FColor", Fnt.Color);
 FIni.WriteInteger("FONTDATA", "FPitch", ORD(Fnt.Pitch));
 FIni.WriteInteger("FONTDATA", "FSize", Fnt.Size);
 FIni.WriteInteger("FONTDATA", "FStyle", FontStyleToInt(Fnt.Style));
 FIni.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 GetFontFromIni(ExtractFilePath(ParamStr(0))+"memo.ini", Memo1.Font);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 SetFontToIni(ExtractFilePath(ParamStr(0))+"memo.ini", Memo1.Font);
end;

---

← →
Джо ©   (2006-10-01 01:14) [20]

> [19] RASkov   (01.10.06 01:05)

Простите, но это ужас! :)
Вот, например — зачем нужна функция FontStyleToInt? Всю ее можно свести к одной простой строке: N := Byte(Font.Style).

---

← →
RASkov   (2006-10-01 01:22) [21]

> [20] Джо ©   (01.10.06 01:14)

Блин, точно

> Что ж за день такой?!

---

← →
RASkov   (2006-10-01 01:41) [22]

В процедуре SetFontToIni
procedure SetFontToIni(const FlIni: String; Fnt: TFont);
...
//исправить на
FIni.WriteInteger("FONTDATA", "FStyle", Byte(Fnt.Style));
...
end;

ну и выделить всю FontStyleToInt и нажать Del :)
затем переписать константы :)

> [21] RASkov   (01.10.06 01:22)

Да... но только теперь нужно константы переделать и...
(забыл в первый раз:) добавить FONTS (зачеркнутый)

> [20] Джо ©   (01.10.06 01:14)

А нельзя ли как-то и от GetFontStyle избавится? ну или тоже к одной строчке привести...?

---

← →
Джо ©   (2006-10-01 01:44) [23]

> [22] RASkov   (01.10.06 01:41)
> А нельзя ли как-то и от GetFontStyle избавится? ну или тоже
> к одной строчке привести...?

var
 N: Byte;
begin
 Font.Style := TFontStyles(N);
end;


---

← →
Джо ©   (2006-10-01 01:46) [24]

Но я бы все-равно рекоммендовал [16], как пример гораздо более универсального подхода :)

---

← →
RASkov   (2006-10-01 01:51) [25]

> [24] Джо ©   (01.10.06 01:46)

Согласен на 150%


> [23] Джо ©   (01.10.06 01:44)

[Error] Unit1.pas(96): Invalid typecast

---

← →
RASkov   (2006-10-01 01:59) [26]

> [23] Джо ©   (01.10.06 01:44)

Извеняюсь за

> [Error] Unit1.pas(96): Invalid typecast

У меня Integer был :)
Джо, Спасибо.

---

← →
RASkov   (2006-10-01 02:12) [27]

С помощью Джо вот что осталось:

uses ..., IniFiles;
.....
procedure GetFontFromIni(const FlIni: String; Fnt: TFont);
var FIni: TIniFile;
begin
 FIni:= TIniFile.Create(FlIni);
 Fnt.Name:=FIni.ReadString("FONTDATA", "FName", "Courier New Cyr");
 Fnt.Color:=TColor(FIni.ReadInteger("FONTDATA", "FColor", clBlack));
 Fnt.Pitch:=TFontPitch(FIni.ReadInteger("FONTDATA", "FPitch", 0));
 Fnt.Size:=FIni.ReadInteger("FONTDATA", "FSize", 8);
 Fnt.Style:=TFontStyles(Byte(FIni.ReadInteger("FONTDATA", "FStyle", 0)));
 FIni.Free;
end;

procedure SetFontToIni(const FlIni: String; Fnt: TFont);
var FIni: TIniFile;
begin
 FIni:= TIniFile.Create(FlIni);
 FIni.WriteString("FONTDATA", "FName", Fnt.Name);
 FIni.WriteInteger("FONTDATA", "FColor", Fnt.Color);
 FIni.WriteInteger("FONTDATA", "FPitch", ORD(Fnt.Pitch));
 FIni.WriteInteger("FONTDATA", "FSize", Fnt.Size);
 FIni.WriteInteger("FONTDATA", "FStyle", Byte(Fnt.Style));
 FIni.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 GetFontFromIni(ExtractFileDir(ParamStr(0))+"\memo.ini", Memo1.Font);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 SetFontToIni(ExtractFileDir(ParamStr(0))+"\memo.ini", Memo1.Font);
end;

[19] - было тренировкой:)
ЗЫ я не настаиваю на своём решении, просто испровляю ошибки...
ЗЫЫ > anton773 технология [16] усе равно гибче, тем самым лучше. ИМХО.

---

← →
RASkov   (2006-10-01 02:15) [28]

надоже написать "просто испровляю ошибки" - и тут же с ошибкой;)
Вот правильно:
"я не настаиваю на своём решении, просто исправляю ошибки"
Усё... пора спать.

---

← →
Юрий Зотов ©   (2006-10-01 02:35) [29]

ObjectBinaryToText
ObjectTextToBinary

И всех дел.
:o)

---

← →
Джо ©   (2006-10-01 02:40) [30]

> [29] Юрий Зотов ©   (01.10.06 02:35)
> ObjectBinaryToText
> ObjectTextToBinary
>
> И всех дел.

У TFont нету WriteToStream, равно как и не выйдет TStream.WriteComponent, по очевидным причинам.

---

← →
Джо ©   (2006-10-01 03:39) [31]

Не корысти ради, а во благо, выкладываю плод бессоницы :о)


uses ..., IniFiles;

type
 TExtendedIniFile = class (TIniFile)
 public
   procedure WriteObject (AObject: TObject; const Section: string);
   procedure ReadObject (AObject: TObject; const Section: string);
 end;

implementation

uses ..., TypInfo;

type
 TPropInfo = record
   Name: string;
   Kind: TTypeKind;
 end;

 TPropInfoArray = array of TPropInfo;

function GetPropertyNames (AClass: TClass): TPropInfoArray;
var
 I,Cnt: Integer;
 Pti: PTypeInfo;
 PPropLst: PPropList;
begin
 Pti := PTypeInfo(AClass.ClassInfo);

 GetMem (PPropLst,High(TPropList));
 try
   Cnt := GetPropList(
     Pti,
     [tkInteger, tkChar, tkEnumeration, tkFloat, tkString,
     tkSet, tkWChar, tkLString, tkWString,tkInt64],
     PPropLst
   );

   SetLength(Result,Cnt);

   for I := 0 to Cnt-1 do
   begin
     Result[I].Name := PPropLst^[I].Name;
     Result[I].Kind := PPropLst^[I].PropType^.Kind;
   end;

 finally
   FreeMem (PPropLst);
 end;

end;

{ TExtendedIniFile }

procedure TExtendedIniFile.ReadObject(AObject: TObject; const Section: string);
var
 I: Integer;
 Props: TPropInfoArray;
 V: Variant;
begin
 Props := GetPropertyNames(AObject.ClassType);
 for I := 0 to High(Props) do
 begin
   case Props[I].Kind of
     tkInteger,tkInt64:
       SetOrdProp(AObject,Props[I].Name,ReadInteger(Section,Props[I].Name,0));

     tkString,tkLString,tkWString,tkChar,tkWChar:
       SetStrProp(AObject,Props[I].Name,ReadString(Section,Props[I].Name,""));

     tkFloat:
       SetFloatProp(AObject,Props[I].Name,ReadFloat(Section,Props[I].Name,0));

     tkEnumeration:
       SetEnumProp(AObject,Props[I].Name,ReadString(Section,Props[I].Name,""));

     tkSet:
       SetSetProp(
         AObject,
         Props[I].Name,
         ReadString (Section,Props[I].Name,"")
       );
   end;
 end;
end;

procedure TExtendedIniFile.WriteObject(AObject: TObject; const Section: string);
var
 I: Integer;
 Props: TPropInfoArray;
 V: Variant;
begin
 Props := GetPropertyNames(AObject.ClassType);

 for I := 0 to High(Props) do
 begin
   V := GetPropValue(AObject,Props[I].Name);

   case Props[I].Kind of
     tkInteger,tkInt64:
       WriteInteger (Section,Props[I].Name,V);

     tkString,tkLString,tkWString,tkChar,tkWChar:
       WriteString (Section,Props[I].Name,V);

     tkFloat:
       WriteFloat (Section,Props[I].Name,V);

     tkEnumeration:
         WriteString (Section,Props[I].Name,
           GetEnumProp(AObject,Props[I].Name));
     tkSet:
       begin
         WriteString(
           Section,
           Props[I].Name,
           GetSetProp(AObject,Props[I].Name,True)
         );
       end;
     else
       begin
         // Этого не должно случиться
         // ибо в GetPropertyNames мы фильтруем
         // только нужные нам типы свойств
         Assert (False,"Unsupported property type");
       end;
   end;

 end;
end;

end.


Пример:


procedure TForm1.Button1Click(Sender: TObject);
var
 Ini: TExtendedIniFile;
begin
 Ini := TExtendedIniFile.Create("d:\form.ini");
 try
   // Сохраняем, что угодно
   Ini.WriteObject(Self,"Form");
   Ini.WriteObject(Font,"Font");

   // Читаем, что угодно
   Ini.ReadObject(Font,"Font");
   Ini.ReadObject(Self,"Form");
 finally
   Ini.Free;
 end;
end;


---
ToDo:
1. Сделать рекурсивные чтение/запись "вложенных" классов, т.е., включить в "фильтр" в функции GetPropertyNames тип tkClass и обрабатывать его в соответствующих методах записи/чтения рекурсивно.
2. Устранить (возможную) утечку памяти в GetPropertyNames — чую, что она там должна быть, но уже лень проверять :0)

---

← →
anton773 ©   (2006-10-01 04:13) [32]

всем спасибо. разобрался!

---

← →
Карелин Артем ©   (2006-10-02 09:18) [33]

По-моему приведение шрифта без стиля к байту и обратное преобразование байта 0 в стиль даст [fsBold]. Попраьте меня если что, ибо год уже не пишу на дельфи.

---

← →
Loginov Dmitry ©   (2006-10-02 10:04) [34]

> Карелин Артем ©   (02.10.06 09:18)


А вот и нет! Стилю fsBold соответстует установленный младший бит.

---

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

Форум: "Начинающим";
Текущий архив: 2006.10.22;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.55 MB
Время: 0.03 c