{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvOfficeColorForm.PAS, released on 2004-02-26. The Initial Developer of the Original Code is dejoy [dejoy att ynl dott gov dott cn] Portions created by Peter Thörnqvist are Copyright (C) 2004 Peter Thörnqvist. All Rights Reserved. Contributor(s): dejoy, Andreas Hausladen You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} // $Id: JvOfficeDragBarForm.pas 11641 2007-12-24 16:34:00Z outchy $ unit JvOfficeDragBarForm; interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} SysUtils, Classes, Windows, Messages, Graphics, Controls, Forms, StdCtrls, ExtCtrls, JvConsts, JvComponent; const MinDragBarHeight = 7; MinDragBarSpace = 3; Tag_DragBarHeight = 9; Tag_DragBarSpace = 10; JvDefaultSubDragBarActiveColor = clActiveCaption; JvDefaultSubDragBarInactiveColor = clInactiveCaption; type TJvOfficeDragBarForm = class; { Internal class } TJvOfficePanelDragBar = class(TJvWinControl) private FOwnerForm: TJvOfficeDragBarForm; protected procedure MouseEnter(Control: TControl); override; procedure MouseLeave(Control: TControl); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; end; TJvOfficeDragBarForm = class(TJvForm) private FBusy: Boolean; FInited: Boolean; FWordStyle: Boolean; FClient: TControl; FDragBar: TJvOfficePanelDragBar; FDragBarSpace: Integer; FDragBarHeight: Integer; FFlat: Boolean; FToolWindowStyle: Boolean; FOnShowingChanged: TNotifyEvent; FOnKillFocus: TNotifyEvent; FOnWindowStyleChanged: TNotifyEvent; FShowDragBar: Boolean; FDragBarHint: string; procedure FormDeactivate(Sender: TObject); procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SetMeasure(const Index, Value: Integer); procedure SetFlat(const Value: Boolean); procedure SetWordStyle(const Value: Boolean); procedure SetToolWindowStyle(const Value: Boolean); procedure SetShowDragBar(const Value: Boolean); procedure SetDragBarHint(const Value: string); protected DropDownMoved: Boolean; DropDownMoving: Boolean; MoveEnd: Boolean; MoveStart: Boolean; procedure SetClient(AControl: TControl); procedure Resize; override; procedure VisibleChanged; override; procedure CreateParams(var Params: TCreateParams); override; procedure FocusKilled(NextWnd: THandle); override; procedure ShowingChanged; override; property OnShowingChanged: TNotifyEvent read FOnShowingChanged write FOnShowingChanged; property OnKillFocus: TNotifyEvent read FOnKillFocus write FOnKillFocus; property OnWindowStyleChanged: TNotifyEvent read FOnWindowStyleChanged write FOnWindowStyleChanged; public constructor Create(AOwner: TComponent); override; procedure AdjustForm; virtual; property Client: TControl read FClient; property ShowDragBar: Boolean read FShowDragBar write SetShowDragBar default True; property DragBarHeight: Integer index Tag_DragBarHeight read FDragBarHeight write SetMeasure; property DragBarHint: string read FDragBarHint write SetDragBarHint; property DragBarSpace: Integer index Tag_DragBarSpace read FDragBarSpace write SetMeasure; property ToolWindowStyle: Boolean read FToolWindowStyle write SetToolWindowStyle default False; property Flat: Boolean read FFlat write SetFlat; procedure AfterConstruction; override; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvOfficeDragBarForm.pas $'; Revision: '$Revision: 11641 $'; Date: '$Date: 2007-12-24 17:34:00 +0100 (lun., 24 déc. 2007) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses JvResources; //=== { TJvOfficeDragBarForm } ================================================= constructor TJvOfficeDragBarForm.Create(AOwner: TComponent); var ParentControl: TWinControl; begin inherited CreateNew(AOwner); HintColor := Application.HintColor; FInited := False; FShowDragBar := True; // Scaled := False; AutoScroll := False; BorderIcons := []; BorderStyle := bsDialog; BorderWidth := 0; AutoSize := True; FormStyle := fsStayOnTop; FToolWindowStyle := False; ParentControl := Self; FDragBar := TJvOfficePanelDragBar.Create(Self); with FDragBar do begin Parent := ParentControl; FOwnerForm := Self; AutoSize := False; Caption := ''; Color := JvDefaultSubDragBarActiveColor; Height := MinDragBarHeight; ShowHint := True; end; SetWordStyle(True); KeyPreview := True; OnDeactivate := FormDeactivate; OnKeyUp := FormKeyUp; end; procedure TJvOfficeDragBarForm.AfterConstruction; begin inherited AfterConstruction; FInited := True; end; procedure TJvOfficeDragBarForm.SetClient(AControl: TControl); begin if FClient <> nil then FClient.Parent := nil; FClient := AControl; if FClient <> nil then FClient.Parent := Self; end; procedure TJvOfficeDragBarForm.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style and not WS_CAPTION; end; procedure TJvOfficeDragBarForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then begin Hide; ModalResult := mrCancel; end; end; procedure TJvOfficeDragBarForm.AdjustForm; var TempHeight: Integer; HasDragBar: Boolean; Offset: Integer; begin if not FInited or FBusy then Exit; FBusy := True; DisableAlign; if ShowDragBar and not ToolWindowStyle then begin FDragBar.Visible := True; HasDragBar := FDragBar.Visible; FDragBar.Height := FDragBarHeight; end else begin HasDragBar := False; FDragBar.Visible := False; end; Offset := 0; if HasDragBar then TempHeight := FDragBarHeight + FDragBarSpace * 2 else TempHeight := 0; ClientHeight := TempHeight + Client.ClientHeight + Offset * 2; Width := Client.Width + Offset * 2; if FDragBar.Visible then FDragBar.SetBounds(Offset, FDragBarSpace + Offset, Client.Width, FDragBarHeight); Client.SetBounds(Offset, TempHeight + 1, Client.Width, Client.Height); FBusy := False; end; procedure TJvOfficeDragBarForm.SetMeasure(const Index, Value: Integer); var MeasureItem: PInteger; MeasureConst: Integer; begin case Index of Tag_DragBarHeight: begin MeasureItem := @FDragBarHeight; MeasureConst := MinDragBarHeight; end; Tag_DragBarSpace: begin MeasureItem := @FDragBarSpace; MeasureConst := MinDragBarSpace; end; else Exit; end; if MeasureItem^ = Value then Exit; MeasureItem^ := Value; FWordStyle := False; if MeasureItem^ < MeasureConst then MeasureItem^ := MeasureConst; AdjustForm; end; procedure TJvOfficeDragBarForm.SetFlat(const Value: Boolean); begin if FFlat <> Value then begin FFlat := Value; end; end; procedure TJvOfficeDragBarForm.SetToolWindowStyle(const Value: Boolean); begin if ShowDragBar then begin FToolWindowStyle := Value; if Value then begin BorderIcons := [biSystemMenu]; BorderStyle := bsToolWindow; {$IFDEF COMPILER10_UP} if HandleAllocated then // BDS 2006 bug RecreateWnd; {$ENDIF COMPILER10_UP} FDragBar.Visible := False; end else begin BorderIcons := []; BorderStyle := bsDialog; {$IFDEF COMPILER10_UP} if HandleAllocated then // BDS 2006 bug RecreateWnd; {$ENDIF COMPILER10_UP} FDragBar.Visible := True; end; if not DropDownMoving then AdjustForm; if Assigned(FOnWindowStyleChanged) then FOnWindowStyleChanged(Self); end else begin FToolWindowStyle := False; BorderIcons := []; BorderStyle := bsDialog; {$IFDEF COMPILER10_UP} if HandleAllocated then // BDS 2006 bug RecreateWnd; {$ENDIF COMPILER10_UP} FDragBar.Visible := False; end; end; procedure TJvOfficeDragBarForm.ShowingChanged; begin inherited ShowingChanged; if Assigned(FOnShowingChanged) then FOnShowingChanged(ActiveControl); end; procedure TJvOfficeDragBarForm.FocusKilled(NextWnd: THandle); begin inherited FocusKilled(NextWnd); if Assigned(FOnKillFocus) and not DropDownMoving then FOnKillFocus(ActiveControl); end; procedure TJvOfficeDragBarForm.FormDeactivate(Sender: TObject); begin MoveStart := False; DropDownMoved := False; end; procedure TJvOfficeDragBarForm.VisibleChanged; begin inherited VisibleChanged; if not Visible then begin if ToolWindowStyle then ToolWindowStyle := False; DropDownMoving := False; MoveStart := False; DropDownMoved := False; end; end; procedure TJvOfficeDragBarForm.SetDragBarHint(const Value: string); begin if FDragBarHint<>Value then begin FDragBarHint := Value; FDragBar.Hint := Value; end; end; //=== { TJvOfficePanelDragBar } ========================================= procedure TJvOfficePanelDragBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if Button = mbLeft then TJvOfficeDragBarForm(FOwnerForm).MoveStart := True; end; procedure TJvOfficePanelDragBar.MouseEnter(Control: TControl); begin inherited MouseEnter(Control); Color := JvDefaultSubDragBarActiveColor; Cursor := crSizeAll; end; procedure TJvOfficePanelDragBar.MouseLeave(Control: TControl); begin inherited MouseLeave(Control); Color := JvDefaultSubDragBarInactiveColor; Cursor := crDefault; end; procedure TJvOfficeDragBarForm.Resize; begin inherited Resize; if FInited then AdjustForm; end; procedure TJvOfficeDragBarForm.SetWordStyle(const Value: Boolean); begin if FWordStyle <> Value then begin FWordStyle := Value; if FWordStyle then begin FDragBarHeight := MinDragBarHeight; FDragBarSpace := MinDragBarSpace; end; end; end; procedure DragControl(WinControl: TWinControl); const SM = $F012; begin ReleaseCapture; WinControl.Perform(WM_SYSCOMMAND, SM, 0); end; procedure TJvOfficePanelDragBar.MouseMove(Shift: TShiftState; X, Y: Integer); var lOwnerForm: TJvOfficeDragBarForm; begin inherited MouseMove(Shift, X, Y); lOwnerForm := TJvOfficeDragBarForm(FOwnerForm); if lOwnerForm.MoveStart or lOwnerForm.DropDownMoving then begin if not lOwnerForm.DropDownMoved then lOwnerForm.DropDownMoved := True; if lOwnerForm.MoveStart and not lOwnerForm.ToolWindowStyle then begin lOwnerForm.ToolWindowStyle := True; lOwnerForm.AdjustForm; end; DragControl(lOwnerForm); lOwnerForm.DropDownMoving := True; lOwnerForm.MoveStart := False; end; end; procedure TJvOfficePanelDragBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); if Button = mbLeft then begin FOwnerForm.MoveStart := False; FOwnerForm.DropDownMoving := False; end; end; procedure TJvOfficeDragBarForm.SetShowDragBar(const Value: Boolean); begin FShowDragBar := Value; if Value then begin if not DropDownMoved then FDragBar.Visible := True; end else begin if DropDownMoved then SetToolWindowStyle(False); end; AdjustForm; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.