⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 placemnt.pas

📁 RX Library contains a large number of components, objects and routines for Borland Delphi with full
💻 PAS
📖 第 1 页 / 共 3 页
字号:
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 + -