Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Управление приложением



Вернуться к списку функций
 Сохранение и восстановление положения и размеров окон

 Прислал: Александр Хабаров aka Desdechado (Феодосия) ( 13 мая 2002 г. )
©  Александр Хабаров
 Описание:
Процедуры 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

 Ограничения:
Проверено под D5 + WinNT4, Win98 SE, WinME, WinXP Home

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Сохранение и восстановление положения и размеров окон

Процедуры 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;


Вернуться к списку функций

Наверх ▲