jvdocksupportcontrol.pas

East make Tray Icon in delphi

    FSaveCount: Integer;
    FDragObject: TJvDockDragDockObject;
    FDragControl: TControl;
    FDragFreeObject: Boolean;
    FDragCapture: HWND;
    FDragStartPos: TPoint;
    FDragSaveCursor: HCURSOR;
    FDragThreshold: Integer;
    FActiveDrag: TJvDockDragOperation;
    FDragImageList: TDragImageList;
    FDockSiteList: TList;
    FQualifyingSites: TSiteList;
    procedure BeginLoad;
    procedure EndLoad;
    procedure BeginSave;
    procedure EndSave;
  public
    procedure CalcDockSizes(Control: TControl);
    constructor Create; virtual;
    destructor Destroy; override;
    procedure AddDockServerToDockManager(AControl: TControl);
    procedure AddDockClientToDockManager(AControl: TControl);
    procedure RemoveDockServerFromDockManager(AControl: TControl);
    procedure RemoveDockClientFromDockManager(AControl: TControl);
    function FindDockServerForm(const AName: string): TControl;
    function FindDockClientForm(const AName: string): TControl;
    function FindDockControlForm(const AName: string): TControl;
    function IsDockLoading: Boolean;
    function IsSaving: Boolean;
    procedure ShowDockForm(DockWindow: TWinControl);
    procedure HideDockForm(DockWindow: TWinControl);
    function GetFormVisible(DockWindow: TWinControl): Boolean;
    procedure SetTabDockHostBorderStyle(Value: TFormBorderStyle);
    procedure SetConjoinDockHostBorderStyle(Value: TFormBorderStyle);
    {$IFDEF USEJVCL}
    procedure SaveDockTreeToAppStorage(AppStorage: TJvCustomAppStorage; const AppStoragePath: string = '');
    procedure LoadDockTreeFromAppStorage(AppStorage: TJvCustomAppStorage; const AppStoragePath: string = '');
    {$ELSE}
    procedure SaveDockTreeToFile(const FileName: string);
    procedure LoadDockTreeFromFile(const FileName: string);
    procedure SaveDockTreeToReg(RootKey: DWORD; const RegPatch: string);
    procedure LoadDockTreeFromReg(RootKey: DWORD; const RegPatch: string);
    {$ENDIF USEJVCL}
    procedure BeginDrag(Control: TControl;
      Immediate: Boolean; Threshold: Integer = -1); virtual;
    procedure DragInitControl(Control: TControl;
      Immediate: Boolean; Threshold: Integer); virtual;
    procedure DragInit(ADragObject: TJvDockDragDockObject;
      Immediate: Boolean; Threshold: Integer); virtual;
    procedure DragTo(const Pos: TPoint); virtual;
    procedure DragDone(Drop: Boolean); virtual;
    procedure CancelDrag; virtual;
    procedure ResetCursor; virtual;
    function DragFindTarget(const Pos: TPoint; var Handle: HWND;
      DragKind: TDragKind; Client: TControl): Pointer; virtual;
    procedure DoGetSiteInfo(Target, Client: TControl; var InfluenceRect: TRect;
      MousePos: TPoint; var CanDock: Boolean); virtual;
    function DoDockOver(DragState: TDragState): Boolean; virtual;
    procedure DoDockDrop(Source: TJvDockDragDockObject; Pos: TPoint); virtual;
    function DoUnDock(Source: TJvDockDragDockObject; Target: TWinControl; Client: TControl): Boolean; virtual;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); virtual;
    function DragFindWindow(const Pos: TPoint): HWND; virtual;
    function GetDockSiteAtPos(MousePos: TPoint; Client: TControl): TWinControl; virtual;
    procedure DoGetDockEdge(Target: TControl; MousePos: TPoint; var DropAlign: TAlign); virtual;
    procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean); virtual;
    property DockServersList: TList read FDockServersList;
    property DockClientsList: TList read FDockClientsList;
    property DockServersHash: TJvDockControlHashTable read FDockServersHash;
    property DockClientsHash: TJvDockControlHashTable read FDockClientsHash;
    property DockableFormList: TList read FDockableFormList;
    property DragObject: TJvDockDragDockObject read FDragObject write FDragObject;
  end;

  {$IFDEF USEJVCL}
  TJvDockCustomPanelSplitter = class(TJvCustomControl)
  {$ELSE}
  TJvDockCustomPanelSplitter = class(TCustomControl)
  {$ENDIF USEJVCL}
  private
    FActiveControl: TWinControl;
    FAutoSnap: Boolean;
    FBeveled: Boolean;
    FBrush: TBrush;
    FControl: TControl;
    FDownPos: TPoint;
    FLineDC: HDC;
    FLineVisible: Boolean;
    FMinSize: NaturalNumber;
    FMaxSize: Integer;
    FNewSize: Integer;
    FOldKeyDown: TKeyEvent;
    FOldSize: Integer;
    FPrevBrush: HBRUSH;
    FResizeStyle: TResizeStyle;
    FSplit: Integer;
    FOnCanResize: TCanResizeEvent;
    FOnMoved: TNotifyEvent;
    FOnPaint: TNotifyEvent;
    procedure AllocateLineDC;
    procedure CalcSplitSize(X, Y: Integer; var NewSize, Split: Integer);
    procedure DrawLine;
    procedure FocusKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ReleaseLineDC;
    procedure SetBeveled(Value: Boolean);
    procedure UpdateControlSize;
    procedure UpdateSize(X, Y: Integer);
  protected
    function CanResize(var NewSize: Integer): Boolean; reintroduce; virtual;
    function DoCanResize(var NewSize: Integer): Boolean; virtual;
    function FindControl: TControl; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    procedure RequestAlign; override;
    procedure StopSizing; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas;
  published
    property Align default alLeft;
    property AutoSnap: Boolean read FAutoSnap write FAutoSnap default True;
    property Beveled: Boolean read FBeveled write SetBeveled default False;
    property Color;
    property Constraints;
    property MinSize: NaturalNumber read FMinSize write FMinSize default 30;
    property ParentColor;
    property ResizeStyle: TResizeStyle read FResizeStyle write FResizeStyle
      default rsPattern;
    property Visible;
    property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
    property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDockSupportControl.pas,v $';
    Revision: '$Revision: 1.28 $';
    Date: '$Date: 2005/02/17 10:20:24 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  ComStrs, Consts, SysUtils,
  JvDockGlobals, JvDockControlForm, JvDockSupportProc;

type
  TlbNCButtonProc = procedure(Msg: TWMNCHitMessage; Button: TMouseButton;
    MouseStation: TJvDockMouseStation) of object;

  PCheckTargetInfo = ^TCheckTargetInfo;
  TCheckTargetInfo = record
    ClientWnd: HWND;
    TargetWnd: HWND;
    CurrentWnd: HWND;
    MousePos: TPoint;
    Found: Boolean;
  end;

  TControlAccessProtected = class(TControl);
  TWinControlAccessProtected = class(TWinControl);

//=== Local procedures =======================================================

function ButtonEvent(Page: TJvDockPageControl; Msg: TWMMouse;
  Button: TMouseButton; MouseStation: TJvDockMouseStation; Proc: TlbNCButtonProc): TControl;
begin
  Result := Page.GetDockClientFromMousePos(SmallPointToPoint(Msg.Pos));
  if (Result <> nil) and Assigned(Proc) then
  begin
    JvGlobalDockClient := FindDockClient(Result);
    Proc(Page.DoMouseEvent(Msg, Page), Button, MouseStation);
  end;
end;

procedure TabControlError(const S: string);
begin
  raise EListError.Create(S);
end;

procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean);
var
  Style: Integer;
begin
  if Ctl.HandleAllocated then
  begin
    Style := GetWindowLong(Ctl.Handle, GWL_STYLE);
    if not UseStyle then
      Style := Style and not Value
    else
      Style := Style or Value;
    SetWindowLong(Ctl.Handle, GWL_STYLE, Style);
  end;
end;

function IsBeforeTargetWindow(Window: HWND; Data: Longint): Bool; stdcall;
var
  R: TRect;
begin
  if Window = PCheckTargetInfo(Data)^.TargetWnd then
    Result := False
  else
  begin
    if PCheckTargetInfo(Data)^.CurrentWnd = 0 then
    begin
      GetWindowRect(Window, R);
      if PtInRect(R, PCheckTargetInfo(Data)^.MousePos) then
        PCheckTargetInfo(Data)^.CurrentWnd := Window;
    end;
    if Window = PCheckTargetInfo(Data)^.CurrentWnd then
    begin
      Result := False;
      PCheckTargetInfo(Data)^.Found := True;
    end
    else
    if Window = PCheckTargetInfo(Data)^.ClientWnd then
    begin
      Result := True;
      PCheckTargetInfo(Data)^.CurrentWnd := 0;
    end
    else
      Result := True;
  end;
end;

//=== { TJvDockCustomControl } ===============================================

procedure TJvDockCustomControl.CustomDockDrop(Source: TJvDockDragDockObject;
  X, Y: Integer);
var
  DestRect: TRect;
  Form: TCustomForm;
begin
  DestRect := Source.DockRect;
  MapWindowPoints(0, Handle, DestRect, 2);
  DisableAlign;
  try
    Source.Control.Dock(Self, DestRect);
    if UseDockManager and (DockManager <> nil) then
      DockManager.InsertControl(Source.Control,
        Source.DropAlign, Source.DropOnControl);
  finally
    EnableAlign;
  end;
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.BringToFront;

  if Source.Control is TForm then
  begin
    TForm(Source.Control).ActiveControl := nil;
    SetDockSite(TForm(Source.Control), False);
  end;
end;

procedure TJvDockCustomControl.CustomDockOver(Source: TJvDockDragDockObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  CustomPositionDockRect(Source, X, Y);
end;

procedure TJvDockCustomControl.CustomEndDock(Target: TObject; X, Y: Integer);
begin
end;

procedure TJvDockCustomControl.CustomGetDockEdge(Source: TJvDockDragDockObject;
  MousePos: TPoint; var DropAlign: TAlign);
begin
  DropAlign := GetDockEdge(MousePos);
end;

procedure TJvDockCustomControl.CustomGetSiteInfo(Source: TJvDockDragDockObject;
  Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
  GetWindowRect(Handle, InfluenceRect);
  InflateRect(InfluenceRect, DefExpandoRect, DefExpandoRect);
end;

procedure TJvDockCustomControl.CustomPositionDockRect(Source: TJvDockDragDockObject;
  X, Y: Integer);
var
  NewWidth, NewHeight: Integer;
  TempX, TempY: Double;
  R: TRect;
begin
  with Source do
  begin
    if (DragTarget = nil) or (not TWinControlAccessProtected(DragTarget).UseDockManager) then
    begin
      NewWidth := Control.UndockWidth;
      NewHeight := Control.UndockHeight;
      TempX := DragPos.X - ((NewWidth) * MouseDeltaX);
      TempY := DragPos.Y - ((NewHeight) * MouseDeltaY);
      with DockRect do
      begin
        Left := Round(TempX);
        Top := Round(TempY);
        Right := Left + NewWidth;
        Bottom := Top + NewHeight;
      end;
      AdjustDockRect(DockRect);
    end
    else
    begin
      GetWindowRect(TargetControl.Handle, R);
      DockRect := R;
      if TWinControlAccessProtected(DragTarget).UseDockManager then
        if TargetControl is TJvDockCustomPanel then
          if TJvDockCustomPanel(DragTarget).JvDockManager <> nil then
          begin
            R := DockRect;
            TJvDockCustomPanel(DragTarget).JvDockManager.PositionDockRect(Control,
              DropOnControl, DropAlign, R);
            DockRect := R;
          end;
    end;
  end;
end;

procedure TJvDockCustomControl.CustomStartDock(var Source: TJvDockDragDockObject);
begin
end;

function TJvDockCustomControl.CustomUnDock(Source: TJvDockDragDockObject;
  NewTarget: TWinControl; Client: TControl): Boolean;
begin
  Result := (Perform(CM_UNDOCKCLIENT, Integer(NewTarget), Integer(Client)) = 0);
end;

function TJvDockCustomControl.GetJvDockManager: IJvDockManager;
begin
  Result := IJvDockManager(DockManager);
end;

procedure TJvDockCustomControl.SetJvDockManager(const Value: IJvDockManager);
begin
  DockManager := Value;
end;

procedure TJvDockCustomControl.UpdateCaption(Exclude: TControl);
var
  I: Integer;
  Host: TJvDockableForm;
begin
  if Parent is TJvDockableForm then
  begin
    Host := TJvDockableForm(Parent);
    Host.Caption := '';

    for I := 0 to Host.DockableControl.DockClientCount - 1 do
      if Host.DockableControl.DockClients[I].Visible and (Host.DockableControl.DockClients[I] <> Exclude) then
        Host.Caption := Host.Caption + TCustomForm(Host.DockableControl.DockClients[I]).Caption + RsDockStringSplitter;

    if Host.HostDockSite is TJvDockTabPageControl then
      with TJvDockTabPageControl(Host.HostDockSite) do
        if (ActivePage <> nil) and (ActivePage.Controls[0] = Self) then
          ActivePage.Caption := Host.Caption;
    if Host.HostDockSite is TJvDockCustomControl then
      TJvDockCustomControl(Host.HostDockSite).UpdateCaption(nil);
  end;
end;

procedure TJvDockCustomControl.WndProc(var Msg: TMessage);
var
  CMUnDockClient: TCMUnDockClient;
  DockableForm: TJvDockableForm;
begin
  if Msg.Msg = CM_UNDOCKCLIENT then
  begin
    CMUnDockClient := TCMUnDockClient(Msg);
    if CMUnDockClient.Client is TJvDockableForm then
    begin
      DockableForm := TJvDockableForm(CMUnDockClient.Client);
      if DockableForm.FloatingChild <> nil then
        // (rom) useless try finally
        try
          if Self is TJvDockTabPageControl then
            DockableForm.FloatingChild.ManualDock(Self)
          else
            DockableForm.FloatingChild.Dock(Self, Rect(0, 0, 0, 0));
          DockableForm.FloatingChild.Visible := True;
          if Self is TJvDockCustomPanel then
            JvDockManager.ReplaceZoneChild(DockableForm, DockableForm.FloatingChild);
        finally
        end;
    end;
  end;
  inherited WndProc(Msg);
end;

//=== { TJvDockCustomPanel } =================================================

constructor TJvDockCustomPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  Color := clBtnFace;
  UseDockManager := True;
end;

destructor TJvDockCustomPanel.Destroy;