Часто в приложении требуется сохранить размер и положение окна (формы). Встроенной технологии в 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.
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.
Комментариев нет:
Отправить комментарий