Способ автосохранения Editов, CheckBoxов, Memo и т.д.

Victor Cookin
Дата: 15.08.2019 19:41:08
Вот может кому пригодится

Вызов:
+
procedure TYourForm.FormCreate(Sender: TObject);
begin
  FormLoad(Self);
...

procedure TYourForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FormSave (self);
...

program YourProgramm;
uses
....
begin
//  ReportMemoryLeaksOnShutdown := True;
  Application.UpdateFormatSettings:=False;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.Title := 'Enforce it!';
  Start;
....

procedure Start; // 
var
  buffer     : array[0..255] of char;
  buffsize   : DWORD;
begin
  buffsize := sizeOf(buffer);
  GetComputerName(buffer, buffsize);
  MyMachine := buffer;

  buffsize := sizeOf(buffer);
  GetUserName(@buffer, buffSize);
  if MyUSerCode = '' then MyUserCode := UpperCase(buffer);
end;


procedure FormLoad(Form: TForm);
var
  INIFile : TIniFile;
  FormOnResize : Tevent;
begin
  Form.Caption := Application.Title + '   ' + MyUserCode;
  CM_INI := lowercase(ExtractFilePath(Application.ExeName) +'\ini');
  FormOnResize := nil;
  if CM_INI <> '' then begin
    if MyUserCode <> '' then begin
      INIFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'ini\' + lowercase(MyUserCode) + '.ini');
      try
        if Assigned (Form.OnResize) then begin
          FormOnResize := Form.OnResize;
          Form.OnResize := nil;
        end;
        ReadVals (Form, Form.Caption, INIFile);
      finally
        if Assigned (FormOnResize) then
          Form.OnResize := FormOnResize;
        INIFile.Free;
      end;
    end;
  end;
end;


function FormSave(Form: TForm; ConfirmExit: Boolean = false): boolean;
var
  iniUser        : TIniFile;
begin
  Result := True;
  if ConfirmExit = True then
      if MessageDlg('Выходим??',mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes then
        Result := True
      else
        Result := False
    else
      Result := True;
// save the screens position in the users .ini file

  if result then begin
    try
      if MyUserCode <> '' then begin
        if not SysUtils.DirectoryExists(ExtractFilePath(Application.ExeName) + 'ini') then
          SysUtils.ForceDirectories (ExtractFilePath(Application.ExeName) + 'ini');
        iniUser := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'ini\' + lowercase(MyUserCode) + '.ini');
        try
          if Form.Caption <> '' then begin
            WriteVals (Form, Form.Caption, iniUser);
          end;
        finally
          iniUser.Free;
        end;
      end;
    except
      ErrorLog('Error saving user settings' + ' ' + MyUserCode);
    end;
  end;
end;
Victor Cookin
Дата: 15.08.2019 19:43:19
Собственно, самый цимес:

+
procedure ReadVals (Parent: TWinControl; Capt : string; ini : TIniFile);
var i : Integer; s : string;
begin
  for i := 0 to Parent.ControlCount - 1 do begin
    if Parent.Controls [i].tag = 22 then begin
        if Parent.Controls [i] is TEdit then
          (Parent.Controls [i] as TEdit).Text := ini.ReadString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TEdit).Text);
        if Parent.Controls [i] is TLabeledEdit then
          (Parent.Controls [i] as TLabeledEdit).Text := ini.ReadString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TLabeledEdit).Text);
//        if Parent.Controls [i] is TDBEdit then
//          (Parent.Controls [i] as TDBEdit).Text := ini.ReadString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TDBEdit).text);
{$ifdef INFOPOWER}
        if Parent.Controls [i] is TwwDBEdit then
          (Parent.Controls [i] as TwwDBEdit).Text := ini.ReadString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TwwDBEdit).text);
        if Parent.Controls [i] is TwwDBDateTimePicker then
          (Parent.Controls [i] as TwwDBDateTimePicker).Date := StrToDate (ini.ReadString(Capt, Parent.Controls [i].name, emptystr));
{$endif}
        if Parent.Controls [i] is TDateTimePicker then
          (Parent.Controls [i] as TDateTimePicker).Date := StrToDate (ini.ReadString(Capt, Parent.Controls [i].name, emptystr));
        if Parent.Controls [i] is TDriveComboBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            TDriveComboBox(Parent.Controls [i]).Drive := s[1];
        end;
        if Parent.Controls [i] is TDirectoryListBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            TDirectoryListBox(Parent.Controls [i]).Directory := s;
        end;
        if Parent.Controls [i] is TFileListBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            TFileListBox(Parent.Controls [i]).FileName := s;
        end;
{$ifdef JV}
        if Parent.Controls [i] is TJvDriveCombo then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            (Parent.Controls [i] as TJvDriveCombo).Drive := s[1];
        end;
        if Parent.Controls [i] is TJvDirectoryListBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            (Parent.Controls [i] as TJvDirectoryListBox).Directory := s;
        end;
        if Parent.Controls [i] is TJvFileListBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then
            (Parent.Controls [i] as TJvFileListBox).FileName := s;
        end;
{$endif}
        if Parent.Controls [i] is TMemo then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim(s) <> emptystr then TMemo(Parent.Controls[i]).Lines.Clear;
          while trim(s) <> emptystr do begin
            TMemo(Parent.Controls[i]).Lines.Add(s);
            ini.DeleteKey(Capt, Parent.Controls [i].name);
            s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          end;
        end;
        if Parent.Controls [i] is TCheckBox then begin
          s := ini.ReadString(Capt, Parent.Controls [i].name, emptystr);
          if trim (s) = '1' then (Parent.Controls [i] as TCheckBox).Checked := true else
             (Parent.Controls [i] as TCheckBox).Checked := false;
        end;
    end;
    if Parent.Controls [i] is TWinControl then
      ReadVals (TWinControl(Parent.Controls [i]),Capt, ini);
  end;
end;

procedure WriteVals (Parent: TWinControl; Capt : string; ini : TIniFile);
var i,j : Integer; F : TextFile;
begin
  for i := 0 to Parent.ControlCount - 1 do begin
    if Parent.Controls [i].tag = 22 then begin
        if Parent.Controls [i] is TEdit then
          ini.WriteString(Capt, Parent.Controls [i].name,            TEdit(Parent.Controls [i]).text);
        if Parent.Controls [i] is TLabeledEdit then
          ini.WriteString(Capt, Parent.Controls [i].name,            TLabeledEdit(Parent.Controls [i]).text);
//        if Parent.Controls [i] is TDBEdit then
//          ini.WriteString(Capt, Parent.Controls [i].name,            (Parent.Controls [i] as TDBEdit).text);
{$ifdef INFOPOWER}
        if Parent.Controls [i] is TwwDBEdit then
          ini.WriteString(Capt, Parent.Controls [i].name,            (Parent.Controls [i] as TwwDBEdit).text);
        if Parent.Controls [i] is TwwDBDateTimePicker then
          ini.WriteString(Capt, Parent.Controls [i].name, DateToStr ((Parent.Controls [i] as TwwDBDateTimePicker).Date));
{$endif}
        if Parent.Controls [i] is TDateTimePicker then
          ini.WriteString(Capt, Parent.Controls [i].name, DateToStr ((Parent.Controls [i] as TDateTimePicker).Date));
        if Parent.Controls [i] is TDriveComboBox then
          ini.WriteString(Capt, Parent.Controls [i].name, TDriveComboBox(Parent.Controls [i]).Drive);
        if Parent.Controls [i] is TDirectoryListBox then
          ini.WriteString(Capt, Parent.Controls [i].name, TDirectoryListBox(Parent.Controls [i]).Directory);
        if Parent.Controls [i] is TFileListBox then
          ini.WriteString(Capt, Parent.Controls [i].name, TFileListBox(Parent.Controls [i]).FileName);
{$ifdef JV}
        if Parent.Controls [i] is TJvDriveCombo then
          ini.WriteString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TJvDriveCombo).Drive);
        if Parent.Controls [i] is TJvDirectoryListBox then
          ini.WriteString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TJvDirectoryListBox).Directory);
        if Parent.Controls [i] is TJvFileListBox then
          ini.WriteString(Capt, Parent.Controls [i].name, (Parent.Controls [i] as TJvFileListBox).FileName);
{$endif}
        if Parent.Controls [i] is TMemo then begin
            AssignFile(F, ini.FileName);
            Append(F);
          for j := 0 to TMemo(Parent.Controls[i]).Lines.Count - 1 do begin
              if trim (TMemo(Parent.Controls[i]).Lines[j]) <> emptystr then
                Writeln(F, Parent.Controls [i].name + '=' + TMemo(Parent.Controls[i]).Lines[j]);
          end;
            Flush(F);
            CloseFile(F);
          end;
        if Parent.Controls [i] is TCheckBox then begin
          if TCheckBox(Parent.Controls [i]).Checked then
             ini.WriteString(Capt, Parent.Controls [i].name, '1') else ini.WriteString(Capt, Parent.Controls [i].name, '0')
        end;
    end;
    if Parent.Controls [i] is TWinControl then
      WriteVals (TWinControl(Parent.Controls [i]), Capt, ini);
  end;
end;

Теперь ставим на контролы, которые хотим сохранять тэг=22 и voila
makhaon
Дата: 15.08.2019 19:44:13
что этот код делает?
Victor Cookin
Дата: 15.08.2019 19:56:17
makhaon,

Сохраняет значения контролов при выходе из программы в ini файле и загружает их при создании формы. Нужно только в тэге поставить 22.
makhaon
Дата: 15.08.2019 20:07:01
Victor Cookin,

Стоило ли городить велосипед, когда готовых много? Я, например, юзаю TJvFormStorage. Умеет сохранять любые опубликованные свойства компонент формы, кода не нужно вообще. Сохраняет в Ini, xml, базу, реестр.
makhaon
Дата: 15.08.2019 20:08:46
ну и так, куча плюшек - сохранение самой формы, и любых параметров.
и это не единственные компоненты такие.
Victor Cookin
Дата: 15.08.2019 20:14:58
makhaon, а TJvFormStorage, умеет сохранять только те, которые попросили или скопом все?
Gator
Дата: 15.08.2019 20:40:16
Victor Cookin, а нагуглить https://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvFormStorage религия запрещает?
___
Это я так... Ворчу
makhaon
Дата: 15.08.2019 20:47:23
Victor Cookin,

что добавишь в список сохранения, то сохранит и восстановит.
Victor Cookin
Дата: 15.08.2019 20:51:28
Gator, makhaon - спасибо. Человек - животное общественное. Спросить приятнее чем гуглить.