Сохранение и восстановление положения и размеров окон

Автор: 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;