{ ----------------------------------- Formに配置してメソッドを呼ぶと Formの位置とWindowStateを保存/復帰する事のできる コンポーネントです。 ＜機能＞ 情報の保存先を同一フォルダ内のIniか レジストリで選ぶことが可能 LoadWindowState 位置などを復帰 使用可能 Form.FormCreate/Form.Createのinherited以降 使用不可能 Form.FormShow SaveWindowState 位置などを保存 使用可能 Form.FormDestroy/Form.FormClose/FormCloseQuery DataSaveObjectCreate TRegistryIniFile/TIniFileを生成 DataSave IniかRegかを選択 DataSaveName Iniファイル名かレジストリキー名 DataSaveNameがプロジェクト名ではないのは 設計時にコンストラクタでプロジェクト名を取得できなかったから。 ParamStr(0)やApplication.ExeNameではDelphi自体の名前が 取れてしまって意味がない… ＜使い方説明＞ もっとも簡単な実装例 procedure TForm1.FormCreate(Sender: TObject); begin FormPosition1.LoadWindowState; end; procedure TForm1.FormDestroy(Sender: TObject); begin FormPosition1.SaveWindowState; end; 位置復帰は LoadWindowState を呼び出す。 使用可能な場所は Form.FormCreate(=OnCreateイベント)か Form.Create(=Formのコンストラクタ)のinherited以降 位置保存は SaveWindowState を呼び出す 使用可能な場所は Form.FormDestroy(=OnDestroyイベント)か Form.FormClose(=OnCloseイベント)か Form.FormCloseQuery(=OnCloseQueryイベント Load/SaveWindowStateは引数無し呼び出しなら DataSave/DataSaveNameプロパティで指定された場所に 情報が保存/読込される。 Load/SaveWindowStateで引数にTCustomIniFileを使用した呼び出しも可能 DataSaveObjectCreateは DataSave/DataSaveNameプロパティで指定された場所の TCustomIniFileを生成して返す ＜使用上の注意＞ Application.MainFormのVisibleがTrueだと 最小化終了→起動したときにApplicationが最小化されるとともに MainFormも子Windowとして最小化されてしまい誤動作するので プロパティで『Application.MainForm は False』にしてください 更新履歴──────────────────── 2005/08/17 DataExist項目を削除して代わりにSessionExistを使うようにした 2006/06/28(水) ・TMemIniFileだとIniファイルのコメント記号が無視されて削除されるので TIniFileに変更した //----------------------------------- } unit FormPosition; interface uses Windows, Messages, SysUtils, Classes, IniFiles, Registry, Forms; type TIniRegSelect = (irsApplicationIni, irsHKEYCURRENTUSER); {↑データ保存先をIniファイルかか HKEY_CURRENT_USER\Software以下のレジストリキーに保存するかを選ぶ処理} TSaveType = (stPosition, stOnlySize); TFormPosition = class(tcomponent) private FDataSave: TIniRegSelect; FDataSaveName: String; FSaveType: TSaveType; // FAutoSaveLoad: Boolean; procedure SetDataSaveName(const Value: String); private // FOldFormProc: TWndMethod; // procedure FormWndProc(var Message: TMessage); procedure SetDataSave(const Value: TIniRegSelect); protected public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure LoadWindowState(DataSaveObject: TCustomIniFile = nil); procedure SaveWindowState(DataSaveObject: TCustomIniFile = nil); function DataSaveObjectCreate: TCustomIniFile; published {↓保存先をIniかRegかを選択} property DataSave: TIniRegSelect read FDataSave write SetDataSave; {↓Iniファイル名かRegのHKEY_CURRENT_USER\以下のキーを指定} property DataSaveName: String read FDataSaveName write SetDataSaveName; property SaveType: TSaveType read FSaveType write FSaveType; // property AutoSaveLoad: Boolean read FAutoSaveLoad write FAutoSaveLoad; end; procedure Register; function NoneTaskBarDesktopRect: TRect; function wsNormalPosition(Form: TCustomForm): TRect; function GetWindowState(WndHandle: HWnd): TWindowState; function AppWindowState: TWindowState; implementation uses StrUtils, RectPointUnit; procedure Register; begin RegisterComponents('Samples', [TFormPosition]); end; {------------------------------- //タスクバーを除いたデスクトップの大きさを求める 備考: タスクバーのプロパティが 『常に手前に表示ON』『自動で隠すOFF』 の場合だけがResult.Top/Leftが0でなくなり Screen.Height/Width値とずれることになる 履歴: 2000/11/07 //------------------------------} function NoneTaskBarDesktopRect: TRect; var rectDesktop : TRect; begin Result := Rect(0,0,0,0); if SystemParametersInfo(SPI_GETWORKAREA, 0, @rectDesktop, 0) then begin Result := rectDesktop; end; end; (*-----------------------------------BCBでのやり方 TRect NoneTaskBarDesktopRect() { TRect result, rectDesktop; result = Rect(0,0,0,0); if (SystemParametersInfo(SPI_GETWORKAREA, 0, &rectDesktop, 0)) { result = rectDesktop; } return result; } //-----------------------------------*) //------------------------------ {------------------------------- //Formが最大化最小化していてもwsNormal時のFormの位置を求めます 戻り値: FormのRect 処理： 1.GetWindowPlacementで値を求める 2.タスクバーを含まないDesktopRectから位置を補正 タスクバーが上や左に配置されていても 正しい位置を表示するために タスクバーの無いデスクトップの大きさ から値を取得して修正しています。 備考: MainFormでもSubFormでも正しい動作をしています MainForm最小化時はBoundRect値でもwsNormal時の値をとるが SubForm最小化時は変な値を取るので、この関数を使いましょう。 履歴: 2000/11/07 2003/04/12 引数をTFormからTCustomFormへ変更 2003/12/21 MainFormだけタスクバー位置調整を行うことにした 2004/01/09 MainFormではなく、BorderStyle=bsToolWindow/bsSizeToolWinの 時以外にタスクバー位置調整を行えばよいことが判明した //------------------------------} function wsNormalPosition(Form: TCustomForm): TRect; var WindowPlacement: TWindowPlacement; DesktopOrigination: TPoint; begin {↓wsNormal時のWindowの大きさを求めています} Result := Rect(0,0,0,0); WindowPlacement.length := SizeOf(WindowPlacement); GetWindowPlacement(Form.Handle, @WindowPlacement); Result := WindowPlacement.rcNormalPosition; {↓タスクバー上/左の場合のバグを修正} if not ( (Form.BorderStyle = bsToolWindow) or (Form.BorderStyle = bsSizeToolwin) ) then begin DesktopOrigination := NoneTaskBarDesktopRect.TopLeft; Result.Top := Result.Top + DesktopOrigination.y; Result.Bottom := Result.Bottom + DesktopOrigination.y; Result.Left := Result.Left + DesktopOrigination.x; Result.Right := Result.Right + DesktopOrigination.x; end; end; //------------------------------ {------------------------------- //ハンドルからWindowStateを調べる 引数説明: WndHandle: ハンドル //------------------------------} function GetWindowState(WndHandle: HWnd): TWindowState; var pw : TWINDOWPLACEMENT; begin pw.length := SizeOf(TWINDOWPLACEMENT); GetWindowPlacement(WndHandle, @pw); case pw.showCmd of SW_SHOWNORMAL:{=1} Result := wsNormal; SW_SHOWMINIMIZED: {=2} Result := wsMinimized; SW_MAXIMIZE: {=3} Result := wsMaximized; else raise Exception.Create('WindowStateのエラー'+IntToStr(pw.showCmd)); end; end; //------------------------------ {------------------------------- //Applicationの正しいWindowStateを調べる 機能: App.HandleとApp.MainForm.Handleから WindowStateを調べています 戻り値: Application自体のWindowState 処理: 1.AppがwsMiniならwsMinimizeを返す 2.AppがwsNormalならAppMainFormのWindowState (wsNormal/wsMaximizeになるはず)を返す 備考: MainFormのFormClose/FormDestroyで正常動作します FormCreateでの動作は確認していません。 履歴: 2001/03/29 //------------------------------} function AppWindowState: TWindowState; begin case GetWindowState(Application.Handle) of wsNormal: {←AppがwsNormalなら} begin {↓AppMainFormのWindowStateを戻す} case GetWindowState(Application.MainForm.Handle) of wsNormal: Result := wsNormal; wsMaximized: Result := wsMaximized; else raise Exception.Create('ApplicationWindowStateエラー'); Result := wsNormal; end; end; wsMinimized: {←AppがwsMiniなら} begin Result := wsMinimized; {←wsMinimized} end; else raise Exception.Create('ApplicationWindowStateエラー'); end; end; //------------------------------ { TFormPosition } constructor TFormPosition.Create(AOwner: TComponent); begin if not (AOwner is TForm) then begin raise Exception.Create('Form上で機能するコンポーネントです'); {↑設計時、Frame上に生成される事の防止} end; FDataSave := irsApplicationIni; FDataSaveName := ChangeFileExt( ExtractFileName(TForm(AOwner).Name) , '.ini'); inherited; end; destructor TFormPosition.Destroy; begin inherited; end; {------------------------------- // サブクラス化処理 機能: 備考: 履歴: 2003/04/12 //------------------------------} (*----------------------------------- constructor TFormPosition.Create(AOwner: TComponent); begin if AOwner is TForm then begin FOldFormProc := TCustomForm(AOwner).WindowProc; TCustomForm(AOwner).WindowProc := Self.FormWndProc; end else begin raise Exception.Create('Form上で機能するコンポーネントです'); {↑設計時、Frame上に生成される事の防止} end; FDataSave := irsApplicationIni; FDataSaveName := ChangeFileExt( ExtractFileName(TForm(AOwner).Name) , '.ini'); FAutoSaveLoad := False; inherited; end; //------------------------------- //メソッドが一致するかどうか調べる関数 function SameMethod(const A, B: TMethod): Boolean; begin if (A.Code = B.Code) and (A.Data = B.Data) then Result := True else Result := False; end; destructor TFormPosition.Destroy; var Method: TWndMethod; begin if Assigned(FOldFormProc) and (Self.Owner is TCustomForm) then begin Method := Self.FormWndProc; if SameMethod( TMethod(TCustomForm(Self.Owner).WindowProc), TMethod(Method) ) then begin TCustomForm(Self.Owner).WindowProc := FOldFormProc; FOldFormProc := nil; end else raise EComponentError.Create('サブクラス化解除失敗'); end; inherited; end; procedure TFormPosition.FormWndProc(var Message: TMessage); begin case Message.Msg of WM_CREATE: begin if FAutoSaveLoad then LoadWindowState; end; WM_CLOSE: begin if FAutoSaveLoad then SaveWindowState; end; end; //case FOldFormProc(Message); end; procedure TFormPosition.SetAutoSaveLoad(const Value: Boolean); begin FAutoSaveLoad := Value; end; //-----------------------------------*) //------------------------------ {------------------------------- // データ保存先指定処理 備考: 履歴: 2003/04/12 //------------------------------} procedure TFormPosition.SetDataSave(const Value: TIniRegSelect); var PathIndex: Integer; begin if FDataSave <> Value then begin FDataSave := Value; case FDataSave of irsApplicationIni: begin {↓Software\AAAをAAA.iniに変更} PathIndex := AnsiPos(PathDelim, FDataSaveName); if (1 <= PathIndex) and (PathIndex <= Length(FDataSaveName)-1) then FDataSaveName := copy(FDataSaveName, PathIndex+1, MaxInt); FDataSaveName := ChangeFileExt( FDataSaveName , '.ini'); end; irsHKEYCURRENTUSER: begin {↓AAA.iniをSoftware\AAAに変更} FDataSaveName := 'Software\' + ChangeFileExt(FDataSaveName, ''); end; end; end; end; procedure TFormPosition.SetDataSaveName(const Value: String); begin FDataSaveName := Value; end; function TFormPosition.DataSaveObjectCreate: TCustomIniFile; begin Result := nil; if FDataSaveName = '' then raise Exception.Create('データ格納先が指定されていません'); case FDataSave of irsApplicationIni: begin Result := TIniFile.Create(ExtractFilePath(Application.ExeName) + FDataSaveName); end; irsHKEYCURRENTUSER: begin Result := TRegistryIniFile.Create(FDataSaveName); end; end; end; //------------------------------ {------------------------------- // データ保存・読み込み処理 備考: 履歴: 2003/04/12 { ----------------------------------- //----------------------------------- } const {↓Ini/RegDataのパラメータ} irdState = 'State'; irdTop = 'Top'; irdLeft = 'Left'; irdWidth = 'Width'; irdHeight = 'Height'; {------------------------------- //Formの位置を保存します。 機能: Formの位置保存 処理： ・Dataの存在確認フラグを書き込み ・ApplicationのWindowStateを書き込み ・wsNormal時のFormRectを書き込み 備考: Form.FormDestroyや Form.FormCloseで使える。 履歴: 2000/11/07 2003/04/12 FormRestoreユニットの関数から FormPositionコンポのメソッドへ変更 2006/05/17 自信がないがTargetFormがMainFormじゃない場合の WindowStateの記述が誤っているようなので修正 //------------------------------} procedure TFormPosition.SaveWindowState(DataSaveObject: TCustomIniFile = nil); var TargetForm: TForm; wsNormalRect: TRect; ObjCreateFlag: Boolean; begin TargetForm := TForm(Self.Owner); ObjCreateFlag := False; if DataSaveObject = nil then begin ObjCreateFlag := True; DataSaveObject := DataSaveObjectCreate; end; with DataSaveObject do try if TargetForm = Application.MainForm then begin WriteInteger(TargetForm.Name, irdState, Ord(AppWindowState)); end else begin WriteInteger(TargetForm.Name, irdState, Ord(GetWindowState(TargetForm.Handle))); end; wsNormalRect := wsNormalPosition(TargetForm); WriteInteger(TargetForm.Name, irdLeft, wsNormalRect.Left); WriteInteger(TargetForm.Name, irdTop, wsNormalRect.Top); WriteInteger(TargetForm.Name, irdWidth, wsNormalRect.Right - wsNormalRect.Left); WriteInteger(TargetForm.Name, irdHeight, wsNormalRect.Bottom - wsNormalRect.Top); finally DataSaveObject.UpdateFile; if ObjCreateFlag = True then DataSaveObject.Free; end; end; //procedure TFormPosition.SaveWindowState(DataSaveObject: TCustomIniFile = nil); //var // TargetForm: TForm; // wsNormalRect: TRect; // ObjCreateFlag: Boolean; //begin // TargetForm := TForm(Owner); // // ObjCreateFlag := False; // if DataSaveObject = nil then // begin // ObjCreateFlag := True; // DataSaveObject := DataSaveObjectCreate; // end; // with DataSaveObject do // try // WriteInteger(TargetForm.Name, irdState, Ord(AppWindowState)); // // wsNormalRect := wsNormalPosition(TargetForm); // WriteInteger(TargetForm.Name, irdLeft, wsNormalRect.Left); // WriteInteger(TargetForm.Name, irdTop, wsNormalRect.Top); // WriteInteger(TargetForm.Name, irdWidth, wsNormalRect.Right - wsNormalRect.Left); // WriteInteger(TargetForm.Name, irdHeight, wsNormalRect.Bottom - wsNormalRect.Top); // // finally // DataSaveObject.UpdateFile; // if ObjCreateFlag = True then // DataSaveObject.Free; // end; //end; //------------------------------ {------------------------------- //Formの位置を復帰します。 機能: Formの位置復帰 処理： ・Dataの存在確認フラグを読み込み ・データがあるなら位置情報読み込み ・位置復帰とサイズ復帰フラグで 　poDesigned指定を選択　　 ・WindowStateを設定 ショートカットファイルによるCmdShowの設定は D5WinNt/D6WinXPでは自動設定される。 備考: Form.FormCreateや Form.Createのinherited以降で使える。 Form.FormShowでは使えない。 履歴: 2000/11/07 2003/04/12 FormRestoreユニットの関数から FormPositionコンポのメソッドへ変更 2003/04/27 DataSaveObjectを引数渡しでの指定も可能にした 2005/02/05 Minimize指定の場合にMainFormの時はApplicationWindowを最小化するように 変更した。 //------------------------------} procedure TFormPosition.LoadWindowState(DataSaveObject: TCustomIniFile = nil); var TargetForm: TForm; WindowState1: TWindowState; wsNormalRect: TRect; ObjCreateFlag: Boolean; begin TargetForm := TForm(Owner); ObjCreateFlag := False; if DataSaveObject = nil then begin ObjCreateFlag := True; DataSaveObject := DataSaveObjectCreate; end; with DataSaveObject do try if SectionExists(TargetForm.Name) then begin wsNormalRect := wsNormalPosition(TargetForm); wsNormalRect.Left := ReadInteger(TargetForm.Name, irdLeft, wsNormalRect.Left); wsNormalRect.Top := ReadInteger(TargetForm.Name, irdTop, wsNormalRect.Top); wsNormalRect.Right := wsNormalRect.Left + ReadInteger(TargetForm.Name, irdWidth, wsNormalRect.Right - wsNormalRect.Left); wsNormalRect.Bottom := wsNormalRect.Top + ReadInteger(TargetForm.Name, irdHeight, wsNormalRect.Bottom - wsNormalRect.Top); case FSaveType of stPosition: begin TargetForm.Position := poDesigned; TargetForm.BoundsRect := wsNormalRect; end; stOnlySize: begin TargetForm.Width := RectWidth(wsNormalRect); TargetForm.Height := RectHeight(wsNormalRect); end; end; WindowState1 := TWindowState(ReadInteger(TargetForm.Name, irdState, Ord(wsNormal))); (*----------------------------------- CmdShowに対しての処理を実行しなくても D5NT4/D6WinXP環境の場合TFormで自動的に処理される case CmdShow of SW_SHOWNORMAL: ;{=1 通常のウィンドウ/ShortCutパラメータ無し} SW_SHOWMINNOACTIVE: ;{=7 最小化} SW_SHOWMAXIMIZED: ;{=3 最大化} else ;{その他:IDEから起動するとなぜかSW_RESTORE=9になったりする} end; //case //-----------------------------------*) if (WindowState1 = wsMinimized) and (TargetForm = Application.MainForm) then begin Application.Minimize; end else begin TargetForm.WindowState := WindowState1; end; end; finally if ObjCreateFlag = True then DataSaveObject.Free; end; end; //------------------------------ end.