1{%MainUnit ../comctrls.pp}
2
3{******************************************************************************
4                                  TToolbar
5 ******************************************************************************
6
7 *****************************************************************************
8  This file is part of the Lazarus Component Library (LCL)
9
10  See the file COPYING.modifiedLGPL.txt, included in this distribution,
11  for details about the license.
12 *****************************************************************************
13
14}
15
16function CompareToolBarControlHorz(Control1, Control2: TControl): integer;
17var
18  ToolBar: TToolBar;
19  Row1: Integer;
20  Row2: Integer;
21  HalfBtnHeight, BtnHeight: Integer;
22begin
23  Result := 0;
24  if not (Control1.Parent is TToolBar) then Exit;
25
26  ToolBar := TToolBar(Control1.Parent);
27  BtnHeight := ToolBar.ButtonHeight;
28  if BtnHeight <= 0 then BtnHeight := 1;
29  HalfBtnHeight := BtnHeight div 2;
30
31  Row1 := (Control1.Top + HalfBtnHeight) div BtnHeight;
32  Row2 := (Control2.Top + HalfBtnHeight) div BtnHeight;
33  Result := CompareValue(Row1, Row2);
34  if Result = 0 then
35  begin
36    Result := CompareValue(Control1.Left, Control2.Left);
37    if ToolBar.UseRightToLeftAlignment then
38      Result:=-Result;
39  end;
40  if Result = 0 then
41  begin
42    Row1 := ToolBar.GetControlIndex(Control1);
43    Row2 := ToolBar.GetControlIndex(Control2);
44    Result := CompareValue(Row1, Row2);
45  end;
46end;
47
48function CompareToolBarControlVert(Control1, Control2: TControl): integer;
49var
50  ToolBar: TToolBar;
51  Col1: Integer;
52  Col2: Integer;
53  HalfBtnWidth, BtnWidth: Integer;
54begin
55  Result := 0;
56  if not (Control1.Parent is TToolBar) then Exit;
57
58  ToolBar := TToolBar(Control1.Parent);
59  BtnWidth := ToolBar.ButtonWidth;
60  if BtnWidth <= 0 then BtnWidth := 1;
61  HalfBtnWidth := BtnWidth div 2;
62
63  Col1 := (Control1.Left + HalfBtnWidth) div BtnWidth;
64  Col2 := (Control2.Left + HalfBtnWidth) div BtnWidth;
65  Result := CompareValue(Col1, Col2);
66  if Result = 0 then
67    Result := CompareValue(Control1.Top, Control2.Top);
68  if Result = 0 then
69  begin
70    Col1 := ToolBar.GetControlIndex(Control1);
71    Col2 := ToolBar.GetControlIndex(Control2);
72    Result := CompareValue(Col1, Col2);
73  end;
74end;
75
76{------------------------------------------------------------------------------
77  Method: TToolbar.Create
78  Params:  AOwner: the owner of the class
79  Returns: Nothing
80
81  Constructor for the class.
82 ------------------------------------------------------------------------------}
83constructor TToolBar.Create(TheOwner: TComponent);
84var
85  Details: TThemedElementDetails;
86begin
87  inherited Create(TheOwner);
88  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
89    csDoubleClicks, csMenuEvents, csSetCaption, csParentBackground, csOpaque];
90  FFlat := True;
91  Height := 32;
92  Details := ThemeServices.GetElementDetails(ttbSplitButtonDropDownNormal);
93  FThemeDropDownWidth := ThemeServices.GetDetailSize(Details).cx;
94  Details := ThemeServices.GetElementDetails(ttbDropDownButtonNormal);
95  FThemeButtonDropWidth := ThemeServices.GetDetailSize(Details).cx;
96  FButtonHeight := -1;
97  FButtonWidth := -1;
98  FDropDownWidth := -1;
99  FNewStyle := True;
100  FWrapable := True;
101  FButtons := TList.Create;
102  FIndent := 1;
103  FList := False;
104  FImageChangeLink := TChangeLink.Create;
105  FImageChangeLink.OnChange := @ImageListChange;
106  FDisabledImageChangeLink := TChangeLink.Create;
107  FDisabledImageChangeLink.OnChange := @DisabledImageListChange;
108  FHotImageChangeLink := TChangeLink.Create;
109  FHotImageChangeLink.OnChange := @HotImageListChange;
110  EdgeBorders := [ebTop];
111  with GetControlClassDefaultSize do
112    SetInitialBounds(0, 0, CX, CY);
113  Align := alTop;
114end;
115
116destructor TToolBar.Destroy;
117var
118  I: Integer;
119begin
120  for I := 0 to FButtons.Count - 1 do
121    if TControl(FButtons[I]) is TToolButton then
122      TToolButton(FButtons[I]).FToolBar := nil;
123
124  FreeThenNil(FButtons);
125  FreeThenNil(FHotImageChangeLink);
126  FreeThenNil(FImageChangeLink);
127  FreeThenNil(FDisabledImageChangeLink);
128  inherited Destroy;
129end;
130
131procedure TToolBar.FlipChildren(AllLevels: Boolean);
132begin
133  if AllLevels then ;
134  // no flipping
135end;
136
137procedure TToolBar.CreateWnd;
138begin
139  BeginUpdate;
140  try
141    DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TToolBar.CreateWnd'){$ENDIF};
142    try
143      inherited CreateWnd;
144      UpdateVisibleBar;
145    finally
146      EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TToolBar.CreateWnd'){$ENDIF};
147    end;
148  finally
149    EndUpdate;
150  end;
151end;
152
153procedure TToolBar.AlignControls(AControl: TControl;
154  var RemainingClientRect: TRect);
155var
156  NewWidth, NewHeight: integer;
157begin
158  if tbfPlacingControls in FToolBarFlags then exit;
159  Include(FToolBarFlags, tbfPlacingControls);
160  DisableAlign;
161  try
162    AdjustClientRect(RemainingClientRect);
163    if IsVertical then
164      WrapButtons(Height, NewWidth, NewHeight, False)
165    else
166      WrapButtons(Width, NewWidth, NewHeight, False);
167  finally
168    Exclude(FToolBarFlags, tbfPlacingControls);
169    EnableAlign;
170  end;
171end;
172
173procedure TToolBar.RepositionButton(Index: Integer);
174begin
175  if ([csLoading,csDestroying]*ComponentState<>[]) then exit;
176  UpdateVisibleBar;
177end;
178
179procedure TToolBar.RepositionButtons(Index: Integer);
180begin
181  UpdateVisibleBar;
182end;
183
184procedure TToolBar.SetButtonHeight(const AValue: Integer);
185begin
186  SetButtonSize(ButtonWidth,AValue);
187end;
188
189procedure TToolBar.SetButtonWidth(const AValue: Integer);
190begin
191  SetButtonSize(AValue,ButtonHeight);
192end;
193
194procedure TToolBar.ToolButtonDown(AButton: TToolButton; NewDown: Boolean);
195begin
196  AButton.Down:=NewDown;
197end;
198
199procedure TToolBar.ImageListChange(Sender: TObject);
200begin
201  if (Sender = Images) then UpdateVisibleBar;
202end;
203
204procedure TToolBar.SetShowCaptions(const AValue: Boolean);
205begin
206  if FShowCaptions = AValue then exit;
207  FShowCaptions := AValue;
208  UpdateVisibleBar;
209end;
210
211procedure TToolBar.CloseCurrentMenu;
212begin
213  FCurrentMenu.Close;
214  // move menu items back
215  if Assigned(FSrcMenuItem) then
216  begin
217    MoveSubMenuItems(FCurrentMenu.Items, FSrcMenuItem);
218    if Assigned(FDropDownButton) then
219      FDropDownButton.Down := False;
220  end;
221end;
222
223procedure TToolBar.MoveSubMenuItems(SrcMenuItem, DestMenuItem: TMenuItem);
224var
225  i: Integer;
226  MovingMenuItem: TMenuItem;
227begin
228  if (SrcMenuItem = nil) or (DestMenuItem = nil) or (SrcMenuItem = DestMenuItem) then
229    Exit;
230  for i := SrcMenuItem.Count - 1 downto 0 do
231  begin
232    MovingMenuItem := SrcMenuItem.Items[i];
233    SrcMenuItem.Delete(i);
234    DestMenuItem.Insert(0, MovingMenuItem);
235  end;
236end;
237
238procedure TToolBar.AddButton(Button: TToolButton);
239begin
240  FButtons.Add(Button);
241end;
242
243procedure TToolBar.RemoveButton(Button: TToolButton);
244begin
245  if FDropDownButton=Button then FDropDownButton:=nil;
246  FButtons.Remove(Button);
247end;
248
249function TToolBar.IsVertical: Boolean;
250begin
251  if (Parent is TCoolBar) then
252    Exit(TCoolBar(Parent).Vertical);
253
254  if Align in [alNone, alClient, alCustom] then
255    Result := Height > Width
256  else
257    Result := Align in [alLeft, alRight];
258end;
259
260class procedure TToolBar.WSRegisterClass;
261begin
262  inherited WSRegisterClass;
263  RegisterToolBar;
264end;
265
266procedure TToolBar.ApplyFontForButtons;
267var
268  i: integer;
269begin
270  for i := 0 to ButtonCount - 1 do
271    Buttons[i].Font := Font;
272end;
273
274function TToolBar.ButtonHeightIsStored: Boolean;
275begin
276  Result := FButtonHeight >= 0;
277end;
278
279function TToolBar.ButtonWidthIsStored: Boolean;
280begin
281  Result := FButtonWidth >= 0;
282end;
283
284function TToolBar.GetButton(Index: Integer): TToolButton;
285begin
286  Result := TToolButton(FButtons[Index]);
287end;
288
289function TToolBar.GetButtonCount: Integer;
290begin
291  Result := FButtons.Count;
292end;
293
294function TToolBar.GetTransparent: Boolean;
295begin
296  Result := not (csOpaque in ControlStyle);
297end;
298
299procedure TToolBar.SetList(const AValue: Boolean);
300begin
301  if FList = AValue then exit;
302  FList := AValue;
303  UpdateVisibleBar;
304end;
305
306procedure TToolBar.SetFlat(const AValue: Boolean);
307begin
308  if FFlat = AValue then exit;
309  FFlat := AValue;
310  Invalidate;
311end;
312
313procedure TToolBar.SetTransparent(const AValue: Boolean);
314begin
315  if GetTransparent = AValue then exit;
316  if AValue then
317    ControlStyle := ControlStyle - [csOpaque]
318  else
319    ControlStyle := ControlStyle + [csOpaque];
320  Invalidate;
321end;
322
323procedure TToolBar.SetWrapable(const AValue: Boolean);
324begin
325  if FWrapable = AValue then exit;
326  FWrapable := AValue;
327  ReAlign;
328end;
329
330procedure TToolBar.Notification(AComponent: TComponent;
331  Operation: TOperation);
332begin
333  inherited Notification(AComponent, Operation);
334  if Operation = opRemove then
335  begin
336    if AComponent = FImages then Images := nil;
337    if AComponent = FHotImages then HotImages := nil;
338    if AComponent = FDisabledImages then DisabledImages := nil;
339  end;
340end;
341
342procedure TToolBar.SetImages(const AValue: TCustomImageList);
343begin
344  if FImages = AValue then Exit;
345  if FImages <> nil then
346    FImages.UnRegisterChanges(FImageChangeLink);
347  FImages := AValue;
348  if FImages <> nil then
349  begin
350    FImages.RegisterChanges(FImageChangeLink);
351    FImages.FreeNotification(Self);
352  end;
353  UpdateVisibleBar;
354end;
355
356procedure TToolBar.SetImagesWidth(const aImagesWidth: Integer);
357begin
358  if FImagesWidth = aImagesWidth then Exit;
359  FImagesWidth := aImagesWidth;
360  UpdateVisibleBar;
361end;
362
363procedure TToolBar.DisabledImageListChange(Sender: TObject);
364begin
365  if (Sender = DisabledImages) then UpdateVisibleBar;
366end;
367
368procedure TToolBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
369  const AXProportion, AYProportion: Double);
370begin
371  inherited;
372
373  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
374  begin
375    BeginUpdate;
376    try
377      if ButtonWidthIsStored then
378        ButtonWidth := Round(ButtonWidth * AXProportion);
379      if ButtonHeightIsStored then
380        ButtonHeight := Round(ButtonHeight * AYProportion);
381      if DropDownWidthIsStored then
382        DropDownWidth := Round(DropDownWidth * AXProportion);
383      FRealizedButtonHeight := 0;
384      FRealizedButtonWidth := 0;
385      FRealizedDropDownWidth := 0;
386      FRealizedButtonDropWidth := 0;
387      FToolBarFlags := FToolBarFlags + [tbfUpdateVisibleBarNeeded];
388    finally
389      EndUpdate;
390    end;
391  end;
392end;
393
394procedure TToolBar.SetDisabledImages(const AValue: TCustomImageList);
395begin
396  if FDisabledImages = AValue then Exit;
397  if FDisabledImages <> nil then
398    FDisabledImages.UnRegisterChanges(FDisabledImageChangeLink);
399  FDisabledImages := AValue;
400  if FDisabledImages <> nil then
401  begin
402    FDisabledImages.RegisterChanges(FDisabledImageChangeLink);
403    FDisabledImages.FreeNotification(Self);
404  end;
405  UpdateVisibleBar;
406end;
407
408procedure TToolBar.SetDropDownWidth(const ADropDownWidth: Integer);
409begin
410  if FDropDownWidth = ADropDownWidth then Exit;
411  FDropDownWidth := ADropDownWidth;
412  UpdateVisibleBar;
413end;
414
415procedure TToolBar.HotImageListChange(Sender: TObject);
416begin
417  if (Sender = HotImages) then UpdateVisibleBar;
418end;
419
420procedure TToolBar.UpdateVisibleBar;
421var
422  i: Integer;
423begin
424  if ([csLoading,csDestroying]*ComponentState<>[]) or (not HandleAllocated) then
425  begin
426    Include(FToolBarFlags,tbfUpdateVisibleBarNeeded);
427    Exit;
428  end;
429  for i := 0 to FButtons.Count - 1 do
430  begin
431    TControl(FButtons[i]).InvalidatePreferredSize;
432    TControl(FButtons[i]).AdjustSize;
433  end;
434  AdjustSize;
435  Invalidate;
436  Exclude(FToolBarFlags,tbfUpdateVisibleBarNeeded);
437end;
438
439procedure TToolBar.SetHotImages(const AValue: TCustomImageList);
440begin
441  if FHotImages = AValue then Exit;
442  if FHotImages <> nil then
443    FHotImages.UnRegisterChanges(FHotImageChangeLink);
444  FHotImages := AValue;
445  if FHotImages <> nil then
446  begin
447    FHotImages.RegisterChanges(FHotImageChangeLink);
448    FHotImages.FreeNotification(Self);
449  end;
450  UpdateVisibleBar;
451end;
452
453procedure TToolBar.SetIndent(const AValue: Integer);
454begin
455  if FIndent = AValue then exit;
456  FIndent := AValue;
457  UpdateVisibleBar;
458end;
459
460procedure TToolBar.Loaded;
461begin
462  inherited Loaded;
463  UpdateVisibleBar;
464end;
465
466procedure TToolBar.EndUpdate;
467begin
468  inherited EndUpdate;
469  if FUpdateCount=0 then begin
470    if tbfUpdateVisibleBarNeeded in FToolBarFlags then
471      UpdateVisibleBar;
472  end;
473end;
474
475function TToolBar.GetEnumerator: TToolBarEnumerator;
476begin
477  Result := TToolBarEnumerator.Create(Self);
478end;
479
480function TToolBar.GetDropDownWidth: Integer;
481begin
482  if FDropDownWidth < 0 then
483  begin
484    if FRealizedDropDownWidth = 0 then
485      FRealizedDropDownWidth := ScaleScreenToFont(FThemeDropDownWidth);
486    Result := FRealizedDropDownWidth;
487  end else
488    Result := FDropDownWidth;
489end;
490
491function TToolBar.GetButtonDropWidth: Integer;
492begin
493  if FDropDownWidth < 0 then
494  begin
495    if FRealizedButtonDropWidth = 0 then
496      FRealizedButtonDropWidth := ScaleScreenToFont(FThemeButtonDropWidth);
497    Result := FRealizedButtonDropWidth;
498  end else
499    Result := FDropDownWidth+FThemeButtonDropWidth-FThemeDropDownWidth;
500end;
501
502function TToolBar.GetButtonHeight: Integer;
503begin
504  if FButtonHeight < 0 then
505  begin
506    if FRealizedButtonHeight = 0 then
507      FRealizedButtonHeight := Scale96ToFont(cDefButtonHeight);
508    Result := FRealizedButtonHeight;
509  end else
510    Result := FButtonHeight;
511end;
512
513function TToolBar.GetButtonWidth: Integer;
514begin
515  if FButtonWidth < 0 then
516  begin
517    if FRealizedButtonWidth = 0 then
518      FRealizedButtonWidth := Scale96ToFont(cDefButtonWidth);
519    Result := FRealizedButtonWidth;
520  end else
521    Result := FButtonWidth;
522end;
523
524procedure TToolBar.Paint;
525begin
526  if csDesigning in ComponentState then
527  begin
528    Canvas.Pen.Color:=clRed;
529    Canvas.FrameRect(Clientrect);
530  end;
531  inherited Paint;
532  if Assigned(OnPaint) then
533    OnPaint(Self);
534end;
535
536procedure TToolBar.SetButtonSize(NewButtonWidth, NewButtonHeight: integer);
537var
538  CurControl: TControl;
539  NewWidth: Integer;
540  NewHeight: Integer;
541  i, RealButtonWidth, RealButtonHeight: Integer;
542  ChangeW, ChangeH: Boolean;
543begin
544  ChangeW := FButtonWidth <> NewButtonWidth;
545  ChangeH := FButtonHeight <> NewButtonHeight;
546  if not (ChangeW or ChangeH) then Exit;
547
548  FButtonWidth:=NewButtonWidth;
549  FButtonHeight:=NewButtonHeight;
550  RealButtonWidth := ButtonWidth;
551  RealButtonHeight := ButtonHeight;
552  if FUpdateCount > 0 then Exit;
553  if [csLoading, csDestroying] * ComponentState <> [] then Exit;
554
555  // set all children to ButtonWidth ButtonHeight
556  BeginUpdate;
557  try
558    for i:=ControlCount-1 downto 0 do
559    begin
560      CurControl := Controls[i];
561      CurControl.InvalidatePreferredSize;
562      NewWidth := CurControl.Width;
563      NewHeight := CurControl.Height;
564
565      // width
566      if ChangeW
567      and (RealButtonWidth > 0)
568      and not CurControl.AutoSize
569      and (CurControl is TToolButton)
570      and (CurControl.Align in [alNone, alLeft, alRight])
571      then begin
572        if TToolButton(CurControl).Style in [tbsButton,tbsCheck,tbsDropDown]
573        then begin
574          CurControl.GetPreferredSize(NewWidth,NewHeight);
575          if NewWidth < RealButtonWidth then
576            NewWidth := RealButtonWidth;
577        end;
578      end;
579
580      // height
581      // in horizontal toolbars the height is set by the toolbar independent of autosize
582      if ChangeH
583      and (RealButtonHeight > 0)
584      and ((Align in [alTop, alBottom]) or not CurControl.AutoSize)
585      then NewHeight := RealButtonHeight;
586
587      CurControl.SetBounds(CurControl.Left, CurControl.Top, NewWidth, NewHeight);
588    end;
589  finally
590    EndUpdate;
591  end;
592end;
593
594function TToolBar.CanFocus: Boolean;
595begin
596  Result := False;
597end;
598
599procedure TToolBar.DoAutoSize;
600begin
601  // children are moved in ControlsAligned independent of AutoSize=true
602end;
603
604function TToolBar.DropDownWidthIsStored: Boolean;
605begin
606  Result := FDropDownWidth >= 0;
607end;
608
609procedure TToolBar.CalculatePreferredSize(var PreferredWidth,
610  PreferredHeight: integer; WithThemeSpace: Boolean);
611var
612  NewWidth: Integer;
613  NewHeight: Integer;
614  FixedWidth: Boolean;
615begin
616  NewWidth:=0;
617  NewHeight:=0;
618
619  FixedWidth:=false;
620  if (Parent<>nil)
621  and (not Parent.AutoSize)
622  and AnchorSideLeft.IsAnchoredToParent(akLeft)
623  and AnchorSideRight.IsAnchoredToParent(akRight) then begin
624    // the width depends on the parent
625    // the width is fixed
626    FixedWidth:=true;
627    WrapButtons(Width, NewWidth, NewHeight, True);
628    PreferredWidth := NewWidth;
629    PreferredHeight := NewHeight;
630    //DebugLn(['TToolBar.CalculatePreferredSize fixed width: ',PreferredWidth,'x',PreferredHeight]);
631  end;
632  if not FixedWidth then begin
633    WrapButtons(Screen.Width,NewWidth,NewHeight,true);
634    PreferredWidth := NewWidth;
635    PreferredHeight := NewHeight;
636  end;
637  //DebugLn(['TToolBar.CalculatePreferredSize ',DbgSName(Self),' ',PreferredWidth,'x',PreferredHeight,' Count=',ControlCount]);
638end;
639
640{------------------------------------------------------------------------------
641  function TToolBar.WrapButtons(var NewWidth, NewHeight: Integer): Boolean;
642
643  Position all controls, that have Align=alNone.
644  The controls are put from left to right.
645  If the controls don't fit in a row and Wrapable=true, then the next row is
646  started.
647  If Wrapable=false, then the row is wrapped after the first button with
648  Wrap=true.
649------------------------------------------------------------------------------}
650function TToolBar.WrapButtons(UseSize: integer;
651  out NewWidth, NewHeight: Integer; Simulate: boolean): Boolean;
652var
653  ARect: TRect;
654  x, y, w, h: Integer;
655  NewControlWidth, NewControlHeight: Integer;
656  CurControl: TControl;
657  ObstacleControls: TFPList;
658  FullSizeObstacleControls: TFPList;
659  StartX, StartY: Integer;
660  Vertical: Boolean; // true = ToolBar is vertical, controls are put in rows
661  RowsLeftToRight: Boolean; // rows are left to right
662  RealButtonWidth, RealButtonHeight: Integer;
663
664  procedure CalculatePosition;
665  var
666    AlignedControl: TControl;
667    NewBounds: TRect;
668    SiblingBounds: TRect;
669    j: Integer;
670    PreferredBtnWidth, PreferredBtnHeight: Integer;
671    Intersects: Boolean;
672    IntersectsWithLimitedHeightControl: Boolean;
673    StartedAtRowStart: Boolean;
674  begin
675    // compute the size
676    if (CurControl is TToolButton) and (not CurControl.AutoSize) then
677    begin
678      PreferredBtnWidth := 0;
679      PreferredBtnHeight := 0;
680      CurControl.GetPreferredSize(PreferredBtnWidth, PreferredBtnHeight);
681      if Vertical then
682      begin
683        // column layout
684        NewControlHeight := PreferredBtnHeight;
685        NewControlWidth := RealButtonWidth;
686      end
687      else
688      begin
689        // row layout
690        NewControlHeight := RealButtonHeight;
691        NewControlWidth := PreferredBtnWidth;
692      end;
693      if (TToolButton(CurControl).Style in [tbsButton, tbsDropDown, tbsCheck]) then
694      begin
695        if Vertical then
696        begin
697          // column layout
698          if (NewControlHeight < RealButtonHeight) then
699            NewControlHeight := RealButtonHeight;
700        end
701        else begin
702          // row layout
703          if (NewControlWidth < RealButtonWidth) then
704            NewControlWidth := RealButtonWidth;
705        end;
706      end;
707      //debugln(['CalculatePosition preferred toolbutton size ',DbgSName(CurControl),' ',NewControlWidth,' ',NewControlHeight]);
708    end
709    else
710    if Vertical then
711    begin
712      // column layout
713      NewControlWidth := RealButtonWidth;
714      NewControlHeight := CurControl.Height;
715    end
716    else
717    begin
718      // row layout
719      NewControlWidth := CurControl.Width;
720      NewControlHeight := RealButtonHeight;
721    end;
722
723    if Vertical or RowsLeftToRight then
724      NewBounds := Bounds(x, y, NewControlWidth, NewControlHeight)
725    else
726      NewBounds := Bounds(x-NewControlWidth, y, NewControlWidth, NewControlHeight);
727
728    //DebugLn(['CalculatePosition ',DbgSName(CurControl),' NewBounds=',dbgs(NewBounds),' x=',x,' y=',y]);
729    if Vertical then
730      StartedAtRowStart := y = StartY
731    else
732      StartedAtRowStart := x = StartX;
733    repeat
734      // move control until it does not overlap
735      IntersectsWithLimitedHeightControl := False;
736      j := 0;
737      while j < ObstacleControls.Count do
738      begin
739        AlignedControl := TControl(ObstacleControls[j]);
740        SiblingBounds := AlignedControl.BoundsRect;
741        Intersects:=(SiblingBounds.Right > NewBounds.Left) and
742                    (SiblingBounds.Left < NewBounds.Right) and
743                    (SiblingBounds.Bottom > NewBounds.Top) and
744                    (SiblingBounds.Top < NewBounds.Bottom);
745        if Intersects then
746        begin
747          //DebugLn(['CalculatePosition Move ',NewBounds.Left,'->',SiblingBounds.Right]);
748          if Vertical then
749          begin
750            // column layout
751            NewBounds.Top := SiblingBounds.Bottom;
752            NewBounds.Bottom := NewBounds.Top + NewControlHeight;
753          end
754          else
755          begin
756            // row layout
757            if RowsLeftToRight then
758            begin
759              NewBounds.Left := SiblingBounds.Right;
760              NewBounds.Right := NewBounds.Left + NewControlWidth;
761            end else begin
762              NewBounds.Right := SiblingBounds.Left;
763              NewBounds.Left := NewBounds.Right - NewControlWidth;
764            end;
765          end;
766          j := 0; // check again, needed, because ObstacleControls are not sorted
767                // (and can not be sorted, because they can overlap)
768          if FullSizeObstacleControls.IndexOf(AlignedControl) < 0 then
769            IntersectsWithLimitedHeightControl := True;
770        end
771        else
772          inc(j);
773      end;
774      if Vertical then
775      begin
776        // column layout
777        if (not Wrapable) or
778           (NewBounds.Bottom <= ARect.Bottom) or (NewBounds.Top = StartY) or
779           (StartedAtRowStart and not IntersectsWithLimitedHeightControl) then
780        begin
781          // control fits into the row
782          //DebugLn(['CalculatePosition fits: ',DbgSName(CurControl),' ',dbgs(NewBounds)]);
783          x := NewBounds.Left;
784          y := NewBounds.Top;
785          break;
786        end;
787
788        // try next row
789        NewBounds.Top := StartY;
790        NewBounds.Bottom := NewBounds.Top + NewControlHeight;
791        inc(NewBounds.Left, RealButtonWidth);
792        inc(NewBounds.Right, RealButtonWidth);
793      end
794      else
795      begin
796        // row layout
797        if (not Wrapable)
798        or (StartedAtRowStart and not IntersectsWithLimitedHeightControl)
799        or (RowsLeftToRight and ((NewBounds.Left = StartX) or (NewBounds.Right <= ARect.Right)))
800        or ((not RowsLeftToRight) and ((NewBounds.Right = StartX) or (NewBounds.Left >= ARect.Left)))
801        then begin
802          // control fits into the row
803          //DebugLn(['CalculatePosition fits: ',DbgSName(CurControl),' ',dbgs(NewBounds)]);
804          x := NewBounds.Left;
805          y := NewBounds.Top;
806          break;
807        end;
808
809        //debugln(['CalculatePosition overlaps: ',DbgSName(CurControl),' ',dbgs(NewBounds),' ARect=',DbgS(ARect),' StartX=',StartX]);
810
811        // try next row
812        inc(NewBounds.Top, RealButtonHeight);
813        inc(NewBounds.Bottom, RealButtonHeight);
814        if RowsLeftToRight then
815        begin
816          NewBounds.Left := StartX;
817          NewBounds.Right := NewBounds.Left + NewControlWidth;
818        end else begin
819          NewBounds.Right := StartX;
820          NewBounds.Left := NewBounds.Right - NewControlWidth;
821        end;
822      end;
823      StartedAtRowStart := True;
824      //DebugLn('CalculatePosition Next Row ',DbgSName(CurControl),' ',dbgs(NewBounds));
825    until false;
826  end;
827
828  function AnchoredToParent(AControl: TControl; Side: TAnchorKind): boolean;
829  var
830    AnchorControl: TControl;
831    AnchorSide: TAnchorSideReference;
832    p: integer;
833  begin
834    if not (Side in CurControl.Anchors) then exit(false);
835    AnchorControl:=nil;
836    CurControl.AnchorSide[Side].GetSidePosition(AnchorControl,AnchorSide,P);
837    if AnchorControl=nil then
838      AnchorControl:=CurControl;
839    Result:=(Side in AnchorControl.Anchors);
840  end;
841
842var
843  OrderedControls: TFPList;
844  CurClientRect: TRect;
845  AdjustClientFrame: TRect;
846  i: Integer;
847  GrowSide: TAnchorKind; // when a line is full, grow the TToolBar in this direction
848  SeparatorWidthChange: Boolean;
849begin
850  //DebugLn(['WrapButtons ',DbgSName(Self),' Wrapable=',Wrapable,' ',dbgs(BoundsRect),' Vertical=',IsVertical,' RTL=',UseRightToLeftAlignment,' Simulate=',Simulate]);
851  Result := True;
852  RealButtonWidth := ButtonWidth;
853  RealButtonHeight := ButtonHeight;
854  Vertical := IsVertical;
855  NewWidth := 0;
856  NewHeight := 0;
857  ObstacleControls := TFPList.Create;
858  FullSizeObstacleControls := TFPList.Create;
859  OrderedControls := TFPList.Create;
860  if not Simulate then
861    FRowCount := 0;
862  DisableAlign;
863  BeginUpdate;
864  try
865    if Vertical then
866    begin
867      GrowSide := akRight;
868      RowsLeftToRight := true;
869    end
870    else begin
871      GrowSide := akBottom;
872      RowsLeftToRight:=not UseRightToLeftAlignment;
873    end;
874    for i:=0 to ControlCount-1 do
875    begin
876      CurControl := Controls[i];
877      if CurControl.Align = alNone then begin
878        // this control will be auto positioned and auto sized by this function
879        // => set to Left,Top anchoring
880        CurControl.Anchors:=[akLeft,akTop];
881        CurControl.AnchorSide[akLeft].Control:=nil;
882        CurControl.AnchorSide[akTop].Control:=nil;
883        OrderedControls.Add(CurControl);
884      end else begin
885        // this control will be positioned/sized by the default LCL functions
886        // the OrderedControls will be positioned around them (without overlapping)
887        ObstacleControls.Add(CurControl);
888        // check if this obstacle auto grows, for example if this toolbar is
889        // aligned to the top, check if the obstacle grows downwards (Align=alLeft)
890        if AnchoredToParent(CurControl,GrowSide) then begin
891          // this obstacle auto grows (important for the wrap algorithm)
892          FullSizeObstacleControls.Add(CurControl);
893        end;
894      end;
895    end;
896    // sort OrderedControls
897    if Vertical then
898      OrderedControls.Sort(TListSortCompare(@CompareToolBarControlVert))
899    else
900      OrderedControls.Sort(TListSortCompare(@CompareToolBarControlHorz));
901
902    // position OrderedControls
903    CurClientRect := ClientRect;
904    if Vertical then
905      inc(CurClientRect.Bottom, UseSize - Height)
906    else
907      inc(CurClientRect.Right, UseSize - Width);
908    ARect := CurClientRect;
909    AdjustClientRect(ARect);
910    AdjustClientFrame.Left := ARect.Left - CurClientRect.Left;
911    AdjustClientFrame.Top := ARect.Top - CurClientRect.Top;
912    AdjustClientFrame.Right := CurClientRect.Right - ARect.Right;
913    AdjustClientFrame.Bottom := CurClientRect.Bottom - ARect.Bottom;
914    //DebugLn(['TToolBar.WrapButtons ',DbgSName(Self),' ARect=',dbgs(ARect)]);
915    // important: top, left button must start in the corner of AdjustClientRect
916    // otherwise Toolbar.AutoSize=true will create an endless loop
917    if Vertical or RowsLeftToRight then
918      StartX := ARect.Left
919    else
920      StartX := ARect.Right;
921    StartY := ARect.Top;
922    x := StartX;
923    y := StartY;
924    //debugln(['TToolBar.WrapButtons Start=',StartX,' ',StartY]);
925    for i := 0 to OrderedControls.Count - 1 do
926    begin
927      CurControl := TControl(OrderedControls[i]);
928      if not CurControl.IsControlVisible then
929        Continue;
930      CalculatePosition;
931      //DebugLn(['WrapButtons ',DbgSName(CurControl),' ',x,',',y,',',CurControl.Width,'x',CurControl.Height]);
932      if CurControl.AutoSize then
933      begin
934        w := CurControl.Width;
935        h := CurControl.Height;
936      end
937      else
938      begin
939        w := NewControlWidth;
940        h := NewControlHeight;
941      end;
942
943      w := CurControl.Constraints.MinMaxWidth(w);
944      h := CurControl.Constraints.MinMaxHeight(h);
945      SeparatorWidthChange := (CurControl is TToolButton) and
946        (TToolButton(CurControl).Style in [tbsSeparator, tbsDivider]);
947      if SeparatorWidthChange then begin
948        if not Vertical then begin
949          SeparatorWidthChange := (w <> CurControl.Width);
950          w := CurControl.Width;
951        end else begin
952          SeparatorWidthChange := (h <> CurControl.Height);
953          h := CurControl.Height;
954        end;
955      end;
956      if Vertical <> FPrevVertical then  //swap h/w when orientation changed
957      begin
958        if (CurControl is TToolButton) and
959          (TToolButton(CurControl).Style in [tbsSeparator, tbsDivider]) then
960          begin
961            if not Vertical then
962              w := CurControl.Height
963            else
964              h := CurControl.Width;
965          end;
966      end;
967      if (CurControl.Left <> x) or (CurControl.Top <> y) or
968         (CurControl.Width <> w) or (CurControl.Height <> h) then
969      begin
970        //DebugLn(['TToolBar.WrapButtons moving child: ',DbgSName(CurControl),' Old=',dbgs(CurControl.BoundsRect),' New=',dbgs(Bounds(x,y,w,h))]);
971        if not Simulate then
972        begin
973          //DebugLn(['TToolBar.WrapButtons moving child: ',DbgSName(CurControl),' Old=',dbgs(CurControl.BoundsRect),' New=',dbgs(Bounds(x,y,w,h))]);
974          if SeparatorWidthChange then
975            CurControl.SetBoundsKeepBase(x,y,w,h)
976          else
977            CurControl.SetBounds(x,y,w,h);
978          //DebugLn(['TToolBar.WrapButtons moved child: ',DbgSName(CurControl),' ',dbgs(CurControl.BoundsRect)]);
979        end;
980      end;
981
982      // adjust NewWidth, NewHeight
983      if Vertical or RowsLeftToRight then
984        NewWidth := Max(NewWidth, x + w + AdjustClientFrame.Right)
985      else
986        NewWidth := Max(NewWidth, ARect.Right - x + ARect.Left + AdjustClientFrame.Right);
987      NewHeight := Max(NewHeight, y + h + AdjustClientFrame.Bottom);
988
989      // step to next position
990      if Vertical then
991      begin
992        inc(y, h);
993        if not Wrapable and
994          (CurControl is TToolButton) and
995          (TToolButton(CurControl).Wrap) then
996        begin
997          // user forced wrap -> start new line
998          y := StartY;
999          inc(x, RealButtonWidth);
1000          if not Simulate then
1001            inc(FRowCount);
1002        end;
1003      end
1004      else
1005      begin
1006        if RowsLeftToRight then
1007          inc(x, w);
1008        if not Wrapable and
1009          (CurControl is TToolButton) and
1010          (TToolButton(CurControl).Wrap) then
1011        begin
1012          // user forced wrap -> start new line
1013          x := StartX;
1014          inc(y, RealButtonHeight);
1015          if not Simulate then
1016            inc(FRowCount);
1017        end;
1018      end;
1019    end;
1020  finally
1021    ObstacleControls.Free;
1022    OrderedControls.Free;
1023    FullSizeObstacleControls.Free;
1024    EndUpdate;
1025    EnableAlign;
1026    FPrevVertical := Vertical;
1027  end;
1028end;
1029
1030procedure TToolBar.CNDropDownClosed(var Message: TLMessage);
1031begin
1032  CloseCurrentMenu;
1033end;
1034
1035procedure TToolBar.AdjustClientRect(var ARect: TRect);
1036begin
1037  inherited AdjustClientRect(ARect);
1038  inc(ARect.Left, Indent);
1039end;
1040
1041class function TToolBar.GetControlClassDefaultSize: TSize;
1042begin
1043  Result.CX := 150;
1044  Result.CY := 26;
1045end;
1046
1047function TToolBar.FindButtonFromAccel(Accel: Word): TToolButton;
1048var
1049  i: Integer;
1050begin
1051  for i := 0 to FButtons.Count - 1 do
1052    if TControl(FButtons[i]) is TToolButton then
1053    begin
1054      Result := Buttons[i];
1055      if Result.Visible and Result.Enabled and IsAccel(Accel, Result.Caption) then
1056        Exit;
1057    end;
1058  Result := nil;
1059end;
1060
1061procedure TToolBar.FontChanged(Sender: TObject);
1062begin
1063  inherited FontChanged(Sender);
1064  ApplyFontForButtons;
1065  FRealizedButtonWidth := 0;
1066  FRealizedButtonHeight := 0;
1067  FRealizedDropDownWidth := 0;
1068  FRealizedButtonDropWidth := 0;
1069end;
1070
1071function TToolBar.CheckMenuDropdown(Button: TToolButton): Boolean;
1072var
1073  APoint: TPoint;
1074begin
1075  Result := False;
1076  if Button = nil then
1077    Exit;
1078  if Assigned(FCurrentMenu) then
1079  begin
1080    CloseCurrentMenu;
1081    if FCurrentMenuAutoFree then
1082    begin
1083      FreeAndNil(FCurrentMenu);
1084      FCurrentMenuAutoFree := False;
1085    end;
1086  end;
1087  FSrcMenuItem := nil;
1088  FSrcMenu := nil;
1089  FDropDownButton := Button;
1090  if Assigned(Button.DropdownMenu) then
1091    // the button has a popupenu
1092    FCurrentMenu := Button.DropdownMenu
1093  else
1094  if Assigned(Button.MenuItem) then
1095  begin
1096    // the button has a menuitem
1097
1098    // since the button is clicked - menu item must be clicked too
1099    Button.MenuItem.Click;
1100    // -> create a temporary TPopupMenu and move all child menuitems
1101    FCurrentMenuAutoFree := True;
1102    FCurrentMenu := TPopupMenu.Create(Self);
1103    FSrcMenuItem := Button.MenuItem;
1104    FSrcMenu := FSrcMenuItem.GetParentMenu;
1105    FCurrentMenu.Items.HelpContext := FSrcMenuItem.HelpContext;
1106    if Assigned(FSrcMenu) then
1107      FCurrentMenu.Images := FSrcMenu.Images;
1108    MoveSubMenuItems(FSrcMenuItem, FCurrentMenu.Items);
1109  end
1110  else
1111    Exit;
1112  FCurrentMenu.PopupComponent := Self;
1113  APoint := Button.ClientToScreen(Point(0, Button.ClientHeight));
1114  if FCurrentMenu.IsRightToLeft then Inc(APoint.X, Button.Width);
1115  FCurrentMenu.Popup(APoint.X, APoint.Y);
1116  // The next command will be executed after popup menu close because Popup is a
1117  // syncronous method. We can't send this message on Menu.Close event because
1118  // Click happen after the Close event and if we remove all the menu items there
1119  // we will not be able to handle the Click event
1120  // we also need to postpone this message to allow after Popup cleanup and click happen
1121  PostMessage(Handle, CN_DROPDOWNCLOSED, 0, 0);
1122  Result := True;
1123end;
1124
1125procedure TToolBar.ClickButton(Button: TToolButton);
1126begin
1127  Button.Click;
1128end;
1129
1130