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