jvformplacement.pas

East make Tray Icon in delphi

procedure TJvFormPlacement.MinMaxInfoModified;
begin
  UpdatePlacement;
  {$IFDEF VCL}
  if not (csLoading in ComponentState) then
    CheckToggleHook;
  {$ENDIF VCL}
end;

procedure TJvFormPlacement.SetWinMinMaxInfo(AValue: TJvWinMinMaxInfo);
begin
  FWinMinMaxInfo.Assign(AValue);
end;

{$IFDEF VCL}
procedure TJvFormPlacement.WndMessage(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);
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;
{$ENDIF VCL}

procedure TJvFormPlacement.FormShow(Sender: TObject);
begin
  if IsActive then
  try
    RestoreFormPlacement;
  except
    Application.HandleException(Self);
  end;
  if Assigned(FSaveFormShow) then
    FSaveFormShow(Sender);
end;

procedure TJvFormPlacement.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(FSaveFormCloseQuery) then
    FSaveFormCloseQuery(Sender, CanClose);
  if CanClose and IsActive and (Owner is TCustomForm) and (Form.Handle <> NullHandle) then
  try
    SaveFormPlacement;
  except
    Application.HandleException(Self);
  end;
end;

procedure TJvFormPlacement.FormDestroy(Sender: TObject);
begin
  if IsActive and not FSaved then
  begin
    FDestroying := True;
    try
      SaveFormPlacement;
    except
      Application.HandleException(Self);
    end;
    FDestroying := False;
  end;
  if Assigned(FSaveFormDestroy) then
    FSaveFormDestroy(Sender);
end;

{$IFDEF VisualCLX}
procedure TJvFormPlacement.FormConstrainedResize(Sender: TObject; var MinWidth, MinHeight,
  MaxWidth, MaxHeight: Integer);
begin
  if FPreventResize and (Owner is TCustomForm) then
  begin
    if FWinMinMaxInfo.MinTrackWidth <> 0 then
      MinWidth := FWinMinMaxInfo.MinTrackWidth;
    if FWinMinMaxInfo.MinTrackHeight <> 0 then
      MinHeight := 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
      MaxWidth := FWinMinMaxInfo.MaxSizeWidth;
    if FWinMinMaxInfo.MaxSizeHeight <> 0 then
      MaxHeight := FWinMinMaxInfo.MaxSizeHeight;

    if FWinMinMaxInfo.MaxPosLeft <> 0 then
      if TCustomForm(Owner).Left > FWinMinMaxInfo.MaxPosLeft then
        TCustomForm(Owner).Left := FWinMinMaxInfo.MaxPosLeft;
    if FWinMinMaxInfo.MaxPosTop <> 0 then
      if TCustomForm(Owner).Top > FWinMinMaxInfo.MaxPosTop then
        TCustomForm(Owner).Top := FWinMinMaxInfo.MaxPosTop;
  end;
  if Assigned(FSaveFormConstrainedResize) then
    FSaveFormConstrainedResize(Sender, MinWidth, MinHeight, MaxWidth, MaxHeight);
end;
{$ENDIF VisualCLX}

procedure TJvFormPlacement.UpdatePlacement;
const
  {$IFDEF VCL}
  Metrics: array [bsSingle..bsSizeToolWin] of Word =
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Metrics: array [fbsSingle..fbsSizeToolWin] of TSysMetrics =
  {$ENDIF VisualCLX}
    (SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME, SM_CXBORDER, SM_CXFRAME);
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 <> fbsNone then
      begin
        Placement.ptMaxPosition.X := -GetSystemMetrics(Metrics[Form.BorderStyle]);
        Placement.ptMaxPosition.Y := -GetSystemMetrics(Succ(Metrics[Form.BorderStyle]));
      end
      else
        Placement.ptMaxPosition := Point(0, 0);
      SetWindowPlacement(Form.Handle, @Placement);
    end;
end;

procedure TJvFormPlacement.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 <> fbsDialog) then
        Form.BorderIcons := Form.BorderIcons + [biMaximize]
      else
        Form.BorderIcons := Form.BorderIcons - [biMaximize];
    finally
      Active := IsActive;
    end;
    {$IFDEF VCL}
    if not (csLoading in ComponentState) then
      CheckToggleHook;
    {$ENDIF VCL}
  end;
end;

procedure TJvFormPlacement.SetPreventResize(AValue: Boolean);
begin
  if (Form <> nil) and (FPreventResize <> AValue) then
  begin
    FPreventResize := AValue;
    UpdatePlacement;
    UpdatePreventResize;
  end;
end;

procedure TJvFormPlacement.Save;
begin
  if Assigned(FOnSavePlacement) then
    FOnSavePlacement(Self);
end;

procedure TJvFormPlacement.Restore;
begin
  if Assigned(FOnRestorePlacement) then
    FOnRestorePlacement(Self);
end;

procedure TJvFormPlacement.SavePlacement;
begin
  if Owner is TCustomForm then
  begin
    if Options <> [fpActiveControl] then
    begin
      InternalSaveFormPlacement(Form, AppStorage, AppStoragePath, Options);
      if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
        AppStorage.WriteString(AppStoragePath + siActiveCtrl, Form.ActiveControl.Name);
    end;
  end;
  NotifyLinks(poSave);
end;

procedure TJvFormPlacement.RestorePlacement;
begin
  if Owner is TCustomForm then
    InternalRestoreFormPlacement(Form, AppStorage, AppStoragePath, Options);
  NotifyLinks(poRestore);
end;

function TJvFormPlacement.ConcatPaths(const Paths: array of string): string;
begin
  if Assigned(AppStorage) then
    Result := AppStorage.ConcatPaths(Paths)
  else
    Result := '';
end;

function TJvFormPlacement.ReadString(const Ident: string; const Default: string = ''): string;
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      Result := ReadString(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, True)]), Default)
  else
    Result := Default;
end;

procedure TJvFormPlacement.WriteString(const Ident, AValue: string);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteString(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), AValue);
end;

function TJvFormPlacement.ReadBoolean(const Ident: string; Default: Boolean): Boolean;
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      Result := ReadBoolean(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, True)]), Default)
  else
    Result := Default;
end;

procedure TJvFormPlacement.WriteBoolean(const Ident: string; AValue: Boolean);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteBoolean(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), AValue);
end;

function TJvFormPlacement.ReadFloat(const Ident: string; Default: Double = 0): Double;
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      Result := ReadFloat(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, True)]), Default)
  else
    Result := Default;
end;

procedure TJvFormPlacement.WriteFloat(const Ident: string; AValue: Double);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteFloat(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), AValue);
end;

function TJvFormPlacement.ReadInteger(const Ident: string; Default: Longint = 0): Longint;
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      Result := ReadInteger(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, True)]), Default)
  else
    Result := Default;
end;

procedure TJvFormPlacement.WriteInteger(const Ident: string; AValue: Longint);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteInteger(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), AValue);
end;

function TJvFormPlacement.ReadDateTime(const Ident: string; Default: TDateTime = 0): TDateTime;
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      Result := ReadDateTime(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, True)]), Default)
  else
    Result := Default;
end;

procedure TJvFormPlacement.WriteDateTime(const Ident: string; AValue: TDateTime);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteDateTime(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), AValue);
end;

procedure TJvFormPlacement.EraseSections;
begin
  AppStorage.DeleteSubTree(AppStoragePath);
end;

function TJvFormPlacement.IsActive: Boolean;
begin
  Result := Active and (AppStorage <> nil);
end;

procedure TJvFormPlacement.SaveFormPlacement;
begin
  { (marcelb) say what? Store when the component has done a restore previously or if it's inactive?
    I think it should only store if Active is set to True. Changed accordingly }
//  if FRestored or not Active then
  if Assigned(AppStorage) then
  begin
    WriteInteger(siVersion, FVersion);
    Save;
    SavePlacement;
    FSaved := True;
  end;
end;

procedure TJvFormPlacement.RestoreFormPlacement;
var
  ActiveCtl: TComponent;
  ReadVersion: Integer;
  ContinueRestore: Boolean;
begin
  if Assigned(AppStorage) then
  begin
    FSaved := False;
    ReadVersion := ReadInteger(siVersion, 0);
    case VersionCheck of
      fpvcNocheck:
        ContinueRestore := True;
      fpvcCheckGreaterEqual:
        ContinueRestore := ReadVersion >= FVersion;
      fpvcCheckEqual:
        ContinueRestore := ReadVersion = FVersion;
    else
      ContinueRestore := False;
    end;
    if ContinueRestore then
    begin
      RestorePlacement;             
      FRestored := True;
      Restore;
      if (fpActiveControl in Options) and (Owner is TCustomForm) then
      begin
        ActiveCtl := Form.FindComponent(AppStorage.ReadString(AppStorage.ConcatPaths([AppStoragePath, siActiveCtrl]), ''));
        if (ActiveCtl <> nil) and (ActiveCtl is TWinControl) and
          TWinControl(ActiveCtl).CanFocus then
          Form.ActiveControl := TWinControl(ActiveCtl);
      end;
    end;
    FRestored := True;
  end;
  UpdatePlacement;
end;

procedure TJvFormPlacement.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = AppStorage) then
    AppStorage := nil;
end;

//=== { TJvWinMinMaxInfo } ===================================================

procedure TJvWinMinMaxInfo.Assign(Source: TPersistent);
begin
  if Source is TJvWinMinMaxInfo then
  begin
    FMinMaxInfo := TJvWinMinMaxInfo(Source).FMinMaxInfo;
    if FOwner <> nil then
      FOwner.MinMaxInfoModified;
  end
  else
    inherited Assign(Source);
end;

function TJvWinMinMaxInfo.GetMinMaxInfo(Index: Integer): Integer;
begin
  with FMinMaxInfo do
  begin
    case Index of
      0:
        Result := ptMaxPosition.X;
      1:
        Result := ptMaxPosition.Y;
      2:
        Result := ptMaxSize.Y;
      3:
        Result := ptMaxSize.X;
      4:
        Result := ptMaxTrackSize.Y;
      5:
        Result := ptMaxTrackSize.X;
      6:
        Result := ptMinTrackSize.Y;
      7:
        Result := ptMinTrackSize.X;
    else
      Result := 0;
    end;
  end;
end;