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