completed new TToolBar

git-svn-id: trunk@5226 -

.gitattributes

@@ -686,6 +686,7 @@ images/components/ttogglebox.ico -text svneol=unset#image/x-icon
 images/components/ttogglebox.xpm -text svneol=native#image/x-xpixmap
 images/components/ttoolbar.ico -text svneol=unset#image/x-icon
 images/components/ttoolbar.xpm -text svneol=native#image/x-xpixmap
+images/components/ttoolbutton.xpm -text svneol=native#image/x-xpixmap
 images/components/ttrackbar.ico -text svneol=unset#image/x-icon
 images/components/ttrackbar.xpm -text svneol=native#image/x-xpixmap
 images/components/ttreeview.xpm -text svneol=native#image/x-xpixmap

components/jpeg/readme.txt

@@ -1,4 +1,15 @@
 
+WARNING  WARNING  WARNING  WARNING  WARNING
+
+This package is broken. Read further.
+
+The pasjpeg code in the current fpc sources have a bug.
+If you want jpeg, then you must use an older fpc and the jpeg from lazarus-ccr
+on sourceforge. Not this package.
+
+-------------------------------------------------------------------------------
+
+
 The lazarus TJPEGImage is in lazjpeg.pas
 
 It uses the pasjpeg and fpimage libs provided by FreePascal. See there for in

designer/controlselection.pp

@@ -213,6 +213,8 @@ type
     cssOnlyVisualNeedsSelected,
     cssOnlyInvisibleNeedsUpdate,
     cssOnlyInvisibleSelected,
+    cssOnlyBoundLessNeedsUpdate,
+    cssOnlyBoundLessSelected,
     cssBoundsNeedsUpdate,
     cssBoundsNeedsSaving,
     cssParentLevelNeedsUpdate,
@@ -364,6 +366,7 @@ type
     function OnlyNonVisualComponentsSelected: boolean;
     function OnlyVisualComponentsSelected: boolean;
     function OnlyInvisibleComponentsSelected: boolean;
+    function OnlyBoundLessComponentsSelected: boolean;
     function LookupRootSelected: boolean;
 
     // resizing, moving, aligning, mirroring, ...
@@ -721,7 +724,7 @@ begin
   FActiveGrabber:=nil;
   FUpdateLock:=0;
   FStates:=[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate,
-            cssOnlyInvisibleNeedsUpdate,
+            cssOnlyInvisibleNeedsUpdate,cssOnlyBoundLessNeedsUpdate,
             cssParentLevelNeedsUpdate,cssCacheGuideLines];
   FRubberbandType:=rbtSelection;
   FRubberbandCreationColor:=clMaroon;
@@ -1762,7 +1765,7 @@ begin
   if NewSelectedControl.DesignerForm<>FForm then Clear;
   Result:=FControls.Add(NewSelectedControl);
   FStates:=FStates+[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate,
-                    cssOnlyInvisibleNeedsUpdate,
+                    cssOnlyInvisibleNeedsUpdate,cssOnlyBoundLessNeedsUpdate,
                     cssParentLevelNeedsUpdate,cssParentChildFlagsNeedUpdate];
   if Count=1 then SetCustomForm;
   if AComponent=FLookupRoot then Include(FStates,cssLookupRootSelected);
@@ -1803,7 +1806,7 @@ begin
   Items[Index].Free;
   FControls.Delete(Index);
   FStates:=FStates+[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate,
-                    cssOnlyInvisibleNeedsUpdate,
+                    cssOnlyInvisibleNeedsUpdate,cssOnlyBoundLessNeedsUpdate,
                     cssParentLevelNeedsUpdate,cssParentChildFlagsNeedUpdate];
 
   if Count=0 then SetCustomForm;
@@ -1822,7 +1825,7 @@ begin
   for i:=0 to FControls.Count-1 do Items[i].Free;
   FControls.Clear;
   FStates:=FStates+[cssOnlyNonVisualNeedsUpdate,cssOnlyVisualNeedsUpdate,
-                    cssOnlyInvisibleNeedsUpdate,
+                    cssOnlyInvisibleNeedsUpdate,cssOnlyBoundLessNeedsUpdate,
                     cssParentLevelNeedsUpdate,cssParentChildFlagsNeedUpdate]
                   -[cssLookupRootSelected];
   FForm:=nil;
@@ -2013,7 +2016,7 @@ var
 begin
   if (Count=0) or (FForm=nil)
   or LookupRootSelected
-  or OnlyInvisibleComponentsSelected then exit;
+  or OnlyBoundLessComponentsSelected then exit;
 
   Diff:=DC.FormOrigin;
 
@@ -2373,6 +2376,26 @@ begin
     Result:=cssOnlyInvisibleSelected in FStates;
 end;
 
+function TControlSelection.OnlyBoundLessComponentsSelected: boolean;
+var
+  i: Integer;
+begin
+  if cssOnlyBoundLessNeedsUpdate in FStates then begin
+    Result:=true;
+    for i:=0 to FControls.Count-1 do
+      if ComponentBoundsDesignable(Items[i].Component) then begin
+        Result:=false;
+        break;
+      end;
+    if Result then
+      Include(FStates,cssOnlyBoundLessSelected)
+    else
+      Exclude(FStates,cssOnlyBoundLessSelected);
+    Exclude(FStates,cssOnlyBoundLessNeedsUpdate);
+  end else
+    Result:=cssOnlyBoundLessSelected in FStates;
+end;
+
 function TControlSelection.LookupRootSelected: boolean;
 begin
   Result:=cssLookupRootSelected in FStates;

designer/designerprocs.pas

@@ -89,6 +89,7 @@ var
 function GetParentLevel(AControl: TControl): integer;
 function ControlIsInDesignerVisible(AControl: TControl): boolean;
 function ComponentIsInvisible(AComponent: TComponent): boolean;
+function ComponentBoundsDesignable(AComponent: TComponent): boolean;
 
 function GetParentFormRelativeTopLeft(Component: TComponent): TPoint;
 function GetParentFormRelativeBounds(Component: TComponent): TRect;
@@ -292,6 +293,17 @@ begin
     Result:=false;
 end;
 
+function ComponentBoundsDesignable(AComponent: TComponent): boolean;
+begin
+  Result:=(not ComponentIsInvisible(AComponent));
+  if Result and (AComponent is TControl) then begin
+    if [csDesignFixedBounds,csNoDesignVisible]*TControl(AComponent).ControlStyle
+      <>[]
+    then
+      Result:=false;
+  end;
+end;
+
 { TDesignerDeviceContext }
 
 function TDesignerDeviceContext.GetDCOrigin: TPoint;

ide/componentpalette.pas

@@ -38,9 +38,9 @@ unit ComponentPalette;
 interface
 
 uses
-  Classes, SysUtils, Dialogs, Graphics, ExtCtrls, Buttons, Menus, LResources,
+  Classes, SysUtils, Controls, Dialogs, Graphics, ExtCtrls, Buttons, Menus,
-  AVL_Tree, LazarusIDEStrConsts, ComponentReg, DesignerProcs, IDEProcs,
+  LResources, AVL_Tree, LazarusIDEStrConsts, ComponentReg, DesignerProcs,
-  PackageDefs;
+  IDEProcs, PackageDefs;
 
 const
   ComponentPaletteBtnWidth  = 25;
@@ -76,7 +76,7 @@ type
     procedure OnPageRemovedComponent(Page: TBaseComponentPage;
                                      Component: TRegisteredComponent); override;
     procedure Update; override;
-    procedure CheckComponentHasIcon(AComponent: TComponent;
+    procedure CheckComponentDesignerVisible(AComponent: TComponent;
                                             var Invisible: boolean);
   public
     constructor Create;
@@ -273,25 +273,31 @@ begin
   UpdateNoteBookButtons;
 end;
 
-procedure TComponentPalette.CheckComponentHasIcon(AComponent: TComponent;
+procedure TComponentPalette.CheckComponentDesignerVisible(
-  var Invisible: boolean);
+  AComponent: TComponent; var Invisible: boolean);
 var
   RegComp: TRegisteredComponent;
+  AControl: TControl;
 begin
+  if (AComponent is TControl) then begin
+    AControl:=TControl(AComponent);
+    Invisible:=(csNoDesignVisible in AControl.ControlStyle)
+  end else begin
     RegComp:=FindComponent(AComponent.ClassName);
     Invisible:=(RegComp<>nil) and (RegComp.PageName='');
+  end;
 end;
 
 constructor TComponentPalette.Create;
 begin
   inherited Create;
   fComponents:=TAVLTree.Create(@CompareRegisteredComponents);
-  OnComponentIsInvisible:=@CheckComponentHasIcon;
+  OnComponentIsInvisible:=@CheckComponentDesignerVisible;
 end;
 
 destructor TComponentPalette.Destroy;
 begin
-  if OnComponentIsInvisible=@CheckComponentHasIcon then
+  if OnComponentIsInvisible=@CheckComponentDesignerVisible then
     OnComponentIsInvisible:=nil;
   NoteBook:=nil;
   fComponents.Free;

ide/exttooleditdlg.pas

@@ -506,7 +506,6 @@ begin
       Height:=Self.ClientHeight-50-Top;
       Caption:=lisEdtExtToolMacros;
       OnResize:=@MacrosGroupboxResize;
-      Visible:=true; 
     end;
     
     MacrosListbox:=TListbox.Create(Self);
@@ -516,7 +515,6 @@ begin
       SetBounds(5,5,MacrosGroupbox.ClientWidth-120,
                    MacrosGroupbox.ClientHeight-30);
       OnClick:=@MacrosListboxClick;
-      Visible:=true; 
     end;
     
     MacrosInsertButton:=TButton.Create(Self);
@@ -527,7 +525,6 @@ begin
       Caption:=lisEdtExtToolInsert;
       OnClick:=@MacrosInsertButtonClick;
       Enabled:=false;
-      Visible:=true; 
     end;
     
     OkButton:=TButton.Create(Self);
@@ -537,7 +534,6 @@ begin
       SetBounds(270,Self.ClientHeight-40,100,25);
       Caption:=lisLazBuildOk;
       OnClick:=@OkButtonClick;
-      Visible:=true;
     end;
     
     CancelButton:=TButton.Create(Self);
@@ -547,10 +543,10 @@ begin
       SetBounds(390,OkButton.Top,100,25);
       Caption:=dlgCancel;
       OnClick:=@CancelButtonClick;
-      Visible:=true;
     end;
     
     OnResize:=@ExternalToolOptionDlgResize;
+    KeyPreview:=true;
     OnKeyUp:=@FormKeyUp;
   end;
   fOptions:=TExternalToolOptions.Create;

ideintf/componenteditors.pas

@@ -27,7 +27,8 @@ unit ComponentEditors;
 interface
 
 uses
-  Classes, SysUtils, TypInfo, Forms, Controls, Menus, ExtCtrls, Grids, Buttons,
+  Classes, SysUtils, TypInfo,
+  Forms, Controls, Menus, ExtCtrls, Grids, Buttons, ComCtrls,
   PropEdits, ObjInspStrConsts;
 
 
@@ -192,6 +193,7 @@ type
     procedure ExecuteVerb(Index: Integer); override;
   end;
   
+  
 { TNotebookComponentEditor
   The default component editor for TCustomNotebook. }
   TNotebookComponentEditor = class(TDefaultComponentEditor)
@@ -213,6 +215,7 @@ type
     function Notebook: TCustomNotebook; virtual;
   end;
   
+  
 { TPageComponentEditor
   The default component editor for TCustomPage. }
   TPageComponentEditor = class(TNotebookComponentEditor)
@@ -237,6 +240,19 @@ type
   end;
 
 
+{ TToolBarComponentEditor
+  The default componenteditor fo TToolBar}
+
+  TToolBarComponentEditor = class(TDefaultComponentEditor)
+  protected
+  public
+    procedure ExecuteVerb(Index: Integer); override;
+    function GetVerb(Index: Integer): string; override;
+    function GetVerbCount: Integer; override;
+    function ToolBar: TToolBar; virtual;
+  end;
+
+
 { Register a component editor }
 type
   TRegisterComponentEditorProc =
@@ -815,6 +831,55 @@ begin
   Result:=1;
 end;
 
+{ TToolBarComponentEditor }
+
+procedure TToolBarComponentEditor.ExecuteVerb(Index: Integer);
+var
+  NewStyle: TToolButtonStyle;
+  Hook: TPropertyEditorHook;
+  NewToolButton: TToolButton;
+  NewName: string;
+  CurToolBar: TToolBar;
+begin
+  Hook:=nil;
+  if not GetHook(Hook) then exit;
+  case Index of
+  0: NewStyle:=tbsButton;
+  1: NewStyle:=tbsCheck;
+  2: NewStyle:=tbsSeparator;
+  else exit;
+  end;
+  CurToolBar:=ToolBar;
+  NewToolButton:=TToolButton.Create(CurToolBar.Owner);
+  NewName:=GetDesigner.CreateUniqueComponentName(NewToolButton.ClassName);
+  NewToolButton.Caption:=NewName;
+  NewToolButton.Name:=NewName;
+  NewToolButton.Style:=NewStyle;
+  NewToolButton.Parent:=CurToolBar;
+  Hook.ComponentAdded(NewToolButton,true);
+  GetDesigner.Modified;
+end;
+
+function TToolBarComponentEditor.GetVerb(Index: Integer): string;
+begin
+  case Index of
+  0: Result:='New Button';
+  1: Result:='New Checkbutton';
+  2: Result:='New Separator';
+  else Result:='';
+  end;
+end;
+
+function TToolBarComponentEditor.GetVerbCount: Integer;
+begin
+  Result:=3;
+end;
+
+function TToolBarComponentEditor.ToolBar: TToolBar;
+begin
+  Result:=TToolBar(GetComponent);
+end;
+
 //------------------------------------------------------------------------------
 
 procedure InternalFinal;
@@ -836,6 +901,7 @@ initialization
   RegisterComponentEditor(TCustomNotebook,TNotebookComponentEditor);
   RegisterComponentEditor(TCustomPage,TPageComponentEditor);
   RegisterComponentEditor(TStringGrid,TStringGridComponentEditor);
+  RegisterComponentEditor(TToolBar,TToolBarComponentEditor);
 
 finalization
   InternalFinal;

images/components/ttoolbutton.xpm

@@ -0,0 +1,64 @@
+/* XPM */
+static char * tbutton_xpm[] = {
+"19 11 50 1",
+" 	c None",
+".	c #F8F8F8",
+"+	c #FFFFFF",
+"@	c #EFEFEF",
+"#	c #F0F0F0",
+"$	c #FCFCFC",
+"%	c #030303",
+"&	c #C1C1C1",
+"*	c #BCBCBC",
+"=	c #BDBDBD",
+"-	c #C5C5C5",
+";	c #BFBFBF",
+">	c #BEBEBE",
+",	c #BBBBBB",
+"'	c #CCCCCC",
+")	c #BABABA",
+"!	c #808080",
+"~	c #000000",
+"{	c #F4F4F4",
+"]	c #C8C8C8",
+"^	c #C6C6C6",
+"/	c #B8B8B8",
+"(	c #010101",
+"_	c #C7C7C7",
+":	c #C4C4C4",
+"<	c #C0C0C0",
+"[	c #040404",
+"}	c #060606",
+"|	c #050505",
+"1	c #B9B9B9",
+"2	c #020202",
+"3	c #C9C9C9",
+"4	c #C3C3C3",
+"5	c #080808",
+"6	c #070707",
+"7	c #CACACA",
+"8	c #B7B7B7",
+"9	c #B6B6B6",
+"0	c #CFCFCF",
+"a	c #FEFEFE",
+"b	c #7C7C7C",
+"c	c #8B8B8B",
+"d	c #767676",
+"e	c #828282",
+"f	c #878787",
+"g	c #7A7A7A",
+"h	c #7F7F7F",
+"i	c #888888",
+"j	c #7D7D7D",
+"k	c #898989",
+".+@++#++++++++++$+%",
+"+&*=-&;&;>,';);&;!~",
+"{]>^/;(~&-~&~_:&;!~",
+"+*&<=~;<[>}/|=1&;!~",
+".;-,&2<&~;2~-:<&;!~",
+".;-,&2<;%3~]~->&;!~",
+"+*&<=~;4~1~<5=<&;!~",
+"{]>^/;(6/7|*~1:&;!~",
+"+&*=-&;*]8<^90)&;!~",
+"abcdefghhhhhhhhijk~",
+"~2~|~(~~~~~~~~~~2~ "};

images/components_images.lrs

@@ -2503,6 +2503,28 @@ LazarusResources.Add('ttoolbar','XPM',[
   +'".##@++++++##@+.#@++++@ ",'#10'".###########@+.#####@  ",'#10'".@@@@@@@@@@@'
   +'@+.@@@@@@  ",'#10'"++++++++++++++++++++   "};'#10
 ]);
+LazarusResources.Add('ttoolbutton','XPM',[
+  '/* XPM */'#10'static char * tbutton_xpm[] = {'#10'"19 11 50 1",'#10'" '#9'c '
+  +'None",'#10'".'#9'c #F8F8F8",'#10'"+'#9'c #FFFFFF",'#10'"@'#9'c #EFEFEF",'#10
+  +'"#'#9'c #F0F0F0",'#10'"$'#9'c #FCFCFC",'#10'"%'#9'c #030303",'#10'"&'#9'c #'
+  +'C1C1C1",'#10'"*'#9'c #BCBCBC",'#10'"='#9'c #BDBDBD",'#10'"-'#9'c #C5C5C5",'
+  +#10'";'#9'c #BFBFBF",'#10'">'#9'c #BEBEBE",'#10'",'#9'c #BBBBBB",'#10'"'''#9
+  +'c #CCCCCC",'#10'")'#9'c #BABABA",'#10'"!'#9'c #808080",'#10'"~'#9'c #000000'
+  +'",'#10'"{'#9'c #F4F4F4",'#10'"]'#9'c #C8C8C8",'#10'"^'#9'c #C6C6C6",'#10'"/'
+  +#9'c #B8B8B8",'#10'"('#9'c #010101",'#10'"_'#9'c #C7C7C7",'#10'":'#9'c #C4C4'
+  +'C4",'#10'"<'#9'c #C0C0C0",'#10'"['#9'c #040404",'#10'"}'#9'c #060606",'#10
+  +'"|'#9'c #050505",'#10'"1'#9'c #B9B9B9",'#10'"2'#9'c #020202",'#10'"3'#9'c #'
+  +'C9C9C9",'#10'"4'#9'c #C3C3C3",'#10'"5'#9'c #080808",'#10'"6'#9'c #070707",'
+  +#10'"7'#9'c #CACACA",'#10'"8'#9'c #B7B7B7",'#10'"9'#9'c #B6B6B6",'#10'"0'#9
+  +'c #CFCFCF",'#10'"a'#9'c #FEFEFE",'#10'"b'#9'c #7C7C7C",'#10'"c'#9'c #8B8B8B'
+  +'",'#10'"d'#9'c #767676",'#10'"e'#9'c #828282",'#10'"f'#9'c #878787",'#10'"g'
+  +#9'c #7A7A7A",'#10'"h'#9'c #7F7F7F",'#10'"i'#9'c #888888",'#10'"j'#9'c #7D7D'
+  +'7D",'#10'"k'#9'c #898989",'#10'".+@++#++++++++++$+%",'#10'"+&*=-&;&;>,'';);'
+  +'&;!~",'#10'"{]>^/;(~&-~&~_:&;!~",'#10'"+*&<=~;<[>}/|=1&;!~",'#10'".;-,&2<&~'
+  +';2~-:<&;!~",'#10'".;-,&2<;%3~]~->&;!~",'#10'"+*&<=~;4~1~<5=<&;!~",'#10'"{]>'
+  +'^/;(6/7|*~1:&;!~",'#10'"+&*=-&;*]8<^90)&;!~",'#10'"abcdefghhhhhhhhijk~",'#10
+  +'"~2~|~(~~~~~~~~~~2~ "};'#10
+]);
 LazarusResources.Add('ttrackbar','XPM',[
   '/* XPM */'#10'static char * ttrackbar_xpm[] = {'#10'"21 12 5 1",'#10'" '#9'c'
   +' None",'#10'".'#9'c #FFFFFF",'#10'"+'#9'c #C0C0C0",'#10'"@'#9'c #808080",'

lcl/buttons.pp

@@ -63,20 +63,14 @@ type
     FCancel : Boolean;
     FDefault : Boolean;
     FModalResult : TModalResult;
-    FOnMouseLeave: TNotifyEvent;
-    FOnMouseEnter: TNotifyEvent;
     FShortCut : TLMShortcut;
     Procedure SetDefault(Value : Boolean);
-    procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
-    procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
     procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED;
   protected
     procedure Click; override;
     procedure CreateWnd; override;
     procedure DoSendBtnDefault; virtual;
 
-    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
-    property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
     procedure SetParent(AParent: TWinControl); override;
     procedure SetText(const Value: TCaption); override;
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
@@ -229,8 +223,8 @@ type
     procedure SetLayout(const Value: TButtonLayout);
     procedure SetTransparent(const Value: boolean);
     procedure CMButtonPressed(var Message: TLMessage); message CM_BUTTONPRESSED;
-    procedure CMMouseEnter(var Message: TLMessage); message CM_MouseEnter;
+    procedure MouseEnter; override;
-    procedure CMMouseLeave(var Message: TLMessage); message CM_MouseLeave;
+    procedure MouseLeave; override;
     procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
   protected
     FState: TButtonState;
@@ -332,6 +326,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.60  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.59  2004/02/22 10:43:20  mattias
   added child-parent checks
 

lcl/comctrls.pp

@@ -816,8 +816,6 @@ type
     procedure SetWrap(Value: Boolean);
     procedure SetMouseInControl(NewMouseInControl: Boolean);
     procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
-    procedure CMMouseEnter(var Message: TLMessage); message CM_MouseEnter;
-    procedure CMMouseLeave(var Message: TLMessage); message CM_MouseLeave;
   protected
     FToolBar: TToolBar;
     function GetActionLinkClass: TControlActionLinkClass; override;
@@ -828,6 +826,8 @@ type
     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 MouseEnter; override;
+    procedure MouseLeave; override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Paint; override;
     procedure RefreshControl; virtual;
@@ -837,6 +837,7 @@ type
     procedure SetParent(AParent: TWinControl); override;
     procedure UpdateVisibleToolbar;
     function GroupAllUpAllowed: boolean;
+    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
   public
     constructor Create(TheOwner: TComponent); override;
     function CheckMenuDropdown: Boolean; dynamic;
@@ -893,6 +894,7 @@ type
   TToolBar = class(TToolWindow)
   private
     FButtonHeight: Integer;
+    FRealizedButtonHeight: integer;
     FButtons: TList;
     FButtonWidth: Integer;
     FDisabledImageChangeLink: TChangeLink;
@@ -958,6 +960,8 @@ type
     procedure FlipChildren(AllLevels: Boolean); override;
     procedure BeginUpdate; virtual;
     procedure EndUpdate; virtual;
+    procedure Paint; override;
+    procedure SetButtonSize(NewButtonWidth, NewButtonHeight: integer);
   public
     property ButtonCount: Integer read GetButtonCount;
     property Buttons[Index: Integer]: TToolButton read GetButton;
@@ -2235,6 +2239,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.115  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.114  2004/02/22 16:22:53  mattias
   fixed old toolbar compilation
 

lcl/controls.pp

@@ -262,7 +262,10 @@ type
     csReflector,
     csActionClient,
     csMenuEvents,
-    csNoFocus);
+    csNoFocus,
+    csDesignNoSmoothResize, // no WYSIWYG resizing in designer
+    csDesignFixedBounds // control can not be moved nor resized in designer
+    );
   TControlStyle = set of TControlStyleType;
 
 const
@@ -805,8 +808,8 @@ type
     procedure LockBaseBounds;
     procedure UnlockBaseBounds;
     procedure UpdateAnchorRules;
-    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
+    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
-    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
+    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
     procedure ChangeScale(M,D : Integer); dynamic;
     Function CanAutoSize(var NewWidth, NewHeight : Integer): Boolean; virtual;
     procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
@@ -881,6 +884,9 @@ type
     procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); dynamic;
     procedure MouseMove(Shift: TShiftState; X,Y: Integer); Dynamic;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); dynamic;
+    procedure MouseEnter; virtual;
+    procedure MouseLeave; virtual;
+    procedure CaptureChanged; virtual;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     Function CanTab: Boolean; virtual;
     Function Focused : Boolean; dynamic;
@@ -974,6 +980,7 @@ type
     Procedure SetZOrder(TopMost: Boolean); virtual;
     function HandleObjectShouldBeVisible: boolean; virtual;
     procedure InitiateAction; virtual;
+    property MouseEntered: Boolean read FMouseEntered;
   public
     // Event lists
     procedure RemoveAllControlHandlersOfObject(AnObject: TObject);
@@ -1287,7 +1294,7 @@ type
     procedure CreateComponent(TheOwner: TComponent); virtual;
     procedure DestroyComponent; virtual;
     procedure DoConstraintsChange(Sender : TObject); override;
-    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); override;
+    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
     procedure DoAutoSize; Override;
     procedure GetChildren(Proc : TGetChildProc; Root : TComponent); override;
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
@@ -1682,7 +1689,6 @@ procedure SetCaptureControl(Control : TControl);
 function GetCaptureControl : TControl;
 procedure CancelDrag;
 
-
 var
   NewStyleControls : Boolean;
   Mouse : TMouse;
@@ -2023,32 +2029,51 @@ begin
 end;
 
 procedure SetCaptureControl(Control : TControl);
+var
+  OldCaptureWinControl: TWinControl;
+  NewCaptureWinControl: TWinControl;
 begin
+  if CaptureControl=Control then exit;
+  if Control=nil then begin
     {$IFDEF VerboseMouseCapture}
-  write('SetCaptureControl');
+    write('SetCaptureControl Only ReleaseCapture');
-  if CaptureControl<>nil then
-    write(' Old=',CaptureControl.Name,':',CaptureControl.ClassName)
-  else
-    write(' Old=nil');
-  if Control<>nil then
-    write(' New=',Control.Name,':',Control.ClassName)
-  else
-    write(' New=nil');
-  writeln('');
     {$ENDIF}
+    // just unset the capturing, intf call not needed
+    CaptureControl:=nil;
     ReleaseCapture;
-  CaptureControl := nil;
+    exit;
-  if Control <> nil
-  then begin
-    if not (Control is TWinControl)
-    then begin
-      if Control.Parent = nil then Exit;
-
-      CaptureControl := Control;
-      Control := Control.Parent;
   end;
-    SetCapture(TWinControl(Control).Handle);
+  OldCaptureWinControl:=FindOwnerControl(GetCapture);
+  if Control is TWinControl then
+    NewCaptureWinControl:=TWinControl(Control)
+  else
+    NewCaptureWinControl:=Control.Parent;
+  if NewCaptureWinControl=nil then begin
+    {$IFDEF VerboseMouseCapture}
+    write('SetCaptureControl Only ReleaseCapture');
+    {$ENDIF}
+    // just unset the capturing, intf call not needed
+    CaptureControl:=nil;
+    ReleaseCapture;
+    exit;
   end;
+  if NewCaptureWinControl=OldCaptureWinControl then begin
+    {$IFDEF VerboseMouseCapture}
+    write('SetCaptureControl Keep WinControl ',NewCaptureWinControl.Name,':',NewCaptureWinControl.ClassName,
+    ' switch Control ',Control.Name,':',Control.ClassName);
+    {$ENDIF}
+    // just change the CaptureControl, intf call not needed
+    CaptureControl:=Control;
+    exit;
+  end;
+  // switch capture control
+  {$IFDEF VerboseMouseCapture}
+    write('SetCaptureControl Switch to WinControl=',NewCaptureWinControl.Name,':',NewCaptureWinControl.ClassName,
+    ' and Control=',Control.Name,':',Control.ClassName);
+  {$ENDIF}
+  CaptureControl:=Control;
+  ReleaseCapture;
+  SetCapture(TWinControl(NewCaptureWinControl).Handle);
 end;
 
 procedure CancelDrag;
@@ -2366,6 +2391,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.182  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.181  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/forms.pp

@@ -778,6 +778,8 @@ type
     procedure IconChanged(Sender: TObject);
     procedure Idle;
     function InvokeHelp(Command: Word; Data: Longint): Boolean;
+    function GetControlAtMouse: TControl;
+    procedure UpdateMouseControl(NewMouseControl: TControl);
     procedure MouseIdle(const CurrentControl: TControl);
     procedure SetCaptureExceptions(const AValue: boolean);
     procedure SetHint(const AValue: string);

lcl/include/application.inc

@@ -237,21 +237,9 @@ end;
   Handles mouse Idle
  ------------------------------------------------------------------------------}
 procedure TApplication.MouseIdle(const CurrentControl: TControl);
-var
-  CaptureControl: TControl;
-  IsOther: Boolean;
 begin
-  CaptureControl := GetCaptureControl;
+  if FMouseControl <> CurrentControl then begin
-  if FMouseControl <> CurrentControl then
+    UpdateMouseControl(CurrentControl);
-  begin
-    IsOther:=((FMouseControl <> nil) and (CaptureControl = nil)) or
-      ((CaptureControl <> nil) and (FMouseControl = CaptureControl));
-
-    if IsOther and (FMouseControl<>nil) then
-      FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
-    FMouseControl := CurrentControl;
-    if IsOther and (FMouseControl<>nil) then
-      FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
   end;
 end;
 
@@ -284,17 +272,9 @@ end;
  ------------------------------------------------------------------------------}
 procedure TApplication.Idle;
 var
-  P: TPoint;
   Done: Boolean;
-  CurrentControl: TControl;
 begin
-  GetCursorPos(P);
+  MouseIdle(GetControlAtMouse);
-  CurrentControl := FindDragTarget(P, True);
-  if (CurrentControl <> nil)
-  and (csDesigning in CurrentControl.ComponentState)
-  then CurrentControl := nil;
-
-  MouseIdle(CurrentControl);
 
   Done := True;
   if Assigned(FOnIdle) then FOnIdle(Self, Done);
@@ -352,6 +332,34 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  function TApplication.GetControlAtMouse: TControl;
+
+ ------------------------------------------------------------------------------}
+function TApplication.GetControlAtMouse: TControl;
+var
+  P: TPoint;
+begin
+  GetCursorPos(P);
+  Result := FindDragTarget(P, True);
+  if (Result <> nil) and (csDesigning in Result.ComponentState) then
+    Result := nil;
+end;
+
+{------------------------------------------------------------------------------
+  procedure TApplication.UpdateMouseControl(NewMouseControl: TControl);
+
+ ------------------------------------------------------------------------------}
+procedure TApplication.UpdateMouseControl(NewMouseControl: TControl);
+begin
+  if FMouseControl=NewMouseControl then exit;
+  if (FMouseControl<>nil) then
+    FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
+  FMouseControl := NewMouseControl;
+  if (FMouseControl<>nil) then
+    FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
+end;
+
 {------------------------------------------------------------------------------
   Method: TApplication.SetIcon
   Params: the new icon
@@ -1081,13 +1089,7 @@ end;
 ------------------------------------------------------------------------------}
 procedure TApplication.DoBeforeMouseMessage(CurMouseControl: TControl);
 begin
-  if (FMouseControl<>CurMouseControl) then begin
+  UpdateMouseControl(GetControlAtMouse);
-    if (FMouseControl<>nil) then
-      FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
-    FMouseControl := CurMouseControl;
-    if (FMouseControl<>nil) then
-      FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
-  end;
 end;
 
 {------------------------------------------------------------------------------
@@ -1161,6 +1163,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.74  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.73  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/include/buttons.inc

@@ -103,36 +103,6 @@ Begin
   inherited Click;
 end;
 
-{------------------------------------------------------------------------------
-  Method:  TButton.CMMouseEnter
-  Params:  None
-  Returns: Nothing
-
-  Handles the event when the button is entered
- ------------------------------------------------------------------------------}
-procedure TButton.CMMouseEnter(var Message: TLMessage);
-begin
-  Assert(False,'Trace:[TButton.CMMouseEnter]');
-  inherited CMMouseEnter(Message);
-  If assigned(FOnMouseEnter) then
-    FOnMouseEnter(Self);
-end;
-
-{------------------------------------------------------------------------------
-  Method:  TButton.CMMouseLeave
-  Params:  None
-  Returns: Nothing
-
-  Handles the event when the mouse leaves the button
- ------------------------------------------------------------------------------}
-procedure TButton.CMMouseLeave(var Message: TLMessage);
-begin
-  Assert(False,'Trace:[TButton.CMMouseLeave]');
-  inherited CMMouseLeave(Message);
-  If assigned(FOnMouseLeave) then
-    FOnMouseLeave(Self);
-end;
-
 {------------------------------------------------------------------------------
   Method:  TButton.CMDefaultClicked
   Params:  None
@@ -173,6 +143,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.20  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.19  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/include/control.inc

@@ -569,6 +569,7 @@ end;
 Procedure TControl.LMCaptureChanged(Var Message: TLMessage);
 Begin
   //Writeln('[LMCaptureChanged for '+Name+':'+Classname+']');
+  CaptureChanged;
 End;
 
 {------------------------------------------------------------------------------}
@@ -590,12 +591,12 @@ end;
 {------------------------------------------------------------------------------
        TControl.CMMouseEnter
 ------------------------------------------------------------------------------}
-Procedure TControl.CMMouseEnter(var Message :TLMessage);
+Procedure TControl.CMMouseEnter(var Message: TLMessage);
 Begin
   // this is a LCL based mouse message, so don't call DoBeforeMouseMessage
-  if not FMouseEntered then begin
+  if (Message.LParam=0) and (not FMouseEntered) then begin
     FMouseEntered:=true;
-    if Assigned(OnMouseEnter) then OnMouseEnter(Self);
+    MouseEnter;
     if FParent <> nil then
       FParent.Perform(CM_MOUSEENTER, 0, LParam(Self));
   end;
@@ -604,12 +605,12 @@ end;
 {------------------------------------------------------------------------------
        TControl.CMMouseLeave
 ------------------------------------------------------------------------------}
-Procedure TControl.CMMouseLeave(var Message :TLMessage);
+Procedure TControl.CMMouseLeave(var Message: TLMessage);
 Begin
   // this is a LCL based mouse message, so don't call DoBeforeMouseMessage
-  if FMouseEntered then begin
+  if (Message.LParam=0) and FMouseEntered then begin
     FMouseEntered:=false;
-    if Assigned(OnMouseLeave) then OnMouseLeave(Self);
+    MouseLeave;
     if FParent <> nil then
       FParent.Perform(CM_MOUSELEAVE, 0, LParam(Self));
   end;
@@ -1408,11 +1409,13 @@ end;
  ------------------------------------------------------------------------------}
 procedure TControl.WMLButtonDown(var Message: TLMLButtonDown);
 begin
-  {$IFDEF VerboseMouseBugfix}
-  Writeln('TCONTROL WMLBUTTONDOWN A ',Name,':',ClassName);
-  {$ENDIF}
   DoBeforeMouseMessage;
-  if csCaptureMouse in ControlStyle then MouseCapture := True;
+  if csCaptureMouse in ControlStyle then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('TControl.WMLButtonDown ',Name,':',ClassName);
+    {$ENDIF}
+    MouseCapture := True;
+  end;
   if csClickEvents in ControlStyle then Include(FControlState, csClicked);
   DoMouseDown(Message, mbLeft, []);
   //Writeln('TCONTROL WMLBUTTONDOWN B ',Name,':',ClassName);
@@ -1455,7 +1458,12 @@ procedure TControl.WMLButtonDblClk(var Message: TLMLButtonDblClk);
 begin
   DoBeforeMouseMessage;
   //TODO: SendCancelMode(self);
-  if csCaptureMouse in ControlStyle then MouseCapture := True;
+  if csCaptureMouse in ControlStyle then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('TControl.WMLButtonDblClk ',Name,':',ClassName);
+    {$ENDIF}
+    MouseCapture := True;
+  end;
   // first send a mouse down
   DoMouseDown(Message, mbLeft ,[ssDouble]);
   // then send the double click
@@ -1499,7 +1507,12 @@ procedure TControl.WMLButtonTripleClk(var Message: TLMLButtonTripleClk);
 begin
   DoBeforeMouseMessage;
   //TODO: SendCancelMode(self);
-  if csCaptureMouse in ControlStyle then MouseCapture := True;
+  if csCaptureMouse in ControlStyle then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('TControl.WMLButtonTripleClk ',Name,':',ClassName);
+    {$ENDIF}
+    MouseCapture := True;
+  end;
   if csClickEvents in ControlStyle then TripleClick;
   DoMouseDown(Message, mbLeft ,[ssTriple]);
 end;
@@ -1541,7 +1554,12 @@ procedure TControl.WMLButtonQuadClk(var Message: TLMLButtonQuadClk);
 begin
   DoBeforeMouseMessage;
   //TODO: SendCancelMode(self);
-  if csCaptureMouse in ControlStyle then MouseCapture := True;
+  if csCaptureMouse in ControlStyle then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('TControl.WMLButtonQuadClk ',Name,':',ClassName);
+    {$ENDIF}
+    MouseCapture := True;
+  end;
   if csClickEvents in ControlStyle then QuadClick;
   DoMouseDown(Message, mbLeft ,[ssQuad]);
 end;
@@ -1583,8 +1601,12 @@ procedure TControl.WMLButtonUp(var Message: TLMLButtonUp);
 begin
   DoBeforeMouseMessage;
   //Writeln('TControl.WMLButtonUp A ',Name,':',ClassName,' csCaptureMouse=',csCaptureMouse in ControlStyle,' csClicked=',csClicked in ControlState);
-  if csCaptureMouse in ControlStyle then
+  if csCaptureMouse in ControlStyle then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('TControl.WMLButtonUp ',Name,':',ClassName);
+    {$ENDIF}
     MouseCapture := False;
+  end;
 
   if csClicked in ControlState then
   begin
@@ -2344,31 +2366,47 @@ begin
   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X,Y);
 end;
 
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
-{  TControl MouseMove
+  TControl MouseMove
-}
-{------------------------------------------------------------------------------}
 
+------------------------------------------------------------------------------}
 Procedure TControl.MouseMove(Shift:TShiftState; X, Y: Integer);
 begin
   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X,Y);
 end;
 
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
-{  TControl MouseUp
+  TControl MouseUp
-}
+------------------------------------------------------------------------------}
-{------------------------------------------------------------------------------}
-
 Procedure TControl.MouseUp(Button: TMouseButton; Shift:TShiftState;
   X, Y: Integer);
 begin
   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X,Y);
 end;
 
-{------------------------------------------------------------------------------}
+procedure TControl.MouseEnter;
-{  TControl SetShowHint
+begin
-}
+  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
-{------------------------------------------------------------------------------}
+end;
+
+procedure TControl.MouseLeave;
+begin
+  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
+end;
+
+{------------------------------------------------------------------------------
+  procedure TControl.CaptureChanged;
+
+------------------------------------------------------------------------------}
+procedure TControl.CaptureChanged;
+begin
+  // anything to do here?
+end;
+
+{------------------------------------------------------------------------------
+  TControl SetShowHint
+
+------------------------------------------------------------------------------}
 procedure TControl.SetShowHint(Value : Boolean);
 begin
   if FShowHint <> Value then
@@ -2798,6 +2836,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.174  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.173  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/include/custompage.inc

@@ -24,7 +24,7 @@ begin
 
   fImageIndex:=-1;
   fCompStyle := csPage;
-  ControlStyle := ControlStyle + [csAcceptsControls];
+  ControlStyle := ControlStyle + [csAcceptsControls,csDesignFixedBounds];
 
   // set the default height and width
   if (Owner<>nil) and (Owner is TControl) then begin

lcl/include/graphiccontrol.inc

@@ -41,8 +41,6 @@ end;
  ------------------------------------------------------------------------------}
 destructor TGraphicControl.Destroy;
 begin
-{  if CaptureControl = Self then
-    SetCaptureControl(nil); }
   FCanvas.Free;
   inherited Destroy;
 end;
@@ -91,6 +89,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.8  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.7  2003/06/13 21:08:53  mattias
   moved TColorButton to dialogs.pp
 

lcl/include/mouse.inc

@@ -42,6 +42,7 @@ Begin
   {$ENDIF}
   FCapture := Value;
   if Value = 0 then ReleaseCapture else LCLIntf.SetCapture(Value);
+  FCapture := GetCapture;
 end;
 
 Procedure TMouse.SetCursorPos(Value : Tpoint);

lcl/include/popupmenu.inc

@@ -50,6 +50,7 @@ Procedure TPopupMenu.PopUp(X,Y : Integer);
 begin
   if ActivePopupMenu<>nil then ActivePopupMenu.Close;
   FPopupPoint := Point(X, Y);
+  ReleaseCapture;
   DoPopup(Self);
   if Items.Count=0 then exit;
   ActivePopupMenu:=Self;
@@ -74,6 +75,9 @@ end;
 
 {
   $Log$
+  Revision 1.9  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.8  2003/05/12 13:40:50  mattias
   fixed clsing popupmenu on showmodal
 

lcl/include/speedbutton.inc

@@ -686,14 +686,14 @@ Begin
 end;
 
 {------------------------------------------------------------------------------
-  Method: TSpeedButton.CMMouseEnter
+  Method: TSpeedButton.MouseEnter
-  Params: Message:
+  Params:
   Returns:  nothing
 
  ------------------------------------------------------------------------------}
-procedure TSpeedButton.CMMouseEnter(var Message :TLMessage);
+procedure TSpeedButton.MouseEnter;
 begin
-  inherited CMMouseEnter(Message);
+  inherited MouseEnter;
   if csDesigning in ComponentState then exit;
 
   if not FMouseInControl
@@ -705,14 +705,14 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Method: TSpeedButton.CMMouseLeave
+  Method: TSpeedButton.MouseLeave
-  Params: Message:
+  Params:
   Returns:  nothing
 
  ------------------------------------------------------------------------------}
-procedure TSpeedButton.CMMouseLeave(var Message :TLMessage);
+procedure TSpeedButton.MouseLeave;
 begin
-  inherited CMMouseLeave(Message);
+  inherited MouseLeave;
   if csDesigning in ComponentState then exit;
 
   if FMouseInControl
@@ -773,6 +773,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.49  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.48  2004/02/11 11:34:15  mattias
   started new TToolBar
 

lcl/include/toolbar.inc

@@ -20,6 +20,29 @@
 
 {$IFDEF NewToolBar}
 
+function CompareToolBarControl(Control1, Control2: TControl): integer;
+var
+  ToolBar: TToolBar;
+  Row1: Integer;
+  Row2: Integer;
+  BtnHeight: Integer;
+begin
+  Result:=0;
+  if not (Control1.Parent is TToolBar) then exit;
+  ToolBar:=TToolBar(Control1.Parent);
+  BtnHeight:=ToolBar.FRealizedButtonHeight;
+  Row1:=(Control1.Top+(BtnHeight div 2)) div ToolBar.FRealizedButtonHeight;
+  Row2:=(Control2.Top+(BtnHeight div 2)) div ToolBar.FRealizedButtonHeight;
+  if Row1<Row2 then
+    Result:=-1
+  else if Row1>Row2 then
+    Result:=1
+  else if Control1.Left<Control2.Left then
+    Result:=-1
+  else if Control1.Left>Control2.Left then
+    Result:=1;
+end;
+
 {------------------------------------------------------------------------------
   Method: TToolbar.Create
   Params:  AOwner: the owner of the class
@@ -48,7 +71,7 @@ begin
   FHotImageChangeLink := TChangeLink.Create;
   FHotImageChangeLink.OnChange := @HotImageListChange;
   EdgeBorders := [ebTop];
-  SetInitialBounds(1,1,150,32);
+  SetInitialBounds(0,0,150,26);
   Align := alTop;
 end;
 
@@ -135,10 +158,6 @@ procedure TToolBar.ControlsAligned;
 var
   NewWidth, NewHeight: integer;
 begin
-  if FUpdateCount>0 then begin
-    UpdateVisibleBar;
-    exit;
-  end;
   if tbfPlacingControls in FToolBarFlags then exit;
   Include(FToolBarFlags,tbfPlacingControls);
   try
@@ -160,48 +179,13 @@ begin
 end;
 
 procedure TToolBar.SetButtonHeight(const AValue: Integer);
-var
-  i: Integer;
 begin
-  if AValue = FButtonHeight then exit;
+  SetButtonSize(ButtonWidth,AValue);
-  FButtonHeight := AValue;
-  if ([csLoading,csDestroying]*ComponentState<>[]) or (FUpdateCount > 0) then
-    Exit;
-  // set all childs to buttonheight
-  BeginUpdate;
-  try
-    for i:=ControlCount-1 downto 0 do Controls[i].Height:=FButtonHeight;
-  finally
-    EndUpdate;
-  end;
 end;
 
 procedure TToolBar.SetButtonWidth(const AValue: Integer);
-var
-  i: Integer;
-  CurControl: TControl;
-  CurButton: TToolButton;
 begin
-  if AValue = FButtonWidth then exit;
+  SetButtonSize(AValue,ButtonHeight);
-  FButtonWidth := AValue;
-  if ([csLoading,csDestroying]*ComponentState<>[]) or (FUpdateCount > 0) then
-    Exit;
-  // set all toolbuttons to buttonwidth
-  BeginUpdate;
-  try
-    for i:=ControlCount-1 downto 0 do begin
-      CurControl:=Controls[i];
-      if (CurControl is TToolButton) then begin
-        CurButton:=TToolButton(CurControl);
-        case CurButton.Style of
-        tbsButton,tbsCheck,tbsDropDown:
-          CurButton.Width:=FButtonWidth;
-        end;
-      end;
-    end;
-  finally
-    EndUpdate;
-  end;
 end;
 
 procedure TToolBar.ToolButtonDown(AButton: TToolButton; NewDown: Boolean);
@@ -396,6 +380,52 @@ begin
   end;
 end;
 
+procedure TToolBar.Paint;
+begin
+  if csDesigning in ComponentState then begin
+    Canvas.Pen.Color:=clRed;
+    Canvas.FrameRect(Clientrect);
+  end;
+  inherited Paint;
+end;
+
+procedure TToolBar.SetButtonSize(NewButtonWidth, NewButtonHeight: integer);
+var
+  CurControl: TControl;
+  NewWidth: Integer;
+  NewHeight: Integer;
+  i: Integer;
+  CurButton: TToolButton;
+begin
+  if (FButtonWidth=NewButtonWidth) and (FButtonHeight=NewButtonHeight) then
+    exit;
+  FButtonWidth:=NewButtonWidth;
+  FButtonHeight:=NewButtonHeight;
+  if ([csLoading,csDestroying]*ComponentState<>[]) or (FUpdateCount > 0) then
+    Exit;
+  // set all childs to ButtonWidth ButtonHeight
+  BeginUpdate;
+  try
+    for i:=ControlCount-1 downto 0 do begin
+      CurControl:=Controls[i];
+      if CurControl.Align<>alNone then continue;
+      NewWidth:=CurControl.Width;
+      NewHeight:=FButtonHeight;
+      if (CurControl is TToolButton) then begin
+        CurButton:=TToolButton(CurControl);
+        case CurButton.Style of
+        tbsButton,tbsCheck,tbsDropDown:
+          NewWidth:=FButtonWidth;
+        end;
+      end;
+      CurControl.SetBounds(CurControl.Left,CurControl.Top,
+                           NewWidth,NewHeight);
+    end;
+  finally
+    EndUpdate;
+  end;
+end;
+
 function TToolBar.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
 begin
   Result := WrapButtons(NewWidth, NewHeight);
@@ -411,14 +441,6 @@ end;
   If Wrapable=false, then the row is wrapped after the first button with
   Wrap=true.
 
-  Wrapable
-  Indent
-  EdgeInner
-  EdgeOuter
-  EdgeBorders
-  BorderWidth
-  Button.Wrap
-
 ------------------------------------------------------------------------------}
 function TToolBar.WrapButtons(var NewWidth, NewHeight: Integer): Boolean;
 var
@@ -426,36 +448,106 @@ var
   ARect: TRect;
   x: Integer;
   y: Integer;
+  NewControlWidth: Integer;
   CurControl: TControl;
   AlignedControls: TList;
+  StartX: Integer;
+  OrderedControls: TList;
+
+  procedure CalculatePosition;
+  var
+    AlignedControl: TControl;
+    NewBounds: TRect;
+    CurBounds: TRect;
+    j: Integer;
+  begin
+    if (CurControl is TToolButton)
+    and (TToolButton(CurControl).Style in [tbsButton,tbsDropDown,tbsCheck])
+    then
+      NewControlWidth:=ButtonWidth
+    else
+      NewControlWidth:=CurControl.Width;
+    NewBounds:=Bounds(x,y,NewControlWidth,ButtonHeight);
+    repeat
+      // move control to the right, until it does not overlap
+      for j:=0 to AlignedControls.Count-1 do begin
+        AlignedControl:=TControl(AlignedControls[j]);
+        CurBounds:=Bounds(AlignedControl.Left,AlignedControl.Top,
+                          AlignedControl.Width,AlignedControl.Height);
+        if (CurBounds.Right>NewBounds.Left)
+        and (CurBounds.Left<NewBounds.Right)
+        and (CurBounds.Bottom>NewBounds.Top)
+        and (CurBounds.Top<NewBounds.Bottom) then begin
+          //writeln('CalculatePosition Move ',NewBounds.Left,'->',CurBounds.Right);
+          NewBounds.Left:=CurBounds.Right;
+          NewBounds.Right:=NewBounds.Left+NewControlWidth;
+        end;
+      end;
+      if (not Wrapable) or (NewBounds.Right<=ARect.Right)
+      or (NewBounds.Left=StartX) then begin
+        // control fits into the row
+        x:=NewBounds.Left;
+        y:=NewBounds.Top;
+        exit;
+      end;
+      // try next row
+      NewBounds.Left:=StartX;
+      NewBounds.Right:=NewBounds.Left+NewControlWidth;
+      inc(NewBounds.Top,ButtonHeight);
+      inc(NewBounds.Bottom,ButtonHeight);
+      //writeln('CalculatePosition Next Row ',NewBounds.Left,',',NewBounds.Top);
+    until false;
+  end;
+
 begin
+  //writeln('WrapButtons ');
   Result:=true;
+  BeginUpdate;
   NewWidth:=0;
   NewHeight:=0;
-  BeginUpdate;
   AlignedControls:=TList.Create;
+  OrderedControls:=TList.Create;
   try
     for i:=0 to ControlCount-1 do begin
       CurControl:=Controls[i];
-      if CurControl.Align<>alNone then
+      if CurControl.Align=alNone then
-        AlignedControls.Add(CurControl);
+        OrderedControls.Add(CurControl)
+      else
+        AlignedControls.Add(CurControl)
+    end;
+    // sort OrderedControls
+    if FRealizedButtonHeight=0 then FRealizedButtonHeight:=FButtonHeight;
+    OrderedControls.Sort(@CompareToolBarControl);
+    
+    // position OrderedControls
     ARect:=ClientRect;
     AdjustClientRect(ARect);
-      x:=ARect.Left+Indent;
+    StartX:=ARect.Left+Indent;
+    x:=StartX;
     y:=ARect.Top;
+    NewControlWidth:=ButtonWidth;
     i:=0;
-      while i<ControlCount do begin
+    while i<OrderedControls.Count do begin
-        CurControl:=Controls[i];
+      CurControl:=TControl(OrderedControls[i]);
       if CurControl.Align=alNone then begin
-          // wrap
+        CalculatePosition;
-          CurControl.SetBounds(x,y,CurControl.Width,CurControl.Height);
+        //writeln('WrapButtons ',CurControl.Name,':',CurControl.ClassName,' ',x,',',y,',',CurControl.Width,',',CurControl.Height);
+        CurControl.SetBounds(x,y,NewControlWidth,ButtonHeight);
         inc(x,CurControl.Width);
+        
+        if (not Wrapable) and (CurControl is TToolButton)
+        and (TToolButton(CurControl).Wrap) then begin
+          // user forced wrap -> start new line
+          x:=StartX;
+          inc(y,ButtonHeight);
+        end;
       end;
       inc(i);
     end;
-    end;
+    FRealizedButtonHeight:=FButtonHeight;
   finally
     AlignedControls.Free;
+    OrderedControls.Free;
     EndUpdate;
   end;
 end;
@@ -2001,6 +2093,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.24  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.23  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/include/toolbutton.inc

@@ -1,3 +1,5 @@
+// included by comctrls.pp
+
 { TToolButton
 
  *****************************************************************************
@@ -55,23 +57,29 @@ begin
   fCompStyle := csToolButton;
   FImageIndex := -1;
   FStyle := tbsButton;
-  ControlStyle := [csCaptureMouse, csSetCaption];
+  ControlStyle := [csCaptureMouse, csSetCaption, csDesignNoSmoothResize];
   SetInitialBounds(0,0,23,22);
 end;
 
 procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin
-  writeln('TToolButton.MouseDown ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
+  //writeln('TToolButton.MouseDown ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
-  SetMouseInControl(true);
+  SetMouseInControl((X>=0) and (X<ClientWidth) and (Y>=0) and (Y<ClientHeight));
   if (Button=mbLeft) and (not (tbfPressed in FToolButtonFlags)) then begin
     Include(FToolButtonFlags,tbfPressed);
     Invalidate;
   end;
-  if (Style=tbsDropDown) and (Button=mbLeft) and Enabled then
+
-    // switch
-    Down := not Down;
   inherited MouseDown(Button,Shift,X,Y);
+
+  if (Style=tbsDropDown) and (Button=mbLeft) and Enabled then begin
+    if (FToolBar<>nil) and (X>ClientWidth-FToolBar.FDropDownWidth) then begin
+    
+    end else begin
+      Down := true;
+    end;
+  end;
 end;
 
 procedure TToolButton.MouseMove(Shift: TShiftState; X, Y: Integer);
@@ -79,27 +87,36 @@ begin
   //writeln('TToolButton.MouseMove ',Name,':',ClassName,' ',X,',',Y);
   SetMouseInControl((X>=0) and (X<ClientWidth) and (Y>=0) and (Y<ClientHeight));
   inherited MouseMove(Shift, X, Y);
-  if (Style=tbsDropDown) and MouseCapture then
-    // while dragging: down when mouse in, and up, when mouse out of control
-    Down := FMouseInControl;
 end;
 
 procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin
-  writeln('TToolButton.MouseUp ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
+  //writeln('TToolButton.MouseUp ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y);
   if (Button=mbLeft) and (tbfPressed in FToolButtonFlags) then begin
     Exclude(FToolButtonFlags,tbfPressed);
     Invalidate;
   end;
-  SetMouseInControl(true);
+  SetMouseInControl((X>=0) and (X<ClientWidth) and (Y>=0) and (Y<ClientHeight));
+  
   inherited MouseUp(Button, Shift, X, Y);
-  if (Button=mbLeft) and FMouseInControl then begin
+  
-  writeln('TToolButton.MouseUp ',Name,':',ClassName,' ',Style=tbsCheck);
+  if (Button=mbLeft) then begin
-    if Style=tbsDropDown then Down:=False;
+    //writeln('TToolButton.MouseUp ',Name,':',ClassName,' ',Style=tbsCheck);
-    if Style=tbsCheck then Down:=not Down;
+    if (Style=tbsButton) then Down:=false;
+    if (Style=tbsDropDown) then begin
+      if (FToolBar<>nil) and FMouseInControl
+      and (X>ClientWidth-FToolBar.FDropDownWidth) then begin
+        CheckMenuDropdown;
+      end;
+      Down:=false;
+    end;
+
+    if FMouseInControl then begin
+      if (Style=tbsCheck) then Down:=not Down;
       Click;
     end;
+  end;
   Invalidate;
 end;
 
@@ -148,7 +165,7 @@ var
   ImgList: TCustomImageList;
   ImgIndex: integer;
 begin
-  writeln('TToolButton.Paint A ',Name,' FToolBar=',HexStr(Cardinal(FToolBar),8),' ',ClientWidth,',',ClientHeight,' ',ord(Style));
+  //writeln('TToolButton.Paint A ',Name,' FToolBar=',HexStr(Cardinal(FToolBar),8),' ',ClientWidth,',',ClientHeight,' ',ord(Style));
   if (FToolBar<>nil) and (ClientWidth>0) and (ClientHeight>0) then begin
     PaintRect:=ClientRect; // the whole paint area
 
@@ -186,9 +203,9 @@ begin
       if IconSize.X>0 then begin
         if FToolBar.List then begin
           // icon left of text
-          IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x-TextSize.cy-2) div 2;
+          IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x-TextSize.cx-2) div 2;
           IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y) div 2;
-          TextPos.X:=IconPos.X+2;
+          TextPos.X:=IconPos.X+IconSize.X+2;
           TextPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-TextSize.cy) div 2;
         end else begin
           // icon above text
@@ -237,13 +254,15 @@ begin
     and (csDesigning in ComponentState) then begin
       Canvas.Brush.Color:=clBackground;
       Canvas.Pen.Color:=clBlack;
+      dec(PaintRect.Right);
+      dec(PaintRect.Bottom);
       Canvas.FrameRect(PaintRect);
     end;
     
     // draw divider
     if (Style in [tbsDivider]) then begin
-      DividerRect.Left:=((ButtonRect.Left+ButtonRect.Right) div 2)-2;
+      DividerRect.Left:=((ButtonRect.Left+ButtonRect.Right) div 2)-1;
-      DividerRect.Right:=DividerRect.Left+4;
+      DividerRect.Right:=DividerRect.Left+2;
       DividerRect.Top:=2;
       DividerRect.Bottom:=Max(DividerRect.Top,PaintRect.Bottom-2);
       DrawEdge(Canvas.Handle,DividerRect,EDGE_ETCHED,BF_LEFT);
@@ -293,14 +312,21 @@ begin
     Message.Result := 0;
 end;
 
-procedure TToolButton.CMMouseEnter(var Message: TLMessage);
+procedure TToolButton.MouseEnter;
 begin
+  //writeln('TToolButton.MouseEnter ',Name);
+  inherited MouseEnter;
   SetMouseInControl(true);
 end;
 
-procedure TToolButton.CMMouseLeave(var Message: TLMessage);
+procedure TToolButton.MouseLeave;
 begin
+  //writeln('TToolButton.MouseLeave ',Name);
+  inherited MouseLeave;
   SetMouseInControl(false);
+  if (not MouseCapture) and (tbfPressed in FToolButtonFlags) then begin
+    Exclude(FToolButtonFlags,tbfPressed);
+  end;
 end;
 
 procedure TToolButton.SetDown(Value: Boolean);
@@ -315,7 +341,7 @@ begin
     exit;
   end;
   
-  writeln('TToolButton.SetDown ',Style=tbsCheck,',',FDown,',',GroupAllUpAllowed);
+  //writeln('TToolButton.SetDown ',Style=tbsCheck,',',FDown,',',GroupAllUpAllowed);
   if (Style=tbsCheck) and FDown and (not GroupAllUpAllowed) then
     exit;
 
@@ -339,8 +365,6 @@ begin
   Invalidate;
   if FToolBar <> nil then
     FToolBar.ToolButtonDown(Self,FDown);
-  if (Style=tbsDropDown) and Down and Enabled then
-    CheckMenuDropdown;
 end;
 
 procedure TToolButton.SetDropdownMenu(Value: TPopupMenu);
@@ -451,6 +475,8 @@ procedure TToolButton.SetMouseInControl(NewMouseInControl: Boolean);
 begin
   if FMouseInControl=NewMouseInControl then exit;
   FMouseInControl:=NewMouseInControl;
+  if (Style in [tbsDropDown,tbsButton]) and (not FMouseInControl) then
+    Down:=false;
   Invalidate;
 end;
 
@@ -580,7 +606,9 @@ end;
 function TToolButton.GetButtonDrawFlags: integer;
 begin
   Result:=DFCS_BUTTONPUSH;
-  if FDown or (tbfPressed in FToolButtonFlags) then inc(Result,DFCS_PUSHED);
+  if FDown
+  or ((tbfPressed in FToolButtonFlags) and FMouseInControl) then
+    inc(Result,DFCS_PUSHED);
   if not Enabled then inc(Result,DFCS_INACTIVE);
 
   if (FToolBar<>nil) and FToolBar.Flat
@@ -655,6 +683,40 @@ begin
   end;
 end;
 
+procedure TToolButton.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
+var
+  NewButtonWidth: Integer;
+  NewButtonHeight: Integer;
+  OldLeft: Integer;
+  OldTop: Integer;
+  OldWidth: Integer;
+  OldHeight: Integer;
+begin
+  if ([csDesigning,csLoading,csDestroying]*ComponentState=[csDesigning])
+  and (FToolBar<>nil)
+  and (not (tbfPlacingControls in FToolBar.FToolBarFlags))
+  and (FToolBar.FUpdateCount=0)
+  and (AWidth>0) and (AHeight>0) then begin
+    if Style in [tbsButton,tbsDropDown,tbsCheck] then
+      NewButtonWidth:=AWidth
+    else
+      NewButtonWidth:=FToolBar.ButtonWidth;
+    NewButtonHeight:=AHeight;
+    //writeln('TToolButton.DoSetBounds NewButtonSize=',NewButtonWidth,',',NewButtonHeight);
+    OldLeft:=Left;
+    OldTop:=Top;
+    OldWidth:=Width;
+    OldHeight:=Height;
+    FToolBar.SetButtonSize(NewButtonWidth,NewButtonHeight);
+    if (OldLeft<>Left) or (OldTop<>Top)
+    or (OldWidth<>Width) or (OldHeight<>Height) then
+      // button was auto aligned -> ignore setbounds
+      exit;
+  end;
+  
+  inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
+end;
+
 {$ELSE NewToolBar}
 
 const
@@ -1126,9 +1188,13 @@ end;
 
 {$ENDIF}
 
+// included by comctrls.pp
 
 {
   $Log$
+  Revision 1.14  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.13  2004/02/22 16:22:53  mattias
   fixed old toolbar compilation
 

lcl/include/toolwindow.inc

@@ -42,7 +42,7 @@ begin
   if ebRight in FEdgeBorders then
     dec(ARect.Right,EdgeWidth);
   if ebBottom in FEdgeBorders then
-    inc(ARect.Bottom,EdgeWidth);
+    dec(ARect.Bottom,EdgeWidth);
 end;
 
 procedure TToolWindow.SetEdgeBorders(Value: TEdgeBorders);
@@ -79,13 +79,13 @@ var
 begin
   FEdgeBorderType := 0;
   if (ebTOP in FEdgeBorders)  then
-  FEdgeBorderType := FEdgeBorderType or longint(ebTOP);
+  FEdgeBorderType := FEdgeBorderType or longint(BF_TOP);
   if (ebBottom in FEdgeBorders)  then
-  FEdgeBorderType := FEdgeBorderType or longint(ebBottom);
+  FEdgeBorderType := FEdgeBorderType or longint(BF_BOTTOM);
   if (ebLeft in FEdgeBorders)  then
-  FEdgeBorderType := FEdgeBorderType or longint(ebLeft);
+  FEdgeBorderType := FEdgeBorderType or longint(BF_LEFT);
   if (ebRight in FEdgeBorders)  then
-  FEdgeBorderType := FEdgeBorderType or longint(ebRight);
+  FEdgeBorderType := FEdgeBorderType or longint(BF_RIGHT);
   ARect:=ClientRect;
   DrawEdge(Canvas.Handle,ARect,
            InnerStyles[FEdgeInner] or OuterStyles[FEdgeOuter],FEdgeBorderType);

lcl/include/treeview.inc

@@ -4669,6 +4669,7 @@ begin
   inherited MouseUp(Button, Shift, X, Y);
   if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then
     exit;
+  if Button=mbLeft then
     MouseCapture := False;
   Exclude(fStates, tvsWaitForDragging);
   if (Button=mbLeft)

lcl/include/wincontrol.inc

@@ -490,16 +490,14 @@ begin
 
   try
     //if csDesigning in ComponentState then begin
-      //writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',AlignWork);
+      //writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',AlignWork,' ControlCount=',ControlCount);
       //if AControl<>nil then writeln('  AControl=',AControl.Name,':',AControl.ClassName);
     //end;
     if AlignWork then
     begin
       AdjustClientRect(ARect);
       FAdjustClientRectRealized:=ARect;
-      {$IFDEF VerboseClientRectBugFix}
+      //writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom);
-      writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',Rect.Left,',',Rect.Top,',',Rect.Right,',',Rect.Bottom);
-      {$ENDIF}
       AlignList := TList.Create;
       try
         DoAlign(alTop);
@@ -1311,7 +1309,7 @@ var
   P : TPoint;
   ClientBounds: TRect;
 begin
-  if GetCapture = Handle
+  if FindOwnerControl(GetCapture) = Self
   then begin
     Control := nil;
     if (CaptureControl <> nil)
@@ -1792,7 +1790,7 @@ Begin
     if Dragging then Exit;
 
   LM_CANCELMODE:
-    if (GetCapture = Handle)
+    if (FindOwnerControl(GetCapture) = Self)
     and (CaptureControl <> nil)
     and (CaptureControl.Parent = Self)
     then CaptureControl.Perform(LM_CANCELMODE,0,0);
@@ -3388,6 +3386,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.207  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.206  2004/02/23 08:19:04  micha
   revert intf split
 

lcl/interfaces/gtk/gtkcallback.inc

@@ -479,6 +479,8 @@ begin
   end;
   writeln('');
   {$ENDIF}
+  
+  UpdateMouseCaptureControl;
   Mess.Msg := LM_ACTIVATE;
   Status := DeliverPostMessage(Data, Mess);
 
@@ -509,6 +511,8 @@ begin
   else
     writeln(' LCLObject=nil');
   {$ENDIF}
+  UpdateMouseCaptureControl;
+
   Mess.Msg := LM_DEACTIVATE;
   Status := DeliverPostMessage(Data, Mess);
 
@@ -850,6 +854,8 @@ begin
   writeln('');
   {$ENDIF}
 
+  UpdateMouseCaptureControl;
+
   //TODO: fill in old focus
   FillChar(Mess,SizeOf(Mess),0);
   Mess.msg := LM_SETFOCUS;
@@ -942,6 +948,9 @@ begin
   end;
   writeln('');
   {$ENDIF}
+
+  UpdateMouseCaptureControl;
+
   FillChar(Mess,SizeOf(Mess),0);
   Mess.msg := LM_KILLFOCUS;
 
@@ -1418,16 +1427,9 @@ begin
     if DesignOnlySignal then exit;
     if not ControlGetsMouseDownBefore(TControl(Data)) then exit;
 
-    // grabbing for TSplitter and our special widgets -> Maybe ths is the key for drag&drop
     CaptureWidget:=PGtkWidget(TWinControl(Data).Handle);
-    if (GtkWidgetIsA(CaptureWidget,GTKAPIWidget_GetType))
+    if Event^.button=1 then begin
-    or (TWinControl(Data) is TCustomSplitter)
+      CaptureMouseForWidget(CaptureWidget,mctGTKIntf);
-    or (TWinControl(Data) is TToolButton) then begin
-      CaptureWidget:=GetWidgetInfo(CaptureWidget,true)^.ImplementationWidget;
-      if not gtk_widget_has_focus(CaptureWidget) then
-        gtk_widget_grab_focus(CaptureWidget);
-      if Event^.button=1 then
-        gtk_grab_add(CaptureWidget);
     end;
 
   end else begin
@@ -1566,7 +1568,6 @@ function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
   data: gPointer) : GBoolean; cdecl;
 var
   DesignOnlySignal: boolean;
-  CaptureWidget: PGtkWidget;
 begin
   Result := CallBackDefaultReturn;
 
@@ -1588,19 +1589,9 @@ begin
   if not (csDesigning in TComponent(Data).ComponentState) then begin
     DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
     
-    CaptureWidget:=PGtkWidget(TWinControl(Data).Handle);
+    ReleaseMouseCapture;
-    if GtkWidgetIsA(CaptureWidget,GTKAPIWidget_GetType)
-    or (TWinControl(Data) is TCustomSplitter)
-    or (TWinControl(Data) is TToolButton)
-    then begin
-      CaptureWidget:=GetWidgetInfo(CaptureWidget,true)^.ImplementationWidget;
-      if Event^.button=1 then
-        gtk_grab_remove(CaptureWidget);
-    end;
-
     if DesignOnlySignal or (not ControlGetsMouseUpBefore(TControl(Data))) then
     begin
-      ReleaseMouseCapture(false);
       exit;
     end;
   end else begin
@@ -3074,6 +3065,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.221  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.220  2004/02/22 15:39:44  mattias
   fixed error handling on saving lpi file
 

lcl/interfaces/gtk/gtkglobals.pp

@@ -36,6 +36,13 @@ var
   UpdatingTransientWindows: boolean;
 
   // mouse --------------------------------------------------------------------
+type
+  TMouseCaptureType = (
+    mctGTK,     // gtk is handling capturing
+    mctGTKIntf, // gtk interface has captured the mouse
+    mctLCL      // a LCL control has captured the mouse
+    );
+  
 var
   //drag icons
   //TrashCan_Open : PgdkPixmap;
@@ -48,7 +55,8 @@ var
   //Dragging : Boolean;
 
   MouseCaptureWidget: PGtkWidget;
-  MouseCapureByLCL: boolean;
+  MouseCaptureType: TMouseCaptureType;
+  MouseCaptureIndex: cardinal;
 
 const
   DblClickTime = 250;// 250 miliseconds or less between clicks is a double click

lcl/interfaces/gtk/gtkint.pp

@@ -344,7 +344,7 @@ begin
   gtk_handler_quark := g_quark_from_static_string('gtk-signal-handlers');
 
   MouseCaptureWidget := nil;
-  MouseCapureByLCL := false;
+  MouseCaptureType := mctGTK;
 
   LastLeft:=EmptyLastMouseClick;
   LastMiddle:=EmptyLastMouseClick;
@@ -423,6 +423,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.169  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.168  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/interfaces/gtk/gtkobject.inc

@@ -430,6 +430,8 @@ procedure TgtkObject.ShowModal(Sender: TObject);
 var
   GtkWindow: PGtkWindow;
 begin
+  ReleaseMouseCapture;
+   
   if Sender is TCommonDialog then
   begin
     GtkWindow:=PGtkWindow(TCommonDialog(Sender).Handle);
@@ -1128,7 +1130,7 @@ begin
   if GtkWidgetIsA(Widget,gtk_toolbar_get_type) then begin
     FixedWidget:=GetFixedWidget(Widget);
     if (FixedWidget<>nil) and (FixedWidget<>Widget) then begin
-      writeln('WARNING: ToDo TgtkObject.RealizeWidgetSize ',NewWidth,',',NewHeight);
+      //writeln('WARNING: ToDo TgtkObject.RealizeWidgetSize for TToolBar ',NewWidth,',',NewHeight);
       gtk_widget_set_usize(FixedWidget,NewWidth,NewHeight);
     end;
   end;
@@ -3265,6 +3267,7 @@ begin
 
       LM_POPUPSHOW :
         Begin
+          ReleaseMouseCapture;
           gtk_menu_popup(PgtkMenu(TPopupMenu(Sender).Handle),
                          nil,
                          nil,
@@ -6261,7 +6264,6 @@ begin
   SetMainWidget(Result,ClientWidget);
   gtk_toolbar_set_space_size(PGTKToolbar(Result),0);
   gtk_toolbar_set_space_style(PGTKToolbar(Result),GTK_TOOLBAR_SPACE_EMPTY);
-  writeln('TgtkObject.CreateToolBar ',PGTKToolbar(Result)^.button_maxw,',',PGTKToolbar(Result)^.button_maxh);
   {$ENDIF}
   gtk_widget_show(Result);
 end;
@@ -6909,6 +6911,11 @@ begin
         gdk_window_set_functions(AWindow, func);
       end;
       ShareWindowAccelGroups(SenderWidget);
+      
+      // capturing is always gtkwindow dependent. On showing a new window
+      // the gtk will put a new widget on the grab stack.
+      // -> release our capture
+      ReleaseMouseCapture;
     end;
 
     gtk_widget_show(SenderWidget);
@@ -9225,6 +9232,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.472  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.471  2004/02/22 10:43:20  mattias
   added child-parent checks
 

lcl/interfaces/gtk/gtkproc.inc

@@ -3104,35 +3104,119 @@ begin
   CurMouseCaptureWidget:=gtk_grab_get_current;
 
   if OldMouseCaptureWidget<>CurMouseCaptureWidget then begin
+    // the mouse grab changed
+    // -> this means the gtk itself has changed the mouse grab
+    {$IFDEF VerboseMouseCapture}
+    writeln('UpdateMouseCaptureControl Capture changed from ',
+      '[',GetWidgetDebugReport(OldMouseCaptureWidget),']',
+      ' to [',GetWidgetDebugReport(CurMouseCaptureWidget),']');
+    {$ENDIF}
+
     // notify the new capture control
     MouseCaptureWidget:=CurMouseCaptureWidget;
-    MouseCapureByLCL:=false;
+    MouseCaptureType:=mctGTK;
-    if MouseCaptureWidget<>nil then
+    if MouseCaptureWidget<>nil then begin
+      // the MouseCaptureWidget is probably not a main widget
       SendMessage(HWnd(MouseCaptureWidget), LM_CAPTURECHANGED, 0,
         HWnd(OldMouseCaptureWidget));
     end;
+  end;
+end;
+
+procedure IncreaseMouseCaptureIndex;
+begin
+  if MouseCaptureIndex<$ffffffff then
+    inc(MouseCaptureIndex)
+  else
+    MouseCaptureIndex:=0;
+end;
+
+procedure CaptureMouseForWidget(Widget: PGtkWidget; Owner: TMouseCaptureType);
+var
+  CaptureWidget: PGtkWidget;
+  NowIndex: Cardinal;
+begin
+  {$IFDEF VerboseMouseCapture}
+  writeln('CaptureMouseForWidget START ',GetWidgetDebugReport(Widget));
+  {$ENDIF}
+  if not (Owner in [mctGTKIntf,mctLCL]) then exit;
+  // not every widget can capture the mouse
+  CaptureWidget:=GetDefaultMouseCaptureWidget(Widget);
+  if CaptureWidget=nil then exit;
+
+  UpdateMouseCaptureControl;
+  if (MouseCaptureType<>mctGTK) then begin
+    // we are capturing
+    if (MouseCaptureWidget=CaptureWidget) then begin
+      // we are already capturing this widget
+      exit;
+    end;
+    // release old capture
+    ReleaseMouseCapture;
+  end;
+
+  {$IFDEF VerboseMouseCapture}
+  writeln('CaptureMouseForWidget Start Capturing for ',GetWidgetDebugReport(CaptureWidget));
+  {$ENDIF}
+  IncreaseMouseCaptureIndex;
+  NowIndex:=MouseCaptureIndex;
+  if not gtk_widget_has_focus(CaptureWidget) then
+    gtk_widget_grab_focus(CaptureWidget);
+  if NowIndex=MouseCaptureIndex then begin
+    {$IFDEF VerboseMouseCapture}
+    writeln('CaptureMouseForWidget Commit Capturing for ',GetWidgetDebugReport(CaptureWidget));
+    {$ENDIF}
+    MouseCaptureWidget:=CaptureWidget;
+    MouseCaptureType:=Owner;
+    gtk_grab_add(CaptureWidget);
+  end;
+end;
+
+function GetDefaultMouseCaptureWidget(Widget: PGtkWidget
+  ): PGtkWidget;
+var
+  WidgetInfo: PWinWidgetInfo;
+  LCLObject: TObject;
+begin
+  Result:=nil;
+  if Widget=nil then exit;
+  if GtkWidgetIsA(Widget,GTKAPIWidget_GetType) then begin
+    WidgetInfo:=GetWidgetInfo(Widget,false);
+    if WidgetInfo<>nil then
+      Result:=WidgetInfo^.ImplementationWidget;
+    exit;
+  end;
+  LCLObject:=GetNearestLCLObject(Widget);
+  if LCLObject=nil then exit;
+  if ((TWinControl(LCLObject) is TCustomSplitter)
+  or (TWinControl(LCLObject) is TToolButton))
+  and (TWinControl(LCLObject).HandleAllocated)
+  then begin
+    WidgetInfo:=GetWidgetInfo(PGtkWidget(TWinControl(LCLObject).Handle),false);
+    if WidgetInfo<>nil then
+      Result:=WidgetInfo^.ImplementationWidget;
+  end;
 end;
 
 {------------------------------------------------------------------------------
-  procedure ReleaseLCLMouseCapture;
+  procedure ReleaseMouseCapture;
 
-  If the current mouse capture was captured by the LCL, release the capture.
+  If the current mouse capture was captured by the LCL or the gtk intf, release
+  the capture. Don't release mouse captures of the gtk, because captures must
+  be balanced and this is already done by the gtk.
  ------------------------------------------------------------------------------}
-procedure ReleaseMouseCapture(OnlyIfCapturedByLCL: boolean);
+procedure ReleaseMouseCapture;
 var
-  OldCaptureWidget: PGtkWidget;
+  OldMouseCaptureWidget: PGtkWidget;
 begin
-  if OnlyIfCapturedByLCL and (not MouseCapureByLCL) then exit;
+  {$IFDEF VerboseMouseCapture}
-  {$IfNDef ActivateMouseCapture}
+  writeln('ReleaseMouseCapture ',ord(MouseCaptureType),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
-  exit;
+  {$ENDIF}
-  {$EndIf}
+  if MouseCaptureType=mctGTK then exit;
-  repeat
+  OldMouseCaptureWidget:=MouseCaptureWidget;
-    OldCaptureWidget:=gtk_grab_get_current;
+  MouseCaptureWidget:=nil;
-    if OldCaptureWidget<>nil then
+  MouseCaptureType:=mctGTK;
-      gtk_grab_remove(OldCaptureWidget)
+  gtk_grab_remove(OldMouseCaptureWidget);
-    else
-      break;
-  until false;
 end;
 
 {------------------------------------------------------------------------------
@@ -6320,6 +6404,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.260  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.259  2004/02/13 15:49:54  mattias
   started advanced LCL auto sizing
 

lcl/interfaces/gtk/gtkproc.pp

@@ -401,10 +401,14 @@ function GetWidgetOrigin(TheWidget: PGtkWidget): TPoint;
 function GetWidgetClientOrigin(TheWidget: PGtkWidget): TPoint;
 function TranslateGdkPointToClientArea(SourceWindow: PGdkWindow;
   SourcePos: TPoint;  DestinationWidget: PGtkWidget): TPoint;
-procedure ReleaseMouseCapture(OnlyIfCapturedByLCL: boolean);
-procedure UpdateMouseCaptureControl;
 procedure SetCursor(AWinControl : TWinControl; Data: Pointer);
 
+// mouse capturing
+procedure CaptureMouseForWidget(Widget: PGtkWidget; Owner: TMouseCaptureType);
+function GetDefaultMouseCaptureWidget(Widget: PGtkWidget): PGtkWidget;
+procedure ReleaseMouseCapture;
+procedure UpdateMouseCaptureControl;
+
 {$IFNDEF GTK2_2}
 // MWE:
 // TODO: check if the new keyboard routines require X on GTK2

lcl/interfaces/gtk/gtkwinapi.inc

@@ -2415,8 +2415,33 @@ end;
   Draws one or more edges of a rectangle. The rectangle is the area
   Left to Right-1 and Top to Bottom-1.
  ------------------------------------------------------------------------------}
-function TgtkObject.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal;
+function TgtkObject.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal;
   grfFlags: Cardinal): Boolean;
+  
+  procedure DrawEdges(var R: TRect; GC: pgdkGC; Drawable:PGdkDrawable;
+    const TopLeftColor, BottomRightColor: TGDKColor);
+  begin
+    gdk_gc_set_foreground(GC, @TopLeftColor);
+    if (grfFlags and BF_TOP) = BF_TOP then begin
+      gdk_draw_line(Drawable, GC, R.Left, R.Top, R.Right, R.Top);
+      inc(R.Top);
+    end;
+    if (grfFlags and BF_LEFT) = BF_LEFT then begin
+      gdk_draw_line(Drawable, GC, R.Left, R.Top, R.Left, R.Bottom);
+      inc(R.Left);
+    end;
+
+    gdk_gc_set_foreground(GC, @BottomRightColor);
+    if (grfFlags and BF_BOTTOM) = BF_BOTTOM then begin
+      gdk_draw_line(Drawable, GC, R.Left, R.Bottom-1, R.Right, R.Bottom-1);
+      dec(R.Bottom);
+    end;
+    if (grfFlags and BF_RIGHT) = BF_RIGHT then begin
+      gdk_draw_line(Drawable, GC, R.Right-1, R.Top, R.Right-1, R.Bottom);
+      dec(R.Right);
+    end;
+  end;
+  
 Var
   InnerTL, OuterTL,
   InnerBR, OuterBR: TGDKColor;
@@ -2425,7 +2450,7 @@ Var
   R: TRect;
   DCOrigin: TPoint;
 begin
-  Assert(False, Format('trace:> [TgtkObject.DrawEdge] DC:0x%x, Rect = %d,%d,%d,%d', [DC, Rect.Left, Rect.Top,Rect.Right, Rect.Bottom]));
+  //writeln('TgtkObject.DrawEdge Edge=',HexStr(Cardinal(Edge),8),' grfFlags=',HexStr(Cardinal(grfFlags),8));
   Result := IsValidDC(DC);
   if Result
   then with TDeviceContext(DC) do
@@ -2436,90 +2461,50 @@ begin
       Result := False;
     end
     else begin
-      R := Rect;
+      R := ARect;
-      Dec(R.Right);
+      DCOrigin:=GetDCOffset(TDeviceContext(DC));
-      Dec(R.Bottom);
+      OffsetRect(R,DCOrigin.X,DCOrigin.Y);
 
       // try to use the gdk functions, so that the current theme is used
       BInner := False;
       BOuter := False;
 
-      // TODO: changeThis to real colors
+      // TODO: change this to real colors
       if (edge and BDR_RAISEDINNER) = BDR_RAISEDINNER
       then begin
         InnerTL := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
         InnerBR := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
-//        gdk_color_white(gdk_colormap_get_system, @InnerTL);
-//        gdk_color_black(gdk_colormap_get_system, @InnerBR);
         BInner := True;
       end;
       if (edge and BDR_SUNKENINNER) = BDR_SUNKENINNER
       then begin
         InnerTL := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
         InnerBR := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
-//        gdk_color_black(gdk_colormap_get_system, @InnerTL);
-//        gdk_color_white(gdk_colormap_get_system, @InnerBR);
         BInner := True;
       end;
       if (edge and BDR_RAISEDOUTER) = BDR_RAISEDOUTER
       then begin
-        OuterTL := AllocGDKColor(GetSysColor(COLOR_BTNFACE));
+        OuterTL := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
-        OuterBR := AllocGDKColor(GetSysColor(COLOR_WINDOWFRAME));
+        OuterBR := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
-//        gdk_color_white(gdk_colormap_get_system, @OuterTL);
-//        gdk_color_black(gdk_colormap_get_system, @OuterBR);
         BOuter := True;
       end;
       if (edge and BDR_SUNKENOUTER) = BDR_SUNKENOUTER
       then begin
-        OuterTL := AllocGDKColor(GetSysColor(COLOR_WINDOWFRAME));
+        OuterTL := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
-        OuterBR := AllocGDKColor(GetSysColor(COLOR_BTNFACE));
+        OuterBR := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
-//        gdk_color_black(gdk_colormap_get_system, @OuterTL);
-//        gdk_color_white(gdk_colormap_get_system, @OuterBR);
         BOuter := True;
       end;
 
+      gdk_gc_set_fill(GC, GDK_SOLID);
       SelectedColors := dcscCustom;
 
-      BeginGDKErrorTrap;
-      gdk_gc_set_fill(GC, GDK_SOLID);
-
       // Draw outer rect
-      if Bouter
+      if Bouter then
-      then with R do
+        DrawEdges(R,GC,Drawable,OuterTL,OuterBR);
-      begin
-        gdk_gc_set_foreground(GC, @OuterTL);
-        if (grfFlags and BF_TOP) = BF_TOP
-        then gdk_draw_line(Drawable, GC, Left, Top, Right, Top);
-        if (grfFlags and BF_LEFT) = BF_LEFT
-        then gdk_draw_line(Drawable, GC, Left, Top, Left, Bottom);
-
-        gdk_gc_set_foreground(GC, @OuterBR);
-        if (grfFlags and BF_BOTTOM) = BF_BOTTOM
-        then gdk_draw_line(Drawable, GC, Left, Bottom, Right + 1, Bottom);
-        if (grfFlags and BF_RIGHT) = BF_RIGHT
-        then gdk_draw_line(Drawable, GC, Right, Top, Right, Bottom + 1);
-
-        InflateRect(R, -1, -1);
-      end;
 
       // Draw inner rect
-      if BInner
+      if BInner then
-      then with R do
+        DrawEdges(R,GC,Drawable,InnerTL,InnerBR);
-      begin
-        gdk_gc_set_foreground(GC, @InnerTL);
-        if (grfFlags and BF_TOP) = BF_TOP
-        then gdk_draw_line(Drawable, GC, Left, Top, Right, Top);
-        if (grfFlags and BF_LEFT) = BF_LEFT
-        then gdk_draw_line(Drawable, GC, Left, Top, Left, Bottom);
-
-        gdk_gc_set_foreground(GC, @InnerBR);
-        if (grfFlags and BF_BOTTOM) = BF_BOTTOM
-        then gdk_draw_line(Drawable, GC, Left, Bottom, Right + 1, Bottom);
-        if (grfFlags and BF_RIGHT) = BF_RIGHT
-        then gdk_draw_line(Drawable, GC, Right, Top, Right, Bottom + 1);
-
-        InflateRect(R, -1, -1);
-      end;
 
 //      gdk_colormap_free_colors(gdk_colormap_get_system, @OuterTL, 1);
 //      gdk_colormap_free_colors(gdk_colormap_get_system, @OuterBR, 1);
@@ -2533,26 +2518,23 @@ begin
         Width := R.Right - R.Left + 1;
         Height := R.Bottom - R.Top + 1;
         SelectGDKBrushProps(DC);
-        DCOrigin:=GetDCOffset(TDeviceContext(DC));
         If not CurrentBrush^.IsNullBrush then
           if (CurrentBrush^.GDIBrushFill = GDK_SOLID)
-          and (IsBackgroundColor(TColor(CurrentBrush^.GDIBrushColor.ColorRef))) then
+          and (IsBackgroundColor(TColor(CurrentBrush^.GDIBrushColor.ColorRef)))
+          then
             StyleFillRectangle(Drawable, GC, CurrentBrush^.GDIBrushColor.ColorRef,
-                               R.Left+DCOrigin.X, R.Top+DCOrigin.Y, Width, Height)
+                               R.Left, R.Top, Width, Height)
           else
-   	    gdk_draw_rectangle(Drawable, GC, 1, R.Left+DCOrigin.X, R.Top+DCOrigin.Y,
+            gdk_draw_rectangle(Drawable, GC, 1, R.Left, R.Top, Width, Height);
-                               Width, Height);
       end;
 
-      EndGDKErrorTrap;
       // adjust rect if needed
       if (grfFlags and BF_ADJUST) = BF_ADJUST
-      then Rect := R;
+      then ARect := R;
 
       Result := True;
     end;
   end;
-  Assert(False, Format('trace:< [TgtkObject.DrawEdge] DC:0x%x, Rect = %d,%d,%d,%d', [DC, Rect.Left, Rect.Top,Rect.Right, Rect.Bottom]));
 end;
 
 {------------------------------------------------------------------------------
@@ -7596,58 +7578,20 @@ end;
 
  ------------------------------------------------------------------------------}
 function TgtkObject.SetCapture(Value: Longint): Longint;
-{$IfDef VerboseMouseCapture}
 var
-  Sender : TObject;
+  Widget: PGtkWidget;
-  CurMouseCaptureHandle: PGtkWidget;
-{$EndIf}
 begin
   Assert(False, Format('Trace:> [TgtkObject.SetCapture] 0x%x', [Value]));
+  Widget:=PGtkWidget(Value);
   {$IfDef VerboseMouseCapture}
-  if Value<>0 then
+  writeln('TgtkObject.SetCapture NewValue=[',GetWidgetDebugReport(Widget),']');
-    Sender:=GetLCLObject(Pointer(Value))
-  else
-    Sender:=nil;
-  write('TgtkObject.SetCapture New=',HexStr(Cardinal(Value),8),' ');
-  if Sender=nil then
-    writeln('Sender=nil')
-  else
-    writeln('Sender=',TControl(Sender).Name,':',Sender.ClassName);
-
-  CurMouseCaptureHandle:=gtk_grab_get_current;
-  writeln('  gtk=',HexStr(Cardinal(CurMouseCaptureHandle),8),
-    ' MouseCaptureWidget=',HexStr(Cardinal(MouseCaptureWidget),8));
   {$EndIf}
 
   // return old capture handle
   Result := GetCapture;
   
-  // check that the widget is a widget with a LCL control
+  // capture
-  if (Value<>0) and (GetLCLObject(Pointer(Value))=nil) then exit;
+  CaptureMouseForWidget(Widget,mctLCL);
-
-  if Result<>Value then begin
-    // capture changes
-
-    // If the gtk-interface has grabbed the mouse, it is somewhere in the stack
-    // of grabs. The gtk uses a grab stack to handle parent-child chains of
-    // mouse events. But we stop this chain anyway, the LCL can set and release
-    // mouse captures at any time and X can freeze, when a grab is not realeased
-    // and the window is destroyed.
-    // -> remove all grabs
-    ReleaseMouseCapture(true);
-
-    // grab
-    if (Value<>0) then begin
-      {$IfDef ActivateMouseCapture}
-      gtk_grab_add(PgtkWidget(Value));
-      {$EndIf}
-    end;
-    {$IfDef VerboseMouseCapture}
-    writeln('TgtkObject.SetCapture RESULT: gtk=',HexStr(Cardinal(gtk_grab_get_current),8));
-    {$EndIf}
-  end;
-
-  UpdateMouseCaptureControl;
 end;
 
 {------------------------------------------------------------------------------
@@ -8745,6 +8689,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.333  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.332  2004/02/21 01:01:03  mattias
   added uninstall popupmenuitem to package graph explorer
 

lcl/interfaces/gtk/gtkwinapih.inc

@@ -66,7 +66,7 @@ function DeleteDC(hDC: HDC): Boolean; override;
 function DeleteObject(GDIObject: HGDIOBJ): Boolean;  override;
 function DestroyCaret(Handle : HWND): Boolean; override;
 Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; override;
-function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
+function DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; grfFlags: Cardinal): Boolean; override;
 function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; Override;
 
 function Ellipse(DC: HDC; x1,y1,x2,y2: Integer): Boolean; override;
@@ -213,6 +213,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
 { =============================================================================
 
   $Log$
+  Revision 1.89  2004/02/23 18:24:38  mattias
+  completed new TToolBar
+
   Revision 1.88  2004/02/19 05:07:17  mattias
   CreateBitmapFromRawImage now creates mask only if needed