Платные хостинги     Раскрутка сайта     Книги по программированию

Сохранение шрифта таблицы в ini-файл

- Создаю ini-файл, куда записываю все параметры размеров формы, фон и шрифт таблицы...Есть проблема записи в ini-файл параметров шрифта... Как решить проблему со шрифтами...Исходный код ниже:procedure TForm1.FormDestroy(Sender: TObject);varIni: 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);varIni: 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;

- Код Ini.WriteInteger('Grig', 'FontTitle', DBGrideh1.Columns.Items[0].Title.Font);highlightSyntax('delphiGYzMjg','delphi');Да, тут действительно проблема... Именно так, как написано - не получится. Конфликт типов TFont и Integer.Думаю, надо сохранять для шрифта все его параметры (Name, Color, Height, Size, Style и т.д.), а потом их загружать. Собственно так должно получиться.

- Попробовал написать... 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... Что делать?

- Код 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;highlightSyntax('delphiI2YmM5','delphi');

- Alex, про Charset забыл.В помощь:Код TFontCharset = 0..255;highlightSyntax('delphiiZjE1M','delphi');

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

- Я добавил, но это не пример, это кошмар Код 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;highlightSyntax('delphiRiYzBi','delphi');Я вечером нормальный сделаю и выложу

- Я бы сделал так:Код 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;highlightSyntax('delphizM2NGM','delphi');Только 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', ''));highlightSyntax('delphi5YjRlO','delphi');

- Спасибо всем! То, что вы здесь прописали, для меня очень полезно... И я попробую реализовать все это в своей проге...А пока я решил немного "поиграть", чтобы понять суть работы...Написал следующий небольшой кодик:procedure TForm1.FormDestroy(Sender: TObject);varIni: 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);varIni: 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!

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

- Я сделал так:Код 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;highlightSyntax('delphimYyZDQ','delphi');

- Спасибо!!!

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

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD