dockmanager example: now notebooks can be created in an empty docksite.

Added toolbar demo project. git-svn-id: trunk@20299 -
2025-04-17 04:29:25 +02:00 · 2009-05-30 07:09:06 +00:00 · 2009-05-30 07:09:06 +00:00 · 8c261f0252
commit 8c261f0252
parent e50a4f4556
13 changed files with 355 additions and 51 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -2223,6 +2223,12 @@ examples/dockmanager/easytree/ftree.lfm svneol=native#text/plain
 examples/dockmanager/easytree/ftree.lrs svneol=native#text/plain
 examples/dockmanager/easytree/ftree.pas svneol=native#text/plain
 examples/dockmanager/easytree/zoneheader.inc svneol=native#text/pascal
+examples/dockmanager/toolbar/README.txt svneol=native#text/plain
+examples/dockmanager/toolbar/test1.lpi svneol=native#text/plain
+examples/dockmanager/toolbar/test1.lpr svneol=native#text/plain
+examples/dockmanager/toolbar/unit1.lfm svneol=native#text/plain
+examples/dockmanager/toolbar/unit1.lrs svneol=native#text/plain
+examples/dockmanager/toolbar/unit1.pas svneol=native#text/pascal
 examples/dragimagelist/project1.lpi svneol=native#text/plain
 examples/dragimagelist/project1.lpr svneol=native#text/pascal
 examples/dragimagelist/readme.txt svneol=native#text/plain
--- a/examples/dockmanager/easytree/easydocksite.pas
+++ b/examples/dockmanager/easytree/easydocksite.pas
@ -195,6 +195,7 @@ type
  public
    procedure MessageHandler(Sender: TControl; var Message: TLMessage); override;
  public
+    SingleTab: boolean; //always create notebook for alCustom?
    constructor Create(ADockSite: TWinControl);
    destructor Destroy; override;
    procedure AdjustDockRect(Control: TControl; var ARect: TRect);
@ -284,12 +285,13 @@ begin
  FDockSite := ADockSite;
 //reset inappropriate docking defaults - should be fixed in Controls/DragManager!
  DragManager.DragImmediate := False;
-  //DragManager.DragThreshold:=5;
 //workaround: check for already assigned docking manager
  //FreeAndNil(DockSite.DockManager); - seems to be fixed
  DockSite.DockManager := self;
 //init node class - impossible due to visibility restrictions!
  inherited Create; //(DockSite);
+//test: notebook with 1 tab in root zone
+  SingleTab := True;
 //init top zone
  FSiteRect := DockSite.ClientRect;
  FTopZone := TEasyZone.Create(self);
@ -440,39 +442,39 @@ begin
 (* alCustom means: drop into notebook.
  Valid only when dropped onto an existing control, not into empty dock site.
  Create notebook, if required (put both controls into new notebook).
-*)
-  if (InsertAt = alCustom) and (FTopZone.FirstChild <> nil) then begin
-  //dock into book
-    if (DropCtl is TEasyBook) then begin
-      NoteBook := DropCtl as TEasyBook;
-    end else begin
-    //create new book
-      NoteBook := NoteBookCreate(FDockSite); // TEasyPages.Create(FDockSite);
-      NoteBook.ManualDock(nil, nil);
-    //hack: manually dock the notebook
-      FReplacingControl := NoteBook; //ignore insert (see above)
-      NoteBook.ManualDock(FDockSite); //move into DockClients[]
-      DropZone.ChildControl := NoteBook; //put into the zone
-    { TODO -cdocking : make the notebook take the desired position }
-      r := DropZone.GetPartRect(zpClient);
-    {$IFDEF debug}
-      DebugLn('NoteBook as (%d,%d)-(%d,%d)', [r.Top, r.Left, r.Bottom, r.Right]);
-      NoteBook.BoundsRect := r;
-      r := NoteBook.BoundsRect;
-      DebugLn('NoteBook is (%d,%d)-(%d,%d)', [r.Top, r.Left, r.Bottom, r.Right]);

-      DropCtl.ManualDock(NoteBook); //put the original control into the notebook
-      DropCtl := NoteBook; //put further controls into the notebook
-      ResetBounds(True); //for some reason only setting the size doesn't work
-      NoteBook.Update;
-    {$ELSE}
-      NoteBookAdd(NoteBook, DropCtl); //put the original control into the notebook
-      NoteBook.BoundsRect := r;
-    {$ENDIF}
-    end; //else use existing control
-    NoteBookAdd(NoteBook, Control);
-    FDockSite.Invalidate; //update notebook caption
-    exit;
+  Try: create notebook already for first dropped control.
+*)
+  if (InsertAt = alCustom) then begin
+  //dock into book
+    if (FTopZone.FirstChild <> nil) then begin
+    //root zone is not empty
+      if (DropCtl is TEasyBook) then begin
+        NoteBook := DropCtl as TEasyBook;
+      end else begin
+      //create new book
+        NoteBook := NoteBookCreate(FDockSite);
+        NoteBook.ManualDock(nil, nil);
+      //hack: manually dock the notebook
+        FReplacingControl := NoteBook; //ignore insert (see above)
+        NoteBook.ManualDock(FDockSite); //move into DockClients[]
+        DropZone.ChildControl := NoteBook; //put into the zone
+        r := DropZone.GetPartRect(zpClient);
+        NoteBookAdd(NoteBook, DropCtl); //put the original control into the notebook
+        NoteBook.BoundsRect := r;
+      end; //else use existing control
+      NoteBookAdd(NoteBook, Control);
+      FDockSite.Invalidate; //update notebook caption
+      exit;
+    end else if SingleTab and not (DropCtl is TEasyBook)  then begin
+    //empty root zone, create new notebook
+      NoteBook := NoteBookCreate(FDockSite);
+      NoteBook.ManualDock(FDockSite, nil, alClient);
+      NoteBookAdd(NoteBook, Control);
+      FDockSite.Invalidate; //update notebook caption
+      exit;
+    end;  // else //continue docking of the notebook
+    InsertAt := alNone; //force automatic orientation
  end;

  NewZone := TEasyZone.Create(self);
@ -613,10 +615,13 @@ Signal results:
    end else begin
      ADockRect := zone.GetBounds; //include header
      DropOnControl := zone.ChildControl;
+      DropAlign := DetectAlign(ADockRect, DragTargetPos);
      if DropOnControl = nil then begin
-        DropAlign := alClient //first element in entire site
-      end else //determine the alignment within the zone.
-        DropAlign := DetectAlign(ADockRect, DragTargetPos);
+        if SingleTab and (DropAlign = alCustom) then begin
+          //notebook in top zone
+        end else
+          DropAlign := alClient; //first element in entire site
+      end; //else //determine the alignment within the zone.
    //to screen coords
      ADockRect.TopLeft := FDockSite.ClientToScreen(ADockRect.TopLeft);
      ADockRect.BottomRight := FDockSite.ClientToScreen(ADockRect.BottomRight);
@ -652,7 +657,7 @@ begin
 //debug!
  DropOn := DropCtl;

-  if (DropCtl = nil) then
+  if (DropCtl = nil) and not SingleTab then
    exit; //empty dock site

  case DropAlign of
@ -800,7 +805,6 @@ begin
    ptNew.x := FSplitter.Left; //left of splitter
  FSizeZone.PrevSibling.ScaleTo(FSizeZone.PrevSibling.BR, ptNew, ptNew);
  FSizeZone.SetBounds(FSizeZone.GetBounds); //BR unchanged, only update the control
-{ TODO -cdocking : Invalidate seems to miss a repaint of the docked controls, sometimes? }
  FDockSite.Invalidate;
 end;

--- a/examples/dockmanager/easytree/fdockbook.lfm
+++ b/examples/dockmanager/easytree/fdockbook.lfm
@ -20,7 +20,7 @@ object EasyDockBook: TEasyDockBook
    BorderWidth = 1
    Caption = 'Tabs'
    ChildSizing.HorizontalSpacing = 2
-    ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
    Color = clBtnFace
    EdgeBorders = [ebTop, ebBottom]
    Flat = False
@ -30,6 +30,14 @@ object EasyDockBook: TEasyDockBook
    ParentFont = False
    ShowCaptions = True
    TabOrder = 0
+    object ToolButton1: TToolButton
+      Left = 0
+      Top = 0
+      AutoSize = True
+      Caption = 'ToolButton1'
+      Style = tbsCheck
+      Visible = False
+    end
  end
  object pnlDock: TPanel
    Left = 0
--- a/examples/dockmanager/easytree/fdockbook.lrs
+++ b/examples/dockmanager/easytree/fdockbook.lrs
@ -7,11 +7,13 @@ LazarusResources.Add('TEasyDockBook','FORMDATA',[
  +'omatic'#10'LCLVersion'#6#6'0.9.27'#7'Visible'#9#0#8'TToolBar'#4'Tabs'#4'Lef'
  +'t'#2#1#6'Height'#2#26#3'Top'#2#1#5'Width'#3#142#1#8'AutoSize'#9#20'BorderSp'
  +'acing.Around'#2#1#11'BorderWidth'#2#1#7'Caption'#6#4'Tabs'#29'ChildSizing.H'
-  +'orizontalSpacing'#2#2#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousS'
-  +'paceResize'#5'Color'#7#9'clBtnFace'#11'EdgeBorders'#11#5'ebTop'#8'ebBottom'
-  +#0#4'Flat'#8#10'Font.Style'#11#6'fsBold'#0#4'List'#9#11'ParentColor'#8#10'Pa'
-  +'rentFont'#8#12'ShowCaptions'#9#8'TabOrder'#2#0#0#0#6'TPanel'#7'pnlDock'#4'L'
-  +'eft'#2#0#6'Height'#3#16#1#3'Top'#2#28#5'Width'#3#144#1#5'Align'#7#8'alClien'
-  +'t'#7'Caption'#6#7'pnlDock'#8'DockSite'#9#8'TabOrder'#2#1#10'OnDockDrop'#7#15
-  +'pnlDockDockDrop'#8'OnUnDock'#7#13'pnlDockUnDock'#0#0#0
+  +'orizontalSpacing'#2#2#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBo'
+  +'ttom'#5'Color'#7#9'clBtnFace'#11'EdgeBorders'#11#5'ebTop'#8'ebBottom'#0#4'F'
+  +'lat'#8#10'Font.Style'#11#6'fsBold'#0#4'List'#9#11'ParentColor'#8#10'ParentF'
+  +'ont'#8#12'ShowCaptions'#9#8'TabOrder'#2#0#0#11'TToolButton'#11'ToolButton1'
+  +#4'Left'#2#0#3'Top'#2#0#8'AutoSize'#9#7'Caption'#6#11'ToolButton1'#5'Style'#7
+  +#8'tbsCheck'#7'Visible'#8#0#0#0#6'TPanel'#7'pnlDock'#4'Left'#2#0#6'Height'#3
+  +#16#1#3'Top'#2#28#5'Width'#3#144#1#5'Align'#7#8'alClient'#7'Caption'#6#7'pnl'
+  +'Dock'#8'DockSite'#9#8'TabOrder'#2#1#10'OnDockDrop'#7#15'pnlDockDockDrop'#8
+  +'OnUnDock'#7#13'pnlDockUnDock'#0#0#0
 ]);
--- a/examples/dockmanager/easytree/fdockbook.pas
+++ b/examples/dockmanager/easytree/fdockbook.pas
@ -31,6 +31,7 @@ type
  TEasyDockBook = class(TForm)
    pnlDock: TPanel;
    Tabs: TToolBar;
+    ToolButton1: TToolButton;
    procedure pnlDockDockDrop(Sender: TObject; Source: TDragDockObject;
      X, Y: Integer);
    procedure pnlDockUnDock(Sender: TObject; Client: TControl;
@ -158,15 +159,20 @@ end;
 { TTabButton }

 constructor TTabButton.Create(TheOwner: TComponent);
+var
+  i, last: integer;
 begin
+{ TODO : create as last button }
  inherited Create(TheOwner);
-  Parent := TWinControl(TheOwner);
-  Grouped := True;
-  AllowAllUp := False;
+//these properties must be set before Parent
+  //AllowAllUp := False;
  Style := tbsCheck;
-  //self.Constraints.MinWidth:=200; //.Options;
-  self.Width := 100;
+  //self.Width := 100;
  AutoSize := True;
+  Parent := TWinControl(TheOwner);
+//these properties must be set after Parent
+  Grouped := True;
+  //AdjustSize; //doesn't help
 end;

 procedure TTabButton.MouseMove(Shift: TShiftState; X, Y: Integer);
--- a/examples/dockmanager/easytree/fmain.lrs
+++ b/examples/dockmanager/easytree/fmain.lrs
@ -1,3 +1,5 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TEasyDockMain','FORMDATA',[
  'TPF0'#13'TEasyDockMain'#12'EasyDockMain'#4'Left'#3#168#2#6'Height'#3#29#1#3
  +'Top'#2'}'#5'Width'#3#205#1#13'ActiveControl'#7#6'buDump'#7'Caption'#6#12'Ea'
--- a/examples/dockmanager/easytree/zoneheader.inc
+++ b/examples/dockmanager/easytree/zoneheader.inc
@ -30,8 +30,11 @@ procedure DestroyDockHeaderImages;
 var
  ImageKind: TDockHeaderImageKind;
 begin
+//called from unit finalization only!
+{ this code can result in crashes, due to missing handles
  for ImageKind := Low(TDockHeaderImageKind) to High(TDockHeaderImageKind) do
    FreeAndNil(DockBtnImages[ImageKind]);
+}
 end;


--- a/examples/dockmanager/toolbar/README.txt
+++ b/examples/dockmanager/toolbar/README.txt
@ -0,0 +1,31 @@
+The test1 project should do:
+
+Pressing "Add button" should add an autosized button to the right of the toolbar.
+
+All buttons should be grouped, so that only one button can be down at the same
+time.
+
+The toolbar should wrap or give some navigation aid, when the buttons no more
+fit into a single row.
+
+
+What it does:
+
+- The added buttons are NOT autosized.
+- New buttons are added to the LEFT of the bar.
+- The toolbar does NOT properly wrap added buttons.
+
+A dummy button was added to the bar, and seemed to cure some misbehaviour. It
+finally should be removed, so that the toolbar only contains programmatically
+created buttons.
+When the project was published from the IDE menu, the button size was not
+retained, nor did the button autosize any more.
+
+Option CheckBoxes:
+
+"Init button size" sets the Width of the new button to some predefined value.
+"First button visible" immediately toggles the visibility of the dummy button.
+
+It's recommended to check "Init button size", so that the buttons can be
+distinguished by their Captions, as long as AutoSize doesn't work.
+
--- a/examples/dockmanager/toolbar/test1.lpi
+++ b/examples/dockmanager/toolbar/test1.lpi
@ -0,0 +1,89 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="7"/>
+    <General>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="test1"/>
+      <UseXPManifest Value="True"/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="D:\SourceForge\lazarus\examples\dockmanager\toolbar"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="test1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test1"/>
+        <CursorPos X="14" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="21"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+        <CursorPos X="17" Y="16"/>
+        <TopLine Value="15"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="21"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="README.txt"/>
+        <IsPartOfProject Value="True"/>
+        <CursorPos X="1" Y="31"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="None"/>
+      </Unit2>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
--- a/examples/dockmanager/toolbar/test1.lpr
+++ b/examples/dockmanager/toolbar/test1.lpr
@ -0,0 +1,20 @@
+program test1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Unit1
+  { you can add units after this };
+
+{$IFDEF WINDOWS}{$R test1.rc}{$ENDIF}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/examples/dockmanager/toolbar/unit1.lfm
+++ b/examples/dockmanager/toolbar/unit1.lfm
@ -0,0 +1,58 @@
+object Form1: TForm1
+  Left = 310
+  Height = 139
+  Top = 151
+  Width = 400
+  ActiveControl = swInitSize
+  Caption = 'Form1'
+  ClientHeight = 139
+  ClientWidth = 400
+  LCLVersion = '0.9.27'
+  object ToolBar1: TToolBar
+    Left = 0
+    Height = 26
+    Top = 0
+    Width = 400
+    BorderWidth = 2
+    Caption = 'ToolBar1'
+    EdgeBorders = [ebLeft, ebTop, ebRight, ebBottom]
+    Flat = False
+    ShowCaptions = True
+    TabOrder = 0
+    object ToolButton1: TToolButton
+      Left = 3
+      Top = 2
+      AutoSize = True
+      Caption = 'ToolButton0'
+      Grouped = True
+      Style = tbsCheck
+      Visible = False
+    end
+  end
+  object Button1: TButton
+    Left = 8
+    Height = 25
+    Top = 88
+    Width = 75
+    Caption = 'Add button'
+    OnClick = Button1Click
+    TabOrder = 1
+  end
+  object swInitSize: TCheckBox
+    Left = 112
+    Height = 17
+    Top = 88
+    Width = 90
+    Caption = 'init button size'
+    TabOrder = 2
+  end
+  object swView1: TCheckBox
+    Left = 112
+    Height = 17
+    Top = 112
+    Width = 108
+    Caption = 'First button visible'
+    OnClick = swView1Click
+    TabOrder = 3
+  end
+end
--- a/examples/dockmanager/toolbar/unit1.lrs
+++ b/examples/dockmanager/toolbar/unit1.lrs
@ -0,0 +1,19 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'6'#1#6'Height'#3#139#0#3'Top'#3#151#0#5'W'
+  +'idth'#3#144#1#13'ActiveControl'#7#10'swInitSize'#7'Caption'#6#5'Form1'#12'C'
+  +'lientHeight'#3#139#0#11'ClientWidth'#3#144#1#10'LCLVersion'#6#6'0.9.27'#0#8
+  +'TToolBar'#8'ToolBar1'#4'Left'#2#0#6'Height'#2#26#3'Top'#2#0#5'Width'#3#144#1
+  +#11'BorderWidth'#2#2#7'Caption'#6#8'ToolBar1'#11'EdgeBorders'#11#6'ebLeft'#5
+  +'ebTop'#7'ebRight'#8'ebBottom'#0#4'Flat'#8#12'ShowCaptions'#9#8'TabOrder'#2#0
+  +#0#11'TToolButton'#11'ToolButton1'#4'Left'#2#3#3'Top'#2#2#8'AutoSize'#9#7'Ca'
+  +'ption'#6#11'ToolButton0'#7'Grouped'#9#5'Style'#7#8'tbsCheck'#7'Visible'#8#0
+  +#0#0#7'TButton'#7'Button1'#4'Left'#2#8#6'Height'#2#25#3'Top'#2'X'#5'Width'#2
+  +'K'#7'Caption'#6#10'Add button'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#1
+  +#0#0#9'TCheckBox'#10'swInitSize'#4'Left'#2'p'#6'Height'#2#17#3'Top'#2'X'#5'W'
+  +'idth'#2'Z'#7'Caption'#6#16'init button size'#8'TabOrder'#2#2#0#0#9'TCheckBo'
+  +'x'#7'swView1'#4'Left'#2'p'#6'Height'#2#17#3'Top'#2'p'#5'Width'#2'l'#7'Capti'
+  +'on'#6#20'First button visible'#7'OnClick'#7#12'swView1Click'#8'TabOrder'#2#3
+  +#0#0#0
+]);
--- a/examples/dockmanager/toolbar/unit1.pas
+++ b/examples/dockmanager/toolbar/unit1.pas
@ -0,0 +1,56 @@
+unit Unit1; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  ComCtrls, StdCtrls;
+
+type
+  TForm1 = class(TForm)
+    Button1: TButton;
+    swView1: TCheckBox;
+    swInitSize: TCheckBox;
+    ToolBar1: TToolBar;
+    ToolButton1: TToolButton;
+    procedure Button1Click(Sender: TObject);
+    procedure swView1Click(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+  btn: TToolButton;
+begin
+  btn := TToolButton.Create(ToolBar1);
+  btn.Parent := ToolBar1;
+  btn.Style := tbsCheck;
+  btn.AutoSize := True;
+  if swInitSize.Checked then
+    btn.Width := 100;
+  btn.Caption := 'button ' + IntToStr(btn.Index);
+  btn.Grouped := True;
+end;
+
+procedure TForm1.swView1Click(Sender: TObject);
+begin
+  ToolButton1.Visible := swView1.Checked;
+end;
+
+initialization
+  {$I unit1.lrs}
+
+end.
+