1{%MainUnit ../comctrls.pp} 2 3{****************************************************************************** 4 TTabControl 5 ****************************************************************************** 6 7 Author: Mattias Gaertner 8 9 ***************************************************************************** 10 This file is part of the Lazarus Component Library (LCL) 11 12 See the file COPYING.modifiedLGPL.txt, included in this distribution, 13 for details about the license. 14 ***************************************************************************** 15 16} 17 18{ TTabControlStrings } 19 20procedure TTabControlStrings.SetHotTrack(const AValue: Boolean); 21begin 22 if FHotTrack=AValue then exit; 23 FHotTrack:=AValue; 24end; 25 26procedure TTabControlStrings.SetImages(const AValue: TCustomImageList); 27begin 28 if FImages=AValue then exit; 29 FImages:=AValue; 30end; 31 32procedure TTabControlStrings.SetMultiLine(const AValue: Boolean); 33begin 34 if FMultiLine=AValue then exit; 35 FMultiLine:=AValue; 36end; 37 38procedure TTabControlStrings.SetMultiSelect(const AValue: Boolean); 39begin 40 if FMultiSelect=AValue then exit; 41 FMultiSelect:=AValue; 42end; 43 44procedure TTabControlStrings.SetOwnerDraw(const AValue: Boolean); 45begin 46 if FOwnerDraw=AValue then exit; 47 FOwnerDraw:=AValue; 48end; 49 50procedure TTabControlStrings.SetRaggedRight(const AValue: Boolean); 51begin 52 if FRaggedRight=AValue then exit; 53 FRaggedRight:=AValue; 54end; 55 56procedure TTabControlStrings.SetScrollOpposite(const AValue: Boolean); 57begin 58 if FScrollOpposite=AValue then exit; 59 FScrollOpposite:=AValue; 60end; 61 62constructor TTabControlStrings.Create(TheTabControl: TTabControl); 63begin 64 inherited Create; 65 FTabControl:=TheTabControl; 66 FHotTrack:=false; 67 FMultiLine:=false; 68 FMultiSelect:=false; 69 FOwnerDraw:=false; 70 FRaggedRight:=false; 71 FScrollOpposite:=false; 72end; 73 74procedure TTabControlStrings.TabControlBoundsChange; 75begin 76 77end; 78 79function TTabControlStrings.IndexOfTabAt(X, Y: Integer): Integer; 80begin 81 Result:=0; 82end; 83 84function TTabControlStrings.GetHitTestInfoAt(X, Y: Integer): THitTests; 85begin 86 Result:=[]; 87end; 88 89function TTabControlStrings.TabRect(Index: Integer): TRect; 90begin 91 FillChar(Result,SizeOf(Result),0); 92end; 93 94function TTabControlStrings.RowCount: Integer; 95begin 96 Result:=1; 97end; 98 99procedure TTabControlStrings.ScrollTabs(Delta: Integer); 100begin 101end; 102 103procedure TTabControlStrings.UpdateTabImages; 104begin 105end; 106 107procedure TTabControlStrings.BeginUpdate; 108begin 109 inc(FUpdateCount); 110end; 111 112procedure TTabControlStrings.EndUpdate; 113begin 114 if FUpdateCount=0 then 115 RaiseGDBException('TTabControlStrings.EndUpdate'); 116 dec(FUpdateCount); 117end; 118 119function TTabControlStrings.IsUpdating: boolean; 120begin 121 Result:=FUpdateCount>0; 122end; 123 124procedure TTabControlStrings.ImageListChange(Sender: TObject); 125begin 126end; 127 128{ TNoteBookStringsTabControl } 129 130procedure TNoteBookStringsTabControl.CreateHandle; 131begin 132 inherited CreateHandle; 133 if FHandleCreated <> nil then 134 FHandleCreated(self); 135end; 136 137procedure TNoteBookStringsTabControl.DoStartDrag(var DragObject: TDragObject); 138begin 139 if (Parent is TTabControl) then 140 begin 141 if Assigned(TTabControl(Parent).OnStartDrag) then 142 TTabControl(Parent).OnStartDrag(Parent, DragObject); 143 if not Assigned(DragObject) then 144 DragObject := TDragControlObject.AutoCreate(Parent); 145 end; 146 inherited DoStartDrag(DragObject); 147end; 148 149procedure TNoteBookStringsTabControl.DragDrop(Source: TObject; X, Y: Integer); 150begin 151 inherited DragDrop(Source, X, Y); 152 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnDragDrop) then 153 TTabControl(Parent).OnDragDrop(Parent, Source, X, Y); 154end; 155 156procedure TNoteBookStringsTabControl.DragOver(Source: TObject; X, Y: Integer; 157 State: TDragState; var Accept: Boolean); 158begin 159 inherited DragOver(Source, X, Y, State, Accept); 160 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnDragOver) then 161 TTabControl(Parent).OnDragOver(Parent, Source, X, Y, State, Accept); 162end; 163 164procedure TNoteBookStringsTabControl.MouseDown(Button: TMouseButton; 165 Shift: TShiftState; X, Y: Integer); 166begin 167 inherited MouseDown(Button, Shift, X, Y); 168 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseDown) then 169 TTabControl(Parent).OnMouseDown(Parent, Button, Shift, X, Y); 170end; 171 172procedure TNoteBookStringsTabControl.MouseMove(Shift: TShiftState; X, Y: Integer); 173begin 174 inherited MouseMove(Shift, X, Y); 175 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseMove) then 176 TTabControl(Parent).OnMouseMove(Parent, Shift, X, Y); 177end; 178 179procedure TNoteBookStringsTabControl.MouseUp(Button: TMouseButton; 180 Shift: TShiftState; X, Y: Integer); 181begin 182 inherited MouseUp(Button, Shift, X, Y); 183 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseUp) then 184 TTabControl(Parent).OnMouseUp(Parent, Button, Shift, X, Y); 185end; 186 187procedure TNoteBookStringsTabControl.MouseEnter; 188begin 189 inherited MouseEnter; 190 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseEnter) then 191 TTabControl(Parent).OnMouseEnter(Parent); 192end; 193 194procedure TNoteBookStringsTabControl.MouseLeave; 195begin 196 inherited MouseLeave; 197 if (Parent is TTabControl) and Assigned(TTabControl(Parent).OnMouseLeave) then 198 TTabControl(Parent).OnMouseLeave(Parent); 199end; 200 201function TNoteBookStringsTabControl.GetPopupMenu: TPopupMenu; 202begin 203 if (Parent is TTabControl) and (nboHidePageListPopup in Self.Options) then 204 Result:=TTabControl(Parent).PopupMenu 205 else 206 Result:=inherited GetPopupMenu; 207end; 208 209class procedure TNoteBookStringsTabControl.WSRegisterClass; 210begin 211 inherited WSRegisterClass; 212 // TODO: 213 //RegisterWSComponent(TNoteBookStringsTabControl, TWSPageControl); 214end; 215 216{ TTabControlNoteBookStrings } 217 218procedure TTabControlNoteBookStrings.NBGetImageIndex(Sender: TObject; 219 TheTabIndex: Integer; var ImageIndex: Integer); 220begin 221 ImageIndex := TabControl.GetImageIndex(TheTabIndex); 222end; 223 224procedure TTabControlNoteBookStrings.NBChanging(Sender: TObject; 225 var AllowChange: Boolean); 226begin 227 AllowChange:=TabControl.CanChange; 228end; 229 230procedure TTabControlNoteBookStrings.NBPageChanged(Sender: TObject); 231begin 232 TabControl.Change; 233end; 234 235procedure TTabControlNoteBookStrings.NBHandleCreated(Sender: TObject); 236begin 237 if FInHandleCreated then 238 exit; 239 FInHandleCreated := True; 240 TabControlBoundsChange; 241 FInHandleCreated := False; 242end; 243 244function TTabControlNoteBookStrings.GetTabPosition: TTabPosition; 245begin 246 Result := FNoteBook.TabPosition; 247end; 248 249procedure TTabControlNoteBookStrings.SetTabPosition(AValue: TTabPosition); 250begin 251 FNoteBook.TabPosition := AValue; 252 TabControlBoundsChange; 253end; 254 255procedure TTabControlNoteBookStrings.SetStyle(AValue: TTabStyle); 256begin 257 FNoteBook.Style := AValue; 258 TabControlBoundsChange; 259end; 260 261function TTabControlNoteBookStrings.GetInternalTabControllClass: TNoteBookStringsTabControlClass; 262begin 263 Result := TNoteBookStringsTabControl; 264end; 265 266function TTabControlNoteBookStrings.GetStyle: TTabStyle; 267begin 268 Result := FNoteBook.Style; 269end; 270 271function TTabControlNoteBookStrings.Get(Index: Integer): string; 272begin 273 Result:=FNoteBook.Pages[Index]; 274end; 275 276function TTabControlNoteBookStrings.GetCount: Integer; 277begin 278 Result:=FNoteBook.PageCount; 279end; 280 281function TTabControlNoteBookStrings.GetObject(Index: Integer): TObject; 282begin 283 Result:=FNoteBook.Pages.Objects[Index]; 284end; 285 286procedure TTabControlNoteBookStrings.Put(Index: Integer; const S: string); 287begin 288 FNoteBook.Pages[Index]:=S; 289end; 290 291procedure TTabControlNoteBookStrings.PutObject(Index: Integer; AObject: TObject); 292begin 293 FNoteBook.Pages.Objects[Index]:=AObject; 294end; 295 296procedure TTabControlNoteBookStrings.SetImages(const AValue: TCustomImageList); 297begin 298 if AValue is TImageList then 299 FNoteBook.Images:=TImageList(AValue) 300 else 301 FNoteBook.Images:=nil; 302end; 303 304procedure TTabControlNoteBookStrings.SetMultiLine(const AValue: Boolean); 305begin 306 inherited SetMultiLine(AValue); 307 FNoteBook.MultiLine := AValue; 308 TabControlBoundsChange; 309end; 310 311procedure TTabControlNoteBookStrings.SetUpdateState(Updating: Boolean); 312begin 313 if Updating then 314 FNoteBook.Pages.BeginUpdate 315 else 316 FNoteBook.Pages.EndUpdate; 317end; 318 319function TTabControlNoteBookStrings.GetTabIndex: integer; 320begin 321 Result:=FNoteBook.PageIndex; 322end; 323 324procedure TTabControlNoteBookStrings.SetTabIndex(const AValue: integer); 325begin 326 FNoteBook.PageIndex:=AValue; 327end; 328 329constructor TTabControlNoteBookStrings.Create(TheTabControl: TTabControl); 330begin 331 inherited Create(TheTabControl); 332 FNoteBook := GetInternalTabControllClass.Create(nil); 333 FNoteBook.ControlStyle := FNoteBook.ControlStyle + [csNoDesignSelectable]; 334 FNoteBook.Parent := TabControl; 335 FNoteBook.OnGetImageIndex := @NBGetImageIndex; 336 FNoteBook.OnChanging := @NBChanging; 337 FNoteBook.OnChange := @NBPageChanged; 338 TNoteBookStringsTabControl(FNoteBook).FHandleCreated := @NBHandleCreated; 339 TabControlBoundsChange; 340end; 341 342destructor TTabControlNoteBookStrings.Destroy; 343begin 344 FreeThenNil(FNoteBook); 345 inherited Destroy; 346end; 347 348procedure TTabControlNoteBookStrings.Clear; 349begin 350 FNoteBook.Pages.Clear; 351end; 352 353procedure TTabControlNoteBookStrings.Delete(Index: Integer); 354begin 355 FNoteBook.Pages.Delete(Index); 356end; 357 358procedure TTabControlNoteBookStrings.Insert(Index: Integer; const S: string); 359begin 360 FNoteBook.Pages.Insert(Index, S); 361 TabControlBoundsChange; 362end; 363 364function TTabControlNoteBookStrings.GetSize: integer; 365begin 366 case TabControl.TabPosition of 367 tpTop, tpBottom: Result:=FNoteBook.Height; 368 tpLeft, tpRight: Result:=FNoteBook.Width; 369 end; 370end; 371 372procedure TTabControlNoteBookStrings.TabControlBoundsChange; 373var 374 NewHeight: LongInt; 375 NewWidth: LongInt; 376begin 377 inherited TabControlBoundsChange; 378 379 FNoteBook.TabPosition:=TabControl.TabPosition; 380 381 case TabControl.TabPosition of 382 tpTop,tpBottom: 383 begin 384 NewHeight:=TabControl.TabHeight; 385 if NewHeight<=0 then 386 NewHeight:=FNoteBook.GetMinimumTabHeight; 387 NewHeight:=Min(TabControl.ClientHeight,NewHeight); 388 if TabControl.TabPosition=tpTop then 389 FNoteBook.SetBounds(0,0,TabControl.ClientWidth,NewHeight) 390 else 391 FNoteBook.SetBounds(0,TabControl.ClientHeight-NewHeight, 392 TabControl.ClientWidth,NewHeight); 393 end; 394 395 tpLeft,tpRight: 396 begin 397 NewWidth:=Max(TabControl.TabHeight,FNoteBook.GetMinimumTabWidth); 398 NewWidth:=Min(TabControl.Width,NewWidth); 399 if TabControl.TabPosition=tpLeft then 400 FNoteBook.SetBounds(0,0,NewWidth,TabControl.ClientHeight) 401 else 402 FNoteBook.SetBounds(TabControl.ClientWidth-NewWidth,0, 403 NewWidth,TabControl.ClientHeight); 404 end; 405 end; 406 407 TabControl.Invalidate; 408end; 409 410function TTabControlNoteBookStrings.IndexOfTabAt(X, Y: Integer): Integer; 411begin 412 Result:=FNoteBook.IndexOfPageAt(X, Y); 413end; 414 415{ TTabControl } 416 417procedure TTabControl.AdjustDisplayRect(var ARect: TRect); 418const 419 TabControlInternalBorder = 2; // TTabControl paints a border, so limit the children, to be within that border 420begin 421 AdjustDisplayRectWithBorder(ARect); 422 if TabPosition<>tpTop then 423 ARect.Top:=Min(Max(ARect.Top,ARect.Top+BorderWidth+TabControlInternalBorder),ARect.Bottom); 424 if TabPosition<>tpBottom then 425 ARect.Bottom:=Max(Min(ARect.Bottom,ARect.Bottom-BorderWidth-TabControlInternalBorder),ARect.Top); 426 if TabPosition<>tpLeft then 427 ARect.Left:=Min(Max(ARect.Left,ARect.Left+BorderWidth+TabControlInternalBorder),ARect.Right); 428 if TabPosition<>tpRight then 429 ARect.Right:=Max(Min(ARect.Right,ARect.Right-BorderWidth-TabControlInternalBorder),ARect.Left); 430end; 431 432function TTabControl.GetDisplayRect: TRect; 433begin 434 Result:=ClientRect; 435 AdjustDisplayRect(Result); 436end; 437 438function TTabControl.GetHotTrack: Boolean; 439begin 440 Result:=TTabControlStrings(FTabs).HotTrack; 441end; 442 443function TTabControl.GetMultiLine: Boolean; 444begin 445 Result:=TTabControlStrings(FTabs).MultiLine; 446end; 447 448function TTabControl.GetMultiSelect: Boolean; 449begin 450 Result:=TTabControlStrings(FTabs).MultiSelect; 451end; 452 453function TTabControl.GetOwnerDraw: Boolean; 454begin 455 Result:=TTabControlStrings(FTabs).OwnerDraw; 456end; 457 458function TTabControl.GetRaggedRight: Boolean; 459begin 460 Result:=TTabControlStrings(FTabs).RaggedRight; 461end; 462 463function TTabControl.GetScrollOpposite: Boolean; 464begin 465 Result:=TTabControlStrings(FTabs).ScrollOpposite; 466end; 467 468function TTabControl.GetTabIndex: Integer; 469begin 470 Result:=TTabControlStrings(FTabs).TabIndex; 471end; 472 473procedure TTabControl.SetHotTrack(const AValue: Boolean); 474begin 475 TTabControlStrings(FTabs).HotTrack:=AValue; 476end; 477 478procedure TTabControl.SetImages(const AValue: TCustomImageList); 479begin 480 if FImages = AValue then Exit; 481 if FImages <> nil then 482 FImages.RemoveFreeNotification(Self); 483 FImages := TImageList(AValue); 484 if FImages <> nil then 485 FImages.FreeNotification(Self); 486 TTabControlStrings(FTabs).Images := FImages; 487end; 488 489procedure TTabControl.SetMultiLine(const AValue: Boolean); 490begin 491 TTabControlStrings(FTabs).MultiLine:=AValue; 492end; 493 494procedure TTabControl.SetMultiSelect(const AValue: Boolean); 495begin 496 TTabControlStrings(FTabs).MultiSelect:=AValue; 497end; 498 499procedure TTabControl.SetOwnerDraw(const AValue: Boolean); 500begin 501 TTabControlStrings(FTabs).OwnerDraw:=AValue; 502end; 503 504procedure TTabControl.SetRaggedRight(const AValue: Boolean); 505begin 506 TTabControlStrings(FTabs).RaggedRight:=AValue; 507end; 508 509procedure TTabControl.SetScrollOpposite(const AValue: Boolean); 510begin 511 TTabControlStrings(FTabs).ScrollOpposite:=AValue; 512end; 513 514procedure TTabControl.SetStyle(AValue: TTabStyle); 515begin 516 inherited SetStyle(AValue); 517 if FStyle=AValue then exit; 518 FStyle:=AValue; 519 TTabControlNoteBookStrings(FTabs).Style := AValue; 520end; 521 522procedure TTabControl.SetTabHeight(AValue: Smallint); 523begin 524 if FTabHeight = AValue then exit; 525 if not (nbcTabsSizeable in GetCapabilities) then Exit; 526 FTabHeight := AValue; 527 TTabControlNoteBookStrings(FTabs).NoteBook.TabHeight := AValue; 528end; 529 530procedure TTabControl.SetTabPosition(AValue: TTabPosition); 531begin 532 if FTabPosition=AValue then exit; 533 FTabPosition:=AValue; 534 TTabControlNoteBookStrings(FTabs).TabPosition := AValue; 535 ReAlign; 536end; 537 538procedure TTabControl.SetTabs(const AValue: TStrings); 539begin 540 FTabs.Assign(AValue); 541end; 542 543procedure TTabControl.SetTabStop(const AValue: Boolean); 544begin 545 TTabControlNoteBookStrings(FTabs).NoteBook.TabStop := AValue; 546end; 547 548procedure TTabControl.SetTabWidth(AValue: Smallint); 549begin 550 if FTabWidth = AValue then Exit; 551 if not (nbcTabsSizeable in GetCapabilities) then Exit; 552 FTabWidth := AValue; 553 TTabControlNoteBookStrings(FTabs).NoteBook.TabWidth := AValue; 554end; 555 556procedure TTabControl.SetOptions(const AValue: TCTabControlOptions); 557begin 558 inherited SetOptions(AValue); 559 //propagate the changes to FTabs.NoteBook, this is needed in TCustomTabControl.SetPageIndex 560 //since SetTabIndex eventually does FTabs.NoteBook.SetPageIndex 561 TTabControlNoteBookStrings(FTabs).NoteBook.Options := AValue; 562end; 563 564procedure TTabControl.AddRemovePageHandle(APage: TCustomPage); 565begin 566 // There are no pages, don't create a handle 567end; 568 569function TTabControl.CanChange: Boolean; 570begin 571 Result:=true; 572 if FTabControlCreating then exit; 573 if not IsUpdating and Assigned(FOnChanging) then 574 FOnChanging(Self,Result); 575end; 576 577function TTabControl.CanShowTab(ATabIndex: Integer): Boolean; 578begin 579 Result:=true; 580end; 581 582procedure TTabControl.Change; 583begin 584 if FTabControlCreating then exit; 585 if IsUpdating then begin 586 FOnChangeNeeded:=true; 587 exit; 588 end else 589 FOnChangeNeeded:=false; 590 if Assigned(FOnChange) then 591 FOnChange(Self); 592end; 593 594function TTabControl.GetImageIndex(ATabIndex: Integer): Integer; 595begin 596 Result := ATabIndex; 597 if Assigned(FOnGetImageIndex) then 598 FOnGetImageIndex(Self, ATabIndex, Result); 599end; 600 601procedure TTabControl.CreateWnd; 602begin 603 BeginUpdate; 604 inherited CreateWnd; 605 EndUpdate; 606end; 607 608procedure TTabControl.DestroyHandle; 609begin 610 BeginUpdate; 611 inherited DestroyHandle; 612 EndUpdate; 613end; 614 615procedure TTabControl.Notification(AComponent: TComponent; 616 Operation: TOperation); 617begin 618 inherited Notification(AComponent, Operation); 619 if (Operation = opRemove) and (AComponent = Images) then 620 Images := nil; 621end; 622 623procedure TTabControl.SetDragMode(Value: TDragMode); 624begin 625 inherited SetDragMode(Value); 626 TTabControlNoteBookStrings(FTabs).NoteBook.SetDragMode(Value); 627end; 628 629procedure TTabControl.SetTabIndex(Value: Integer); 630begin 631 TTabControlStrings(FTabs).TabIndex:=Value; 632end; 633 634procedure TTabControl.UpdateTabImages; 635begin 636 TTabControlStrings(FTabs).UpdateTabImages; 637end; 638 639procedure TTabControl.ImageListChange(Sender: TObject); 640begin 641 TTabControlStrings(FTabs).ImageListChange(Sender); 642end; 643 644procedure TTabControl.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); 645begin 646 inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); 647 if FTabs <> nil then 648 TTabControlStrings(FTabs).TabControlBoundsChange; 649end; 650 651class function TTabControl.GetControlClassDefaultSize: TSize; 652begin 653 Result.CX := 200; 654 Result.CY := 150; 655end; 656 657procedure TTabControl.PaintWindow(DC: HDC); 658var 659 DCChanged: boolean; 660begin 661 DCChanged := (not FCanvas.HandleAllocated) or (FCanvas.Handle <> DC); 662 if DCChanged then 663 FCanvas.Handle := DC; 664 try 665 Paint; 666 finally 667 if DCChanged then FCanvas.Handle := 0; 668 end; 669end; 670 671procedure TTabControl.Paint; 672var 673 ARect, ARect2: TRect; 674 TS: TTextStyle; 675 Details: TThemedElementDetails; 676 lCanvas: TCanvas; 677begin 678 lCanvas := FCanvas; 679 680 //DebugLn(['TTabControl.Paint Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect),' CientOrigin=',dbgs(ClientOrigin)]); 681 // clear only display area since button area is painted by another control 682 // draw a frame 683 ARect := ClientRect; 684 AdjustDisplayRectWithBorder(ARect); 685 686 Details := ThemeServices.GetElementDetails(ttPane); 687 ARect2 := ARect; 688 // paint 1 pixel under the header, to avoid painting a closing border 689 case TabPosition of 690 tpTop: ARect2.Top := ARect2.Top - 1; 691 tpBottom: ARect2.Bottom := ARect2.Bottom + 1; 692 tpLeft: ARect2.Left := ARect2.Left - 1; 693 tpRight: ARect2.Right := ARect2.Right + 1; 694 end; 695 ThemeServices.DrawElement(lCanvas.Handle, Details, ARect2); 696 697 InflateRect(ARect,BorderWidth,BorderWidth); 698 lCanvas.Frame3d(ARect, BorderWidth, bvRaised); 699 700 if (csDesigning in ComponentState) and (Caption <> '') then 701 begin 702 ARect:=GetDisplayRect; 703 TS := lCanvas.TextStyle; 704 TS.Alignment:=taCenter; 705 TS.Layout:= tlCenter; 706 TS.Opaque:= false; 707 TS.Clipping:= false; 708 lCanvas.TextRect(ARect, ARect.Left, ARect.Top, Caption, TS); 709 end; 710end; 711 712procedure TTabControl.AdjustDisplayRectWithBorder(var ARect: TRect); 713var 714 TabAreaSize: LongInt; 715begin 716 TabAreaSize := TTabControlStrings(FTabs).GetSize; 717 718 case TabPosition of 719 tpTop: ARect.Top:=Min(TabAreaSize,ARect.Bottom); 720 tpBottom: ARect.Bottom:=Max(ARect.Bottom-TabAreaSize,ARect.Top); 721 tpLeft: ARect.Left:=Min(TabAreaSize,ARect.Right); 722 tpRight: ARect.Right:=Max(ARect.Right-TabAreaSize,ARect.Left); 723 end; 724end; 725 726function TTabControl.GetTabRectWithBorder: TRect; 727var 728 TabAreaSize: LongInt; 729begin 730 Result := ClientRect; 731 TabAreaSize := TTabControlStrings(FTabs).GetSize; 732 case TabPosition of 733 tpTop: Result.Bottom:=Min(TabAreaSize,Result.Bottom); 734 tpBottom: Result.Top:=Max(Result.Bottom-TabAreaSize,Result.Top); 735 tpLeft: Result.Right:=Min(TabAreaSize,Result.Right); 736 tpRight: Result.Left:=Max(Result.Right-TabAreaSize,Result.Left); 737 end; 738end; 739 740function TTabControl.GetTabStop: Boolean; 741begin 742 Result := TTabControlNoteBookStrings(FTabs).NoteBook.TabStop; 743end; 744 745procedure TTabControl.AdjustClientRect(var ARect: TRect); 746begin 747 AdjustDisplayRect(ARect); 748end; 749 750function TTabControl.CreateTabNoteBookStrings: TTabControlNoteBookStrings; 751begin 752 Result := TTabControlNoteBookStrings.Create(Self); 753end; 754 755constructor TTabControl.Create(TheOwner: TComponent); 756begin 757 FTabControlCreating:=true; 758 inherited Create(TheOwner); 759 ControlStyle:=ControlStyle+[csAcceptsControls]; 760 FStyle:=tsTabs; 761 FTabPosition:=tpTop; 762 FImageChangeLink := TChangeLink.Create; 763 FImageChangeLink.OnChange := @ImageListChange; 764 FTabs := CreateTabNoteBookStrings; 765 TWinControl(Self).TabStop := False; // workaround, see #30305 766 TTabControlNoteBookStrings(FTabs).NoteBook.TabStop := True; 767 with GetControlClassDefaultSize do 768 SetInitialBounds(0, 0, CX, CY); 769 BorderWidth:=0; 770 FTabControlCreating:=false; 771 772 FCanvas := TControlCanvas.Create; 773 TControlCanvas(FCanvas).Control := Self; 774end; 775 776destructor TTabControl.Destroy; 777begin 778 BeginUpdate; 779 FCanvas.Free; 780 FreeThenNil(FTabs); 781 FreeThenNil(FImageChangeLink); 782 inherited Destroy; 783end; 784 785function TTabControl.IndexOfTabAt(X, Y: Integer): Integer; 786begin 787 Result:=TTabControlStrings(FTabs).IndexOfTabAt(X,Y); 788end; 789 790function TTabControl.IndexOfTabAt(P: TPoint): Integer; 791begin 792 Result:=TTabControlStrings(FTabs).IndexOfTabAt(P.x, P.y); 793end; 794 795function TTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests; 796begin 797 Result:=TTabControlStrings(FTabs).GetHitTestInfoAt(X,Y); 798end; 799 800function TTabControl.IndexOfTabWithCaption(const TabCaption: string 801 ): Integer; 802begin 803 Result:=0; 804 while Result<Tabs.Count do begin 805 if CompareText(Tabs[Result],TabCaption)=0 then exit; 806 inc(Result); 807 end; 808 Result:=-1; 809end; 810 811function TTabControl.TabRect(Index: Integer): TRect; 812begin 813 Result:=TTabControlStrings(FTabs).TabRect(Index); 814end; 815 816function TTabControl.RowCount: Integer; 817begin 818 Result:=TTabControlStrings(FTabs).RowCount; 819end; 820 821procedure TTabControl.ScrollTabs(Delta: Integer); 822begin 823 TTabControlStrings(FTabs).ScrollTabs(Delta); 824end; 825 826procedure TTabControl.BeginUpdate; 827begin 828 if FTabs=nil then exit; 829 TTabControlStrings(FTabs).BeginUpdate; 830 //debugln('TTabControl.BeginUpdate ',dbgs(IsUpdating)); 831end; 832 833procedure TTabControl.EndUpdate; 834begin 835 if FTabs=nil then exit; 836 TTabControlStrings(FTabs).EndUpdate; 837 //debugln('TTabControl.EndUpdate ',dbgs(IsUpdating)); 838 if not TTabControlStrings(FTabs).IsUpdating then begin 839 if FOnChangeNeeded then Change; 840 end; 841end; 842 843function TTabControl.IsUpdating: boolean; 844begin 845 Result:=(FTabs<>nil) and TTabControlStrings(fTabs).IsUpdating; 846end; 847 848// included by comctrls.pp 849 850