📄 placemnt.pas
字号:
begin
if FPreventResize and (Owner is TCustomForm) then begin
case Msg.Msg of
WM_GETMINMAXINFO:
if Form.HandleAllocated and IsWindowVisible(Form.Handle) then begin
with TWMGetMinMaxInfo(Msg).MinMaxInfo^ do begin
ptMinTrackSize := Point(Form.Width, Form.Height);
ptMaxTrackSize := Point(Form.Width, Form.Height);
end;
Msg.Result := 1;
end;
WM_INITMENUPOPUP:
if TWMInitMenuPopup(Msg).SystemMenu then begin
if Form.Menu <> nil then
Form.Menu.DispatchPopup(TWMInitMenuPopup(Msg).MenuPopup);
EnableMenuItem(TWMInitMenuPopup(Msg).MenuPopup, SC_SIZE,
MF_BYCOMMAND or MF_GRAYED);
EnableMenuItem(TWMInitMenuPopup(Msg).MenuPopup, SC_MAXIMIZE,
MF_BYCOMMAND or MF_GRAYED);
Msg.Result := 1;
end;
WM_NCHITTEST:
begin
if Msg.Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT]
then Msg.Result := HTNOWHERE;
end;
end;
end
else if (Msg.Msg = WM_GETMINMAXINFO) then begin
if CheckMinMaxInfo then begin
with TWMGetMinMaxInfo(Msg).MinMaxInfo^ do begin
if FWinMinMaxInfo.MinTrackWidth <> 0 then
ptMinTrackSize.X := FWinMinMaxInfo.MinTrackWidth;
if FWinMinMaxInfo.MinTrackHeight <> 0 then
ptMinTrackSize.Y := FWinMinMaxInfo.MinTrackHeight;
if FWinMinMaxInfo.MaxTrackWidth <> 0 then
ptMaxTrackSize.X := FWinMinMaxInfo.MaxTrackWidth;
if FWinMinMaxInfo.MaxTrackHeight <> 0 then
ptMaxTrackSize.Y := FWinMinMaxInfo.MaxTrackHeight;
if FWinMinMaxInfo.MaxSizeWidth <> 0 then
ptMaxSize.X := FWinMinMaxInfo.MaxSizeWidth;
if FWinMinMaxInfo.MaxSizeHeight <> 0 then
ptMaxSize.Y := FWinMinMaxInfo.MaxSizeHeight;
if FWinMinMaxInfo.MaxPosLeft <> 0 then
ptMaxPosition.X := FWinMinMaxInfo.MaxPosLeft;
if FWinMinMaxInfo.MaxPosTop <> 0 then
ptMaxPosition.Y := FWinMinMaxInfo.MaxPosTop;
end;
end
else begin
TWMGetMinMaxInfo(Msg).MinMaxInfo^.ptMaxPosition.X := 0;
TWMGetMinMaxInfo(Msg).MinMaxInfo^.ptMaxPosition.Y := 0;
end;
Msg.Result := 1;
end;
end;
procedure TFormPlacement.FormShow(Sender: TObject);
begin
if Active then
try
RestoreFormPlacement;
except
Application.HandleException(Self);
end;
if Assigned(FSaveFormShow) then FSaveFormShow(Sender);
end;
procedure TFormPlacement.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Assigned(FSaveFormCloseQuery) then
FSaveFormCloseQuery(Sender, CanClose);
if CanClose and Active and (Owner is TCustomForm) and (Form.Handle <> 0) then
try
SaveFormPlacement;
except
Application.HandleException(Self);
end;
end;
procedure TFormPlacement.FormDestroy(Sender: TObject);
begin
if Active and not FSaved then begin
FDestroying := True;
try
SaveFormPlacement;
except
Application.HandleException(Self);
end;
FDestroying := False;
end;
if Assigned(FSaveFormDestroy) then FSaveFormDestroy(Sender);
end;
procedure TFormPlacement.UpdatePlacement;
const
{$IFDEF WIN32}
Metrics: array[bsSingle..bsSizeToolWin] of Word =
(SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME, SM_CXBORDER, SM_CXFRAME);
{$ELSE}
Metrics: array[bsSingle..bsDialog] of Word =
(SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME);
{$ENDIF}
var
Placement: TWindowPlacement;
begin
if (Owner <> nil) and (Owner is TCustomForm) and Form.HandleAllocated and
not (csLoading in ComponentState) then
if not (FPreventResize or CheckMinMaxInfo) then begin
Placement.Length := SizeOf(TWindowPlacement);
GetWindowPlacement(Form.Handle, @Placement);
if not IsWindowVisible(Form.Handle) then
Placement.ShowCmd := SW_HIDE;
if Form.BorderStyle <> bsNone then begin
Placement.ptMaxPosition.X := -GetSystemMetrics(Metrics[Form.BorderStyle]);
Placement.ptMaxPosition.Y := -GetSystemMetrics(Metrics[Form.BorderStyle] + 1);
end
else Placement.ptMaxPosition := Point(0, 0);
SetWindowPlacement(Form.Handle, @Placement);
end;
end;
procedure TFormPlacement.UpdatePreventResize;
var
IsActive: Boolean;
begin
if not (csDesigning in ComponentState) and (Owner is TCustomForm) then
begin
if FPreventResize then
FDefMaximize := (biMaximize in Form.BorderIcons);
IsActive := Active;
Active := False;
try
if (not FPreventResize) and FDefMaximize and
(Form.BorderStyle <> bsDialog) then
Form.BorderIcons := Form.BorderIcons + [biMaximize]
else Form.BorderIcons := Form.BorderIcons - [biMaximize];
finally
Active := IsActive;
end;
if not (csLoading in ComponentState) then CheckToggleHook;
end;
end;
procedure TFormPlacement.SetPreventResize(Value: Boolean);
begin
if (Form <> nil) and (FPreventResize <> Value) then begin
FPreventResize := Value;
UpdatePlacement;
UpdatePreventResize;
end;
end;
function TFormPlacement.GetIniFile: TObject;
begin
{$IFDEF WIN32}
if UseRegistry then Result := FRegIniFile
else Result := FIniFile;
{$ELSE}
Result := FIniFile;
{$ENDIF WIN32}
end;
function TFormPlacement.GetIniFileName: string;
begin
Result := FIniFileName;
if (Result = '') and not (csDesigning in ComponentState) then begin
{$IFDEF WIN32}
if UseRegistry then Result := GetDefaultIniRegKey
else Result := GetDefaultIniName;
{$ELSE}
Result := GetDefaultIniName;
{$ENDIF}
end;
end;
procedure TFormPlacement.SetIniFileName(const Value: string);
begin
FIniFileName := Value;
end;
function TFormPlacement.GetIniSection: string;
begin
Result := FIniSection;
if (Result = '') and not (csDesigning in ComponentState) then
Result := GetDefaultSection(Owner);
end;
procedure TFormPlacement.SetIniSection(const Value: string);
begin
FIniSection := Value;
end;
procedure TFormPlacement.Save;
begin
if Assigned(FOnSavePlacement) then FOnSavePlacement(Self);
end;
procedure TFormPlacement.Restore;
begin
if Assigned(FOnRestorePlacement) then FOnRestorePlacement(Self);
end;
procedure TFormPlacement.SavePlacement;
begin
if Owner is TCustomForm then begin
{$IFDEF WIN32}
if UseRegistry then begin
if (Options * [fpState, fpPosition] <> []) then begin
WriteFormPlacementReg(Form, FRegIniFile, IniSection);
FRegIniFile.WriteBool(IniSection, siVisible, FDestroying);
end;
if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
FRegIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
end
else begin
if (Options * [fpState, fpPosition] <> []) then begin
WriteFormPlacement(Form, FIniFile, IniSection);
FIniFile.WriteBool(IniSection, siVisible, FDestroying);
end;
if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
FIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
end;
{$ELSE}
if (Options * [fpState, fpPosition] <> []) then begin
WriteFormPlacement(Form, FIniFile, IniSection);
FIniFile.WriteBool(IniSection, siVisible, FDestroying);
end;
if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
FIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
{$ENDIF}
end;
NotifyLinks(poSave);
end;
procedure TFormPlacement.RestorePlacement;
begin
if Owner is TCustomForm then begin
{$IFDEF WIN32}
if UseRegistry then
ReadFormPlacementReg(Form, FRegIniFile, IniSection, fpState in Options,
fpPosition in Options)
else
{$ENDIF}
ReadFormPlacement(Form, FIniFile, IniSection, fpState in Options,
fpPosition in Options);
end;
NotifyLinks(poRestore);
end;
procedure TFormPlacement.IniNeeded(ReadOnly: Boolean);
begin
if IniFileObject = nil then begin
{$IFDEF WIN32}
if UseRegistry then begin
FRegIniFile := TRegIniFile.Create(IniFileName);
{$IFDEF RX_D5}
if ReadOnly then FRegIniFile.Access := KEY_READ;
{$ENDIF}
case FRegistryRoot of
prLocalMachine:
FRegIniFile.RootKey := HKEY_LOCAL_MACHINE;
prClassesRoot:
FRegIniFile.RootKey := HKEY_CLASSES_ROOT;
prCurrentConfig:
FRegIniFile.RootKey := HKEY_CURRENT_CONFIG;
prUsers:
FRegIniFile.RootKey := HKEY_USERS;
prDynData:
FRegIniFile.RootKey := HKEY_DYN_DATA;
end;
if FRegIniFile.RootKey <> HKEY_CURRENT_USER then
FRegIniFile.OpenKey(FRegIniFile.FileName, not ReadOnly);
end
else
{$ENDIF}
FIniFile := TIniFile.Create(IniFileName);
end;
end;
procedure TFormPlacement.IniFree;
begin
if IniFileObject <> nil then begin
IniFileObject.Free;
FIniFile := nil;
{$IFDEF WIN32}
FRegIniFile := nil;
{$ENDIF}
end;
end;
function TFormPlacement.DoReadString(const Section, Ident,
Default: string): string;
begin
if IniFileObject <> nil then
Result := IniReadString(IniFileObject, Section, Ident, Default)
else begin
IniNeeded(True);
try
Result := IniReadString(IniFileObject, Section, Ident, Default);
finally
IniFree;
end;
end;
end;
function TFormPlacement.ReadString(const Ident, Default: string): string;
begin
Result := DoReadString(IniSection, Ident, Default);
end;
procedure TFormPlacement.DoWriteString(const Section, Ident, Value: string);
begin
if IniFileObject <> nil then
IniWriteString(IniFileObject, Section, Ident, Value)
else begin
IniNeeded(False);
try
IniWriteString(IniFileObject, Section, Ident, Value);
finally
IniFree;
end;
end;
end;
procedure TFormPlacement.WriteString(const Ident, Value: string);
begin
DoWriteString(IniSection, Ident, Value);
end;
function TFormPlacement.ReadInteger(const Ident: string; Default: Longint): Longint;
begin
if IniFileObject <> nil then
Result := IniReadInteger(IniFileObject, IniSection, Ident, Default)
else begin
IniNeeded(True);
try
Result := IniReadInteger(IniFileObject, IniSection, Ident, Default);
finally
IniFree;
end;
end;
end;
procedure TFormPlacement.WriteInteger(const Ident: string; Value: Longint);
begin
if IniFileObject <> nil then
IniWriteInteger(IniFileObject, IniSection, Ident, Value)
else begin
IniNeeded(False);
try
IniWriteInteger(IniFileObject, IniSection, Ident, Value);
finally
IniFree;
end;
end;
end;
procedure TFormPlacement.EraseSections;
var
Lines: TStrings;
I: Integer;
begin
if IniFileObject = nil then begin
IniNeeded(False);
try
Lines := TStringList.Create;
try
IniReadSections(IniFileObject, Lines);
for I := 0 to Lines.Count - 1 do begin
if (Lines[I] = IniSection) or
(IsWild(Lines[I], IniSection + '.*', False) or
IsWild(Lines[I], IniSection + '\*', False)) then
IniEraseSection(IniFileObject, Lines[I]);
end;
finally
Lines.Free;
end;
finally
IniFree;
end;
end;
end;
procedure TFormPlacement.SaveFormPlacement;
begin
if FRestored or not Active then begin
IniNeeded(False);
try
WriteInteger(siVersion, FVersion);
SavePlacement;
Save;
FSaved := True;
finally
IniFree;
end;
end;
end;
procedure TFormPlacement.RestoreFormPlacement;
var
cActive: TComponent;
begin
FSaved := False;
IniNeeded(True);
try
if ReadInteger(siVersion, 0) >= FVersion then begin
RestorePlacement;
FRestored := True;
Restore;
if (fpActiveControl in Options) and (Owner is TCustomForm) then begin
cActive := Form.FindComponent(IniReadString(IniFileObject,
IniSection, siActiveCtrl, ''));
if (cActive <> nil) and (cActive is TWinControl) and
TWinControl(cActive).CanFocus then
Form.ActiveControl := TWinControl(cActive);
end;
end;
FRestored := True;
finally
IniFree;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -