added child-parent checks

git-svn-id: trunk@5218 -

lcl/buttons.pp

@@ -79,6 +79,7 @@ type
     property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
     procedure SetParent(AParent: TWinControl); override;
     procedure SetText(const Value: TCaption); override;
+    function ChildClassAllowed(ChildClass: TClass): boolean; override;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -331,6 +332,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.59  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.58  2004/02/10 00:05:03  mattias
   TSpeedButton now uses MaskBlt
 

lcl/comctrls.pp

@@ -799,7 +799,9 @@ type
     FLastButtonDrawFlags: Integer;
     FMarked: Boolean;
     FMenuItem: TMenuItem;
+    FMouseInControl: boolean;
     FStyle: TToolButtonStyle;
+    FState: TToolButtonState;
     FUpdateCount: Integer;
     FWrap: Boolean;
     function GetIndex: Integer;
@@ -816,7 +818,10 @@ type
     procedure SetMenuItem(Value: TMenuItem);
     procedure SetStyle(Value: TToolButtonStyle);
     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;
@@ -838,6 +843,8 @@ type
   public
     constructor Create(TheOwner: TComponent); override;
     function CheckMenuDropdown: Boolean; dynamic;
+    procedure GetCurrentIcon(var ImageList: TCustomImageList;
+                             var Index: integer); virtual;
     property Index: Integer read GetIndex;
   published
     property Action;
@@ -884,11 +891,19 @@ type
     );
   
   TToolBarFlags = set of TToolBarFlag;
+  
+  TToolBarButtonStyle = (
+    tbbsText,
+    tbbsIcon,
+    tbbsIconLeftOfText,
+    tbbsIconAboveText
+    );
 
   TToolBar = class(TToolWindow)
   private
     FButtonHeight: Integer;
     FButtons: TList;
+    FButtonStyle: TToolBarButtonStyle;
     FButtonWidth: Integer;
     FDisabledImageChangeLink: TChangeLink;
     FDisabledImages: TCustomImageList;
@@ -911,6 +926,7 @@ type
     function GetButton(Index: Integer): TToolButton;
     function GetButtonCount: Integer;
     procedure SetButtonHeight(const AValue: Integer);
+    procedure SetButtonStyle(const AValue: TToolBarButtonStyle);
     procedure SetButtonWidth(const AValue: Integer);
     procedure SetDisabledImages(const AValue: TCustomImageList);
     procedure SetFlat(const AValue: Boolean);
@@ -960,6 +976,7 @@ type
     property BorderWidth;
     property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 22;
     property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 23;
+    property ButtonStyle: TToolBarButtonStyle read FButtonStyle write SetButtonStyle default tbbsIcon;
     property Caption;
     property Color;
     property Ctl3D;
@@ -2232,6 +2249,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.111  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.110  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/controls.pp

@@ -843,6 +843,7 @@ type
     procedure CMVisibleChanged(var Message : TLMessage); message CM_VISIBLECHANGED;
     procedure Changed;
     function  GetPalette: HPalette; virtual;
+    function ChildClassAllowed(ChildClass: TClass): boolean; virtual;
     procedure Loaded; override;
     procedure AssignTo(Dest: TPersistent); override;
     procedure BeginAutoDrag; dynamic;
@@ -952,6 +953,9 @@ type
     procedure Repaint; virtual;
     Procedure Invalidate; virtual;
     procedure AddControl; virtual;
+    function CheckChildClassAllowed(ChildClass: TClass;
+                                 ExceptionOnInvalid: boolean): boolean;
+    procedure CheckNewParent(AParent: TWinControl); virtual;
     Procedure DragDrop(Source: TObject; X,Y: Integer); Dynamic;
     procedure SendToBack;
     procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
@@ -1286,6 +1290,7 @@ type
     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); override;
     procedure DoAutoSize; Override;
     procedure GetChildren(Proc : TGetChildProc; Root : TComponent); override;
+    function ChildClassAllowed(ChildClass: TClass): boolean; override;
     procedure PaintControls(DC: HDC; First: TControl);
     procedure PaintHandler(var TheMessage: TLMPaint);
     procedure PaintWindow(DC: HDC); virtual;
@@ -2361,6 +2366,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.178  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.177  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/extctrls.pp

@@ -135,7 +135,6 @@ type
     fPageIndex: Integer;
     fPageIndexOnLastChange: integer;
     fPageList: TList;  // List of TCustomPage
-    //fMultiLine: boolean;
     fOnPageChanged: TNotifyEvent;
     fShowTabs: Boolean;
     fTabPosition: TTabPosition;
@@ -150,12 +149,10 @@ type
     function GetPageCount : integer;
     function GetPageIndex: Integer;
     function IsStoredActivePage: boolean;
-    //function InternalSetMultiLine(Value: boolean): boolean;
     procedure SetActivePage(const Value: String);
     procedure SetActivePageComponent(const AValue: TCustomPage);
     procedure SetImages(const AValue: TImageList);
     procedure SetOptions(const AValue: TNoteBookOptions);
-    //procedure SetMultiLine(Value: boolean);
     procedure SetPageIndex(AValue: Integer);
     procedure SetPages(AValue: TStrings);
     procedure SetShowTabs(AValue: Boolean);
@@ -171,6 +168,7 @@ type
     procedure ReadState(Reader: TAbstractReader); override;
     procedure ShowControl(APage: TControl); override;
     procedure UpdateTabProperties; virtual;
+    function ChildClassAllowed(ChildClass: TClass): boolean; override;
     property ActivePageComponent: TCustomPage read GetActivePageComponent
                                               write SetActivePageComponent;
     property ActivePage: String read GetActivePage write SetActivePage
@@ -925,6 +923,9 @@ end.
 
  {
   $Log$
+  Revision 1.98  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.97  2004/02/21 01:01:03  mattias
   added uninstall popupmenuitem to package graph explorer
 

lcl/imglist.pp

@@ -50,8 +50,8 @@ interface
 {$endif}
 
 uses
-  SysUtils, Classes, FPCAdds, LCLStrConsts, vclGlobals, LCLProc, Graphics,
+  SysUtils, Classes, FPCAdds, LCLStrConsts, LResources, vclGlobals, LCLProc,
-  GraphType;
+  Graphics, GraphType;
 
 type
   TImageIndex = type integer;
@@ -154,6 +154,7 @@ type
     function AddIcon(Image: TIcon): Integer;
     procedure AddImages(Value: TCustomImageList);
     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
+    function AddFromLazarusResource(const ResourceName: string): integer;
     procedure Change;
     procedure Clear;
     constructor CreateSize(AWidth, AHeight: Integer);
@@ -210,6 +211,9 @@ end.
 
 {
   $Log$
+  Revision 1.15  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.14  2004/02/02 19:13:31  mattias
   started reading TImageList in Delphi format
 

lcl/include/buttons.inc

@@ -163,9 +163,19 @@ begin
     CNSendMessage(LM_SETSHORTCUT, Self, @FShortcut);
   end;
 end;
+
+function TButton.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  // no childs
+  Result:=false;
+end;
+
 { =============================================================================
 
   $Log$
+  Revision 1.17  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.16  2004/01/21 10:19:16  micha
   enable tabstops for controls; implement tabstops in win32 intf
 

lcl/include/control.inc

@@ -685,6 +685,11 @@ begin
   Result:=0;
 end;
 
+function TControl.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  Result:=false;
+end;
+
 {------------------------------------------------------------------------------
   procedure TControl.DoOnResize;
 
@@ -1643,6 +1648,40 @@ begin
   CNSendMessage(LM_AddChild, Self, nil);
 end;
 
+{------------------------------------------------------------------------------
+  function TControl.CheckChildClassAllowed(ChildClass: TClass;
+    ExceptionOnInvalid: boolean): boolean;
+    
+  Checks if this control can be the parent of a control of class ChildClass.
+------------------------------------------------------------------------------}
+function TControl.CheckChildClassAllowed(ChildClass: TClass;
+  ExceptionOnInvalid: boolean): boolean;
+  
+  procedure RaiseInvalidChild;
+  begin
+    raise Exception.Create(ClassName+' can not have '+ChildClass.ClassName+' as child');
+  end;
+  
+begin
+  Result:=ChildClassAllowed(ChildClass);
+  if (not Result) and ExceptionOnInvalid then
+    RaiseInvalidChild;
+end;
+
+{------------------------------------------------------------------------------
+  procedure TControl.CheckNewParent(AParent: TWinControl);
+  
+  Checks if this control can be the child of AParent.
+  This check is executed in SetParent.
+------------------------------------------------------------------------------}
+procedure TControl.CheckNewParent(AParent: TWinControl);
+begin
+  if (AParent<>nil) then AParent.CheckChildClassAllowed(ClassType,true);
+  if AParent = Self then begin
+    raise EInvalidOperation.Create('A control can not have itself as parent');
+  end;
+end;
+
 {------------------------------------------------------------------------------
        TControl SetAutoSize
 ------------------------------------------------------------------------------}
@@ -2218,20 +2257,10 @@ end;
 ------------------------------------------------------------------------------}
 Procedure TControl.SetParent(AParent : TWinControl);
 begin
-{  if AParent = nil
+  if FParent = AParent then exit;
-  then Assert(False, Format('Trace:[TControl.SetParent] %s --> Parent: nil', [ClassName]))
+  CheckNewParent(AParent);
-  else Assert(False, Format('Trace:[TControl.SetParent] %s --> Parent: %s', [ClassName, AParent.ClassName]));
+  if FParent <> nil then FParent.RemoveControl(Self);
-}
+  if AParent <> nil then AParent.InsertControl(Self);
-  if FParent <> AParent
-  then begin
-    if AParent = Self
-    then begin
-      Assert(False, 'Trace:[TControl.SetParent] EInvalidOperation --> FParent = Self');
-      raise EInvalidOperation.Create('A control can''t have itself as parent');
-    end;
-    if FParent <> nil then FParent.RemoveControl(Self);
-    if AParent <> nil then AParent.InsertControl(Self);
-  end;
 end;
 
 procedure TControl.SetParentColor(Value : Boolean);
@@ -2769,6 +2798,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.171  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.170  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/include/customedit.inc

@@ -308,6 +308,15 @@ begin
     inherited SetText(Value);
 end;
 
+{------------------------------------------------------------------------------
+  function TCustomEdit.ChildClassAllowed(ChildClass: TClass): boolean;
+------------------------------------------------------------------------------}
+function TCustomEdit.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  // no childs
+  Result:=false;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomEdit.SetModified
   Params:  Value to set FModified to
@@ -357,6 +366,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.23  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.22  2004/02/04 00:04:37  mattias
   added some TEdit ideas to TSpinEdit
 

lcl/include/customlabelededit.inc

@@ -116,6 +116,5 @@ begin
   FEditLabel.FocusControl := Self;
 end;
 
-
 // included by extctrls.pp
 

lcl/include/customnotebook.inc

@@ -315,7 +315,7 @@ begin
   if PageClass=nil then
     RaiseGDBException('');
   inherited Create(TheOwner);
-  {create the control}
+
   fCompStyle := csNoteBook;
 
   fPageList := TList.Create;
@@ -655,6 +655,11 @@ begin
     CNSendMessage(LM_NB_UpdateTab, Page[i], nil);
 end;
 
+function TCustomNotebook.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  Result:=(ChildClass<>nil) and (ChildClass=PageClass);
+end;
+
 {------------------------------------------------------------------------------
   TCustomNotebook Change
  ------------------------------------------------------------------------------}
@@ -787,6 +792,9 @@ end;}
 { =============================================================================
 
   $Log$
+  Revision 1.42  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.41  2004/01/21 10:19:16  micha
   enable tabstops for controls; implement tabstops in win32 intf
 

lcl/include/custompage.inc

@@ -89,6 +89,7 @@ var
   i: integer;
 begin
   if AParent=Parent then exit;
+  CheckNewParent(AParent);
 
   OldParent:=Parent;
   if (OldParent<>AParent) and (OldParent<>nil)

lcl/include/imglist.inc

@@ -165,6 +165,22 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  function TCustomImageList.AddFromLazarusResource(const ResourceName: string
+    ): integer;
+    
+  Load TBitmap from lazarus resources and add it.
+ ------------------------------------------------------------------------------}
+function TCustomImageList.AddFromLazarusResource(const ResourceName: string
+  ): integer;
+var
+  ABitmap: TBitmap;
+begin
+  ABitmap:=TBitmap.Create;
+  ABitmap.LoadFromLazarusResource(ResourceName);
+  Result:=AddDirect(ABitmap,nil);
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCustomImageList.AllocBitmap
   Params:  Amount: the amount of free image position which should be availabe 
@@ -1066,6 +1082,9 @@ end;
 {
 
   $Log$
+  Revision 1.23  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.22  2004/02/02 21:31:08  mattias
   reduced output
 

lcl/include/toolbar.inc

@@ -34,6 +34,7 @@ begin
     csDoubleClicks, csMenuEvents, csSetCaption];
   FButtonWidth := 23;
   FButtonHeight := 22;
+  FButtonStyle := tbbsIcon;
   FDropDownWidth := 10;
   FNewStyle := True;
   FWrapable := True;
@@ -142,7 +143,7 @@ begin
     UpdateVisibleBar;
     exit;
   end;
-  writeln('TToolBar.ControlsAligned START');
+  //writeln('TToolBar.ControlsAligned START');
   // ToDo
   // hack: stupid put in a row
   for i:=0 to ControlCount-1 do begin
@@ -151,9 +152,9 @@ begin
     NewTop:=0;
     NewWidth:=ButtonWidth;
     NewHeight:=ButtonHeight;
-    writeln('TToolBar.ControlsAligned ',CurControl.Name,
+    //writeln('TToolBar.ControlsAligned ',CurControl.Name,
-      ' Old=',CurControl.Left,',',CurControl.Top,',',CurControl.Width,',',CurControl.Height,
+    //  ' Old=',CurControl.Left,',',CurControl.Top,',',CurControl.Width,',',CurControl.Height,
-      ' New=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight);
+    //  ' New=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight);
     CurControl.SetBoundsKeepBase(NewLeft,NewTop,NewWidth,NewHeight,true);
   end;
 end;
@@ -186,6 +187,13 @@ begin
   end;
 end;
 
+procedure TToolBar.SetButtonStyle(const AValue: TToolBarButtonStyle);
+begin
+  if FButtonStyle=AValue then exit;
+  FButtonStyle:=AValue;
+  UpdateVisibleBar;
+end;
+
 procedure TToolBar.SetButtonWidth(const AValue: Integer);
 var
   i: Integer;
@@ -322,7 +330,6 @@ begin
     Include(FToolBarFlags,tbfUpdateVisibleBarNeeded);
     exit;
   end;
-  writeln('TToolBar.UpdateVisibleBar');
   ReAlign;
   Invalidate;
   Exclude(FToolBarFlags,tbfUpdateVisibleBarNeeded);
@@ -1931,6 +1938,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.20  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.19  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/include/toolbutton.inc

@@ -55,6 +55,7 @@ begin
   fCompStyle := csToolButton;
   FImageIndex := -1;
   FStyle := tbsButton;
+  FState:=tbsEnabled;
   ControlStyle := [csCaptureMouse, csSetCaption];
   SetInitialBounds(0,0,23,22);
 end;
@@ -62,28 +63,33 @@ end;
 procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin
+  SetMouseInControl(true);
   if (Style=tbsDropDown) and (Button=mbLeft) and Enabled then
     // switch
     Down := not Down;
+  if (Style=tbsCheck) and (Button=mbLeft) and Enabled then begin
+    ;
+  end;
   inherited MouseDown(Button,Shift,X,Y);
 end;
 
 procedure TToolButton.MouseMove(Shift: TShiftState; X, Y: Integer);
 begin
+  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 := (X>=0) and (X<ClientWidth) and (Y>=0) and (Y<ClientHeight);
+    Down := FMouseInControl;
 end;
 
 procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 begin
+  SetMouseInControl(true);
   inherited MouseUp(Button, Shift, X, Y);
-  if (Button=mbLeft) and (X>=0) and (X<ClientWidth) and (Y>=0) and
+  if (Button=mbLeft) and FMouseInControl then begin
-    (Y<ClientHeight)
-  then begin
     if Style=tbsDropDown then Down:=False;
+    if Style=tbsCheck then Down:=false;
     Click;
   end;
 end;
@@ -101,18 +107,40 @@ begin
 end;
 
 procedure TToolButton.Paint;
+
+  procedure DrawDropDownArrow(const DropDownButtonRect: TRect);
+  var
+    ArrowRect: TRect;
+    Points: array[1..3] of TPoint;
+  begin
+    ArrowRect:=DropDownButtonRect;
+    ArrowRect.Left:=DropDownButtonRect.Left+2;
+    ArrowRect.Right:=Max(DropDownButtonRect.Right-2,ArrowRect.Left);
+    ArrowRect.Top:=(DropDownButtonRect.Top+DropDownButtonRect.Bottom
+                    +ArrowRect.Left-ArrowRect.Right) div 2;
+    ArrowRect.Bottom:=ArrowRect.Top-ArrowRect.Left+ArrowRect.Right;
+    Points[1]:=Point(ArrowRect.Left,ArrowRect.Top);
+    Points[2]:=Point((ArrowRect.Left+ArrowRect.Right) div 2,ArrowRect.Bottom);
+    Points[3]:=Point(ArrowRect.Right,ArrowRect.Top);
+    Canvas.Brush.Color:=clBlack;
+    Canvas.Pen.Color:=clBlack;
+    Canvas.Polygon(@Points[1],3);
+  end;
+
 var
   PaintRect: TRect;
   ButtonRect: TRect;
   DropDownButtonRect: TRect;
   DividerRect: TRect;
-  IconWidth: Integer;
+  TextSize: TSize;
-  IconHeight: Integer;
+  TextPos: TPoint;
-  IconLeft: Integer;
+  IconSize: TPoint;
-  IconTop: Integer;
+  IconPos: TPoint;
+  ImgList: TCustomImageList;
+  ImgIndex: integer;
 begin
-  writeln('TToolButton.Paint A FToolBar=',HexStr(Cardinal(FToolBar),8),' ',ClientWidth,',',ClientHeight);
+  writeln('TToolButton.Paint A ',Name,' FToolBar=',HexStr(Cardinal(FToolBar),8),' ',ClientWidth,',',ClientHeight,' ',ord(Style));
-  if FToolBar<>nil then begin
+  if (FToolBar<>nil) and (ClientWidth>0) and (ClientHeight>0) then begin
     PaintRect:=ClientRect; // the whole paint area
 
     // calculate button area(s)
@@ -123,29 +151,81 @@ begin
       ButtonRect.Right:=DropDownButtonRect.Left;
     end;
 
+    // calculate text size
+    TextSize.cx:=0;
+    TextSize.cy:=0;
+    if Style in [tbsButton,tbsDropDown,tbsCheck] then begin
+      if (Caption<>'')
+      and (FToolBar.ButtonStyle
+        in [tbbsText,tbbsIconAboveText,tbbsIconLeftOfText])
+      then begin
+        TextSize:=Canvas.TextExtent(Caption);
+      end;
+    end;
+
+    // calculate icon size
+    IconSize:=Point(0,0);
+    GetCurrentIcon(ImgList,ImgIndex);
+    if (ImgList<>nil) then
+      IconSize:=Point(ImgList.Width,ImgList.Height);
+
+    // calculate text and icon position
+    TextPos:=Point(0,0);
+    IconPos:=Point(0,0);
+    case FToolBar.ButtonStyle of
+    
+    tbbsText:
+      begin
+        TextPos.X:=(ButtonRect.Left+ButtonRect.Right-TextSize.cx) div 2;
+        TextPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-TextSize.cy) div 2;
+      end;
+
+    tbbsIcon:
+      begin
+        IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x) div 2;
+        IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y) div 2;
+      end;
+
+    tbbsIconLeftOfText:
+      begin
+        IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x-TextSize.cy-2) div 2;
+        IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y) div 2;
+        TextPos.X:=IconPos.X+2;
+        TextPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-TextSize.cy) div 2;
+      end;
+      
+    tbbsIconAboveText:
+      begin
+        IconPos.X:=(ButtonRect.Left+ButtonRect.Right-IconSize.x) div 2;
+        IconPos.Y:=(ButtonRect.Top+ButtonRect.Bottom-IconSize.y-TextSize.cy-2) div 2;
+        TextPos.X:=(ButtonRect.Left+ButtonRect.Right-TextSize.cx) div 2;
+        TextPos.Y:=IconPos.Y+IconSize.Y+2;
+      end;
+
+    end;
+
     // draw button
     FLastButtonDrawFlags:=GetButtonDrawFlags;
     if Style in [tbsButton,tbsDropDown,tbsCheck] then begin
       DrawFrameControl(Canvas.GetUpdatedHandle([csBrushValid,csPenValid]),
-        ButtonRect, DFC_BUTTON, FLastButtonDrawFlags);
+        PaintRect{ButtonRect}, DFC_BUTTON, FLastButtonDrawFlags);
     end;
 
     // draw dropdown button
     if Style in [tbsDropDown] then begin
-      DrawFrameControl(Canvas.GetUpdatedHandle([csBrushValid,csPenValid]),
+      //DrawFrameControl(Canvas.GetUpdatedHandle([csBrushValid,csPenValid]),
-        DropDownButtonRect, DFC_BUTTON, FLastButtonDrawFlags);
+      //  DropDownButtonRect, DFC_BUTTON, FLastButtonDrawFlags);
+      DrawDropDownArrow(DropDownButtonRect);
     end;
-    
+
     // draw icon
-    if (Style in [tbsButton,tbsDropDown,tbsCheck])
+    if (ImgList<>nil) then begin
-    and (ImageIndex>=0) and (FToolBar.Images<>nil)
+      ImgList.Draw(Canvas,IconPos.X,IconPos.Y,ImgIndex,true);
-    and (FToolBar.Images.Count>ImageIndex) then begin
+    end;
-      IconWidth:=FToolBar.Images.Width;
+
-      IconHeight:=FToolBar.Images.Height;
+    // draw text
-      IconLeft:=(ButtonRect.Left+ButtonRect.Right-IconWidth) div 2;
+    if (TextSize.cx>0) then begin
-      IconTop:=(ButtonRect.Top+ButtonRect.Bottom-IconHeight) div 2;
+      Canvas.TextOut(TextPos.X,TextPos.Y,Caption);
-      FToolBar.Images.Draw(Canvas,IconLeft,IconTop,ImageIndex,
-                           Enabled and not Indeterminate);
     end;
 
     // draw separator (at runtime: just space, at designtime: a rectangle)
@@ -157,9 +237,9 @@ begin
     end;
     
     // draw divider
-    if (Style in [tbsSeparator,tbsDivider]) then begin
+    if (Style in [tbsDivider]) then begin
-      DividerRect.Left:=(ButtonRect.Left+ButtonRect.Right) div 2;
+      DividerRect.Left:=((ButtonRect.Left+ButtonRect.Right) div 2)-2;
-      DividerRect.Right:=DividerRect.Left+2;
+      DividerRect.Right:=DividerRect.Left+4;
       DividerRect.Top:=2;
       DividerRect.Bottom:=Max(DividerRect.Top,PaintRect.Bottom-2);
       DrawEdge(Canvas.Handle,DividerRect,EDGE_ETCHED,BF_LEFT);
@@ -209,13 +289,23 @@ begin
     Message.Result := 0;
 end;
 
+procedure TToolButton.CMMouseEnter(var Message: TLMessage);
+begin
+  SetMouseInControl(true);
+end;
+
+procedure TToolButton.CMMouseLeave(var Message: TLMessage);
+begin
+  SetMouseInControl(false);
+end;
+
 procedure TToolButton.SetDown(Value: Boolean);
 begin
   if Value = FDown then exit;
   FDown := Value;
-  if FToolBar <> nil then begin
+  Invalidate;
+  if FToolBar <> nil then
     FToolBar.ToolButtonDown(Self,FDown);
-  end;
 end;
 
 procedure TToolButton.SetDropdownMenu(Value: TPopupMenu);
@@ -293,6 +383,13 @@ begin
     RefreshControl;
 end;
 
+procedure TToolButton.SetMouseInControl(NewMouseInControl: Boolean);
+begin
+  if FMouseInControl=NewMouseInControl then exit;
+  FMouseInControl:=NewMouseInControl;
+  Invalidate;
+end;
+
 procedure TToolButton.BeginUpdate;
 begin
   Inc(FUpdateCount);
@@ -334,6 +431,36 @@ begin
             and (FToolBar <> nil) and FToolBar.CheckMenuDropdown(Self);
 end;
 
+procedure TToolButton.GetCurrentIcon(var ImageList: TCustomImageList;
+  var Index: integer);
+begin
+  ImageList:=nil;
+  Index:=-1;
+  if (ImageIndex<0) or (FToolBar=nil) then exit;
+  
+  if Style in [tbsButton,tbsDropDown,tbsCheck] then begin
+    if (FToolBar.ButtonStyle in [tbbsText,tbbsIconAboveText,tbbsIconLeftOfText])
+    then begin
+      Index:=ImageIndex;
+      if Enabled and FMouseInControl then
+        // if mouse over button then use HotImages
+        ImageList:=FToolBar.HotImages
+      else if not Enabled then
+        // if button disabled then use HotImages
+        ImageList:=FToolBar.DisabledImages;
+      if (ImageList=nil) or (ImageList.Count<=ImageIndex) then begin
+        // if no special icon available, then try the default Images
+        ImageList:=FToolBar.Images;
+        if (ImageList=nil) or (ImageList.Count<=ImageIndex) then begin
+          // no icon available
+          ImageList:=nil;
+          Index:=-1;
+        end;
+      end;
+    end;
+  end;
+end;
+
 function TToolButton.IsCheckedStored: Boolean;
 begin
   Result := (ActionLink = nil)
@@ -360,7 +487,8 @@ begin
   Result:=DFCS_BUTTONPUSH;
   if FDown then inc(Result,DFCS_PUSHED);
   if not Enabled then inc(Result,DFCS_INACTIVE);
-  if Down and (not (csDesigning in ComponentState)) then
+  if (not (csDesigning in ComponentState)) and (not FMouseInControl)
+  and (not FDown) then
     inc(Result,DFCS_FLAT);
 end;
 
@@ -368,6 +496,7 @@ procedure TToolButton.SetParent(AParent: TWinControl);
 var
   i: Integer;
 begin
+  CheckNewParent(AParent);
   if AParent=Parent then exit;
   
   // remove from old button list
@@ -864,6 +993,9 @@ end;
 
 {
   $Log$
+  Revision 1.10  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.9  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/include/wincontrol.inc

@@ -834,6 +834,16 @@ Begin
   end;
 End;
 
+{-------------------------------------------------------------------------------
+  function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean;
+
+  Allow TControl as child.
+-------------------------------------------------------------------------------}
+function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  Result:=(ChildClass<>nil) and ChildClass.InheritsFrom(TControl);
+end;
+
 {-------------------------------------------------------------------------------
   TWinControl GetClientOrigin
   Result:  TPoint
@@ -3378,6 +3388,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.203  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.202  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/interfaces/gtk/gtkobject.inc

@@ -6720,7 +6720,7 @@ begin
   csToolButton:
     begin
       {$IFDEF NewToolBar}
-      p := gtk_button_new_with_label(StrTemp);
+      p := gtk_fixed_new();
       {$ELSE}
       AccelText := Ampersands2Underscore(StrTemp);
       //p := gtk_button_new_with_label(StrTemp);
@@ -9225,6 +9225,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.471  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.470  2004/02/21 15:37:33  mattias
   moved compiler options to project menu, added -CX for smartlinking
 

lcl/pairsplitter.pas

@@ -104,6 +104,7 @@ type
     procedure CreateSides;
     procedure Loaded; override;
     class function IsSupportedByInterface: boolean;
+    function ChildClassAllowed(ChildClass: TClass): boolean; override;
   public
     property Sides[Index: integer]: TPairSplitterSide read GetSides;
     property SplitterType: TPairSplitterType read FSplitterType
@@ -156,9 +157,7 @@ procedure TPairSplitterSide.SetParent(AParent: TWinControl);
 var
   ASplitter: TCustomPairSplitter;
 begin
-  if (AParent<>nil) and (not (AParent is TCustomPairSplitter)) then
+  CheckNewParent(AParent);
-    RaiseGDBException(
-     'TPairSplitterSide.SetParent Parent not TCustomPairSplitter');
   // remove from side list of old parent
   ASplitter:=Splitter;
   if ASplitter<>nil then begin
@@ -360,5 +359,10 @@ begin
   Result:=PairSplitterGetInterfaceInfo;
 end;
 
+function TCustomPairSplitter.ChildClassAllowed(ChildClass: TClass): boolean;
+begin
+  Result:=ChildClass.InheritsFrom(TPairSplitterSide);
+end;
+
 end.
 

lcl/stdctrls.pp

@@ -492,6 +492,7 @@ type
     procedure SetSelStart(Val : integer); virtual;
     procedure SetSelText(const Val : string); virtual;
     procedure SetText(const Value: TCaption); override;
+    function ChildClassAllowed(ChildClass: TClass): boolean; override;
   public
     constructor Create(AOwner: TComponent); override;
     procedure SelectAll;
@@ -1495,6 +1496,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.132  2004/02/22 10:43:20  mattias
+  added child-parent checks
+
   Revision 1.131  2004/02/13 18:21:31  mattias
   fixed combo chane