mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 05:18:15 +02:00
dockmanager example: added missing form
git-svn-id: trunk@22444 -
This commit is contained in:
dodi
parent
40ee864636
commit
b710514a50
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -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.lfm svneol=native#text/plain
|
||||||
examples/dockmanager/package/fdockbook.lrs svneol=native#text/pascal
|
examples/dockmanager/package/fdockbook.lrs svneol=native#text/pascal
|
||||||
examples/dockmanager/package/fdockbook.pas 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.lfm svneol=native#text/plain
|
||||||
examples/dockmanager/package/ffloatingsite.lrs svneol=native#text/plain
|
examples/dockmanager/package/ffloatingsite.lrs svneol=native#text/plain
|
||||||
examples/dockmanager/package/ffloatingsite.pas svneol=native#text/pascal
|
examples/dockmanager/package/ffloatingsite.pas svneol=native#text/pascal
|
||||||
|
|||||||
88
examples/dockmanager/package/felasticsite.lfm
Normal file
88
examples/dockmanager/package/felasticsite.lfm
Normal file
@ -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
|
||||||
28
examples/dockmanager/package/felasticsite.lrs
Normal file
28
examples/dockmanager/package/felasticsite.lrs
Normal file
@ -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
|
||||||
|
]);
|
||||||
303
examples/dockmanager/package/felasticsite.pas
Normal file
303
examples/dockmanager/package/felasticsite.pas
Normal file
@ -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.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user