From b710514a50a4a5c42e2abc3f97dc17859563e6bc Mon Sep 17 00:00:00 2001 From: dodi Date: Thu, 5 Nov 2009 12:03:29 +0000 Subject: [PATCH] dockmanager example: added missing form git-svn-id: trunk@22444 - --- .gitattributes | 3 + examples/dockmanager/package/felasticsite.lfm | 88 +++++ examples/dockmanager/package/felasticsite.lrs | 28 ++ examples/dockmanager/package/felasticsite.pas | 303 ++++++++++++++++++ 4 files changed, 422 insertions(+) create mode 100644 examples/dockmanager/package/felasticsite.lfm create mode 100644 examples/dockmanager/package/felasticsite.lrs create mode 100644 examples/dockmanager/package/felasticsite.pas diff --git a/.gitattributes b/.gitattributes index cf5f4e1bb2..20d89ed78b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2788,6 +2788,9 @@ examples/dockmanager/package/easydocksite.pas svneol=native#text/plain examples/dockmanager/package/fdockbook.lfm svneol=native#text/plain examples/dockmanager/package/fdockbook.lrs svneol=native#text/pascal examples/dockmanager/package/fdockbook.pas svneol=native#text/pascal +examples/dockmanager/package/felasticsite.lfm svneol=native#text/plain +examples/dockmanager/package/felasticsite.lrs svneol=native#text/plain +examples/dockmanager/package/felasticsite.pas svneol=native#text/pascal examples/dockmanager/package/ffloatingsite.lfm svneol=native#text/plain examples/dockmanager/package/ffloatingsite.lrs svneol=native#text/plain examples/dockmanager/package/ffloatingsite.pas svneol=native#text/pascal diff --git a/examples/dockmanager/package/felasticsite.lfm b/examples/dockmanager/package/felasticsite.lfm new file mode 100644 index 0000000000..0a6894ec67 --- /dev/null +++ b/examples/dockmanager/package/felasticsite.lfm @@ -0,0 +1,88 @@ +object DockingSite: TDockingSite + Left = 444 + Height = 163 + Top = 156 + Width = 255 + AutoSize = True + Caption = 'Dock Site' + ClientHeight = 163 + ClientWidth = 255 + LCLVersion = '0.9.29' + Visible = True + object pnlLeft: TPanel + Left = 0 + Height = 138 + Top = 0 + Width = 0 + Align = alLeft + Caption = 'pnlLeft' + Color = clWhite + DockSite = True + ParentColor = False + TabOrder = 0 + OnDockDrop = pnlLeftDockDrop + OnDockOver = pnlLeftDockOver + OnGetSiteInfo = pnlLeftGetSiteInfo + OnUnDock = pnlLeftUnDock + end + object splitLeft: TSplitter + Left = 0 + Height = 138 + Top = 0 + Width = 4 + end + object pnlRight: TPanel + Left = 255 + Height = 138 + Top = 0 + Width = 0 + Align = alRight + Caption = 'pnlRight' + Color = clAqua + DockSite = True + ParentColor = False + TabOrder = 2 + OnDockDrop = pnlLeftDockDrop + OnDockOver = pnlLeftDockOver + OnGetSiteInfo = pnlLeftGetSiteInfo + OnUnDock = pnlLeftUnDock + end + object pnlBottom: TPanel + Left = 0 + Height = 1 + Top = 142 + Width = 255 + Align = alBottom + Caption = 'pnlBottom' + DockSite = True + TabOrder = 3 + OnDockDrop = pnlLeftDockDrop + OnDockOver = pnlLeftDockOver + OnGetSiteInfo = pnlLeftGetSiteInfo + OnUnDock = pnlLeftUnDock + end + object splitRight: TSplitter + Left = 251 + Height = 138 + Top = 0 + Width = 4 + Align = alRight + ResizeAnchor = akRight + end + object StatusBar1: TStatusBar + Left = 0 + Height = 20 + Top = 143 + Width = 255 + Panels = <> + end + object splitBottom: TSplitter + Cursor = crVSplit + Left = 0 + Height = 4 + Top = 138 + Width = 255 + Align = alBottom + ResizeAnchor = akBottom + end +end diff --git a/examples/dockmanager/package/felasticsite.lrs b/examples/dockmanager/package/felasticsite.lrs new file mode 100644 index 0000000000..6b97d58e7c --- /dev/null +++ b/examples/dockmanager/package/felasticsite.lrs @@ -0,0 +1,28 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TDockingSite','FORMDATA',[ + 'TPF0'#12'TDockingSite'#11'DockingSite'#4'Left'#3#188#1#6'Height'#3#163#0#3'T' + +'op'#3#156#0#5'Width'#3#255#0#8'AutoSize'#9#7'Caption'#6#9'Dock Site'#12'Cli' + +'entHeight'#3#163#0#11'ClientWidth'#3#255#0#10'LCLVersion'#6#6'0.9.29'#7'Vis' + +'ible'#9#0#6'TPanel'#7'pnlLeft'#4'Left'#2#0#6'Height'#3#138#0#3'Top'#2#0#5'W' + +'idth'#2#0#5'Align'#7#6'alLeft'#7'Caption'#6#7'pnlLeft'#5'Color'#7#7'clWhite' + +#8'DockSite'#9#11'ParentColor'#8#8'TabOrder'#2#0#10'OnDockDrop'#7#15'pnlLeft' + +'DockDrop'#10'OnDockOver'#7#15'pnlLeftDockOver'#13'OnGetSiteInfo'#7#18'pnlLe' + +'ftGetSiteInfo'#8'OnUnDock'#7#13'pnlLeftUnDock'#0#0#9'TSplitter'#9'splitLeft' + +#4'Left'#2#0#6'Height'#3#138#0#3'Top'#2#0#5'Width'#2#4#0#0#6'TPanel'#8'pnlRi' + +'ght'#4'Left'#3#255#0#6'Height'#3#138#0#3'Top'#2#0#5'Width'#2#0#5'Align'#7#7 + +'alRight'#7'Caption'#6#8'pnlRight'#5'Color'#7#6'clAqua'#8'DockSite'#9#11'Par' + +'entColor'#8#8'TabOrder'#2#2#10'OnDockDrop'#7#15'pnlLeftDockDrop'#10'OnDockO' + +'ver'#7#15'pnlLeftDockOver'#13'OnGetSiteInfo'#7#18'pnlLeftGetSiteInfo'#8'OnU' + +'nDock'#7#13'pnlLeftUnDock'#0#0#6'TPanel'#9'pnlBottom'#4'Left'#2#0#6'Height' + +#2#1#3'Top'#3#142#0#5'Width'#3#255#0#5'Align'#7#8'alBottom'#7'Caption'#6#9'p' + +'nlBottom'#8'DockSite'#9#8'TabOrder'#2#3#10'OnDockDrop'#7#15'pnlLeftDockDrop' + +#10'OnDockOver'#7#15'pnlLeftDockOver'#13'OnGetSiteInfo'#7#18'pnlLeftGetSiteI' + +'nfo'#8'OnUnDock'#7#13'pnlLeftUnDock'#0#0#9'TSplitter'#10'splitRight'#4'Left' + +#3#251#0#6'Height'#3#138#0#3'Top'#2#0#5'Width'#2#4#5'Align'#7#7'alRight'#12 + +'ResizeAnchor'#7#7'akRight'#0#0#10'TStatusBar'#10'StatusBar1'#4'Left'#2#0#6 + +'Height'#2#20#3'Top'#3#143#0#5'Width'#3#255#0#6'Panels'#14#0#0#0#9'TSplitter' + +#11'splitBottom'#6'Cursor'#7#8'crVSplit'#4'Left'#2#0#6'Height'#2#4#3'Top'#3 + +#138#0#5'Width'#3#255#0#5'Align'#7#8'alBottom'#12'ResizeAnchor'#7#8'akBottom' + +#0#0#0 +]); diff --git a/examples/dockmanager/package/felasticsite.pas b/examples/dockmanager/package/felasticsite.pas new file mode 100644 index 0000000000..ebdbf79cd5 --- /dev/null +++ b/examples/dockmanager/package/felasticsite.pas @@ -0,0 +1,303 @@ +unit fElasticSite; +(* Demonstrate elastic dock sites. + This form has dock sites (panels) on its left, right and bottom. + + Empty panels should be invisible, what's a bit tricky. They cannot have + Visible=False, because this would disallow to dock anything into them. + So the width/height of the panels is set to zero instead. + + When a first control is docked, the dock site is enlarged. + Fine adjustment can be made with the splitters beneath the controls. + + When the last control is undocked, the dock site is shrinked again. +*) + +(* Observed problems: + +Object Inspector says: the bottom panel's OnGetSiteInfo method is incompatible + with other OnGetSiteInfo methods. + +When the form is resized, the dock sites report their old (designed) extent. + This makes initial docking problematic, only the upper-/leftmost parts of the sites + work as dock targets. +*) + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, ComCtrls, + EasyDockSite; + +type + TDockingSite = class(TForm) + pnlBottom: TPanel; + pnlLeft: TPanel; + pnlRight: TPanel; + splitBottom: TSplitter; + splitLeft: TSplitter; + splitRight: TSplitter; + StatusBar1: TStatusBar; + procedure pnlLeftDockDrop(Sender: TObject; Source: TDragDockObject; + X, Y: Integer); + procedure pnlLeftDockOver(Sender: TObject; Source: TDragDockObject; + X, Y: Integer; State: TDragState; var Accept: Boolean); + procedure pnlLeftGetSiteInfo(Sender: TObject; DockClient: TControl; + var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); + procedure pnlLeftUnDock(Sender: TObject; Client: TControl; + NewTarget: TWinControl; var Allow: Boolean); + private + FAutoExpand: boolean; + procedure SetAutoExpand(NewValue: boolean); + public + published + property AutoExpand: boolean read FAutoExpand write SetAutoExpand default True; + end; + +//var DockingSite: TDockingSite; + +procedure Register; + +implementation + +uses + LCLIntf; + +//uses fDockClient; //test only + +procedure Register; +begin + RegisterComponents('DoDi', [TDockingSite]); +end; + +{ TDockingSite } + +procedure TDockingSite.pnlLeftDockDrop(Sender: TObject; + Source: TDragDockObject; X, Y: Integer); +var + w: integer; + r: TRect; + Site: TWinControl absolute Sender; +begin +(* Adjust docksite extent, if required. + H/V depending on align LR/TB. + Take 1/3 of the form's extent for the dock site. + When changed, ensure that the form layout is updated. +*) + if (TWinControl(Source.DragTarget).DockClientCount > 1) + or ((Site.Width > 1) and (Site.Height > 1)) //NoteBook! + then + exit; //no adjustments of the dock site required + with Source do begin + if DragTarget.Align in [alLeft, alRight] then begin + w := self.Width div 3; + if DragTarget.Width < w then begin + //enlarge docksite + DisableAlign; //form(?) + DragTarget.Width := w; + if DragTarget.Align = alRight then begin + if AutoExpand then begin + r := self.BoundsRect; + inc(r.Right, w); + BoundsRect := r; + end else begin + dec(DragTarget.Left, w); + dec(splitRight.Left, w); + end; + end else if AutoExpand then begin + //enlarge left + r := BoundsRect; + dec(r.Left, w); + BoundsRect := r; + end; + EnableAlign; + end; + end else begin + w := self.Height div 3; + if DragTarget.Height < w then begin + //enlarge docksite + DisableAlign; //form(?) + DragTarget.Height := w; + if DragTarget.Align = alBottom then begin + if AutoExpand then begin + //dec(self.Left, w); + r := self.BoundsRect; + inc(r.Bottom, w); + BoundsRect := r; + inc(StatusBar1.Top, w); + end else begin + dec(splitBottom.Top, w); + dec(DragTarget.Top, w); + end; + end; + EnableAlign; + end; + end; + //Control.Align := alClient; + end; +end; + +procedure TDockingSite.pnlLeftDockOver(Sender: TObject; + Source: TDragDockObject; X, Y: Integer; State: TDragState; + var Accept: Boolean); +var + r: TRect; + + procedure Adjust(dw, dh: integer); + begin + (* r.TopLeft in screen coords, r.BottomRight is W/H(?) + negative values mean expansion towards screen origin + *) + if dw <> 0 then begin + r.Right := r.Left; + inc(r.Bottom, r.Top); + if dw > 0 then + inc(r.Right, dw) + else + inc(r.Left, dw); + end else begin + r.Bottom := r.Top; + inc(r.Right, r.Left); + if dh > 0 then + inc(r.Bottom, dh) + else + inc(r.Top, dh); + end; + end; + +var + Site: TWinControl; // absolute Sender; + dw, dh: integer; + //dummy: boolean; +begin +(* This handler has to determine the intended DockRect, + and the alignment within this rectangle. + + This is impossible when the mouse leaves the InfluenceRect, + i.e. when the site is not yet expanded :-( + + For a shrinked site we only can display the intended DockRect, + and signal alClient. +*) + if Source.DragTarget = nil then + exit; //shit happens :-( + if State = dsDragMove then begin + TObject(Site) := Source.DragTarget; + if Site.DockClientCount > 0 then + exit; //everything should be okay + //make DockRect reflect the docking area + //with Source do begin + //StatusBar1.SimpleText := AlignNames[Source.DropAlign]; + {$IFnDEF old} + r := Site.BoundsRect; //XYWH + r.TopLeft := Site.Parent.ClientToScreen(r.TopLeft); + {$ELSE} + GetWindowRect(TWinControl(Source.DragTarget).handle, r); + //Site.GetSiteInfo(Site, r, Point(0,0), dummy); + {$ENDIF} + dw := Width div 3; //r.Right := r.Left + dw; + dh := Height div 3; //r.Bottom := r.Top + dh; + //determine inside/outside + case Site.Align of + alLeft: if AutoExpand then Adjust(-dw, 0) else Adjust(dw, 0); + alRight: if AutoExpand then Adjust(dw, 0) else Adjust(-dw, 0); + alBottom: if AutoExpand then Adjust(0, dh) else Adjust(0, -dh); + else exit; + end; + Source.DockRect := r; + //end; + Accept := True; + end; +end; + +procedure TDockingSite.pnlLeftGetSiteInfo(Sender: TObject; + DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; + var CanDock: Boolean); +const + delta = 10; +begin +(* Is an old copy of InfluenceRect around here? +*) +{ TODO : try getting the current influence rect } + CanDock := True; +{$IFDEF old} +//this doesn't help, reports the designed extent. + InfluenceRect := (Sender as TWinControl).BoundsRect; + InfluenceRect.TopLeft := ClientToScreen(InfluenceRect.TopLeft); + inc(InfluenceRect.Right, InfluenceRect.Left + delta); + inc(InfluenceRect.Bottom, InfluenceRect.Top + delta); + dec(InfluenceRect.Top, delta); + dec(InfluenceRect.Left, delta); +{$ELSE} +{$ENDIF} +end; + +procedure TDockingSite.pnlLeftUnDock(Sender: TObject; Client: TControl; + NewTarget: TWinControl; var Allow: Boolean); +var + Site: TWinControl absolute Sender; + wh: integer; + r: TRect; +begin +(* When the last client is undocked, shrink the dock site to zero extent. + Called *before* the dock client is removed. +*) + if Site.DockClientCount <= 1 then begin + //become empty, hide the dock site + DisableAlign; + case Site.Align of + alLeft: + begin + wh := Site.Width; + Site.Width := 0; //behaves as expected + if AutoExpand then begin + r := BoundsRect; + inc(r.Left, wh); + BoundsRect := r; + end; + end; + alRight: + begin + wh := Site.Width; + Site.Width := 0; + if AutoExpand then begin + r := BoundsRect; + dec(r.Right, wh); + BoundsRect := r; + end else begin + inc(Site.Left, wh); + inc(splitRight.Left, wh); + end; + end; + alBottom: + begin + wh := Site.Height; + Site.Height := 0; + if AutoExpand then begin + r := BoundsRect; + dec(r.Bottom, wh); + BoundsRect := r; + dec(splitBottom.Top, wh); + dec(StatusBar1.Top, wh); + end else begin + inc(Site.Top, wh); + splitBottom.Top := Site.Top - splitBottom.Height - 10; + end; + end; + end; + EnableAlign; + end; +end; + +procedure TDockingSite.SetAutoExpand(NewValue: boolean); +begin + FAutoExpand:=NewValue; +end; + +initialization + {$I felasticsite.lrs} + DefaultDockManagerClass := TEasyTree; +end. +