вторник, 23 сентября 2014 г.

Сохранение размера и позиции формы в Delphi

Часто в приложении требуется сохранить размер и положение окна (формы). Встроенной технологии в Delphi нет. В интернете можно найти различные способы хранения как в INI так и в реестре. Я предлагаю другой вариант. Использовать TPersistant.
Для удобства я поместил все в DLL.


library swpas;

{  SWPAS - Save Windows Position And Size

   Библиотека для сохранения размера и положения формы.
   24.09.2014  Кутовой Максим

   После создания формы загружаем ее размеры и положение из файла. Если его нет,
   то размеры и положение будут как при разработке приложения. После закрытия
   формы сохраняем ее размер и положения в файл. Если не указать имя файла, то
   все будет сохранено в файл <ИМЯ_ФОРМЫ>.frm

     Формат вызова процедур в программе
     procedure LoadFormPositionAndSize(AForm: TForm; APath : string = ''); external 'swpas.dll';
     procedure SaveFormPositionAndSize(AForm: TForm; APath : string = ''); external 'swpas.dll';

     procedure LFPAS(AForm: TForm; APath : string = ''); external 'swpas.dll';
     procedure SFPAS(AForm: TForm; APath : string = ''); external 'swpas.dll';


     Использование в программе:

     procedure TForm1.Button1Click(Sender: TObject);
     var
       NewForm : TForm;
     begin
      NewForm := TForm2.Create(self);
      LFPAS(NewForm);
      NewForm.ShowModal;
      SFPAS(NewForm);
      FreeAndNil(NewForm);
     end;
   }


uses
  System.SysUtils,
  System.Classes,
  VCL.Forms;

{$R *.res}

{
 ****
 ****  КЛАСС для сохранения свойств формы
 ****
}

type
  TSavedForm = class(TPersistent)
  private

    FHeight: Integer;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;

    {Установка свойств}
    procedure SetHeight(const Value: integer);
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
    procedure SetWidth(const Value: integer);

    {Получение свойств}
    function GetHeight: integer;
    function GetLeft: Integer;
    function GetTop: Integer;
    function GetWidth: integer;
  public
    {Конструктор}
    constructor Create;

  published
    Property Left: Integer read GetLeft write SetLeft;
    property Top: Integer read GetTop write SetTop;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;

  end;

{ AForm }

constructor TSavedForm.Create;
begin
  inherited;
end;

function TSavedForm.GetHeight: integer;
begin
  result := FHeight;
end;

function TSavedForm.GetLeft: Integer;
begin
  result := FLeft;
end;

function TSavedForm.GetTop: Integer;
begin
  result := FTop
end;

function TSavedForm.GetWidth: integer;
begin
  result := FWidth;
end;

procedure TSavedForm.SetHeight(const Value: integer);
begin
  FHeight := Value;
end;

procedure TSavedForm.SetLeft(const Value: Integer);
begin
  FLeft := Value;
end;

procedure TSavedForm.SetTop(const Value: Integer);
begin
  FTop := Value;
end;

procedure TSavedForm.SetWidth(const Value: integer);
begin
  FWidth := Value;
end;


{
  ***
  ***  Процедуры для сохранения объекта  в файл
  ***  Можно вынести в отдельный модуль или библиотеку.
  ***
}

type
  TObjWriter = class(TWriter)
  end;
  TObjReader = class(TReader)
  end;


procedure WriteObj(obj: TPersistent; st: TStream);
begin
  with TObjWriter.Create(st, 64) do
  begin
    WriteProperties(obj);
    FlushBuffer; Free;
  end;
end;


procedure ReadObj(obj: TPersistent; st: TStream);
begin
  with TObjReader.Create(st, 1) do
  begin
    while st.Position < st.Size do
    try ReadProperty(obj); except Continue; end;
    Free;
  end;
end;


procedure SaveObjToFile(obj: TPersistent; FileName: string);
var fs: TFileStream;
begin
  try
    fs := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
    try
      WriteObj(obj, fs);
    finally
      fs.Free;
    end;
  except end;
end;


procedure LoadObjFromFile(obj: TPersistent; FileName: string);
var fs: TFileStream;
begin
  if FileExists(FileName) then try
    fs := TFileStream.Create(FileName, fmShareDenyWrite);
    try
      ReadObj(obj, fs);
    finally
      fs.Free;
    end;
  except end;
end;



{
 ***
 ***  Процедуры для работы
 ***
}


// Загрузка позиции и размеров формы
procedure LoadFormPositionAndSize(AForm: TForm; APath: string);
var
  F : TSavedForm;
  fn : string;
begin
  F:= TSavedForm.Create;
  if APath = '' then
    fn := ExtractFilePath(ParamStr(0)) + AForm.Name + '.frm'
  else
    fn := APAth;
  if FileExists(fn) then begin
     LoadObjFromFile(F, fn);
     AForm.Height := F.Height;
     AForm.Width := F.Width;
     AForm.Top := F.Top;
     AForm.Left := F.Left;
  end;
  FreeAndNil(F);
end;

// Сохранение позиции и размеров формы
procedure SaveFormPositionAndSize(AForm: TForm; AFileName: string);
var
  F : TSavedForm;
  fn : string;
begin
  F := TSavedForm.Create;
  F.Height :=  AForm.Height;
  F.Width :=  AForm.Width;
  F.Top :=  AForm.Top;
  F.Left :=  AForm.Left;
  if AFileName =  '' then
    fn := ExtractFilePath(ParamStr(0)) + AForm.Name + '.frm'
  else
     fn := AFileName;
  SaveObjToFile(F, fn);
  FreeAndNil(F);
end;

// Теже процедуры но с сокращенным именем.
procedure SFPAS(AForm: TForm; AFileName: string);
begin
  SaveFormPositionAndSize(AForm, AFileName);
end;

procedure LFPAS(AForm: TForm; AFileName: string);
begin
  LoadFormPositionAndSize(AForm, AFileName);
end;



exports
   SaveFormPositionAndSize, LoadFormPositionAndSize, SFPAS, LFPAS;

begin
end.

Готовую DLL можно взять здесь: swpas.dll

Комментариев нет:

Отправить комментарий