jvqformplacement.pas

East make Tray Icon in delphi

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;


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;


procedure TJvFormPlacement.UpdatePlacement;
const  
  Metrics: array [fbsSingle..fbsSizeToolWin] of TSysMetrics = 
    (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; 
  end;
end;

procedure TJvFormPlacement.SetPreventResize(Value: Boolean);
begin
  if (Form <> nil) and (FPreventResize <> Value) then
  begin
    FPreventResize := Value;
    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, Value: string);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteString(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), Value);
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; Value: Boolean);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteBoolean(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), Value);
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; Value: Double);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteFloat(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), Value);
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; Value: Longint);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteInteger(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), Value);
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; Value: TDateTime);
begin
  if Assigned(AppStorage) and (Ident <> '') then
    with AppStorage do
      WriteDateTime(ConcatPaths([AppStoragePath, TranslatePropertyName(Self, Ident, False)]), Value);
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;

procedure TJvWinMinMaxInfo.SetMinMaxInfo(Index: Integer; Value: Integer);
begin
  if GetMinMaxInfo(Index) <> Value then
  begin
    with FMinMaxInfo do
    begin
      case Index of
        0:
          ptMaxPosition.X := Value;
        1:
          ptMaxPosition.Y := Value;
        2:
          ptMaxSize.Y := Value;
        3:
          ptMaxSize.X := Value;
        4:
          ptMaxTrackSize.Y := Value;
        5:
          ptMaxTrackSize.X := Value;
        6:
          ptMinTrackSize.Y := Value;
        7:
          ptMinTrackSize.X := Value;
      end;
    end;
    if FOwner <> nil then
      FOwner.MinMaxInfoModified;
  end;
end;

function TJvWinMinMaxInfo.DefaultMinMaxInfo: Boolean;
begin
  with FMinMaxInfo do
  begin
    Result := not ((ptMinTrackSize.X <> 0) or (ptMinTrackSize.Y <> 0) or
      (ptMaxTrackSize.X <> 0) or (ptMaxTrackSize.Y <> 0) or
      (ptMaxSize.X <> 0) or (ptMaxSize.Y <> 0) or
      (ptMaxPosition.X <> 0) or (ptMaxPosition.Y <> 0));
  end;
end;

//=== { TJvFormStorage } =====================================================

constructor TJvFormStorage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStoredProps := TStringList.Create;
  FStoredValues := TJvStoredValues.Create(Self);
  FStoredValues.Storage := Self;
end;

destructor TJvFormStorage.Destroy;