Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник
Коллекция курьезных вопросов из форумов
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »
Страницы: 1

Save Font Options toFile and load [Delphi, Windows]


RusSun ©   (21.02.20 19:17

Всем привет! Собственно сабж.
Пробовал что-то нечто подобное ( Не очень удачно =) ):

Hello everyone Actually a subject.
Tried something similar ( Not very successful =) ):


interface
uses KOL,KOLMHFontDialog;
type
IniFontOptions=record
Obj1_font :  PGraphicTool;
Obj2_font :  PGraphicTool;
end;
...
//Объявим чтобы видеть его из другого модуля
procedure WinCntlOptions(Sender: PControl);{Вызов окна Опции}
var
Win_Options: PControl; //Форма окна опции
lbl: PControl; //Надпись для демострации шрифта
implementation
uses Unit_Act;
//QuestionLabel from Unit_Act

{Метод передачи настроек шрифта для-> "Надпись вопроса" }
//For QLabel
procedure DoMHFontClick(Dummy,Sender: PObj);
var fd: PMHFontDialog;
begin
fd := NewMHFontDialog(form);

fd.options :=  fd.options + [fdEffects, fdInitFont];

fd.InitFont.Assign(lbl.font);
fd.InitFont.Assign(QuestionLabel.font);
if fd.Execute then begin
  lbl.Font.assign(fd.Font);
  QuestionLabel.Font.Assign(fd.Font);
                   end;
fd.Free;
end;

{Метод передачи настроек шрифта для-> "Варианты Ответов"  }
procedure DoMHFont_Ansers_Click(Dummy,Sender: PObj);
var fd_A: PMHFontDialog;
begin
fd_A := NewMHFontDialog(form);

fd_A.options :=  fd_A.options + [fdEffects, fdInitFont];

fd_A.InitFont.Assign(lbl.font);
fd_A.InitFont.Assign(QuestionCheckList.font);
if fd_A.Execute then begin
  lbl.Font.assign(fd_A.Font);
  QuestionCheckList.font.Assign(fd_A.Font);
  QuestionCheckList.LVTextColor:=fd_A.Font.Color;
                   end;
fd_A.Free;
end;

{Метод возврат настройек по умолчанию}
procedure Default_Click(Dummy,Sender: PObj);
begin
//Form.Font.FontName
with Form.Font^ do begin
QuestionLabel.font.Assign(Form.Font);
QuestionCheckList.font.Assign(Form.Font);
                   end;
QuestionCheckList.Font.FontName := 'MS Sans Serif';
QuestionCheckList.Font.FontCharset := 0;
QuestionCheckList.LVTextColor:=clblack;
//Obt[g].Font.fontStyle:=Obt[g].Font.fontStyle+[fsBold];//жирный
//Obt[g].Font.fontStyle:=Obt[g].Font.fontStyle+[fsItalic];//курсив
//Obt[g].Font.fontStyle:=Obt[g].Font.fontStyle+[fsUnderline];//подчёркнутый
//Obt[g].Font.fontStyle:=Obt[g].Font.fontStyle+[fsStrikeOut];//зачёркнутый
end;

{Метод для кнопки применить}
procedure UseIt_Click(Dummy,Sender:   Win_Options.Close
end;
{Метод сохранить текущие настройPObj);
begin
ки}
procedure btn_SaveMature_Click(Dummy,Sender: PObj);
//var opt:TFontDialogOptions;
var
   file_Font: file of IniFontOptions;
   Ini_Obj_Font:IniFontOptions;
//-------------------
begin

//----- Read params -----
Ini_Obj_Font.Obj1_font.Assign(lbl.font);
Ini_Obj_Font.Obj2_font.Assign(QuestionCheckList.Font);
//.LVTextColor:=clblack;
//----- Save to file ----
assign(file_Font,GetStartDir +'Obj_Font_Params');
 rewrite(file_Font);
Write(file_Font,Ini_Obj_Font);
close(file_Font)

end;

{Метод Задать из подборки}
//QuestionLabel.font.FontName := 'Tahoma';
//QuestionLabel.Font.FontHeight:= -18;
//QuestionLabel.font.Color:= clOlive;
//QuestionLabel.font.fontStyle:=Form.Font.fontStyle+[fsBold];
procedure btn_LoadMature_Click(Dummy,Sender: PObj);
var
 file_Font: file of IniFontOptions;
 Ini_Obj_Font:IniFontOptions;
//-------------------
begin

//--- Load from file ---
if FileExists('Obj_Font_Params')
then
Begin
assign(file_Font,GetStartDir +'Obj_Font_Params'); // msgok('Есть файл');
 reset(file_Font);//открытие файла для чтения
Read(file_Font,Ini_Obj_Font);
//--- Set params -------
lbl.font.Assign(Ini_Obj_Font.Obj1_font);
QuestionCheckList.Font.Assign(Ini_Obj_Font.Obj2_font);
//---------------------
close(file_Font);
End
Else
Exit

end;

{Вызов окна "Опции Контролов"}
procedure WinCntlOptions(Sender: PControl);
var GroupBox: PControl;//котейнер для других контролов
btn_QLabel: PControl; //Кпопка для изменения настройек шрифта -> "Надписи вопроса" в данном тесте
btn_Ansers: PControl; //Кнопка для изменения настройек шрифта -> "Надписей ответов" в данном тесте
btn_Default: PControl; //Сброс настрок до "По умолчанию"
btn_UseIt:   PControl; //Кнопка применить

btn_SaveMature: PControl; //Кнопка Сохранить настройки
btn_LoadMature: PControl; //Кнопка Загрузить настройки

begin
  Win_Options:= NewForm(Form,'Окно '+#34+'Опции Контролов'+#34+' в разработке ...');
//   SetClientSize(GetSystemMetrics(SM_CXSCREEN),
//   GetSystemMetrics(SM_CXSCREEN));
//   Win_Options.Font.FontName := 'MS Sans Serif';
//   Win_Options.Font.FontCharset := 0;
  Win_Options.Font.FontName:='Times New Roman';
  Win_Options.Font.FontHeight:=-16;
//   Win_Options.Margin:=0;
  Win_Options.SetClientSize( 596, 295  ).CenterOnParent;
  GroupBox:= NewGroupBox(Win_Options, ' Настройка надписи '+#34+'Вопрос'+#34 ).
  setalign( caClient );

  lbl := NewLabel(GroupBox,' Образец "Изменяемой Надписи"  ').AutoSize(True).ResizeParentRight;
  lbl.Top:= 35;
  btn_QLabel := NewButton(GroupBox,' Изменить -> настройки шрифта для -> "Надпись вопрос" ...').AutoSize(true).PlaceUnder.ResizeParentBottom;
  btn_QLabel.Top:= 80;
  btn_QLabel.OnClick := TOnEvent(MakeMethod(nil, @DoMHFontClick));

  btn_Ansers := NewButton(GroupBox,' Изменить -> настройки шрифта для -> "Надписей ответов" ...').AutoSize(true).PlaceUnder.ResizeParentBottom;
  btn_Ansers.Top:= 120;
  btn_Ansers.OnClick := TOnEvent(MakeMethod(nil, @DoMHFont_Ansers_Click));

  btn_Default := NewButton(GroupBox,' По умолчанию ').AutoSize(true).PlaceUnder.ResizeParentBottom;
  btn_Default.Top:= 160;
  btn_Default.OnClick := TOnEvent(MakeMethod(nil, @Default_Click));

  btn_UseIt := NewButton(GroupBox,' Применить ').AutoSize(true).PlaceUnder;
  btn_UseIt.left:= GroupBox.Width -135;
  btn_UseIt.Top:= 220;

  btn_SaveMature:= NewButton(GroupBox,' Сохранить текущие настройки ').AutoSize(true).PlaceUnder.ResizeParentBottom;
  btn_SaveMature.Top:= 200;
  btn_SaveMature.Left:= 5;
  btn_SaveMature.OnClick := TOnEvent(MakeMethod(nil, @btn_SaveMature_Click));

  btn_LoadMature:= NewButton(GroupBox,' Задать из подборки  ').AutoSize(true).PlaceUnder.ResizeParentBottom;
  btn_LoadMature.Top:= 240;
  btn_LoadMature.Left:= 5;
  btn_LoadMature.OnClick := TOnEvent(MakeMethod(nil, @btn_LoadMature_Click));

  //btn_UseIt.PlaceRight;
  btn_UseIt.OnClick := TOnEvent(MakeMethod(nil, @UseIt_Click));
end;

end.


RusSun ©   (26.02.20 09:22[1]

Подробнее.
1 пользователь может поменять шрифт двух контролов
Это надпись "Надпись вопроса" -> Label
и "Варианты Ответов" -> QuestionCheckList as newlistview(Form,lvsList,[lvoNoScroll,lvoMultiselect,lvoCheckBoxes],nil,ni l,nil).PlaceUnder.SetAlign ( caTop );
В котором цвет кстати ответов задаётся "QuestionCheckList.LVTextColor:=clblack"

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

И собственно как сохранить настройки шрифта наиболее правильным и удобным способом?)))

Также я ипользовал юнит KOLMHFontDialog для вызова диалога для изменения настроек шрифта
И связи с этим вопрос:

[fsBold];//жирный
[fsItalic];//курсив
[fsUnderline];//подчёркнутый
[fsStrikeOut];//зачёркнутый
Но в диалоге можно увидеть следующее
https://yadi.sk/i/yl4l6SlDjdl69g
Меняется название шрифта, начертание, размер и цвет.
Причем Начертание обычный, полужирный, наклонный.
Наклонный -> курсив; А вот полужирный это как есть только "Жирный"?


RusSun ©   (28.02.20 20:37[2]

{Метод сохранить текущие настройки}
procedure btn_SaveMature_Click(Dummy,Sender: PObj);
var
   file_Font:pstrlist;
//-------------------
begin
file_Font:= NewStrList;
//----- Read params -----
//Ini_Obj_Font1.Assign(lbl.font);
file_Font.Add(lbl.font.FontName); //  lbl.font.Name
file_Font.Add(Int2Str(lbl.font.Color));
file_Font.Add(Int2Str(lbl.font.FontHeight));
if fsBold in lbl.font.fontStyle then file_Font.Add('fsBold ');
if fsItalic in lbl.font.fontStyle then file_Font.Items[3]:=
file_Font.Items[3]+'fsItalic ';

if fsUnderline in lbl.font.fontStyle then file_Font.Items[3]:=
file_Font.Items[3]+'fsUnderline ';

if fsStrikeOut in lbl.font.fontStyle then file_Font.Items[3]:=
file_Font.Items[3]+'fsStrikeOut';

file_Font.Add(int2str(lbl.font.FontCharset));//4
//=============================================
//Ini_Obj_Font2.Assign(QuestionCheckList.Font);
file_Font.Add(QuestionCheckList.Font.FontName); //  lbl.font.Name  5
file_Font.Add(Int2Str(QuestionCheckList.LVTextColor));//6
file_Font.Add(Int2Str(QuestionCheckList.font.FontHeight));//7

if fsBold in QuestionCheckList.font.fontStyle then file_Font.Add('fsBold '); //8
if fsItalic in QuestionCheckList.font.fontStyle then file_Font.Items[8]:=
file_Font.Items[8]+'fsItalic ';

if fsUnderline in QuestionCheckList.font.fontStyle then file_Font.Items[8]:=
file_Font.Items[8]+'fsUnderline ';

if fsStrikeOut in QuestionCheckList.font.fontStyle then file_Font.Items[8]:=
file_Font.Items[8]+'fsStrikeOut';
file_Font.Add(int2str(QuestionCheckList.font.FontCharset));

//.LVTextColor:=clblack;
//----- Save to file ----
file_Font.SaveToFile(GetStartDir +'Obj_Font_Params.txt');
file_Font.Free;
end;

{Метод Задать из подборки}
procedure btn_LoadMature_Click(Dummy,Sender: PObj);
var
   file_Font:pstrlist;
//-------------------
begin
file_Font:= NewStrList;
//----- Read params -----
//.LVTextColor:=clblack;
//----- Save to file ----
file_Font.LoadFromFile(GetStartDir +'Obj_Font_Params.txt');
lbl.font.FontName:=file_Font.Items[0]; //  lbl.font.Name
lbl.font.Color:=Str2int(file_Font.Items[1]);
lbl.font.FontHeight:=Str2int(file_Font.Items[2]);
if pos('fsBold',file_Font.Items[3])<>0 then lbl.font.fontStyle:=lbl.font.fontStyle+[fsBold];
if pos('fsItalic',file_Font.Items[3])<>0 then lbl.font.fontStyle:=lbl.font.fontStyle+[fsItalic];
if pos('fsUnderline',file_Font.Items[3])<>0 then lbl.font.fontStyle:=lbl.font.fontStyle+[fsUnderline];
if pos('fsStrikeOut',file_Font.Items[3])<>0 then lbl.font.fontStyle:=lbl.font.fontStyle+[fsStrikeOut];
lbl.font.FontCharset:=Str2int(file_Font.Items[4]);
//=============================================
QuestionCheckList.font.FontName:=file_Font.Items[5]; //  lbl.font.Name
QuestionCheckList.LVTextColor:=Str2int(file_Font.Items[6]);
QuestionCheckList.font.FontHeight:=Str2int(file_Font.Items[7]);
if pos('fsBold',file_Font.Items[8])<>0 then QuestionCheckList.font.fontStyle:=
QuestionCheckList.font.fontStyle+[fsBold];
if pos('fsItalic',file_Font.Items[8])<>0 then QuestionCheckList.font.fontStyle:=
QuestionCheckList.font.fontStyle+[fsItalic];
if pos('fsUnderline',file_Font.Items[8])<>0 then QuestionCheckList.font.fontStyle:=
QuestionCheckList.font.fontStyle+[fsUnderline];
if pos('fsStrikeOut',file_Font.Items[8])<>0 then QuestionCheckList.font.fontStyle:=
QuestionCheckList.font.fontStyle+[fsStrikeOut];
QuestionCheckList.font.FontCharset:=Str2int(file_Font.Items[9]);
file_Font.Free;
end;


Сделал так, но настройки переходят только к одному контролу второму.
И в файле происходит дублирование.
Хотя задаю разные настройки)


RusSun ©   (29.02.20 19:54[3]

Всё работает. Только нужно правильно указывать второй контрол)


Страницы: 1 версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо