Время компиляции файла: 2024-04-24 21:32:50
Сохранение и восстановление положения и размеров окон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 и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Размеры и Положение ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |