Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.10.26;
Скачать: [xml.tar.bz2];

Вниз

Сохранить TFont в INI - файл как Data   Найти похожие ветки 

 
koha!   (2008-09-19 06:03) [0]

как сохранять в ини-файлы структуры это понятно, а как можно из свойства Tfont скопировать структуру TFontData с минимальными усилиями не распарсивая.

Var
 INI  : TIniFile;
 Strm : TStringStream;
 Buff : String;
 SizeBuff: Integer;
 FD: TFontData;
begin
 Result := False;
 try
   try
     INI:=TIniFile.Create(CurPath+ConfigFile);

     With INI do begin
       
       SizeBuff:=SizeOf(FD);
       SetLength(buff,SizeBuff);
       FillChar(Buff[1],SizeBuff,0);
       Strm := TStringStream.Create(Buff);
       
        //примерно так можно сохранить одним разом все свойста,
       WriteBinaryStream(FontSection,"FontConfig",Strm);
     
   

     end;
     Result := true;
   finally
     INI.Free;
   end;
 except
   on E: Exception do
      MessageBox(0,PChar(E.ClassName+" ????????? ??????, ? ?????????? : "+E.Message),
      PChar("MSGLoger"),MB_ICONERROR);
 end;


Но вот как TFontData скопировать ее из Тfont?


 
Сергей М. ©   (2008-09-19 08:45) [1]

Что такое "TFontData" ?

И почему WriteBinaryStream, в товремя как стрим заведомо текстовый ?


 
koha!   (2008-09-19 10:09) [2]

TFontData - структура содержащая свойства шрифта в VCL
WriteBinaryStream чтобы сохранить БИНАРНУЮ сериализацию структуры в файл INI
Вопрс как получить из переменной типа TFont стуктуру TFontData


 
Сергей М. ©   (2008-09-19 10:22) [3]

Ты в Инспекторе Объектов свойства фонта видишь в каком виде ?
В текстовом виде ты их видишь)
И хранятся эти свойтва в dfm тоже в текстовом виде.

Так за каким же лешим нужно представлять все это добро в бинарном виде, если оно расчудесно записывается, хранится и считывается в виде текста ?

Ведь ini-контейнер в этом плане ничем не отличается от dfm-контейнера ..


 
koha!   (2008-09-19 23:57) [4]

Для себя я уже нашел решение, жаль что с разу не отпостился на форуме, просто интеренет не всегда доступен бывает.

{------------------------------ WriteINISettings ------------------------------}
Function WriteINISettings: boolean;
Var
 INI  : TIniFile;
 SizeBuff: Integer;
 FontConf: TFontConfigRec;
 mstrm : TMemoryStream;
begin
 Result := False;
 try
   try
     INI:=TIniFile.Create(CurPath+ConfigFile);

     With INI do begin
       // 1. первый традиционныц способ

       WriteString(FontSection,"Name",FontSettings.Name);
       WriteInteger(FontSection,"Height",FontSettings.Height);
       WriteInteger(FontSection,"Orientation",FontSettings.Orientation);
       WriteInteger(FontSection,"Pitch",Integer(TFontPitch(FontSettings.Pitch)));
       WriteInteger(FontSection,"Size",FontSettings.Size);
       // Вот это уже не прет >>>> WriteInteger(FontSection,"Style",Integer(TFontStylesBase(FontSettings.Style)));
       // Попробуй те сохранить множестыенный параметр, если он будет таким FontSettings.Style:=[fsBold,fsItalic]
       WriteInteger(FontSection,"Charset",Integer(TFontCharset(FontSettings.Charset)));
     
       //2. способ...
       //Из кода явно видно что вариант два на много упрощает сохранение параметра шрифта

       if GetObject(FontSettings.Handle,SizeOf(FontConf.LogFont),@FontConf.LogFont) > 0 then begin
         FontConf.Color := FontSettings.Color;
         mstrm:=TMemoryStream.Create;
         mstrm.Write(FontConf,SizeOf(FontConf));
         mstrm.Seek(soFromEnd,soFromBeginning);
         WriteBinaryStream(FontSection,"FontConfig",mstrm);
       end;

     end;
     Result := true;
   finally
     mstrm.Free;
     INI.Free;
   end;
 except
   on E: Exception do
      MessageBox(0,PChar(E.ClassName+" произошла ошибка, с сообщением : "+E.Message),
      PChar("MSGLoger"),MB_ICONERROR);
 end;
end;


 
koha!   (2008-09-20 00:02) [5]

вот еще тип структуры забыл упомянуть для примера нужна:

Type
 TFontConfigRec = packed record
   Color   : TColor;
   LogFont : TLogFont;
 end;


 
KilkennyCat ©   (2008-09-20 00:17) [6]

type
 IIFont = class(TFont);

 pSaveFont = ^ISaveFont;
 ISaveFont = packed record
  CharSet : TFontCharSet;
  Color   : TColor;
  Pitch   : TFontPitch;
  Size    : Word;
  Style   : TFontStyles;
 end;

procedure TDataFile.ReadFont(Section, Ident: string; Font: TFont);
var
 Buf   : TMemoryStream;
 pPos  : PChar;
 pBuf  : Pointer;
 Count : Integer;
 FontChange: TNotifyEvent;
begin
 try
  Buf   := TMemoryStream.Create;
  Count := ReadStream(Section, Ident, Buf);
  if( Count > SizeOf(ISaveFont))then
  begin
   try
    GetMem(pBuf, Count);
    Buf.Seek(0, soFromBeginning);
    Buf.Read(pBuf^, Count);
    FontChange := Font.OnChange;
    Font.OnChange := nil;
    Font.Charset := pSaveFont(pBuf)^.CharSet;
    Font.Color := pSaveFont(pBuf)^.Color;
    Font.Pitch := pSaveFont(pBuf)^.Pitch;
    Font.Size  := pSaveFont(pBuf)^.Size;
    Font.Style := pSaveFont(pBuf)^.Style;
    pPos := pBuf;
    inc(pPos, SizeOf(ISaveFont));
    Font.Name := StrPas(pPos);
   finally
    Font.OnChange := FontChange;
    IIFont(Font).Changed;
    FreeMem(pBuf, Count);
   end;
  end;
 finally
  Buf.Free;
 end;
end;

procedure TDataFile.WriteFont(Section, Ident: string; Font: TFont);
var
 pBuf: Pointer;
 pPos: PChar;
 Len : Integer;
begin
 try
  Len := SizeOf(ISaveFont) + Length(Font.Name) + 1;
  GetMem(pBuf, Len);
  pSaveFont(pBuf)^.CharSet := Font.Charset;
  pSaveFont(pBuf)^.Color := Font.Color;
  pSaveFont(pBuf)^.Pitch := Font.Pitch;
  pSaveFont(pBuf)^.Size  := Font.Size;
  pSaveFont(pBuf)^.Style := Font.Style;
  pPos := pBuf;
  inc(pPos, SizeOf(ISaveFont));
  StrPCopy(pPos, Font.Name);
  WriteData(Section, Ident, pBuf, Len);
 finally
  FreeMem(pBuf, Len);
 end;
end;


(с)Product:       TDataFile
Version:  1.16
Author: Momot Alexander
Web:  http://www.dbwork.kuban.ru


 
koha!   (2008-09-20 00:19) [7]

Раз такое дело то вот еще и сразу покажу пример и для чтения параметров
Эти примеры нашел на ресурсе _www.delphiworld.narod.ru только вних имелось ввиду сохранение параметров Tfont в реестр.

//................................................................................ ..
Type
 TFontConfigRec = packed record
   Color   : TColor;
   LogFont : TLogFont;
 end;

Var
 LogFile      : String;
 CurPath      : String;
 FontSettings : TFont;

Const
 FontSection = "FONTSETTINGS";
 ConfigFile  = "Config.ini";

//................................................................................ ...

{------------------------------- ReadINISettings ------------------------------}
Function ReadINISettings: boolean;
Var
 INI  : TIniFile;
 strm : TStringStream;
 buff : String;
 FontRec: TFontConfigRec;
begin
 Result := False;
 try
   try
     INI:=TIniFile.Create(CurPath+ConfigFile);
     With INI do begin

       strm:=TStringStream.Create(Buff);
       ReadBinaryStream(FontSection,"FontConfig",strm);

       if Length(strm.DataString) = SizeOf(FontRec) then begin
         Move(strm.DataString[1],FontRec,SizeOf(FontRec));
         FontSettings.Handle := CreateFontIndirect(FontRec.LogFont);
         FontSettings.Color  := FontRec.Color;
       end else Exit;
     
     end;
     Result:=true;
   finally
     strm.Free;
     INI.Free;
   end;
 except
   on E: Exception do
      MessageBox(0,PChar(E.ClassName+" ????????? ??????, ? ?????????? : "+E.Message),
      PChar("MSGLoger"),MB_ICONERROR);
 end;
end;


 
{RASkov} ©   (2008-09-20 01:01) [8]

Как все сложно :)

> // Попробуй те сохранить множестыенный параметр, если он
> будет таким FontSettings.Style:=[fsBold,fsItalic]

Да легко
WriteInteger(FontSection, "Style", Byte(Fnt.Style));
Его чтение:
Fnt.Style:=TFontStyles(Byte(ReadInteger(FontSection, "Style", 0)));
где Fnt - TFont;
:)


 
Германн ©   (2008-09-20 01:08) [9]


> {RASkov} ©   (20.09.08 01:01) [8]
>
> Как все сложно :)
>
> > // Попробуй те сохранить множестыенный параметр, если
> он
> > будет таким FontSettings.Style:=[fsBold,fsItalic]
>
> Да легко

Чтобы было легко надо твердо выучить азбуку. А с этим видно проблема. Начал без изучения азбуки, теперь мучается.


 
Германн ©   (2008-09-20 01:28) [10]


> {RASkov} ©   (20.09.08 01:01) [8]

Но

> WriteInteger(FontSection, "Style", Byte(Fnt.Style));

всё равно не наш метод!
Я бы предпочел:
WriteString(FontSection, "Style", IntToHex(Byte(Fnt.Style),2))
и
Fnt.Style:=TFontStyles(Byte(StrToInt("$"+ReadString(FontSection, "Style", "0")));

То же самое, но не люблю слишком часто включать "встроенный" в мой мозг калькулятор для конверта из десятичного в двоичный. :)


 
{RASkov} ©   (2008-09-20 01:35) [11]

> [10] Германн ©   (20.09.08 01:28)
> всё равно не наш метод!

А мне что FF что 255 - одна фикня непонятная :( Это я про калькулятор :)


 
koha!   (2008-09-20 01:41) [12]


> Чтобы было легко надо твердо выучить азбуку. А с этим видно
> проблема. Начал без изучения азбуки, теперь мучается.


И вовсе не мучаюсь,, Дело вовсе не в азбуке, просто нужно так было сделать, ну, вот, просто хочу сделать таким методом, нужно же осваивать все способы записи - чтения, рано или поздно придется и с ними столкнуться.
Ну, кто без ошибок - брось первый камень....


 
KilkennyCat ©   (2008-09-20 01:53) [13]

Бросаю!
(я никогда не признаю своих ошибок) :Р


 
Германн ©   (2008-09-20 01:54) [14]


> {RASkov} ©   (20.09.08 01:35) [11]

Не прибедняйся. Не верю! (с)


 
KilkennyCat ©   (2008-09-20 01:56) [15]

ff и 255 - это разные вещи.


 
{RASkov} ©   (2008-09-20 01:57) [16]

> [14] Германн ©   (20.09.08 01:54)
> Не верю!

:(
Как доказать? :)


 
{RASkov} ©   (2008-09-20 01:58) [17]

> [15] KilkennyCat ©   (20.09.08 01:56)

Точно... Первые - это буквы, а вторые - цифры :)


 
Германн ©   (2008-09-20 01:58) [18]


> koha!   (20.09.08 01:41) [12]
>
>
> > Чтобы было легко надо твердо выучить азбуку. А с этим
> видно
> > проблема. Начал без изучения азбуки, теперь мучается.
>
>
> И вовсе не мучаюсь,, Дело вовсе не в азбуке

Именно мучаешься. И дело именно в азбуке. Именно в азбуке Паскаля описан тип set и то, как он хранится в памяти. А ты азбуку не учил и не знаешь основ. Вот потому и мучаешься.


 
Германн ©   (2008-09-20 02:01) [19]


> KilkennyCat ©   (20.09.08 01:56) [15]
>
> ff и 255 - это разные вещи.
>

Кота понесло. Ну если на крышу, то это ещё пустяки. Хотя вроде сентябрь, а не март?


 
KilkennyCat ©   (2008-09-20 02:12) [20]

Главное, чтоб не пронесло... это неприятно, независимо от месяца.


 
Германн ©   (2008-09-20 02:19) [21]


> KilkennyCat ©   (20.09.08 02:12) [20]
>
> Главное, чтоб не пронесло... это неприятно, независимо от
> месяца.
>

- Что пил?
- Зубровку.
- Точно.
(с) Семь стариков и одна девушка.
За сим прекратим сие общение.


 
Koha!   (2008-09-20 06:29) [22]


> Германн ©   (20.09.08 01:58) [18]


Не, просто я не не смотрел как объявлен тип в "Graphics"..... да и кому это нужно было выяснять, кто от чего страдает, я же ни кого не упрекаю, что кто - то страдает, от чрезмерной мании величия... Это все можно было  решить просто, без взаимных упреков, такой подход, как будто я не выучил урок и пришел экзамены сдавать, вот она ваша преподавательская заносчивость, даже в повседневной жизни, дома и среди друзей , наверное тоже,  "Ставите кафедру"...   А то, действительно как, детский сад .....  (На этот пост можно не отвечать)



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

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

Наверх




Память: 0.52 MB
Время: 0.005 c
6-1194522830
Андрей_Св
2007-11-08 14:53
2008.10.26
Сервер


2-1221822500
burrat
2008-09-19 15:08
2008.10.26
передать данные в другое приложение


2-1221992928
voprsest
2008-09-21 14:28
2008.10.26
поиск дочерних окон


10-1150270549
Grant
2006-06-14 11:35
2008.10.26
Работа с Excel


15-1220599042
noob_one
2008-09-05 11:17
2008.10.26
Как перенести Delphi на новую windows?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский