Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Сохранение шрифта таблицы в ini-файл


Автор: Mick Winder 11.11.2004, 15:48
Создаю ini-файл, куда записываю все параметры размеров формы, фон и шрифт таблицы...
Есть проблема записи в ini-файл параметров шрифта... Как решить проблему со шрифтами...
Исходный код ниже:

procedure TForm1.FormDestroy(Sender: TObject);
var
Ini: Tinifile;
begin
Ini:= TiniFile.Create(extractfilepath(paramstr(0))+'MyIni.ini');
Ini.WriteInteger('Size', 'Width', form1.Width);
Ini.WriteInteger('Size', 'Height', form1.Height);
Ini.WriteInteger('Position', 'X', form1.Left);
Ini.WriteInteger('Position', 'Y', form1.Top);
Ini.WriteInteger('Grid', 'ColorColums[0]', DBGridEh1.Columns.Items[0].Color);
Ini.WriteInteger('Grid', 'ColorTitle[0]', DBGridEh1.Columns.Items[0].Title.Color);
Ini.WriteInteger('Grig', 'FontTitle', DBGrideh1.Columns.Items[0].Title.Font); // проблема
Ini.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Ini: Tinifile;
i: Integer;
begin
Ini:= TiniFile.Create(extractfilepath(paramstr(0))+'MyIni.ini');
Form1.Width:= Ini.ReadInteger('Size', 'Width', 100);
Form1.Height:= Ini.ReadInteger('Size', 'Height', 100);
Form1.Left:= Ini.ReadInteger('Size', 'X', 10);
Form1.Top:= Ini.ReadInteger('Size', 'Y', 10);
DBGridEh1.Columns.Items[0].Color:= Ini.ReadInteger('Grid', 'ColorColums[0]', clWhite);
DBGridEh1.Columns.Items[0].Title.Color:= Ini.ReadInteger('Grid', 'ColorTitle[0]', clLtGray);
for i:=1 to DBgridEh1.Columns.Count -1 do
DBGrideh1.Columns.Items[i]Title.Font:= Ini.ReadInteger('Grid', 'FontTitle', 0);
Ini.Free;
end;

Автор: Dimich 11.11.2004, 17:01
Код

Ini.WriteInteger('Grig', 'FontTitle', DBGrideh1.Columns.Items[0].Title.Font);

Да, тут действительно проблема... Именно так, как написано - не получится. Конфликт типов TFont и Integer.
Думаю, надо сохранять для шрифта все его параметры (Name, Color, Height, Size, Style и т.д.), а потом их загружать. Собственно так должно получиться.

Автор: Mick Winder 11.11.2004, 17:50
Попробовал написать...
Ini.WriteString('Grig', 'FontTitleStyle', DBGridEh1.Columns.Items[0].Title.Font.Style);
или
Ini.WriteInteger('Grig', 'FontTitleStyle', DBGridEh1.Columns.Items[0].Title.Font.Style);

Все равно конфликт типов String или Integer и TFontStyle... Что делать?

Автор: Гость_Pakshin A. S. 11.11.2004, 18:00
Отдельно прописываем все опции класса TFont. TFontStyle можно прописать через integer...

А вообще, по культуре, заведи отдельный файл (типизированный), тип которого будет состоять из патаметров Font'а... и писать отдельный файл, не ini...

Автор: Alex 11.11.2004, 20:39
Код

function FontToStr(font: TFont): string;
 procedure yes(var str: string);
 begin

   str := str + 'y';
 end;
 procedure no(var str: string);
 begin

   str := str + 'n';
 end;
begin

 {кодируем все атрибуты TFont в строку}
 Result := '';
 Result := Result + IntToStr(font.Color) + '|';
 Result := Result + IntToStr(font.Height) + '|';
 Result := Result + font.Name + '|';
 Result := Result + IntToStr(Ord(font.Pitch)) + '|';
 Result := Result + IntToStr(font.PixelsPerInch) + '|';
 Result := Result + IntToStr(font.size) + '|';
 if fsBold in font.style then
   yes(Result)
 else
   no(Result);
 if fsItalic in font.style then
   yes(Result)
 else
   no(Result);
 if fsUnderline in font.style then
   yes(Result)
 else
   no(Result);
 if fsStrikeout in font.style then
   yes(Result)
 else
   no(Result);
end;

procedure StrToFont(str: string; font: TFont);
begin

 if str = '' then
   Exit;
 font.Color := StrToInt(tok('|', str));
 font.Height := StrToInt(tok('|', str));
 font.Name := tok('|', str);
 font.Pitch := TFontPitch(StrToInt(tok('|', str)));
 font.PixelsPerInch := StrToInt(tok('|', str));
 font.Size := StrToInt(tok('|', str));
 font.Style := [];
 if str[0] = 'y' then
   font.Style := font.Style + [fsBold];
 if str[1] = 'y' then
   font.Style := font.Style + [fsItalic];
 if str[2] = 'y' then
   font.Style := font.Style + [fsUnderline];
 if str[3] = 'y' then
   font.Style := font.Style + [fsStrikeout];
end;

function tok(sep: string; var s: string): string;

 function isoneof(c, s: string): Boolean;
 var
   iTmp: integer;
 begin
   Result := False;
   for iTmp := 1 to Length(s) do
   begin
     if c = Copy(s, iTmp, 1) then
     begin
       Result := True;
       Exit;
     end;
   end;
 end;
var

 c, t: string;
begin

 if s = '' then
 begin
   Result := s;
   Exit;
 end;
 c := Copy(s, 1, 1);
 while isoneof(c, sep) do
 begin
   s := Copy(s, 2, Length(s) - 1);
   c := Copy(s, 1, 1);
 end;
 t := '';
 while (not isoneof(c, sep)) and (s <> '') do
 begin
   t := t + c;
   s := Copy(s, 2, length(s) - 1);
   c := Copy(s, 1, 1);
 end;
 Result := t;
end;

Автор: Medved 12.11.2004, 03:12
Alex, про Charset забыл.

В помощь:
Код

TFontCharset = 0..255;

Автор: Alex 12.11.2004, 09:33
Цитата(Pegas @ 12.11.2004, 03:12)
Alex, про Charset забыл.

Значит DRKB подправим smile

Автор: Alex 12.11.2004, 09:52
Я добавил, но это не пример, это кошмар smile

Код

function FontToStr(font: TFont): string;
 procedure yes(var str: string);
 begin
   str := str + 'y';
 end;
 procedure no(var str: string);
 begin
   str := str + 'n';
 end;
begin

{кодируем все атрибуты TFont в строку}
Result := '';
Result := Result + IntToStr(font.Color) + '|';
Result := Result + IntToStr(font.Height) + '|';
Result := Result + font.Name + '|';
Result := Result + IntToStr(Ord(font.Pitch)) + '|';
Result := Result + IntToStr(font.PixelsPerInch) + '|';
Result := Result + IntToStr(font.size) + '|';
Result := Result + IntToStr(font.Charset) + '|';
if fsBold in font.style then
  yes(Result)
else
  no(Result);
if fsItalic in font.style then
  yes(Result)
else
  no(Result);
if fsUnderline in font.style then
  yes(Result)
else
  no(Result);
if fsStrikeout in font.style then
  yes(Result)
else
  no(Result);
end;

function tok(sep: string; var s: string): string;

function isoneof(c, s: string): Boolean;
var
  iTmp: integer;
begin
  Result := False;
  for iTmp := 1 to Length(s) do
  begin
    if c = Copy(s, iTmp, 1) then
    begin
      Result := True;
      Exit;
    end;
  end;
end;
var

c, t: string;
begin

if s = '' then
begin
  Result := s;
  Exit;
end;
c := Copy(s, 1, 1);
while isoneof(c, sep) do
begin
  s := Copy(s, 2, Length(s) - 1);
  c := Copy(s, 1, 1);
end;
t := '';
while (not isoneof(c, sep)) and (s <> '') do
begin
  t := t + c;
  s := Copy(s, 2, length(s) - 1);
  c := Copy(s, 1, 1);
end;
Result := t;
end;

procedure StrToFont(str: string; font: TFont);
begin

if str = '' then
  Exit;
font.Color := StrToInt(tok('|', str));
font.Height := StrToInt(tok('|', str));
font.Name := tok('|', str);
font.Pitch := TFontPitch(StrToInt(tok('|', str)));
font.PixelsPerInch := StrToInt(tok('|', str));
font.Size := StrToInt(tok('|', str));
font.Charset := StrToInt(tok('|', str));
font.Style := [];
if str[2] = 'y' then
  font.Style := font.Style + [fsBold];
if str[3] = 'y' then
  font.Style := font.Style + [fsItalic];
if str[4] = 'y' then
  font.Style := font.Style + [fsUnderline];
if str[5] = 'y' then
  font.Style := font.Style + [fsStrikeout];
end;


Я вечером нормальный сделаю и выложу

Автор: p0s0l 12.11.2004, 11:42
Я бы сделал так:
Код
uses TypInfo;

function GetObjectSettings (Obj : TObject) : string;
var
 pl : PPropList;
 i, Count : integer;
 v : Variant;
 s : string;

begin
 Result := '';
 Count := GetPropList (obj.ClassInfo, pl);
 for i := 0 to Count-1 do
 begin
   v := GetPropValue(Obj, pl^[i].Name, False);
   try s := v; except s := FloatToStr(v); end;
   Result := Result + s + '|';
 end;
end;

procedure SetObjectSettings (Obj : TObject; Value : string);
var
 pl : PPropList;
 i, Count : integer;
 v : Variant;

begin
 Count := GetPropList (obj.ClassInfo, pl);
 for i := 0 to Count-1 do
 begin
   v := Copy(Value, 1, Pos('|', Value)-1);
   Delete (Value, 1, Pos('|', Value));
   try SetPropValue(Obj, pl^[i].Name, v);
   except SetPropValue(Obj, pl^[i].Name, StrToInt(v));
   end;
 end;
end;
Только Tools -> Debugger Options -> Language Exceptions -> Stop on Delphi Exceptions должны быть отключены (по умолчанию это в Delphi включено, но я сразу это вырубаю после установки Delphi)...

Пользоваться так:
GetObjectSettings (Button1.Font) - вовзращает инфу о Fontе кнопки в виде строки
SetObjectSettings (Button1.Font, s) - Font кнопки грузится из строки s

Код
//Запись:
Ini.WriteString('GridFont', 'FontTitleStyle', GetObjectSettings(DBGridEh1.Columns.Items[0].Title.Font));
...
//Чтение:
SetObjectSettings (DBGridEh1.Columns.Items[0].Title.Font, Ini.ReadString('GridFont', 'FontTitleStyle', ''));

Автор: Mick Winder 12.11.2004, 12:03
Спасибо всем! То, что вы здесь прописали, для меня очень полезно... И я попробую реализовать все это в своей проге...
А пока я решил немного "поиграть", чтобы понять суть работы...
Написал следующий небольшой кодик:
procedure TForm1.FormDestroy(Sender: TObject);
var
Ini: Tinifile;
begin
Ini.WriteInteger('Grid', 'ColorTitle[0]', DBGridEh1.Columns.Items[0].Title.Color);
Ini.WriteInteger('Grig', 'FontTitleColor[0]', DBGridEh1.Columns.Items[0].Title.Font.Color);
Ini.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Ini: Tinifile;
i: Integer;
begin
DBGridEh1.Columns.Items[0].Title.Color:= Ini.ReadInteger('Grid', 'ColorTitle[0]', clLtGray);
DBGrideh1.Columns.Items[0].Title.Font.Color:= Ini.ReadInteger('Grid', 'FontTitleColor[0]', 0);
Ini.Free;
end;

Мои действия:
1. Открываю свою программу. На форме таблица. Заголовок первого столбца окрашен в серый цвет (сlLtGreen), наименование заголовка в черный цвет (0 или clBlack).
2. Меняю цвет загловка в желтый цвет, наименование заголовка в синий.
3. Закрываю программу.
Результат при повторном открытии:
Цвет заголовка - желтый,
а цвет наименования заголовка - ...черный, хотя по идее должно быть синим...
Почему? Что за фигня? Сделал пошаговую отладку и параллельно заглядывал в ini-файл... При закрытии проги все последние настройки записываются в файл как положено, а при загрузке значение FontTitleColor стирается и присваивается значение 0 (черный цвет)... Nie razumiem!

Автор: Mick Winder 12.11.2004, 13:12
Цитата(p0s0l @ 12.11.2004, 11:42)
Я бы сделал так:
....

Огромное спасибо!!!
Всё получилось! smile

Автор: Alex 12.11.2004, 23:40
Я сделал так:
Код

uses
 StrUtils;

...

function FontToStr(font: TFont): string;
// Кодируем все атрибуты TFont в строку
begin
 Result := '';
 with TStringList.Create do try
   Add(IntToStr(font.Color        ));
   Add(IntToStr(font.Height       ));
   Add(font.Name                   );
   Add(IntToStr(Ord(font.Pitch)   ));
   Add(IntToStr(font.PixelsPerInch));
   Add(IntToStr(font.size         ));
   Add(IntToStr(font.Charset      ));
   Add(IfThen(fsBold      in font.style, '1', '0'));
   Add(IfThen(fsItalic    in font.style, '1', '0'));
   Add(IfThen(fsUnderline in font.style, '1', '0'));
   Add(IfThen(fsStrikeOut in font.style, '1', '0'));
   Result:= CommaText;
 finally
   Free;
 end;
end;

procedure StrToFont(str: string; font: TFont);
// Выставляем атрибуты TFont из строки
begin
 if str = '' then Exit;
 with TStringList.Create do try
   CommaText:= str;
   if Count <> 11 then Exit;
   font.Color:=                    StrToInt(Strings[0]);
   font.Height:=                   StrToInt(Strings[1]);
   font.Name:=                              Strings[2];
   font.Pitch:=         TFontPitch(StrToInt(Strings[3]));
   font.PixelsPerInch:=            StrToInt(Strings[4]);
   font.Size:=                     StrToInt(Strings[5]);
   font.Charset:=                  StrToInt(Strings[6]);
   font.Style := [];
   if Strings[ 7] = '1' then font.Style := font.Style + [fsBold     ];
   if Strings[ 8] = '1' then font.Style := font.Style + [fsItalic   ];
   if Strings[ 9] = '1' then font.Style := font.Style + [fsUnderline];
   if Strings[10] = '1' then font.Style := font.Style + [fsStrikeOut];
 finally
   Free;
 end;
end;

Автор: Guest 15.11.2004, 09:51
smile Спасибо!!!

Автор: Mick Winder 15.11.2004, 09:52
smile Спасибо!!!

Автор: Akella 16.11.2004, 10:15
smile

smile поставь библиотеку EhLib и не мучайся

Автор: Mick Winder 16.11.2004, 10:24
Цитата(dsergey @ 16.11.2004, 10:15)
smile

smile поставь библиотеку EhLib и не мучайся

А я как раз использую библиотеку EhLib и ею пользуюсь... Однако при создании ini-файлов с помощью данной библиотеки что-то там глючит... Но не эта главная причина, почему я отказался от использования функций EhLib... Просто это нужно для меня, для профессионального роста. smile

Автор: Medved 16.11.2004, 16:09
Цитата(Mick @ 16.11.2004, 13:24)
Но не эта главная причина, почему я отказался от использования функций EhLib... Просто это нужно для меня, для профессионального роста. smile


Абсолютно не вижу взаимосвязи между этими двумя факторами.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)