|
|
|
|
Сохранение и восстановление положения и размеров оконDelphi , Программа и Интерфейс , Размеры и Положение
Автор: Desdechado
{ **** UBPFD *********** by delphibase.endimus.com ****
>>
Процедуры SaveWndPos и SetWndPos работают в паре.
Сохраняют для конкретного пользователя Windows в реестре местоположение,
размер окон (и прочих Control'ов при явном указании),
а также ширины и порядок расположения колонок в DBGrid'ах на форме.
Не дает "потерять" колонки совсем.
Возможные проблемы:
1. С записью в реестр без прав (в некую левую ветку).
2. При изменении имен и количества полей в DBGrid'е.
3. С окнами неизменяемого размера, если его в Design-time поменяли.
Комментарии:
1. Статус колонки DBGrid (visible, readonly) не сохраняется, но сделать
это несложно.
2. Для формы, которая используются для разных целей, но хотелось бы
сохранить ее характеристики для каждой цели отдельно, можно явно
указывать УНИКАЛЬНЫЙ класс.
Важное уточнение:
Сохранение параметров DBGrid происходит ТОЛЬКО при статически
описанных колонках в самом гриде.
Еще комментарий:
параметр lSetSize в SetWndPos применяется только к размерам формы, а
не к ширине колонок. Но можно и это учесть.
Зависимости: Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Registry, Math, DB, DbTables, dbGrids
Автор: Александр Хабаров aka Desdechado, x_a_u@mail.ru, Феодосия
Copyright: Александр Хабаров
Дата: 13 мая 2002 г.
***************************************************** }
const
cRegKey = '\Software\CoolSoft\Настройки\';
procedure SaveWndPos(frm: TControl; cClass: string = '');
var
rct: TRect;
oReg: TRegistry;
grid: TDBGrid;
i, j: Integer;
begin
{--- определить параметры ---}
rct := frm.BoundsRect;
if (cClass = '') then
cClass := frm.ClassName;
{--- сохранить в реестре ---}
oReg := TRegistry.Create();
with (oReg) do
try
RootKey := HKEY_CURRENT_USER;
{--- ... размер окна ---}
if (OpenKey(cRegKey + cClass, True)) then
begin
if (frm is TForm) then
WriteInteger('Show', Ord((frm as TForm).WindowState));
if (not (frm is TForm) or
((frm as TForm).WindowState = wsNormal)) then
begin
WriteInteger('Left', rct.Left);
WriteInteger('Top', rct.Top);
WriteInteger('Right', rct.Right);
WriteInteger('Bottom', rct.Bottom);
end;
end;
CloseKey();
{--- ... размеры и положение колонок в Grid'ах ---}
for i := 0 to frm.ComponentCount - 1 do
if (frm.Components[i].ClassName = D
if (frm.Components[i].ClassName = 'TDBGrid') then
begin
grid := TDBGrid(frm.Components[i]);
for j := 0 to grid.Columns.Count - 1 do
begin
if (OpenKey(cRegKey + cClass + '\' + grid.Name + '\' +
IntToStr(j), True)) then
begin
WriteString('Name', grid.Columns[j].FieldName);
WriteInteger('Width', grid.Columns[j].Width);
end;
CloseKey();
end; // for( j )
end;
finally
CloseKey();
Free;
end;
end;
procedure SetWndPos(frm: TControl; lSetSize: Boolean = True;
cClass: string = '');
var
rct: TRect;
oReg: TRegistry;
nShow, i, j, k: Integer;
grid: TDBGrid;
cName: string;
begin
nShow := Ord(wsNormal);
{--- текущие параметры (на случай, если нет в реестре) ---}
rct := frm.BoundsRect;
if (cClass = '') then
cClass := frm.ClassName;
if (frm is TForm) then
nShow := Ord((frm as TForm).WindowState);
{--- считать из реестра ---}
oReg := TRegistry.Create();
with (oReg) do
try
RootKey := HKEY_CURRENT_USER;
{--- ... размер окна ---}
if (OpenKeyReadOnly(cRegKey + cClass)) then
begin
if (frm is TForm) then
nShow := ReadInteger('Show');
if (ValueExists('Left')) then
rct.Left := ReadInteger('Left');
if (ValueExists('Top')) then
rct.Top := ReadInteger('Top');
if (ValueExists('Right')) then
rct.Right := ReadInteger('Right');
if (ValueExists('Bottom')) then
rct.Bottom := ReadInteger('Bottom');
end;
CloseKey();
{--- ... размеры и положение колонок в Grid'ах ---}
for i := 0 to frm.ComponentCount - 1 do
if (frm.Components[i].ClassName = 'TDBGrid') then
begin
grid := TDBGrid(frm.Components[i]);
for j := 0 to grid.Columns.Count - 1 do
begin
if (OpenKeyReadOnly(cRegKey + cClass + '\' + grid.Name + '\' +
IntToStr(j))) then
begin
cName := ReadString('Name');
for k := 0 to grid.Columns.Count - 1 do
if (grid.Columns[k].FieldName = cName) then
begin
grid.Columns[k].Index := j;
break;
end;
grid.Columns[j].Width := ReadInteger('Width');
end;
CloseKey();
{--- экстремальные ширины - нормировать ---}
grid.Columns[j].Width := Max(grid.Columns[j].Width, 3);
grid.Columns[j].Width := Min(grid.Columns[j].Width,
grid.ClientWidth - 3);
end; // for( j )
end;
finally
CloseKey();
Free;
end;
{--- применить считанное к окну ---}
if (lSetSize) then
frm.BoundsRect := rct
else
begin
frm.Top := rct.Top;
frm.Left := rct.Left;
end;
if ((frm is TForm) and (nShow = Ord(wsMaximized))) then
(frm as TForm).WindowState := wsMaximized;
end;
procedure FitDeskTop(frm: TControl);
var
rct: TRect;
begin
rct := frm.BoundsRect;
if (rct.Top < 0) then
rct.Top := 0
else if (rct.Bottom >= Screen.DeskTopHeight) then
rct.Top := rct.Top + Screen.DeskTopHeight - rct.Bottom - 1;
if (rct.Left < 0) then
rct.Left := 0
else if (rct.Right >= Screen.DeskTopWidth) then
rct.Left := rct.Left + Screen.DeskTopWidth - rct.Right - 1;
rct.Bottom := rct.Top + frm.Height;
rct.Right := rct.Left + frm.Width;
frm.BoundsRect := rct;
end;
Пример использования:
{
0. не забудьте поменять константу для СВОЕЙ ветки в реестре
1. после создания окна перед Show
2. перед frm.Release (удалением) надо вызывать SaveWndPos
}
procedure TfrmCard.FormCreate(Sender: TObject);
begin
// прочий код здесь
SetWndPos(Self);
end;
procedure TfrmCard.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// прочий код здесь
SaveWndPos(Self);
Action := caFree;
end;
Программный код на Delphi, который реализует сохранение и восстановление положения и размера окна. Процедура Описание кода:
Процедура Процедура Пример использования: В этом примере процедура Обратите внимание, что это код предполагает, что имя класса формы или контрола уникально и не конфликтует с другими приложениями. Также ключ реестра, используемый в этом коде, является специфичным для приложения и должен быть изменен, если вы хотите использовать другой ключ. Сохранение и восстановление положения и размеров окон в приложении на языке Delphi. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш :: Главная :: Размеры и Положение ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 | ||||
Telegram-канал