1{ 2 /*************************************************************************** 3 extctrls.pp 4 ----------- 5 Component Library Extended Controls 6 Initial Revision : Sat Jul 26 12:04:35 PDT 1999 7 8 ***************************************************************************/ 9 10 ***************************************************************************** 11 This file is part of the Lazarus Component Library (LCL) 12 13 See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 for details about the license. 15 ***************************************************************************** 16} 17unit ExtCtrls; 18 19{$mode objfpc}{$H+} 20{$I lcl_defines.inc} 21 22interface 23 24{$ifdef Trace} 25{$ASSERTIONS ON} 26{$endif} 27 28uses 29 SysUtils, Types, Classes, contnrs, FGL, 30 // LCL 31 LCLStrConsts, LCLType, LCLProc, LResources, LMessages, Controls, Forms, 32 StdCtrls, GraphType, Graphics, LCLIntf, CustomTimer, Themes, LCLClasses, Menus, 33 PopupNotifier, ImgList, 34 // LazUtils 35 LazLoggerBase, LazUtilities; 36 37type 38 39 { TPage } 40 41 TPage = class; 42 43 TBeforeShowPageEvent = procedure (ASender: TObject; ANewPage: TPage; ANewIndex: Integer) of object; 44 TImagePaintBackgroundEvent = procedure (ASender: TObject; ACanvas: TCanvas; ARect: TRect) of object; 45 46 TPage = class(TCustomControl) 47 private 48 FOnBeforeShow: TBeforeShowPageEvent; 49 function GetPageIndex: Integer; 50 protected 51 procedure SetParent(AParent: TWinControl); override; 52 public 53 constructor Create(TheOwner: TComponent); override; 54 destructor Destroy; override; 55 public 56 property PageIndex: Integer read GetPageIndex; 57 published 58 // Lazarus-specific TPage events 59 // OnBeforeShow occurs before a page is displayed, so that 60 // preparations can be executed in it's user interface, for example 61 property OnBeforeShow: TBeforeShowPageEvent read FOnBeforeShow write FOnBeforeShow; 62 // Other events and properties 63 property BiDiMode; 64 property ChildSizing; 65 property Color; 66 property Left stored False; 67 property Top stored False; 68 property Width stored False; 69 property Height stored False; 70 property OnContextPopup; 71 property OnEnter; 72 property OnExit; 73 property OnMouseDown; 74 property OnMouseEnter; 75 property OnMouseLeave; 76 property OnMouseMove; 77 property OnMouseUp; 78 property OnMouseWheel; 79 property OnMouseWheelDown; 80 property OnMouseWheelUp; 81 property OnResize; 82 property ParentBiDiMode; 83 property ParentShowHint; 84 property PopupMenu; 85 property TabOrder stored False; 86 property TabStop; 87 property Visible stored False; 88 end; 89 90 { TUNBPages } 91 92 TNotebook = class; 93 94 TUNBPages = class(TStrings) 95 private 96 FPageList: TObjectList; 97 FNotebook: TNotebook; 98 function GetNotebookOwner: TComponent; 99 protected 100 function Get(Index: Integer): String; override; 101 function GetCount: Integer; override; 102 function GetObject(Index: Integer): TObject; override; 103 procedure Put(Index: Integer; const S: String); override; 104 public 105 constructor Create(theNotebook: TNotebook); 106 destructor Destroy; override; 107 function Add(const S: string): Integer; override; 108 function AddObject(const S: string; AObject: TObject): Integer; override; 109 procedure Clear; override; 110 procedure Delete(Index: Integer); override; 111 function IndexOfObject(AObject: TObject): Integer; override; 112 procedure Insert(Index: Integer; const S: string); override; 113// procedure Move(CurIndex, NewIndex: Integer); override; 114 end; 115 116 { TNotebook } 117 118 TNotebook = class(TCustomControl) 119 private 120 FPages: TStrings; // TUNBPages 121 FPageIndex: Integer; 122 function GetActivePage: String; 123 function GetActivePageComponent: TPage; 124 function GetPage(AIndex: Integer): TPage; 125 function GetPageCount : integer; 126 function GetPageIndex: Integer; 127{ function FindVisiblePage(Index: Integer): Integer;} 128{ procedure MovePage(APage: TCustomPage; NewIndex: Integer); 129 procedure RemovePage(Index: Integer); 130 procedure SetActivePage(const Value: String);} 131 procedure SetPageIndex(AValue: Integer); 132 procedure SetPages(Items: TStrings); 133 public 134 constructor Create(TheOwner: TComponent); override; 135 destructor Destroy; override; 136 procedure ShowControl(AControl: TControl); override; 137{ function TabIndexAtClientPos(ClientPos: TPoint): integer; 138 function TabRect(AIndex: Integer): TRect; 139 function GetImageIndex(ThePageIndex: Integer): Integer; virtual; 140 function CustomPage(Index: integer): TCustomPage;} 141 function IndexOf(APage: TPage): integer; 142 public 143 property ActivePage: String read GetActivePage;// write SetActivePage; // should not be published because the read can raise an exception 144 property ActivePageComponent: TPage read GetActivePageComponent;// write SetActivePage; // should not be published because the read can raise an exception 145 property Page[Index: Integer]: TPage read GetPage; 146 property PageCount: integer read GetPageCount; 147// property PageList: TList read FPageList; 148 published 149 // LCL TNotebook specific properties 150 property PageIndex: Integer read GetPageIndex write SetPageIndex default -1; 151 property Pages: TStrings read FPages write SetPages stored False; 152 // Generic properties 153 property Align; 154 property AutoSize; 155 property Anchors; 156 property BiDiMode; 157 property BorderSpacing; 158 property Color; 159 property Constraints; 160 property DragCursor; 161 property DragMode; 162 property Enabled; 163// property OnChange; 164 property OnChangeBounds; 165// property OnChanging; 166 property OnContextPopup; 167 property OnDragDrop; 168 property OnDragOver; 169 property OnEndDrag; 170 property OnEnter; 171 property OnExit; 172 property OnMouseDown; 173 property OnMouseEnter; 174 property OnMouseLeave; 175 property OnMouseMove; 176 property OnMouseUp; 177 property OnMouseWheel; 178 property OnMouseWheelDown; 179 property OnMouseWheelUp; 180 property OnResize; 181 property OnStartDrag; 182// property Options; 183// property PageIndex; 184 property ParentBiDiMode; 185 property PopupMenu; 186 property TabOrder; 187 property TabStop; 188 end; 189 190 { Timer } 191 192 TTimer = class (TCustomTimer) 193 published 194 property Enabled; 195 property Interval; 196 property OnTimer; 197 property OnStartTimer; 198 property OnStopTimer; 199 end; 200 201 202 { TIdleTimer 203 For example: 204 Do something after 2 seconds after user input and idle. 205 AutoEnabled:=true; 206 AutoStartEvent:=itaOnIdle; // start the timer on first idle 207 AutoEndEvent:=itaOnUserInput; // end on any user input 208 209 If the OnTimer event works in several chunks, set FireOnIdle:=true. 210 The OnTimer event will then be called on idle until FireOnIdle is false. 211 FireOnIdle is set to false on any user input. } 212 213 TIdleTimerAutoEvent = ( 214 itaOnIdle, 215 itaOnIdleEnd, 216 itaOnUserInput 217 ); 218 TIdleTimerAutoEvents = set of TIdleTimerAutoEvent; 219 220 { TCustomIdleTimer } 221 222 TCustomIdleTimer = class(TCustomTimer) 223 private 224 FAutoEnabled: boolean; 225 FAutoEndEvent: TIdleTimerAutoEvent; 226 FAutoStartEvent: TIdleTimerAutoEvent; 227 FFireOnIdle: boolean; 228 FHandlersConnected: boolean; 229 procedure UpdateHandlers; 230 protected 231 procedure SetAutoEnabled(const AValue: boolean); virtual; 232 procedure DoOnIdle(Sender: TObject; var Done: Boolean); virtual; 233 procedure DoOnIdleEnd(Sender: TObject); virtual; 234 procedure DoOnUserInput(Sender: TObject; Msg: Cardinal); virtual; 235 procedure Loaded; override; 236 public 237 constructor Create(TheOwner: TComponent); override; 238 destructor Destroy; override; 239 240 property AutoEnabled: boolean read FAutoEnabled 241 write SetAutoEnabled default False; 242 property AutoStartEvent: TIdleTimerAutoEvent read FAutoStartEvent 243 write FAutoStartEvent default itaOnIdle; 244 property AutoEndEvent: TIdleTimerAutoEvent read FAutoEndEvent 245 write FAutoEndEvent default itaOnUserInput; 246 property FireOnIdle: boolean read FFireOnIdle write FFireOnIdle default false; 247 end; 248 249 TIdleTimer = class(TCustomIdleTimer) 250 published 251 property AutoEnabled; 252 property AutoStartEvent; 253 property AutoEndEvent; 254 property Enabled; 255 property Interval; 256 property OnTimer; 257 property OnStartTimer; 258 property OnStopTimer; 259 end; 260 261 { TShape } 262 263 TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare, 264 stEllipse, stCircle, stSquaredDiamond, stDiamond, 265 stTriangle, stTriangleLeft, stTriangleRight, stTriangleDown, 266 stStar, stStarDown); 267 268 TShape = class(TGraphicControl) 269 private 270 FPen: TPen; 271 FBrush: TBrush; 272 FShape: TShapeType; 273 function GetStarAngle(N: Integer; ADown: boolean): Double; 274 procedure SetBrush(Value: TBrush); 275 procedure SetPen(Value: TPen); 276 procedure SetShape(Value: TShapeType); 277 protected 278 class procedure WSRegisterClass; override; 279 class function GetControlClassDefaultSize: TSize; override; 280 public 281 constructor Create(TheOwner: TComponent); override; 282 destructor Destroy; override; 283 procedure Paint; override; 284 procedure StyleChanged(Sender: TObject); 285 published 286 property Align; 287 property Anchors; 288 property BorderSpacing; 289 property Brush: TBrush read FBrush write SetBrush; 290 property Constraints; 291 property DragCursor; 292 property DragKind; 293 property DragMode; 294 property Enabled; 295 property ParentShowHint; 296 property Pen: TPen read FPen write SetPen; 297 property OnChangeBounds; 298 property OnDragDrop; 299 property OnDragOver; 300 property OnEndDock; 301 property OnEndDrag; 302 property OnMouseDown; 303 property OnMouseEnter; 304 property OnMouseLeave; 305 property OnMouseMove; 306 property OnMouseUp; 307 property OnMouseWheel; 308 property OnMouseWheelDown; 309 property OnMouseWheelUp; 310 property OnMouseWheelHorz; 311 property OnMouseWheelLeft; 312 property OnMouseWheelRight; 313 property OnPaint; 314 property OnResize; 315 property OnStartDock; 316 property OnStartDrag; 317 property Shape: TShapeType read FShape write SetShape default stRectangle; 318 property ShowHint; 319 property Visible; 320 end; 321 322 323 { TCustomSplitter } 324 325 TResizeStyle = ( 326 rsLine, // draw a line, don't update splitter position during moving 327 rsNone, // draw nothing and don't update splitter position during moving 328 rsPattern, // draw a dot pattern, don't update splitter position during moving 329 rsUpdate // draw nothing, update splitter position during moving 330 ); 331 332 TCanOffsetEvent = procedure(Sender: TObject; var NewOffset: Integer; 333 var Accept: Boolean) of object; 334 TCanResizeEvent = procedure(Sender: TObject; var NewSize: Integer; 335 var Accept: Boolean) of object; 336 { TCustomSplitter is a control to interactively resize another control. 337 It is a vertical or horizontal bar anchored to a side of a control. 338 You can either set the Align property to alLeft (alRight,alTop,alBottom), 339 then it will become a vertical bar, aligned to the left and when the user 340 moves it with the mouse, the control to the left with the same Align=alLeft 341 will be resized. 342 The second more flexible possibility is to set the properties Align=alNone, 343 AnchorSides and ResizeAnchor. 344 } 345 TCustomSplitter = class(TCustomControl) 346 private 347 FAutoSnap: boolean; 348 FBeveled: boolean; 349 FMinSize: integer; 350 FMouseInControl: Boolean; 351 FOnCanOffset: TCanOffsetEvent; 352 FOnCanResize: TCanResizeEvent; 353 FOnMoved: TNotifyEvent; 354 FResizeAnchor: TAnchorKind; 355 FResizeStyle: TResizeStyle; 356 FSplitDragging: Boolean; 357 FSplitterStartMouseXY: TPoint; // in screen coordinates 358 FSplitterStartLeftTop: TPoint; // in screen coordinates 359 FSplitterWindow: HWND; 360 function GetResizeControl: TControl; 361 procedure SetBeveled(const AValue: boolean); 362 procedure SetMinSize(const AValue: integer); 363 protected 364 procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED; 365 366 class procedure WSRegisterClass; override; 367 function AdaptAnchors(const a: TAnchors): TAnchors; 368 function CheckNewSize(var NewSize: Integer): Boolean; virtual; 369 function CheckOffset(var NewOffset: Integer): Boolean; virtual; 370 371 function FindAlignControl: TControl; 372 function FindAlignOtherControl: TControl; 373 374 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; 375 procedure MouseEnter; override; 376 procedure MouseLeave; override; 377 procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; 378 procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; 379 380 procedure Paint; override; 381 procedure SetAlign(Value: TAlign); override; 382 procedure SetAnchors(const AValue: TAnchors); override; 383 procedure SetResizeAnchor(const AValue: TAnchorKind); virtual; 384 procedure SetResizeControl(const AValue: TControl); virtual; 385 procedure StartSplitterMove(const MouseXY: TPoint); 386 procedure StopSplitterMove(const MouseXY: TPoint); 387 procedure UpdateCursor; virtual; 388 public 389 constructor Create(TheOwner: TComponent); override; 390 procedure AnchorSplitter(Kind: TAnchorKind; AControl: TControl); 391 property ResizeControl: TControl read GetResizeControl write SetResizeControl; 392 function GetOtherResizeControl: TControl; 393 procedure MoveSplitter(Offset: integer); virtual; 394 procedure SetSplitterPosition(NewPosition: integer); 395 function GetSplitterPosition: integer; 396 public 397 property Align default alLeft; 398 property AutoSnap: boolean read FAutoSnap write FAutoSnap default true; 399 property Beveled: boolean read FBeveled write SetBeveled default false; 400 property Cursor default crHSplit; 401 property MinSize: integer read FMinSize write SetMinSize default 30; 402 property OnCanOffset: TCanOffsetEvent read FOnCanOffset write FOnCanOffset; 403 property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize; 404 property OnMoved: TNotifyEvent read FOnMoved write FOnMoved; 405 property ResizeAnchor: TAnchorKind read FResizeAnchor write SetResizeAnchor default akLeft; 406 property ResizeStyle: TResizeStyle read FResizeStyle write FResizeStyle default rsUpdate; 407 end; 408 409 410 { TSplitter } 411 412 TSplitter = class(TCustomSplitter) 413 published 414 property Align; 415 property Anchors; 416 property AutoSnap; 417 property Beveled; 418 property Color; 419 property Constraints; 420 property Cursor; 421 property DoubleBuffered; 422 property Height; 423 property MinSize; 424 property OnCanOffset; 425 property OnCanResize; 426 property OnChangeBounds; 427 property OnMoved; 428 property OnMouseWheel; 429 property OnMouseWheelDown; 430 property OnMouseWheelUp; 431 property OnPaint; 432 property ParentColor; 433 property ParentDoubleBuffered; 434 property ParentShowHint; 435 property PopupMenu; 436 property ResizeAnchor; 437 property ResizeStyle; 438 property ShowHint; 439 property Visible; 440 property Width; 441 end; 442 443 444 { TPaintBox } 445 446 TPaintBox = class(TGraphicControl) 447 protected 448 class procedure WSRegisterClass; override; 449 procedure Paint; override; 450 class function GetControlClassDefaultSize: TSize; override; 451 public 452 constructor Create(AOwner: TComponent); override; 453 property Canvas; 454 published 455 property Align; 456 property Anchors; 457 property BorderSpacing; 458 property Color; 459 property Constraints; 460 property DragCursor; 461// property DragKind; 462 property DragMode; 463 property Enabled; 464 property Font; 465 property Hint; 466 property ParentColor; 467 property ParentFont; 468 property ParentShowHint; 469 property PopupMenu; 470 property ShowHint; 471 property Visible; 472 property OnChangeBounds; 473 property OnClick; 474 property OnContextPopup; 475 property OnDblClick; 476 property OnDragDrop; 477 property OnDragOver; 478// property OnEndDock; 479 property OnEndDrag; 480 property OnMouseDown; 481 property OnMouseEnter; 482 property OnMouseLeave; 483 property OnMouseMove; 484 property OnMouseUp; 485 property OnMouseWheel; 486 property OnMouseWheelDown; 487 property OnMouseWheelUp; 488 property OnPaint; 489 property OnResize; 490// property OnStartDock; 491 property OnStartDrag; 492 end; 493 494 495 { TCustomImage } 496 497 TCustomImage = class(TGraphicControl) 498 private 499 FAntialiasingMode: TAntialiasingMode; 500 FOnPictureChanged: TNotifyEvent; 501 FOnPaintBackground: TImagePaintBackgroundEvent; 502 FPicture: TPicture; 503 FCenter: Boolean; 504 FKeepOriginXWhenClipped: Boolean; 505 FKeepOriginYWhenClipped: Boolean; 506 FProportional: Boolean; 507 FTransparent: Boolean; 508 FStretch: Boolean; 509 FStretchOutEnabled: Boolean; 510 FStretchInEnabled: Boolean; 511 FUseAncestorCanvas: boolean; 512 FPainting: boolean; 513 function GetCanvas: TCanvas; 514 procedure SetAntialiasingMode(AValue: TAntialiasingMode); 515 procedure SetPicture(const AValue: TPicture); 516 procedure SetCenter(const AValue : Boolean); 517 procedure SetKeepOriginX(AValue: Boolean); 518 procedure SetKeepOriginY(AValue: Boolean); 519 procedure SetProportional(const AValue: Boolean); 520 procedure SetStretch(const AValue : Boolean); 521 procedure SetStretchInEnabled(AValue: Boolean); 522 procedure SetStretchOutEnabled(AValue: Boolean); 523 procedure SetTransparent(const AValue : Boolean); 524 protected 525 class procedure WSRegisterClass; override; 526 procedure PictureChanged(Sender : TObject); virtual; 527 procedure CalculatePreferredSize(var PreferredWidth, 528 PreferredHeight: integer; 529 WithThemeSpace: Boolean); override; 530 class function GetControlClassDefaultSize: TSize; override; 531 procedure Paint; override; 532 public 533 constructor Create(AOwner: TComponent); override; 534 destructor Destroy; override; 535 property Canvas: TCanvas read GetCanvas; 536 function DestRect: TRect; virtual; 537 procedure Invalidate; override; 538 public 539 property AntialiasingMode: TAntialiasingMode read FAntialiasingMode write SetAntialiasingMode default amDontCare; 540 property Align; 541 property AutoSize; 542 property Center: Boolean read FCenter write SetCenter default False; 543 property KeepOriginXWhenClipped: Boolean read FKeepOriginXWhenClipped write SetKeepOriginX default False; 544 property KeepOriginYWhenClipped: Boolean read FKeepOriginYWhenClipped write SetKeepOriginY default False; 545 property Constraints; 546 property Picture: TPicture read FPicture write SetPicture; 547 property Visible; 548 property OnClick; 549 property OnMouseDown; 550 property OnMouseEnter; 551 property OnMouseLeave; 552 property OnMouseMove; 553 property OnMouseUp; 554 property OnMouseWheel; 555 property OnMouseWheelDown; 556 property OnMouseWheelUp; 557 property Stretch: Boolean read FStretch write SetStretch default False; 558 property StretchOutEnabled: Boolean read FStretchOutEnabled write SetStretchOutEnabled default True; 559 property StretchInEnabled: Boolean read FStretchInEnabled write SetStretchInEnabled default True; 560 property Transparent: Boolean read FTransparent write SetTransparent default False; 561 property Proportional: Boolean read FProportional write SetProportional default False; 562 property OnPictureChanged: TNotifyEvent read FOnPictureChanged write FOnPictureChanged; 563 property OnPaintBackground: TImagePaintBackgroundEvent read FOnPaintBackground write FOnPaintBackground; 564 end; 565 566 567 { TImage } 568 569 TImage = class(TCustomImage) 570 published 571 property AntialiasingMode; 572 property Align; 573 property Anchors; 574 property AutoSize; 575 property BorderSpacing; 576 property Center; 577 property KeepOriginXWhenClipped; 578 property KeepOriginYWhenClipped; 579 property Constraints; 580 property DragCursor; 581 property DragMode; 582 property Enabled; 583 property OnChangeBounds; 584 property OnClick; 585 property OnContextPopup; 586 property OnDblClick; 587 property OnDragDrop; 588 property OnDragOver; 589 property OnEndDrag; 590 property OnMouseDown; 591 property OnMouseEnter; 592 property OnMouseLeave; 593 property OnMouseMove; 594 property OnMouseUp; 595 property OnMouseWheel; 596 property OnMouseWheelDown; 597 property OnMouseWheelUp; 598 property OnPaint; 599 property OnPictureChanged; 600 property OnPaintBackground; 601 property OnResize; 602 property OnStartDrag; 603 property ParentShowHint; 604 property Picture; 605 property PopupMenu; 606 property Proportional; 607 property ShowHint; 608 property Stretch; 609 property StretchOutEnabled; 610 property StretchInEnabled; 611 property Transparent; 612 property Visible; 613 end; 614 615 616 { TBevel } 617 618 TBevelStyle = (bsLowered, bsRaised); 619 TBevelShape=(bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine, bsSpacer); 620 621 TBevel = class(TGraphicControl) 622 private 623 FStyle:TBevelStyle; 624 FShape:TBevelShape; 625 procedure SetStyle(AStyle: TBevelStyle); 626 procedure SetShape(AShape: TBevelShape); 627 protected 628 class procedure WSRegisterClass; override; 629 class function GetControlClassDefaultSize: TSize; override; 630 procedure Paint; override; 631 public 632 constructor Create(AOwner:TComponent); override; 633 destructor Destroy; override; 634 procedure Assign(Source: TPersistent); override; 635 published 636 property Align; 637 property Anchors; 638 property BorderSpacing; 639 property Constraints; 640 property ParentShowHint; 641 property Shape: TBevelShape read FShape write SetShape default bsBox; 642 property ShowHint; 643 property Style: TBevelStyle read FStyle write SetStyle default bsLowered; 644 property Visible; 645 property OnChangeBounds; 646 property OnResize; 647 property OnMouseDown; 648 property OnMouseEnter; 649 property OnMouseLeave; 650 property OnMouseMove; 651 property OnMouseUp; 652 property OnMouseWheel; 653 property OnMouseWheelDown; 654 property OnMouseWheelUp; 655 property OnPaint; 656 end; 657 658 659 { TCustomRadioGroup } 660 661 TColumnLayout = ( 662 clHorizontalThenVertical, 663 clVerticalThenHorizontal 664 ); 665 666 TCustomRadioGroup = class(TCustomGroupBox) 667 private 668 FAutoFill: Boolean; 669 FButtonList: TFPList; // list of TRadioButton 670 FColumnLayout: TColumnLayout; 671 FColumns: integer; 672 FCreatingWnd: boolean; 673 FHiddenButton: TRadioButton; 674 FIgnoreClicks: boolean; 675 FItemIndex: integer; 676 FItems: TStrings; 677 FLastClickedItemIndex: integer; 678 FOnClick: TNotifyEvent; 679 FOnSelectionChanged: TNotifyEvent; 680 FReading: boolean; 681 FUpdatingItems: Boolean; 682 procedure Changed(Sender: TObject); 683 procedure Clicked(Sender: TObject); 684 procedure ItemEnter(Sender: TObject); 685 procedure ItemExit(Sender: TObject); 686 procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 687 procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 688 procedure ItemKeyPress(Sender: TObject; var Key: Char); 689 procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); 690 procedure ItemResize(Sender: TObject); 691 procedure SetAutoFill(const AValue: Boolean); 692 procedure SetColumnLayout(const AValue: TColumnLayout); 693 procedure UpdateControlsPerLine; 694 procedure UpdateItems; 695 procedure UpdateTabStops; 696 protected 697 class procedure WSRegisterClass; override; 698 procedure UpdateInternalObjectList; 699 procedure UpdateAll; 700 procedure InitializeWnd; override; 701 procedure UpdateRadioButtonStates; virtual; 702 procedure ReadState(Reader: TReader); override; 703 procedure SetItems(Value: TStrings); 704 procedure SetColumns(Value: integer); 705 procedure SetItemIndex(Value: integer); 706 function GetItemIndex: integer; 707 procedure CheckItemIndexChanged; virtual; 708 public 709 constructor Create(TheOwner: TComponent); override; 710 destructor Destroy; override; 711 function CanModify: boolean; virtual; 712 procedure FlipChildren(AllLevels: Boolean); override; 713 function Rows: integer; 714 public 715 property AutoFill: Boolean read FAutoFill write SetAutoFill; 716 property ItemIndex: integer read GetItemIndex write SetItemIndex default -1; 717 property Items: TStrings read FItems write SetItems; 718 property Columns: integer read FColumns write SetColumns default 1; 719 property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical; 720 property OnClick: TNotifyEvent read FOnClick write FOnClick; 721 property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged; 722 end; 723 724 725 { TRadioGroup } 726 727 TRadioGroup = class(TCustomRadioGroup) 728 published 729 property Align; 730 property Anchors; 731 property AutoFill; 732 property AutoSize; 733 property BidiMode; 734 property BorderSpacing; 735 property Caption; 736 property ChildSizing; 737 property ClientHeight; 738 property ClientWidth; 739 property Color; 740 property ColumnLayout; 741 property Columns; 742 property Constraints; 743 property DoubleBuffered; 744 property DragCursor; 745 property DragMode; 746 property Enabled; 747 property Font; 748 property ItemIndex; 749 property Items; 750 property OnChangeBounds; 751 property OnClick; 752 property OnDblClick; 753 property OnDragDrop; 754 property OnDragOver; 755 property OnEndDrag; 756 property OnEnter; 757 property OnExit; 758 property OnKeyDown; 759 property OnKeyPress; 760 property OnKeyUp; 761 property OnMouseDown; 762 property OnMouseEnter; 763 property OnMouseLeave; 764 property OnMouseMove; 765 property OnMouseUp; 766 property OnMouseWheel; 767 property OnMouseWheelDown; 768 property OnMouseWheelUp; 769 property OnResize; 770 property OnSelectionChanged; 771 property OnStartDrag; 772 property OnUTF8KeyPress; 773 property ParentBidiMode; 774 property ParentFont; 775 property ParentColor; 776 property ParentDoubleBuffered; 777 property ParentShowHint; 778 property PopupMenu; 779 property ShowHint; 780 property TabOrder; 781 property TabStop; 782 property Visible; 783 end; 784 785 786 { TCustomCheckGroup } 787 788 TCheckGroupClicked = procedure(Sender: TObject; Index: integer) of object; 789 790 TCustomCheckGroup = class(TCustomGroupBox) 791 private 792 FAutoFill: boolean; 793 FButtonList: TList; // list of TCheckBox 794 FColumnLayout: TColumnLayout; 795 FCreatingWnd: boolean; 796 FItems: TStrings; 797 FColumns: integer; 798 FOnItemClick: TCheckGroupClicked; 799 FUpdatingItems: Boolean; 800 function GetChecked(Index: integer): boolean; 801 function GetCheckEnabled(Index: integer): boolean; 802 procedure Clicked(Sender: TObject); 803 procedure DoClick(Index: integer); 804 procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 805 procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 806 procedure ItemKeyPress(Sender: TObject; var Key: Char); 807 procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); 808 procedure RaiseIndexOutOfBounds(Index: integer ); 809 procedure SetAutoFill(const AValue: boolean); 810 procedure SetChecked(Index: integer; const AValue: boolean); 811 procedure SetCheckEnabled(Index: integer; const AValue: boolean); 812 procedure SetColumnLayout(const AValue: TColumnLayout); 813 procedure UpdateItems; 814 procedure UpdateControlsPerLine; 815 protected 816 class procedure WSRegisterClass; override; 817 procedure UpdateInternalObjectList; 818 procedure UpdateAll; 819 procedure SetItems(Value: TStrings); 820 procedure SetColumns(Value: integer); 821 procedure DefineProperties(Filer: TFiler); override; 822 procedure ReadData(Stream: TStream); 823 procedure WriteData(Stream: TStream); 824 procedure Loaded; override; 825 procedure DoOnResize; override; 826 public 827 constructor Create(TheOwner: TComponent); override; 828 destructor Destroy; override; 829 procedure FlipChildren(AllLevels: Boolean); override; 830 function Rows: integer; 831 public 832 property AutoFill: boolean read FAutoFill write SetAutoFill; 833 property Items: TStrings read FItems write SetItems; 834 property Checked[Index: integer]: boolean read GetChecked write SetChecked; 835 property CheckEnabled[Index: integer]: boolean read GetCheckEnabled write SetCheckEnabled; 836 property Columns: integer read FColumns write SetColumns default 1; 837 property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical; 838 property OnItemClick: TCheckGroupClicked read FOnItemClick write FOnItemClick; 839 end; 840 841 842 { TCheckGroup } 843 844 TCheckGroup = class(TCustomCheckGroup) 845 published 846 property Align; 847 property Anchors; 848 property AutoFill; 849 property AutoSize; 850 property BiDiMode; 851 property BorderSpacing; 852 property Caption; 853 property ChildSizing; 854 property ClientHeight; 855 property ClientWidth; 856 property Color; 857 property ColumnLayout; 858 property Columns; 859 property Constraints; 860 property DoubleBuffered; 861 property DragCursor; 862 property DragMode; 863 property Enabled; 864 property Font; 865 property Items; 866 property OnChangeBounds; 867 property OnClick; 868 property OnDblClick; 869 property OnDragDrop; 870 property OnDragOver; 871 property OnEndDrag; 872 property OnEnter; 873 property OnExit; 874 property OnItemClick; 875 property OnKeyDown; 876 property OnKeyPress; 877 property OnKeyUp; 878 property OnMouseDown; 879 property OnMouseEnter; 880 property OnMouseLeave; 881 property OnMouseMove; 882 property OnMouseUp; 883 property OnMouseWheel; 884 property OnMouseWheelDown; 885 property OnMouseWheelUp; 886 property OnResize; 887 property OnStartDrag; 888 property OnUTF8KeyPress; 889 property ParentBiDiMode; 890 property ParentFont; 891 property ParentColor; 892 property ParentDoubleBuffered; 893 property ParentShowHint; 894 property PopupMenu; 895 property ShowHint; 896 property TabOrder; 897 property TabStop; 898 property Visible; 899 end; 900 901 902 { TBoundLabel } 903 904 TBoundLabel = class(TCustomLabel) 905 public 906 constructor Create(TheOwner: TComponent); override; 907 property FocusControl; 908 published 909 property AnchorSideLeft stored False; 910 property AnchorSideTop stored False; 911 property AnchorSideRight stored False; 912 property AnchorSideBottom stored False; 913 property Left stored False; 914 property Top stored False; 915 property Caption; 916 property Color; 917 property DragCursor; 918 property DragMode; 919 property Height; 920 property ParentColor; 921 property ParentFont; 922 property ParentShowHint; 923 property Font; 924 property PopupMenu; 925 property ShowAccelChar; 926 property ShowHint; 927 property Layout; 928 property WordWrap; 929 property OnClick; 930 property OnDblClick; 931 property OnDragDrop; 932 property OnDragOver; 933 property OnEndDrag; 934 property OnMouseDown; 935 property OnMouseEnter; 936 property OnMouseLeave; 937 property OnMouseMove; 938 property OnMouseUp; 939 property OnMouseWheel; 940 property OnMouseWheelDown; 941 property OnMouseWheelUp; 942 //property OnEnter; 943 //property OnExit; 944 property OnStartDrag; 945 end; 946 947 948 { TCustomLabeledEdit } 949 950 TLabelPosition = (lpAbove, lpBelow, lpLeft, lpRight); 951 952 TCustomLabeledEdit = class(TCustomEdit) 953 private 954 FEditLabel: TBoundLabel; 955 FLabelPosition: TLabelPosition; 956 FLabelSpacing: Integer; 957 procedure SetLabelPosition(const Value: TLabelPosition); 958 procedure SetLabelSpacing(const Value: Integer); 959 protected 960 class procedure WSRegisterClass; override; 961 procedure SetParent(AParent: TWinControl); override; 962 procedure SetName(const Value: TComponentName); override; 963 procedure Loaded; override; 964 procedure DoPositionLabel; virtual; 965 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 966 procedure CMBiDiModeChanged(var Msg: TLMessage); message CM_BIDIMODECHANGED; 967 procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED; 968 procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED; 969 procedure CreateInternalLabel; virtual; 970 public 971 constructor Create(TheOwner: TComponent); override; 972 property EditLabel: TBoundLabel read FEditLabel; 973 property LabelPosition: TLabelPosition read FLabelPosition 974 write SetLabelPosition default lpAbove; 975 property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing 976 default 3; 977 end; 978 979 980 { TLabeledEdit } 981 982 TLabeledEdit = class(TCustomLabeledEdit) 983 published 984 property Alignment; 985 property Anchors; 986 property AutoSelect; 987 property AutoSize; 988 property BidiMode; 989 property BorderSpacing; 990 property BorderStyle; 991 property CharCase; 992 property Color; 993 property Constraints; 994 property DoubleBuffered; 995 property DragCursor; 996 property DragMode; 997 property EchoMode; 998 property EditLabel; 999 property Enabled; 1000 property Font; 1001 property LabelPosition; 1002 property LabelSpacing; 1003 property MaxLength; 1004 property ParentBidiMode; 1005 property ParentColor; 1006 property ParentDoubleBuffered; 1007 property ParentFont; 1008 property ParentShowHint; 1009 property PasswordChar; 1010 property PopupMenu; 1011 property ReadOnly; 1012 property ShowHint; 1013 property TabOrder; 1014 property TabStop; 1015 property Text; 1016 property TextHint; 1017 property Visible; 1018 property OnChange; 1019 property OnClick; 1020 property OnDblClick; 1021 property OnDragDrop; 1022 property OnDragOver; 1023 property OnEditingDone; 1024 property OnEndDrag; 1025 property OnEnter; 1026 property OnExit; 1027 property OnKeyDown; 1028 property OnKeyPress; 1029 property OnKeyUp; 1030 property OnMouseDown; 1031 property OnMouseEnter; 1032 property OnMouseLeave; 1033 property OnMouseMove; 1034 property OnMouseUp; 1035 property OnMouseWheel; 1036 property OnMouseWheelDown; 1037 property OnMouseWheelUp; 1038 property OnStartDrag; 1039 property OnUTF8KeyPress; 1040 end; 1041 1042 1043 { TCustomPanel } 1044 1045 TPanelBevel = TBevelCut; 1046 TBevelWidth = 1..Maxint; 1047 1048 TCustomPanel = class(TCustomControl) 1049 private 1050 FBevelColor : TColor; 1051 FBevelInner, FBevelOuter : TPanelBevel; 1052 FBevelWidth : TBevelWidth; 1053 FAlignment : TAlignment; 1054 FFullRepaint: Boolean; 1055 FWordWrap: Boolean; 1056 procedure PaintBevel(var ARect: TRect; ABevel: TPanelBevel); 1057 procedure SetAlignment(const Value : TAlignment); 1058 procedure SetBevelColor(AValue: TColor); 1059 procedure SetBevelInner(const Value: TPanelBevel); 1060 procedure SetBevelOuter(const Value: TPanelBevel); 1061 procedure SetBevelWidth(const Value: TBevelWidth); 1062 procedure SetWordwrap(const Value: Boolean); 1063 protected 1064 class procedure WSRegisterClass; override; 1065 procedure AdjustClientRect(var aRect: TRect); override; 1066 class function GetControlClassDefaultSize: TSize; override; 1067 procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; 1068 function GetDefaultDockCaption: String; override; 1069 procedure Loaded; override; 1070 procedure RealSetText(const Value: TCaption); override; 1071 procedure Paint; override; 1072 procedure SetParentBackground(const AParentBackground: Boolean); override; 1073 procedure UpdateParentColorChange; 1074 property WordWrap: Boolean read FWordwrap write SetWordwrap default false; 1075 public 1076 constructor Create(TheOwner: TComponent); override; 1077 property Align default alNone; 1078 property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; 1079 property BevelColor: TColor read FBevelColor write SetBevelColor default clDefault; 1080 property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone; 1081 property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised; 1082 property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; 1083 property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}; 1084 property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True; // exists only for Delphi compatibility, has no effect in LCL 1085 property ParentBackground default true; 1086 property ParentColor default true; 1087 property TabStop default False; 1088 end; 1089 1090 1091 { TPanel } 1092 1093 TPanel = class(TCustomPanel) 1094 published 1095 property Align; 1096 property Alignment; 1097 property Anchors; 1098 property AutoSize; 1099 property BorderSpacing; 1100 property BevelColor; 1101 property BevelInner; 1102 property BevelOuter; 1103 property BevelWidth; 1104 property BidiMode; 1105 property BorderWidth; 1106 property BorderStyle; 1107 property Caption; 1108 property ChildSizing; 1109 property ClientHeight; 1110 property ClientWidth; 1111 property Color; 1112 property Constraints; 1113 property DockSite; 1114 property DoubleBuffered; 1115 property DragCursor; 1116 property DragKind; 1117 property DragMode; 1118 property Enabled; 1119 property Font; 1120 property FullRepaint; 1121 property ParentBackground; 1122 property ParentBidiMode; 1123 property ParentColor; 1124 property ParentDoubleBuffered; 1125 property ParentFont; 1126 property ParentShowHint; 1127 property PopupMenu; 1128 property ShowHint; 1129 property TabOrder; 1130 property TabStop; 1131 property UseDockManager default True; 1132 property Visible; 1133 property Wordwrap; 1134 property OnClick; 1135 property OnContextPopup; 1136 property OnDockDrop; 1137 property OnDockOver; 1138 property OnDblClick; 1139 property OnDragDrop; 1140 property OnDragOver; 1141 property OnEndDock; 1142 property OnEndDrag; 1143 property OnEnter; 1144 property OnExit; 1145 property OnGetSiteInfo; 1146 property OnGetDockCaption; 1147 property OnMouseDown; 1148 property OnMouseEnter; 1149 property OnMouseLeave; 1150 property OnMouseMove; 1151 property OnMouseUp; 1152 property OnMouseWheel; 1153 property OnMouseWheelDown; 1154 property OnMouseWheelUp; 1155 property OnPaint; 1156 property OnResize; 1157 property OnStartDock; 1158 property OnStartDrag; 1159 property OnUnDock; 1160 end; 1161 1162 { TCustomFlowPanel } 1163 1164 TFlowPanel = class; 1165 TCustomFlowPanel = class; 1166 TFlowPanelControl = class; 1167 TFlowPanelControlList = class; 1168 1169 TFlowStyle = (fsLeftRightTopBottom, fsRightLeftTopBottom, fsLeftRightBottomTop, fsRightLeftBottomTop, 1170 fsTopBottomLeftRight, fsBottomTopLeftRight, fsTopBottomRightLeft, fsBottomTopRightLeft); 1171 1172 TWrapAfter = ( 1173 waAuto, // auto 1174 waForce, // always wrap after this control 1175 waAvoid, // try not to wrap after this control, if the control is already at the beginning of the row, wrap though 1176 waForbid); // never wrap after this control 1177 1178 TFlowPanelControl = class(TCollectionItem) 1179 private 1180 FControl: TControl; 1181 FWrapAfter: TWrapAfter; 1182 procedure SetControl(const aControl: TControl); 1183 procedure SetWrapAfter(const AWrapAfter: TWrapAfter); 1184 protected 1185 procedure SetIndex(Value: Integer); override; 1186 procedure AssignTo(Dest: TPersistent); override; 1187 function FPCollection: TFlowPanelControlList; 1188 function FPOwner: TCustomFlowPanel; 1189 published 1190 property Control: TControl read FControl write SetControl; 1191 property WrapAfter: TWrapAfter read FWrapAfter write SetWrapAfter; 1192 property Index; 1193 end; 1194 1195 TFlowPanelControlList = class(TOwnedCollection) 1196 private 1197 function GetItem(Index: Integer): TFlowPanelControl; 1198 procedure SetItem(Index: Integer; const AItem: TFlowPanelControl); 1199 protected 1200 function FPOwner: TCustomFlowPanel; 1201 1202 function Add: TFlowPanelControl; 1203 procedure AddControl(AControl: TControl; AIndex: Integer = -1); 1204 procedure RemoveControl(AControl: TControl); 1205 public 1206 constructor Create(AOwner: TPersistent); 1207 public 1208 function IndexOf(AControl: TControl): Integer; 1209 1210 property Items[Index: Integer]: TFlowPanelControl read GetItem write SetItem; default; 1211 end; 1212 1213 TCustomFlowPanel = class(TCustomPanel) 1214 private 1215 FControlList: TFlowPanelControlList; 1216 FAutoWrap: Boolean; 1217 FFlowStyle: TFlowStyle; 1218 FFlowLayout: TTextLayout; 1219 procedure SetAutoWrap(const AAutoWrap: Boolean); 1220 procedure SetControlList(const AControlList: TFlowPanelControlList); 1221 procedure SetFlowLayout(const aFlowLayout: TTextLayout); 1222 procedure SetFlowStyle(const AFlowStyle: TFlowStyle); 1223 protected 1224 procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE; 1225 1226 procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override; 1227 procedure CalculatePreferredSize( 1228 var PreferredWidth, PreferredHeight: integer; 1229 WithThemeSpace: Boolean); override; 1230 public 1231 constructor Create(AOwner: TComponent); override; 1232 destructor Destroy; override; 1233 public 1234 function GetControlIndex(AControl: TControl): Integer; 1235 procedure SetControlIndex(AControl: TControl; Index: Integer); 1236 1237 property AutoWrap: Boolean read FAutoWrap write SetAutoWrap; 1238 property ControlList: TFlowPanelControlList read FControlList write SetControlList; 1239 property FlowStyle: TFlowStyle read FFlowStyle write SetFlowStyle; 1240 property FlowLayout: TTextLayout read FFlowLayout write SetFlowLayout; 1241 end; 1242 1243 TFlowPanel = class(TCustomFlowPanel) 1244 published 1245 property Align; 1246 property Alignment; 1247 property Anchors; 1248 property AutoSize; 1249 property AutoWrap default True; 1250 property BevelInner; 1251 property BevelOuter; 1252 property BevelWidth; 1253 property BiDiMode; 1254 property BorderWidth; 1255 property BorderSpacing; 1256 property BorderStyle; 1257 property Caption; 1258 property Color; 1259 property Constraints; 1260 property ControlList; 1261 property UseDockManager default True; 1262 property DockSite; 1263 property DoubleBuffered; 1264 property DragCursor; 1265 property DragKind; 1266 property DragMode; 1267 property Enabled; 1268 property FlowLayout; 1269 property FlowStyle; 1270 property FullRepaint; 1271 property Font; 1272 property ParentBiDiMode; 1273 property ParentColor; 1274 property ParentDoubleBuffered; 1275 property ParentFont; 1276 property ParentShowHint; 1277 property PopupMenu; 1278 property ShowHint; 1279 property TabOrder; 1280 property TabStop; 1281 property Visible; 1282 property OnAlignInsertBefore; 1283 property OnAlignPosition; 1284 property OnClick; 1285 property OnConstrainedResize; 1286 property OnContextPopup; 1287 property OnDockDrop; 1288 property OnDockOver; 1289 property OnDblClick; 1290 property OnDragDrop; 1291 property OnDragOver; 1292 property OnEndDock; 1293 property OnEndDrag; 1294 property OnEnter; 1295 property OnExit; 1296 property OnGetSiteInfo; 1297 property OnMouseDown; 1298 property OnMouseEnter; 1299 property OnMouseLeave; 1300 property OnMouseMove; 1301 property OnMouseUp; 1302 property OnResize; 1303 property OnStartDock; 1304 property OnStartDrag; 1305 property OnUnDock; 1306 end; 1307 1308 { TCustomTrayIcon } 1309 1310 TBalloonFlags = (bfNone, bfInfo, bfWarning, bfError); 1311 1312 TCustomTrayIcon = class(TLCLComponent) 1313 private 1314 FDelayedShowing: Boolean; 1315 FAnimate: Boolean; 1316 FAnimateTimer: TTimer; 1317 FCurAnimationStep: Integer; 1318 FBalloonFlags: TBalloonFlags; 1319 FBalloonHint: string; 1320 FBalloonTimeout: Integer; 1321 FBalloonTitle: string; 1322 FPopUpMenu: TPopupMenu; 1323 FIcon: TIcon; 1324 FIcons: TCustomImageList; 1325 FHint: string; 1326 FVisible, FShowIcon: Boolean; 1327 FNotifier: TPopupNotifier; 1328 FTimer: TTimer; 1329 FOnPaint, FOnClick, FOnDblClick: TNotifyEvent; 1330 FOnMouseDown, FOnMouseUp: TMouseEvent; 1331 FOnMouseMove: TMouseMoveEvent; 1332 function GetAnimateInterval: Cardinal; 1333 function GetCanvas: TCanvas; 1334 function InternalShow: Boolean; 1335 procedure SetAnimate(const AValue: Boolean); 1336 procedure SetAnimateInterval(const AValue: Cardinal); 1337 procedure SetHint(const AValue: string); 1338 procedure SetIcon(const AValue: TIcon); 1339 procedure SetIcons(const AValue: TCustomImageList); 1340 procedure SetPopUpMenu(const AValue: TPopupMenu); 1341 procedure SetVisible(Value: Boolean); 1342 procedure HandleNotifierClose(Sender: TObject; var CloseAction: TCloseAction); 1343 procedure HandleNotifierTimeout(Sender: TObject); 1344 procedure HandleOnAnimateTimer(Sender: TObject); 1345 procedure IconChanged(Sender: TObject); 1346 protected 1347 class procedure WSRegisterClass; override; 1348 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 1349 procedure Loaded; override; 1350 public 1351 Handle: HWND; 1352 constructor Create(TheOwner: TComponent); override; 1353 destructor Destroy; override; 1354 function Hide: Boolean; 1355 function Show: Boolean; 1356 procedure InternalUpdate; 1357 procedure ShowBalloonHint; 1358 function GetPosition: TPoint; 1359 { Properties } 1360 property Animate: Boolean read FAnimate write SetAnimate default False; 1361 property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000; 1362 property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone; 1363 property BalloonHint: string read FBalloonHint write FBalloonHint; 1364 property BalloonTimeout: Integer read FBalloonTimeout write FBalloonTimeout default 3000; 1365 property BalloonTitle: string read FBalloonTitle write FBalloonTitle; 1366 property Canvas: TCanvas read GetCanvas; 1367 property PopUpMenu: TPopupMenu read FPopUpMenu write SetPopUpMenu; 1368 property Icon: TIcon read FIcon write SetIcon; 1369 property Icons: TCustomImageList read FIcons write SetIcons; 1370 property Hint: string read FHint write SetHint; 1371 property ShowIcon: Boolean read FShowIcon write FShowIcon default True; 1372 property Visible: Boolean read FVisible write SetVisible default False; 1373 { Events } 1374 property OnClick: TNotifyEvent read FOnClick write FOnClick; 1375 property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; 1376 property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; 1377 property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; 1378 property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; 1379 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; 1380 end; 1381 1382 { TTrayIcon } 1383 1384 TTrayIcon = class(TCustomTrayIcon) 1385 published 1386 property BalloonFlags; 1387 property BalloonHint; 1388 property BalloonTimeout; 1389 property BalloonTitle; 1390 property PopUpMenu; 1391 property Icon; 1392 property Hint; 1393 property Visible; 1394 property OnClick; 1395 property OnDblClick; 1396 property OnMouseDown; 1397 property OnMouseMove; 1398 property OnMouseUp; 1399 property OnPaint; 1400 end; 1401 1402 { TControlBar } 1403 1404 TBandDrawingStyle = (dsNormal, dsGradient); 1405 TBandPaintOption = (bpoGrabber, bpoFrame, bpoGradient, bpoRoundRect); 1406 TBandPaintOptions = set of TBandPaintOption; 1407 1408 TBandDragEvent = procedure (Sender: TObject; Control: TControl; var Drag: Boolean) of object; 1409 TBandInfoEvent = procedure (Sender: TObject; Control: TControl; 1410 var Insets: TRect; var PreferredSize, RowCount: Integer) of object; 1411 TBandMoveEvent = procedure (Sender: TObject; Control: TControl; var ARect: TRect) of object; 1412 TBandPaintEvent = procedure (Sender: TObject; Control: TControl; ACanvas: TCanvas; 1413 var ARect: TRect; var Options: TBandPaintOptions) of object; 1414 1415 TRowSize = 1..MaxInt; 1416 1417 TBandMove = (bmNone, bmReady, bmMoving); 1418 TCursorDesign = (cdDefault, cdGrabber, cdRestricted); 1419 1420{ BiDi is Left to Right: 1421 +----------------------------------------------------------------------------+ 1422 | cBandBorder + |cGrabWidth| + cBandBorder + [ Control.Width ] + cBandBorder | 1423 +----------------------------------------------------------------------------+ 1424 | cFullGrabber | } 1425 1426 { TCtrlBand } 1427 TCtrlBand = class 1428 private 1429 FControl: TControl; 1430 FControlHeight: Integer; 1431 FControlLeft: Integer; 1432 FControlTop: Integer; 1433 FControlVisible: Boolean; 1434 FControlWidth: Integer; 1435 FHeight: Integer; 1436 FInitLeft: Integer; 1437 FInitTop: Integer; 1438 FLeft: Integer; 1439 FTop: Integer; 1440 FVisible: Boolean; 1441 FWidth: Integer; 1442 function GetBandRect: TRect; 1443 function GetBottom: Integer; 1444 function GetRight: Integer; 1445 procedure SetBandRect(AValue: TRect); 1446 procedure SetRight(AValue: Integer); 1447 public 1448 property BandRect: TRect read GetBandRect write SetBandRect; 1449 property Bottom: Integer read GetBottom; 1450 property Control: TControl read FControl write FControl; 1451 property ControlHeight: Integer read FControlHeight write FControlHeight; 1452 property ControlLeft: Integer read FControlLeft write FControlLeft; 1453 property ControlTop: Integer read FControlTop write FControlTop; 1454 property ControlWidth: Integer read FControlWidth write FControlWidth; 1455 property ControlVisible: Boolean read FControlVisible write FControlVisible; 1456 property Height: Integer read FHeight write FHeight; 1457 property InitLeft: Integer read FInitLeft write FInitLeft; 1458 property InitTop: Integer read FInitTop write FInitTop; 1459 property Left: Integer read FLeft write FLeft; 1460 property Right: Integer read GetRight write SetRight; 1461 property Top: Integer read FTop write FTop; 1462 property Visible: Boolean read FVisible write FVisible; 1463 property Width: Integer read FWidth write FWidth; 1464 end; 1465 1466 { TCtrlBands } 1467 1468 TCtrlBands = class ({$IFDEF FPDoc}TFPGObjectList{$ELSE}specialize TFPGObjectList<TCtrlBand>{$ENDIF}) 1469 public 1470 function GetIndex(AControl: TControl): Integer; 1471 end; 1472 1473 { TCustomControlBar } 1474 1475 TCustomControlBar = class(TCustomPanel) 1476 private 1477 FAutoDrag: Boolean; 1478 FAutoDock: Boolean; 1479 FDrawingStyle: TBandDrawingStyle; 1480 FGradientDirection: TGradientDirection; 1481 FGradientEndColor: TColor; 1482 FGradientStartColor: TColor; 1483 FPicture: TPicture; 1484 FRowSize: TRowSize; 1485 FRowSnap: Boolean; 1486 FOnBandDrag: TBandDragEvent; 1487 FOnBandInfo: TBandInfoEvent; 1488 FOnBandMove: TBandMoveEvent; 1489 FOnBandPaint: TBandPaintEvent; 1490 FOnCanResize: TCanResizeEvent; 1491 FOnPaint: TNotifyEvent; 1492 procedure SetDrawingStyle(AValue: TBandDrawingStyle); 1493 procedure SetGradientDirection(AValue: TGradientDirection); 1494 procedure SetGradientEndColor(AValue: TColor); 1495 procedure SetGradientStartColor(AValue: TColor); 1496 procedure SetPicture(aValue: TPicture); 1497 procedure SetRowSize(AValue: TRowSize); 1498 protected const 1499 cBandBorderH: SmallInt = 4; 1500 cBandBorderV: SmallInt = 2; 1501 cGrabWidth: SmallInt = 3; 1502 protected 1503 class var cFullGrabber: SmallInt; 1504 protected 1505 FBands: TCtrlBands; 1506 FBandMove: TBandMove; 1507 FCursorLock: Boolean; 1508 FDefCursor: TCursor; 1509 FHoveredBand: TCtrlBand; 1510 FInitDrag: TPoint; 1511 FInnerBevelWidth: SmallInt; 1512 FLockResize: Boolean; 1513 FPrevWidth: Integer; 1514 FVisiBands: array of TCtrlBand; 1515 FVisiBandsEx: array of TCtrlBand; 1516 procedure AlignControlToBand(ABand: TCtrlBand; ARightToLeft: Boolean); 1517 procedure AlignControlsToBands; 1518 function CalcBandHeight(AControl: TControl): Integer; 1519 function CalcBandHeightSnapped(AControl: TControl): Integer; 1520 function CalcInnerBevelWidth: Integer; 1521 function CalcLowestBandBottomPx: Integer; 1522 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; 1523 {%H-}WithThemeSpace: Boolean); override; 1524 procedure ChangeCursor(ACursor: TCursorDesign); 1525 procedure CheckBandsSizeAndVisibility; 1526 procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; 1527 procedure CMBorderChanged(var Message: TLMessage); message CM_BORDERCHANGED; 1528 procedure CreateWnd; override; 1529 procedure DoBandMove(AControl: TControl; var ARect: TRect); virtual; 1530 procedure DoBandPaint(AControl: TControl; ACanvas: TCanvas; var ARect: TRect; 1531 var AOptions: TBandPaintOptions); virtual; 1532 function DragControl(AControl: TControl; X, Y: Integer; 1533 KeepCapture: Boolean = False): Boolean; virtual; 1534 procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; 1535 var Accept: Boolean); override; 1536 procedure GetControlInfo(AControl: TControl; var Insets: TRect; 1537 var PreferredSize, RowCount: Integer); virtual; 1538 class constructor InitializeClass; 1539 procedure InitializeBand(ABand: TCtrlBand; AKeepPos: Boolean); 1540 procedure InitializeMove(AMovingBand: TCtrlBand); 1541 procedure Loaded; override; 1542 function IsBandOverlap(ARect, BRect: TRect): Boolean; 1543 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 1544 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 1545 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 1546 procedure MoveBand(AMoveBand: TCtrlBand; X, Y: Integer; ByMouse: Boolean); 1547 procedure NormalizeRows; 1548 procedure Paint; override; 1549 procedure PictureChanged(Sender: TObject); 1550 procedure Resize; override; 1551 procedure SetCursor(Value: TCursor); override; 1552 procedure ShiftBands(AFrom, ATo, AShift, ALimit: Integer); 1553 procedure SortVisibleBands; 1554 procedure WMSize(var Message: TLMSize); message LM_SIZE; 1555 public 1556 FUpdateCount: SmallInt; 1557 constructor Create(AOwner: TComponent); override; 1558 destructor Destroy; override; 1559 procedure BeginUpdate; 1560 procedure EndUpdate; 1561 procedure FlipChildren(AllLevels: Boolean); override; 1562 function HitTest(X, Y: Integer): TControl; 1563 procedure InsertControl(AControl: TControl; Index: Integer); override; 1564 function MouseToBandPos(X, Y: Integer; out AGrabber: Boolean): TCtrlBand; 1565 procedure RemoveControl(AControl: TControl); override; 1566 procedure StickControls; virtual; 1567 property AutoDock: Boolean read FAutoDock write FAutoDock default True; 1568 property AutoDrag: Boolean read FAutoDrag write FAutoDrag default True; 1569 property AutoSize; 1570 property DockSite default True; 1571 property DrawingStyle: TBandDrawingStyle read FDrawingStyle write SetDrawingStyle default dsNormal; 1572 property GradientDirection: TGradientDirection read FGradientDirection write SetGradientDirection default gdVertical; 1573 property GradientStartColor: TColor read FGradientStartColor write SetGradientStartColor default clDefault; 1574 property GradientEndColor: TColor read FGradientEndColor write SetGradientEndColor default clDefault; 1575 property Picture: TPicture read FPicture write SetPicture; 1576 property RowSize: TRowSize read FRowSize write SetRowSize default 26; 1577 property RowSnap: Boolean read FRowSnap write FRowSnap default True; 1578 property OnBandDrag: TBandDragEvent read FOnBandDrag write FOnBandDrag; 1579 property OnBandInfo: TBandInfoEvent read FOnBandInfo write FOnBandInfo; 1580 property OnBandMove: TBandMoveEvent read FOnBandMove write FOnBandMove; 1581 property OnBandPaint: TBandPaintEvent read FOnBandPaint write FOnBandPaint; 1582 property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize; 1583 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; 1584 end; 1585 1586 TControlBar = class(TCustomControlBar) 1587 public 1588 property Canvas; 1589 published 1590 property Align; 1591 property Anchors; 1592 property AutoDock; 1593 property AutoDrag; 1594 property AutoSize; 1595 property BevelInner default bvRaised; 1596 property BevelOuter default bvLowered; 1597 property BevelWidth; 1598 property BiDiMode; 1599 property BorderWidth; 1600 property Color; 1601 property Constraints; 1602 property DockSite; 1603 property DoubleBuffered; 1604 property DragCursor; 1605 property DragKind; 1606 property DragMode; 1607 property DrawingStyle; 1608 property Enabled; 1609 property GradientDirection; 1610 property GradientEndColor; 1611 property GradientStartColor; 1612 property ParentColor; 1613 property ParentDoubleBuffered; 1614 property ParentFont; 1615 property ParentShowHint; 1616 property Picture; 1617 property PopupMenu; 1618 property RowSize; 1619 property RowSnap; 1620 property ShowHint; 1621 property TabOrder; 1622 property TabStop; 1623 property Visible; 1624 property OnBandDrag; 1625 property OnBandInfo; 1626 property OnBandMove; 1627 property OnBandPaint; 1628 property OnCanResize; 1629 property OnClick; 1630 property OnConstrainedResize; 1631 property OnContextPopup; 1632 property OnDockDrop; 1633 property OnDockOver; 1634 property OnDblClick; 1635 property OnDragDrop; 1636 property OnDragOver; 1637 property OnEndDock; 1638 property OnEndDrag; 1639 property OnEnter; 1640 property OnExit; 1641 property OnGetSiteInfo; 1642 property OnMouseDown; 1643 property OnMouseEnter; 1644 property OnMouseLeave; 1645 property OnMouseMove; 1646 property OnMouseUp; 1647 property OnMouseWheel; 1648 property OnMouseWheelDown; 1649 property OnMouseWheelUp; 1650 property OnPaint; 1651 property OnResize; 1652 property OnStartDock; 1653 property OnStartDrag; 1654 property OnUnDock; 1655 end; 1656 1657 1658procedure Frame3D(ACanvas: TCanvas; var ARect: TRect; 1659 TopColor, BottomColor: TColor; const FrameWidth: integer); 1660 1661procedure Register; 1662 1663implementation 1664 1665// !!! Avoid unit circles. Only add units if really needed. 1666uses 1667 Math, WSExtCtrls; 1668 1669{.$define INSTALL_TUNTABBEDNOTEBOOK} 1670 1671// Wrapper function for TCanvas.Frame3D. 1672procedure Frame3D(ACanvas: TCanvas; var ARect: TRect; 1673 TopColor, BottomColor: TColor; const FrameWidth: integer); 1674begin 1675 ACanvas.Frame3D(ARect, TopColor, BottomColor, FrameWidth); 1676end; 1677 1678procedure Register; 1679begin 1680 RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]); 1681 RegisterComponents('Additional',[TImage,TShape,TBevel,TPaintBox, 1682 TNotebook, TLabeledEdit, TSplitter, TTrayIcon, TControlBar, TFlowPanel]); 1683 RegisterComponents('System',[TTimer,TIdleTimer]); 1684 RegisterNoIcon([TPage]); 1685end; 1686 1687{$I page.inc} 1688{$I notebook.inc} 1689{$I idletimer.inc} 1690{$I shape.inc} 1691{$I customsplitter.inc} 1692{$I paintbox.inc} 1693{$I customcheckgroup.inc} 1694{$I boundlabel.inc} 1695{$I customlabelededit.inc} 1696{$I custompanel.inc} 1697{$I customflowpanel.inc} 1698{$I radiogroup.inc} 1699{$I bevel.inc} 1700{$I customimage.inc} 1701{$I customtrayicon.inc} 1702{$I controlbar.inc} 1703 1704initialization 1705 DockSplitterClass := TSplitter; 1706 RegisterPropertyToSkip(TPage, 'ClientHeight', 'This property was published for a long time in Lazarus 0.9.31', ''); 1707 RegisterPropertyToSkip(TPage, 'ClientWidth', 'This property was published for a long time in Lazarus 0.9.31', ''); 1708 1709end. 1710