1{ 2 /*************************************************************************** 3 stdctrls.pp 4 ----------- 5 6 Initial Revision : Tue Oct 19 CST 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} 17 18unit StdCtrls; 19 20{$mode objfpc}{$H+} 21{$I lcl_defines.inc} 22 23interface 24 25 26uses 27 Classes, SysUtils, types, 28 // LCL 29 LCLStrConsts, LCLType, LCLProc, LCLIntf, LMessages, LResources, Graphics, 30 ActnList, Controls, Forms, Menus, Themes, 31 // LazUtils 32 TextStrings, ExtendedStrings, LazUTF8, LazMethodList, LazLoggerBase, LazUtilities; 33 34type 35 36 { TCustomEdit Options} 37 38 TEditCharCase = (ecNormal, ecUppercase, ecLowerCase); 39 TEchoMode = (emNormal, emNone, emPassword); 40 41 { TScrollBar } 42 43 TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth, 44 ssAutoHorizontal, ssAutoVertical, ssAutoBoth); 45 46 TScrollCode = ( 47 // !!! Beware. The position of these enums must correspond to the SB_xxx 48 // values in LCLType (Delphi compatibility, not our decision) 49 // MWE: Don't know if this still is a requirement 50 // afaik have I removed all casts from the LCL 51 scLineUp, // = SB_LINEUP 52 scLineDown, // = SB_LINEDOWN 53 scPageUp, // = SB_PAGEUP 54 scPageDown, // = SB_PAGEDOWN 55 scPosition, // = SB_THUMBPOSITION 56 scTrack, // = SB_THUMBTRACK 57 scTop, // = SB_TOP 58 scBottom, // = SB_BOTTOM 59 scEndScroll // = SB_ENDSCROLL 60 ); 61 62 TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode; 63 var ScrollPos: Integer) of object; 64 65 { TCustomScrollBar } 66 67 TCustomScrollBar = class(TWinControl) 68 private 69 FKind: TScrollBarKind; 70 FPosition: Integer; 71 FMin: Integer; 72 FMax: Integer; 73 FPageSize: Integer; 74 FRTLFactor: Integer; 75 FSmallChange: TScrollBarInc; 76 FLargeChange: TScrollBarInc; 77 FOnChange: TNotifyEvent; 78 FOnScroll: TScrollEvent; 79 procedure DoScroll(var Message: TLMScroll); 80 function NotRightToLeft: Boolean; 81 procedure SetKind(Value: TScrollBarKind); 82 procedure SetMax(Value: Integer); 83 procedure SetMin(Value: Integer); 84 procedure SetPosition(Value: Integer); 85 procedure SetPageSize(Value: Integer); 86 procedure CNHScroll(var Message: TLMHScroll); message LM_HSCROLL; 87 procedure CNVScroll(var Message: TLMVScroll); message LM_VSCROLL; 88 procedure CNCtlColorScrollBar(var Message: TLMessage); message CN_CTLCOLORSCROLLBAR; 89 procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; 90 protected 91 class procedure WSRegisterClass; override; 92 class function GetControlClassDefaultSize: TSize; override; 93 procedure CreateParams(var Params: TCreateParams); override; 94 procedure CreateWnd; override; 95 procedure Change; virtual; 96 procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); virtual; 97 procedure CalculatePreferredSize(var PreferredWidth, 98 PreferredHeight: integer; WithThemeSpace: Boolean); override; 99 public 100 constructor Create(AOwner: TComponent); override; 101 procedure SetParams(APosition, AMin, AMax, APageSize: Integer); 102 procedure SetParams(APosition, AMin, AMax: Integer); 103 public 104 property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal; 105 property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1; 106 property Max: Integer read FMax write SetMax default 100; 107 property Min: Integer read FMin write SetMin default 0; 108 property PageSize: Integer read FPageSize write SetPageSize; 109 property Position: Integer read FPosition write SetPosition default 0; 110 property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1; 111 property TabStop default true; 112 property OnChange: TNotifyEvent read FOnChange write FOnChange; 113 property OnScroll: TScrollEvent read FOnScroll write FOnScroll; 114 end; 115 116 117 { TScrollBar } 118 119 TScrollBar = class(TCustomScrollBar) 120 published 121 property Align; 122 property Anchors; 123 property BidiMode; 124 property BorderSpacing; 125 property Constraints; 126 property DoubleBuffered; 127 property DragCursor; 128 property DragKind; 129 property DragMode; 130 property Enabled; 131 property Kind; 132 property LargeChange; 133 property Max; 134 property Min; 135 property PageSize; 136 property ParentBidiMode; 137 property ParentDoubleBuffered; 138 property ParentShowHint; 139 property PopupMenu; 140 property Position; 141 property ShowHint; 142 property SmallChange; 143 property TabOrder; 144 property TabStop; 145 property Visible; 146 property OnChange; 147 property OnContextPopup; 148 property OnDragDrop; 149 property OnDragOver; 150 property OnEndDrag; 151 property OnEnter; 152 property OnExit; 153 property OnKeyDown; 154 property OnKeyPress; 155 property OnKeyUp; 156 property OnScroll; 157 property OnStartDrag; 158 property OnUTF8KeyPress; 159 end; 160 161 162 { TCustomGroupBox } 163 164 TCustomGroupBox = class(TWinControl) 165 protected 166 class procedure WSRegisterClass; override; 167 class function GetControlClassDefaultSize: TSize; override; 168 procedure CreateParams(var Params: TCreateParams); override; 169 public 170 constructor Create(AOwner: TComponent); override; 171 end; 172 173 174 { TGroupBox } 175 176 TGroupBox = class(TCustomGroupBox) 177 published 178 property Align; 179 property Anchors; 180 property AutoSize; 181 property BidiMode; 182 property BorderSpacing; 183 property Caption; 184 property ChildSizing; 185 property ClientHeight; 186 property ClientWidth; 187 property Color; 188 property Constraints; 189 property DockSite; 190 property DoubleBuffered; 191 property DragCursor; 192 property DragKind; 193 property DragMode; 194 property Enabled; 195 property Font; 196 property ParentBidiMode; 197 property ParentColor; 198 property ParentDoubleBuffered; 199 property ParentFont; 200 property ParentShowHint; 201 property PopupMenu; 202 property ShowHint; 203 property TabOrder; 204 property TabStop; 205 property Visible; 206 property OnChangeBounds; 207 property OnClick; 208 property OnContextPopup; 209 property OnDblClick; 210 property OnDragDrop; 211 property OnDockDrop; 212 property OnDockOver; 213 property OnDragOver; 214 property OnEndDock; 215 property OnEndDrag; 216 property OnEnter; 217 property OnExit; 218 property OnGetSiteInfo; 219 property OnKeyDown; 220 property OnKeyPress; 221 property OnKeyUp; 222 property OnMouseDown; 223 property OnMouseEnter; 224 property OnMouseLeave; 225 property OnMouseMove; 226 property OnMouseUp; 227 property OnMouseWheel; 228 property OnMouseWheelDown; 229 property OnMouseWheelUp; 230 property OnResize; 231 property OnStartDock; 232 property OnStartDrag; 233 property OnUnDock; 234 property OnUTF8KeyPress; 235 end; 236 237 { TCustomComboBox } 238 TComboBoxAutoCompleteTextOption = ( 239 cbactEnabled, //Enable Auto-Completion Feature 240 cbactEndOfLineComplete, //Perform Auto-Complete only when cursor is at end of line 241 cbactRetainPrefixCase, //Retains the case of characters user has typed if is cbactEndOfLineComplete 242 cbactSearchCaseSensitive, //Search Text with CaseSensitivity 243 cbactSearchAscending //Search Text from top of the list 244 ); 245 TComboBoxAutoCompleteText = set of TComboBoxAutoCompleteTextOption; 246const 247 DefaultComboBoxAutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]; 248 249type 250 TComboBoxStyle = ( 251 csDropDown, // like an TEdit plus a button to drop down the list, default 252 csSimple, // like an TEdit plus a TListBox 253 csDropDownList, // like TLabel plus a button to drop down the list 254 csOwnerDrawFixed, // like csDropDownList, but custom drawn 255 csOwnerDrawVariable,// like csDropDownList, but custom drawn and with each item can have another height 256 csOwnerDrawEditableFixed,// like csOwnerDrawFixed, but with TEdit 257 csOwnerDrawEditableVariable// like csOwnerDrawVariable, but with TEdit 258 ); 259 260 TOwnerDrawState = LCLType.TOwnerDrawState; 261 262 TDrawItemEvent = procedure(Control: TWinControl; Index: Integer; 263 ARect: TRect; State: TOwnerDrawState) of object; 264 TMeasureItemEvent = procedure(Control: TWinControl; Index: Integer; 265 var AHeight: Integer) of object; 266 267 { TCustomComboBox } 268 269 TCustomComboBox = class(TWinControl) 270 private 271 FCharCase: TEditCharCase; 272 FAutoCompleteText: TComboBoxAutoCompleteText; 273 FAutoSelect: Boolean; 274 FAutoSelected: Boolean; 275 FAutoDropDown: Boolean; 276 FCanvas: TCanvas; 277 FDropDownCount: Integer; 278 FDroppedDown: boolean; 279 FDroppingDown: Boolean; 280 FItemHeight: integer; 281 FItemIndex: integer; 282 FItemWidth: integer; 283 FItems: TStrings; 284 FMaxLength: integer; 285 FOnChange: TNotifyEvent; 286 FOnCloseUp: TNotifyEvent; 287 FOnDrawItem: TDrawItemEvent; 288 FOnDropDown: TNotifyEvent; 289 FOnGetItems: TNotifyEvent; 290 FOnMeasureItem: TMeasureItemEvent; 291 FOnSelect: TNotifyEvent; 292 FSelLength: integer; 293 FSelStart: integer; 294 FSorted: boolean; 295 FStyle: TComboBoxStyle; 296 FArrowKeysTraverseList: Boolean; 297 FReturnArrowState: Boolean; //used to return the state of arrow keys from termporary change 298 function GetAutoComplete: boolean; 299 function GetDroppedDown: Boolean; 300 function GetItemWidth: Integer; 301 function GetReadOnly: Boolean; 302 procedure SetAutoComplete(const AValue: boolean); 303 procedure SetItemWidth(const AValue: Integer); 304 procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem; 305 procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem; 306 procedure LMSelChange(var TheMessage); message LM_SelChange; 307 procedure CNCommand(var TheMessage: TLMCommand); message CN_Command; 308 procedure SetReadOnly(const AValue: Boolean); 309 procedure UpdateSorted; 310 procedure SetArrowKeysTraverseList(Value: Boolean); 311 procedure WMChar(var Message: TLMChar); message LM_CHAR; 312 procedure SetCharCase(eccCharCase: TEditCharCase); 313 protected 314 class procedure WSRegisterClass; override; 315 procedure CreateParams(var Params: TCreateParams); override; 316 procedure InitializeWnd; override; 317 procedure DestroyWnd; override; 318 procedure DoEnter; override; 319 procedure DoExit; override; 320 procedure DrawItem(Index: Integer; ARect: TRect; 321 State: TOwnerDrawState); virtual; 322 procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override; 323 procedure MeasureItem(Index: Integer; var TheHeight: Integer); virtual; 324 class function GetControlClassDefaultSize: TSize; override; 325 procedure LMChanged(var Msg); message LM_CHANGED; 326 procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY; 327 procedure Change; virtual; 328 procedure Select; virtual; 329 procedure DropDown; virtual; 330 procedure GetItems; virtual; 331 procedure SetItems(const Value: TStrings); virtual; 332 procedure CloseUp; virtual; 333 procedure AdjustDropDown; virtual; 334 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 335 const AXProportion, AYProportion: Double); override; 336 337 function GetItemCount: Integer; //override; 338 function GetItemHeight: Integer; virtual; 339 function GetSelLength: integer; virtual; 340 function GetSelStart: integer; virtual; 341 function GetSelText: string; virtual; 342 function GetItemIndex: integer; virtual; 343 function GetMaxLength: integer; virtual; 344 procedure SetDropDownCount(const AValue: Integer); virtual; 345 procedure SetDroppedDown(const AValue: Boolean); virtual; 346 procedure SetItemHeight(const AValue: Integer); virtual; 347 procedure SetItemIndex(const Val: integer); virtual; 348 procedure SetMaxLength(AValue: integer); virtual; 349 procedure SetSelLength(Val: integer); virtual; 350 procedure SetSelStart(Val: integer); virtual; 351 procedure SetSelText(const Val: string); virtual; 352 procedure SetSorted(Val: boolean); virtual; 353 procedure SetStyle(Val: TComboBoxStyle); virtual; 354 procedure RealSetText(const AValue: TCaption); override; 355 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 356 procedure KeyUp(var Key: Word; Shift: TShiftState); override; 357 procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; 358 procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override; 359 function SelectItem(const AnItem: String): Boolean; 360 procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override; 361 362 property ItemHeight: Integer read GetItemHeight write SetItemHeight; 363 property ItemWidth: Integer read GetItemWidth write SetItemWidth default 0; 364 property MaxLength: integer read GetMaxLength write SetMaxLength default 0; 365 property OnChange: TNotifyEvent read FOnChange write FOnChange; 366 property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; 367 property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem; 368 property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; 369 property OnGetItems: TNotifyEvent read FOnGetItems write FOnGetItems; 370 property OnMeasureItem: TMeasureItemEvent 371 read FOnMeasureItem write FOnMeasureItem; 372 property OnSelect: TNotifyEvent read FOnSelect write FOnSelect; 373 property ParentColor default false; 374 property Sorted: boolean read FSorted write SetSorted default False; 375 public 376 constructor Create(TheOwner: TComponent); override; 377 destructor Destroy; override; 378 procedure IntfGetItems; 379 procedure AddItem(const Item: String; AnObject: TObject); virtual; 380 procedure AddHistoryItem(const Item: string; MaxHistoryCount: integer; 381 SetAsText, CaseSensitive: boolean); 382 procedure AddHistoryItem(const Item: string; AnObject: TObject; 383 MaxHistoryCount: integer; SetAsText, CaseSensitive: boolean); 384 procedure Clear; virtual; 385 procedure ClearSelection; //override; 386 property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal; 387 property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown; 388 property DroppingDown: Boolean read FDroppingDown write FDroppingDown; deprecated 'Will be removed in 2.2'; 389 procedure SelectAll; 390 property AutoComplete: boolean 391 read GetAutoComplete write SetAutoComplete default False; 392 property AutoCompleteText: TComboBoxAutoCompleteText 393 read FAutoCompleteText write FAutoCompleteText 394 default DefaultComboBoxAutoCompleteText; 395 property AutoDropDown: Boolean 396 read FAutoDropDown write FAutoDropDown default False; 397 property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True; 398 property AutoSelected: Boolean read FAutoSelected write FAutoSelected; 399 property AutoSize default True; // Overrides default value 400 property ArrowKeysTraverseList: Boolean read FArrowKeysTraverseList 401 write SetArrowKeysTraverseList default True; 402 property Canvas: TCanvas read FCanvas; 403 property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8; 404 property Items: TStrings read FItems write SetItems; 405 property ItemIndex: integer read GetItemIndex write SetItemIndex default -1; 406 property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored False; 407 property SelLength: integer read GetSelLength write SetSelLength;// UTF-8 length 408 property SelStart: integer read GetSelStart write SetSelStart;// UTF-8 position 409 property SelText: String read GetSelText write SetSelText; 410 property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown; 411 property TabStop default true; 412 property Text; 413 end; 414 415 416 { TComboBox } 417 418 TComboBox = class(TCustomComboBox) 419 published 420 property Align; 421 property Anchors; 422 property ArrowKeysTraverseList; 423 property AutoComplete; 424 property AutoCompleteText; 425 property AutoDropDown; 426 property AutoSelect; 427 property AutoSize;// Note: windows has a fixed height in some styles 428 property BidiMode; 429 property BorderSpacing; 430 property BorderStyle; 431 property CharCase; 432 property Color; 433 property Constraints; 434 property DoubleBuffered; 435 property DragCursor; 436 property DragKind; 437 property DragMode; 438 property DropDownCount; 439 property Enabled; 440 property Font; 441 property ItemHeight; 442 property ItemIndex; 443 property Items; 444 property ItemWidth; 445 property MaxLength; 446 property OnChange; 447 property OnChangeBounds; 448 property OnClick; 449 property OnCloseUp; 450 property OnContextPopup; 451 property OnDblClick; 452 property OnDragDrop; 453 property OnDragOver; 454 property OnDrawItem; 455 property OnEndDrag; 456 property OnDropDown; 457 property OnEditingDone; 458 property OnEnter; 459 property OnExit; 460 property OnGetItems; 461 property OnKeyDown; 462 property OnKeyPress; 463 property OnKeyUp; 464 property OnMeasureItem; 465 property OnMouseDown; 466 property OnMouseEnter; 467 property OnMouseLeave; 468 property OnMouseMove; 469 property OnMouseUp; 470 property OnMouseWheel; 471 property OnMouseWheelDown; 472 property OnMouseWheelUp; 473 property OnSelect; 474 property OnStartDrag; 475 property OnUTF8KeyPress; 476 property ParentBidiMode; 477 property ParentColor; 478 property ParentDoubleBuffered; 479 property ParentFont; 480 property ParentShowHint; 481 property PopupMenu; 482 property ReadOnly; deprecated 'Will be removed in 2.2 - use extended Style values instead.'; 483 property ShowHint; 484 property Sorted; 485 property Style; 486 property TabOrder; 487 property TabStop; 488 property Text; 489 property Visible; 490 end; 491 492 493 { TCustomListBox } 494 495 TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable, lbVirtual); 496 TSelectionChangeEvent = procedure(Sender: TObject; User: boolean) of object; 497 TListBoxOption = ( 498 lboDrawFocusRect // draw focus rect in case of owner drawing 499 ); 500 TListBoxOptions = set of TListBoxOption; 501 502 { TCustomListBox } 503 504 TCustomListBox = class(TWinControl) 505 private const 506 DefOptions = [lboDrawFocusRect]; 507 private 508 FCacheValid: Boolean; 509 FCanvas: TCanvas; 510 FClickOnSelChange: boolean; 511 FClickTriggeredBySelectionChange: Boolean; 512 FColumns: Integer; 513 FExtendedSelect: boolean; 514 FIntegralHeight: boolean; 515 FItemHeight: Integer; 516 FItemIndex: integer; 517 FItems: TStrings; 518 FLockSelectionChange: integer; 519 FMultiSelect: boolean; 520 FOnDrawItem: TDrawItemEvent; 521 FOnMeasureItem: TMeasureItemEvent; 522 FOnSelectionChange: TSelectionChangeEvent; 523 FOptions: TListBoxOptions; 524 FScrollWidth: Integer; 525 FSorted: boolean; 526 FStyle: TListBoxStyle; 527 FTopIndex: integer; 528 function GetCount: Integer; 529 function GetScrollWidth: Integer; 530 function GetTopIndex: Integer; 531 procedure RaiseIndexOutOfBounds(AIndex: integer); 532 procedure SetColumns(const AValue: Integer); 533 procedure SetScrollWidth(const AValue: Integer); 534 procedure SetTopIndex(const AValue: Integer); 535 procedure UpdateSelectionMode; 536 procedure UpdateSorted; 537 procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem; 538 procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem; 539 procedure LMSelChange(var TheMessage); message LM_SelChange; 540 procedure WMLButtonUp(Var Message: TLMLButtonUp); message LM_LBUTTONUP; 541 procedure SendItemSelected(Index: integer; IsSelected: boolean); 542 protected 543 class procedure WSRegisterClass; override; 544 procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); virtual; // called to store item data while the handle isn't created 545 procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); virtual; // called to restore the itemdata after a handle is created 546 procedure BeforeDragStart; override; 547 procedure BeginAutoDrag; override; 548 function CalculateStandardItemHeight: Integer; 549 procedure CreateParams(var Params: TCreateParams); override; 550 procedure InitializeWnd; override; 551 procedure DestroyWnd; override; 552 procedure FinalizeWnd; override; 553 class function GetControlClassDefaultSize: TSize; override; 554 procedure CheckIndex(const AIndex: Integer); 555 function GetItemHeight: Integer; 556 function GetItemIndex: integer; virtual; 557 function GetSelCount: integer; 558 function GetSelected(Index: integer): boolean; 559 function GetCachedDataSize: Integer; virtual; // returns the amount of data needed per item 560 function GetCachedData(const AIndex: Integer): Pointer; 561 procedure SetExtendedSelect(Val: boolean); virtual; 562 procedure SetItemIndex(AIndex: integer); virtual; 563 procedure SetItems(Value: TStrings); virtual; 564 procedure SetItemHeight(Value: Integer); 565 procedure SetMultiSelect(Val: boolean); virtual; 566 procedure SetSelected(Index: integer; Val: boolean); 567 procedure SetSorted(Val: boolean); virtual; 568 procedure SetStyle(Val: TListBoxStyle); virtual; 569 procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); virtual; 570 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 571 const AXProportion, AYProportion: Double); override; 572 procedure DoSelectionChange(User: Boolean); virtual; 573 procedure SendItemIndex; 574 procedure WMGetDlgCode(var Message: TLMNoParams); message LM_GETDLGCODE; 575 public 576 constructor Create(TheOwner: TComponent); override; 577 destructor Destroy; override; 578 procedure AddItem(const Item: String; AnObject: TObject); 579 procedure Click; override; // make it public 580 procedure Clear; virtual; 581 procedure ClearSelection; 582 function GetIndexAtXY(X, Y: integer): integer; 583 function GetIndexAtY(Y: integer): integer; 584 function GetSelectedText: string; 585 function ItemAtPos(const Pos: TPoint; Existing: Boolean): Integer; 586 function ItemRect(Index: Integer): TRect; 587 function ItemVisible(Index: Integer): boolean; 588 function ItemFullyVisible(Index: Integer): boolean; 589 procedure LockSelectionChange; 590 procedure MakeCurrentVisible; 591 procedure MeasureItem(Index: Integer; var TheHeight: Integer); virtual; 592 procedure SelectAll; virtual; 593 procedure DeleteSelected; virtual; 594 procedure UnlockSelectionChange; 595 public 596 property Align; 597 property Anchors; 598 property BorderStyle default bsSingle; 599 property Canvas: TCanvas read FCanvas; 600 property ClickOnSelChange: boolean read FClickOnSelChange 601 write FClickOnSelChange default true; // true is Delphi behaviour 602 property Columns: Integer read FColumns write SetColumns default 0; 603 property Constraints; 604 property Count: Integer read GetCount; // for Delphi compatability 605 property ExtendedSelect: boolean read FExtendedSelect write SetExtendedSelect default true; 606 property Font; 607 property IntegralHeight: boolean read FIntegralHeight write FIntegralHeight default False; // not implemented 608 property ItemHeight: Integer read GetItemHeight write SetItemHeight; 609 property ItemIndex: integer read GetItemIndex write SetItemIndex default -1; 610 property Items: TStrings read FItems write SetItems; 611 property MultiSelect: boolean read FMultiSelect write SetMultiSelect default False; 612 property OnChangeBounds; 613 property OnClick; 614 property OnDblClick; 615 property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem; 616 property OnEnter; 617 property OnExit; 618 property OnKeyDown; 619 property OnKeyPress; 620 property OnKeyUp; 621 property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem; 622 property OnMouseDown; 623 property OnMouseEnter; 624 property OnMouseLeave; 625 property OnMouseMove; 626 property OnMouseUp; 627 property OnMouseWheel; 628 property OnMouseWheelDown; 629 property OnMouseWheelUp; 630 property OnResize; 631 property OnSelectionChange: TSelectionChangeEvent read FOnSelectionChange 632 write FOnSelectionChange; 633 property OnUTF8KeyPress; 634 property Options: TListBoxOptions read FOptions write FOptions default DefOptions; 635 property ParentColor default False; 636 property ParentFont; 637 property ParentShowHint; 638 property PopupMenu; 639 property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0; 640 property SelCount: integer read GetSelCount; 641 property Selected[Index: integer]: boolean read GetSelected write SetSelected; 642 property ShowHint; 643 property Sorted: boolean read FSorted write SetSorted default False; 644 property Style: TListBoxStyle read FStyle write SetStyle default lbStandard; 645 property TabOrder; 646 property TabStop default true; 647 property TopIndex: Integer read GetTopIndex write SetTopIndex default 0; 648 property Visible; 649 end; 650 651 652 { TListBox } 653 654 TListBox = class(TCustomListBox) 655 published 656 property Align; 657 property Anchors; 658 property BidiMode; 659 property BorderSpacing; 660 property BorderStyle; 661 property ClickOnSelChange; 662 property Color; 663 property Columns; 664 property Constraints; 665 property DoubleBuffered; 666 property DragCursor; 667 property DragKind; 668 property DragMode; 669 property ExtendedSelect; 670 property Enabled; 671 property Font; 672 property IntegralHeight; 673 property Items; 674 property ItemHeight; 675 property ItemIndex; 676 property MultiSelect; 677 property OnChangeBounds; 678 property OnClick; 679 property OnContextPopup; 680 property OnDblClick; 681 property OnDragDrop; 682 property OnDragOver; 683 property OnDrawItem; 684 property OnEnter; 685 property OnEndDrag; 686 property OnExit; 687 property OnKeyPress; 688 property OnKeyDown; 689 property OnKeyUp; 690 property OnMeasureItem; 691 property OnMouseDown; 692 property OnMouseEnter; 693 property OnMouseLeave; 694 property OnMouseMove; 695 property OnMouseUp; 696 property OnMouseWheel; 697 property OnMouseWheelDown; 698 property OnMouseWheelUp; 699 property OnResize; 700 property OnSelectionChange; 701 property OnShowHint; 702 property OnStartDrag; 703 property OnUTF8KeyPress; 704 property Options; 705 property ParentBidiMode; 706 property ParentColor; 707 property ParentDoubleBuffered; 708 property ParentShowHint; 709 property ParentFont; 710 property PopupMenu; 711 property ScrollWidth; 712 property ShowHint; 713 property Sorted; 714 property Style; 715 property TabOrder; 716 property TabStop; 717 property TopIndex; 718 property Visible; 719 end; 720 721 722 { TCustomEdit } 723 724 TCustomEdit = class(TWinControl) 725 private 726 FAlignment: TAlignment; 727 FAutoSelect: Boolean; 728 FAutoSelected: Boolean; 729 FCharCase: TEditCharCase; 730 fCaretPos: TPoint; 731 FEchoMode: TEchoMode; 732 FHideSelection: Boolean; 733 FMaxLength: Integer; 734 FModified: Boolean; 735 FOnChangeHandler: TMethodList; 736 FPasswordChar: Char; 737 FReadOnly: Boolean; 738 FNumbersOnly: Boolean; 739 FOnChange: TNotifyEvent; 740 FSelLength: integer; 741 FSelStart: integer; 742 FTextChangedByRealSetText: Boolean; 743 FTextChangedLock: Boolean; 744 FTextHint: TTranslateString; 745 procedure ShowEmulatedTextHint(const ForceShow: Boolean = False); 746 procedure HideEmulatedTextHint; 747 procedure SetAlignment(const AValue: TAlignment); 748 function GetCanUndo: Boolean; 749 function GetModified: Boolean; 750 procedure SetCharCase(Value: TEditCharCase); 751 procedure SetHideSelection(const AValue: Boolean); 752 procedure SetMaxLength(Value: Integer); 753 procedure SetModified(Value: Boolean); 754 procedure SetPasswordChar(const AValue: Char); 755 protected type 756 TEmulatedTextHintStatus = (thsHidden, thsShowing, thsChanging); 757 protected 758 FEmulatedTextHintStatus: TEmulatedTextHintStatus; 759 760 class procedure WSRegisterClass; override; 761 function CanShowEmulatedTextHint: Boolean; virtual; 762 function CreateEmulatedTextHintFont: TFont; virtual; 763 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; 764 WithThemeSpace: Boolean); override; 765 procedure CreateParams(var Params: TCreateParams); override; 766 procedure InitializeWnd; override; 767 procedure TextChanged; override; 768 procedure FontChanged(Sender: TObject); override; 769 procedure Change; virtual; 770 procedure DoEnter; override; 771 procedure DoExit; override; 772 procedure EditingDone; override; 773 function GetCaretPos: TPoint; virtual; 774 function GetNumbersOnly: Boolean; virtual; 775 function GetReadOnly: Boolean; virtual; 776 function GetSelLength: integer; virtual; 777 function GetSelStart: integer; virtual; 778 function GetSelText: string; virtual; 779 function GetTextHint: TTranslateString; virtual; 780 procedure SetCaretPos(const Value: TPoint); virtual; 781 procedure SetEchoMode(Val: TEchoMode); virtual; 782 procedure SetNumbersOnly(Value: Boolean); virtual; 783 procedure SetReadOnly(Value: Boolean); virtual; 784 procedure SetSelLength(Val: integer); virtual; 785 procedure SetSelStart(Val: integer); virtual; 786 procedure SetSelText(const Val: string); virtual; 787 procedure SetTextHint(const AValue: TTranslateString); virtual; 788 function ChildClassAllowed(ChildClass: TClass): boolean; override; 789 class function GetControlClassDefaultSize: TSize; override; 790 procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override; 791 procedure RealSetText(const AValue: TCaption); override; 792 function RealGetText: TCaption; override; 793 procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override; 794 procedure WMChar(var Message: TLMChar); message LM_CHAR; 795 procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY; 796 procedure WndProc(var Message: TLMessage); override; 797 procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override; 798 procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; 799 procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; 800 801 property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True; 802 property AutoSelected: Boolean read FAutoSelected write FAutoSelected; 803 property ParentColor default False; 804 public 805 constructor Create(AOwner: TComponent); override; 806 destructor Destroy; override; 807 procedure Clear; 808 procedure SelectAll; 809 procedure ClearSelection; virtual; 810 procedure CopyToClipboard; virtual; 811 procedure CutToClipboard; virtual; 812 procedure PasteFromClipboard; virtual; 813 procedure Undo; virtual; 814 815 procedure RemoveAllHandlersOfObject(AnObject: TObject); override; 816 procedure AddHandlerOnChange(const AnOnChangeEvent: TNotifyEvent; 817 AsFirst: Boolean = False); 818 procedure RemoveHandlerOnChange(const AnOnChangeEvent: TNotifyEvent); 819 public 820 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 821 property AutoSize default True; 822 property BorderStyle default bsSingle; 823 property CanUndo: Boolean read GetCanUndo; 824 property CaretPos: TPoint read GetCaretPos write SetCaretPos; 825 property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal; 826 property EchoMode: TEchoMode read FEchoMode write SetEchoMode default emNormal; 827 property HideSelection: Boolean read FHideSelection write SetHideSelection default True; 828 property MaxLength: Integer read FMaxLength write SetMaxLength default 0; 829 property Modified: Boolean read GetModified write SetModified; 830 property NumbersOnly: Boolean read GetNumbersOnly write SetNumbersOnly default false; 831 property OnChange: TNotifyEvent read FOnChange write FOnChange; 832 property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0; 833 property PopupMenu; 834 property ReadOnly: Boolean read GetReadOnly write SetReadOnly default false; 835 property SelLength: integer read GetSelLength write SetSelLength; 836 property SelStart: integer read GetSelStart write SetSelStart; 837 property SelText: String read GetSelText write SetSelText; 838 property TabOrder; 839 property TabStop default true; 840 property Text; 841 property TextHint: TTranslateString read GetTextHint write SetTextHint; 842 end; 843 844 845 { TMemoScrollbar } 846 847 TMemoScrollbar = class(TControlScrollBar) 848 protected 849 function GetHorzScrollBar: TControlScrollBar; override; 850 function GetVertScrollBar: TControlScrollBar; override; 851 public 852 property Increment; 853 property Page; 854 property Smooth; 855 property Position; 856 property Range; 857 property Size; 858 property Visible; 859 end; 860 861 862 { TCustomMemo } 863 864 TCustomMemo = class(TCustomEdit) 865 private 866 FHorzScrollBar: TMemoScrollBar; 867 FLines: TStrings; 868 FScrollBars: TScrollStyle; 869 FVertScrollBar: TMemoScrollBar; 870 FWantReturns: Boolean; 871 FWantTabs: boolean; 872 FWordWrap: Boolean; 873 procedure SetHorzScrollBar(const AValue: TMemoScrollBar); 874 procedure SetVertScrollBar(const AValue: TMemoScrollBar); 875 protected 876 class procedure WSRegisterClass; override; 877 procedure CreateParams(var Params: TCreateParams); override; 878 procedure InitializeWnd; override; 879 procedure FinalizeWnd; override; 880 function RealGetText: TCaption; override; 881 procedure RealSetText(const Value: TCaption); override; 882 function GetCachedText(var CachedText: TCaption): boolean; override; 883 function GetCaretPos: TPoint; override; 884 procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override; 885 procedure SetCaretPos(const Value: TPoint); override; 886 procedure SetLines(const Value: TStrings); 887 procedure SetWantReturns(const AValue: Boolean); 888 procedure SetWantTabs(const NewWantTabs: boolean); 889 procedure SetWordWrap(const Value: boolean); 890 procedure SetScrollBars(const Value: TScrollStyle); 891 procedure Loaded; override; 892 procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY; 893 procedure WMGetDlgCode(var Message: TLMGetDlgCode); message LM_GETDLGCODE; 894 class function GetControlClassDefaultSize: TSize; override; 895 procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; 896 function CanShowEmulatedTextHint: Boolean; override; 897 public 898 constructor Create(AOwner: TComponent); override; 899 destructor Destroy; override; 900 procedure Append(const Value: String); 901 procedure ScrollBy(DeltaX, DeltaY: Integer); override; 902 public 903 property Lines: TStrings read FLines write SetLines; 904 property HorzScrollBar: TMemoScrollBar read FHorzScrollBar write SetHorzScrollBar; 905 property VertScrollBar: TMemoScrollBar read FVertScrollBar write SetVertScrollBar; 906 property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone; 907 property WantReturns: Boolean read FWantReturns write SetWantReturns default true; 908 property WantTabs: Boolean read FWantTabs write SetWantTabs default false; 909 property WordWrap: Boolean read FWordWrap write SetWordWrap default true; 910 end; 911 912 913 { TEdit } 914 915 TEdit = class(TCustomEdit) 916 public 917 property AutoSelected; 918 published 919 property Align; 920 property Alignment; 921 property Anchors; 922 property AutoSize; 923 property AutoSelect; 924 property BidiMode; 925 property BorderSpacing; 926 property BorderStyle; 927 property CharCase; 928 property Color; 929 property Constraints; 930 property DoubleBuffered; 931 property DragCursor; 932 property DragKind; 933 property DragMode; 934 property EchoMode; 935 property Enabled; 936 property Font; 937 property HideSelection; 938 property MaxLength; 939 property NumbersOnly; 940 property ParentBidiMode; 941 property OnChange; 942 property OnChangeBounds; 943 property OnClick; 944 property OnContextPopup; 945 property OnDblClick; 946 property OnDragDrop; 947 property OnDragOver; 948 property OnEditingDone; 949 property OnEndDrag; 950 property OnEnter; 951 property OnExit; 952 property OnKeyDown; 953 property OnKeyPress; 954 property OnKeyUp; 955 property OnMouseDown; 956 property OnMouseEnter; 957 property OnMouseLeave; 958 property OnMouseMove; 959 property OnMouseUp; 960 property OnMouseWheel; 961 property OnMouseWheelDown; 962 property OnMouseWheelUp; 963 property OnResize; 964 property OnStartDrag; 965 property OnUTF8KeyPress; 966 property ParentColor; 967 property ParentDoubleBuffered; 968 property ParentFont; 969 property ParentShowHint; 970 property PasswordChar; 971 property PopupMenu; 972 property ReadOnly; 973 property ShowHint; 974 property TabStop; 975 property TabOrder; 976 property Text; 977 property TextHint; 978 property Visible; 979 end; 980 981 982 { TMemo } 983 984 TMemo = class(TCustomMemo) 985 published 986 property Align; 987 property Alignment; 988 property Anchors; 989 property BidiMode; 990 property BorderSpacing; 991 property BorderStyle; 992 property CharCase; 993 property Color; 994 property Constraints; 995 property DoubleBuffered; 996 property DragCursor; 997 property DragKind; 998 property DragMode; 999 property Enabled; 1000 property Font; 1001 property HideSelection; 1002 property Lines; 1003 property MaxLength; 1004 property OnChange; 1005 property OnClick; 1006 property OnContextPopup; 1007 property OnDblClick; 1008 property OnDragDrop; 1009 property OnDragOver; 1010 property OnEditingDone; 1011 property OnEndDrag; 1012 property OnEnter; 1013 property OnExit; 1014 property OnKeyDown; 1015 property OnKeyPress; 1016 property OnKeyUp; 1017 property OnMouseDown; 1018 property OnMouseEnter; 1019 property OnMouseLeave; 1020 property OnMouseMove; 1021 property OnMouseUp; 1022 property OnMouseWheel; 1023 property OnMouseWheelDown; 1024 property OnMouseWheelUp; 1025 property OnResize; 1026 property OnStartDrag; 1027 property OnUTF8KeyPress; 1028 property ParentBidiMode; 1029 property ParentColor; 1030 property ParentDoubleBuffered; 1031 property ParentFont; 1032 property PopupMenu; 1033 property ParentShowHint; 1034 property ReadOnly; 1035 property ScrollBars; 1036 property ShowHint; 1037 property TabOrder; 1038 property TabStop; 1039 property Visible; 1040 property WantReturns; 1041 property WantTabs; 1042 property WordWrap; 1043 end; 1044 1045 1046 { TCustomStaticText } 1047 1048 TStaticBorderStyle = (sbsNone, sbsSingle, sbsSunken); 1049 1050 TCustomStaticText = class(TWinControl) 1051 private 1052 FAlignment: TAlignment; 1053 FFocusControl: TWinControl; 1054 FShowAccelChar: boolean; 1055 FStaticBorderStyle: TStaticBorderStyle; 1056 function GetTransparent: Boolean; 1057 procedure SetAlignment(Value: TAlignment); 1058 procedure SetStaticBorderStyle(Value: TStaticBorderStyle); 1059 procedure SetTransparent(const AValue: Boolean); 1060 procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE; 1061 protected 1062 class procedure WSRegisterClass; override; 1063 function GetLabelText: String ; virtual; 1064 procedure RealSetText(const AValue: TCaption); override; 1065 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 1066 procedure SetFocusControl(Val: TWinControl); virtual; 1067 procedure SetShowAccelChar(Val: boolean); virtual; 1068 function DialogChar(var Message: TLMKey): boolean; override; 1069 class function GetControlClassDefaultSize: TSize; override; 1070 public 1071 constructor Create(AOwner: TComponent); override; 1072 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 1073 property BorderStyle: TStaticBorderStyle read FStaticBorderStyle write SetStaticBorderStyle default sbsNone; 1074 property FocusControl: TWinControl read FFocusControl write SetFocusControl; 1075 property ShowAccelChar: boolean read FShowAccelChar write SetShowAccelChar default true; 1076 property Transparent: Boolean read GetTransparent write SetTransparent default True; 1077 end; 1078 1079 1080 { TStaticText } 1081 1082 TStaticText = class(TCustomStaticText) 1083 published 1084 property Align; 1085 property Alignment; 1086 property Anchors; 1087 property AutoSize; 1088 property BidiMode; 1089 property BorderSpacing; 1090 property BorderStyle; 1091 property Caption; 1092 property Color nodefault; 1093 property Constraints; 1094 property DoubleBuffered; 1095 property DragCursor; 1096 property DragKind; 1097 property DragMode; 1098 property Enabled; 1099 property FocusControl; 1100 property Font; 1101 property OnChangeBounds; 1102 property OnClick; 1103 property OnContextPopup; 1104 property OnDblClick; 1105 property OnDragDrop; 1106 property OnDragOver; 1107 property OnEndDrag; 1108 property OnMouseDown; 1109 property OnMouseEnter; 1110 property OnMouseLeave; 1111 property OnMouseMove; 1112 property OnMouseUp; 1113 property OnMouseWheel; 1114 property OnMouseWheelDown; 1115 property OnMouseWheelUp; 1116 property OnResize; 1117 property OnStartDrag; 1118 property ParentBidiMode; 1119 property ParentFont; 1120 property ParentColor; 1121 property ParentDoubleBuffered; 1122 property ParentShowHint; 1123 property PopupMenu; 1124 property ShowAccelChar; 1125 property ShowHint; 1126 property TabOrder; 1127 property TabStop; 1128 property Transparent; 1129 property Visible; 1130 end; 1131 1132 1133 { TButtonControl } 1134 1135 TButtonControl = class(TWinControl) 1136 private 1137 FOnChange: TNotifyEvent; 1138 FClicksDisabled: Boolean; 1139 function IsCheckedStored: boolean; 1140 procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED; 1141 protected 1142 class procedure WSRegisterClass; override; 1143 function GetActionLinkClass: TControlActionLinkClass; override; 1144 function GetChecked: Boolean; virtual; 1145 procedure SetChecked(Value: Boolean); virtual; 1146 procedure DoOnChange; virtual; 1147 procedure Click; override; 1148 protected 1149 property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False; 1150 property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled; 1151 property OnChange: TNotifyEvent read FOnChange write FOnChange; 1152 public 1153 constructor Create(TheOwner: TComponent); override; 1154 end; 1155 1156 { TButtonActionLink - Finish me } 1157 1158 TButtonActionLink = class(TWinControlActionLink) 1159 protected 1160 FClientButton: TButtonControl; 1161 procedure AssignClient(AClient: TObject); override; 1162 procedure SetChecked(Value: Boolean); override; 1163 public 1164 function IsCheckedLinked: Boolean; override; 1165 end; 1166 1167 TButtonActionLinkClass = class of TButtonActionLink; 1168 1169 1170 { TCustomButton } 1171 1172 TCustomButton = class(TButtonControl) 1173 private 1174 FModalResult: TModalResult; 1175 FShortCut: TShortcut; 1176 FShortCutKey2: TShortcut; 1177 FCancel: Boolean; 1178 FDefault: Boolean; 1179 FActive: boolean; 1180 FRolesUpdateLocked: Boolean; 1181 procedure SetCancel(NewCancel: boolean); 1182 procedure SetDefault(Value: Boolean); 1183 procedure SetModalResult(const AValue: TModalResult); 1184 procedure CMUIActivate(var Message: TLMessage); message CM_UIACTIVATE; 1185 procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; 1186 procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; 1187 procedure UpdateFocus(AFocused: Boolean); 1188 protected 1189 class procedure WSRegisterClass; override; 1190 procedure CreateWnd; override; 1191 procedure CreateParams(var Params: TCreateParams); override; 1192 procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override; 1193 procedure ControlKeyUp(var Key: Word; Shift: TShiftState); override; 1194 function DialogChar(var Message: TLMKey): boolean; override; 1195 function ChildClassAllowed(ChildClass: TClass): boolean; override; 1196 class function GetControlClassDefaultSize: TSize; override; 1197 property ParentColor default false; 1198 procedure WSSetDefault; 1199 procedure WSSetText(const AText: String); override; 1200 procedure TextChanged; override; 1201 procedure Loaded; override; 1202 procedure UpdateDefaultCancel; 1203 public 1204 constructor Create(TheOwner: TComponent); override; 1205 procedure Click; override; 1206 procedure ExecuteDefaultAction; override; 1207 procedure ExecuteCancelAction; override; 1208 procedure ActiveDefaultControlChanged(NewControl: TControl); override; 1209 procedure UpdateRolesForForm; override; 1210 function UseRightToLeftAlignment: Boolean; override; 1211 public 1212 property Active: boolean read FActive stored false; 1213 property Default: Boolean read FDefault write SetDefault default false; 1214 property ModalResult: TModalResult read FModalResult write SetModalResult default mrNone; 1215 property ShortCut: TShortcut read FShortCut; 1216 property ShortCutKey2: TShortcut read FShortCutKey2; 1217 property Cancel: Boolean read FCancel write SetCancel default false; 1218 property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}; 1219 property TabStop default true; 1220 end; 1221 1222 1223 { TButton } 1224 1225 TButton = class(TCustomButton) 1226 published 1227 property Action; 1228 property Align; 1229 property Anchors; 1230 property AutoSize; 1231 property BidiMode; 1232 property BorderSpacing; 1233 property Cancel; 1234 property Caption; 1235 property Color; 1236 property Constraints; 1237 property Default; 1238 property DoubleBuffered; 1239 property DragCursor; 1240 property DragKind; 1241 property DragMode; 1242 property Enabled; 1243 property Font; 1244 property ParentBidiMode; 1245 property ModalResult; 1246 property OnChangeBounds; 1247 property OnClick; 1248 property OnContextPopup; 1249 property OnDragDrop; 1250 property OnDragOver; 1251 property OnEndDrag; 1252 property OnEnter; 1253 property OnExit; 1254 property OnKeyDown; 1255 property OnKeyPress; 1256 property OnKeyUp; 1257 property OnMouseDown; 1258 property OnMouseEnter; 1259 property OnMouseLeave; 1260 property OnMouseMove; 1261 property OnMouseUp; 1262 property OnMouseWheel; 1263 property OnMouseWheelDown; 1264 property OnMouseWheelUp; 1265 property OnResize; 1266 property OnStartDrag; 1267 property OnUTF8KeyPress; 1268 property ParentDoubleBuffered; 1269 property ParentFont; 1270 property ParentShowHint; 1271 property PopupMenu; 1272 property ShowHint; 1273 property TabOrder; 1274 property TabStop; 1275 property Visible; 1276 end; 1277 1278 { TCustomCheckBox } 1279 1280 TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed); 1281 1282 { TCustomCheckBox } 1283 1284 TCustomCheckBox = class(TButtonControl) 1285 private 1286 FAlignment: TLeftRight; 1287 FAllowGrayed: Boolean; 1288 FState: TCheckBoxState; 1289 FShortCut: TShortcut; 1290 FShortCutKey2: TShortcut; 1291 function GetAlignment: TLeftRight; 1292 procedure SetAlignment(AValue: TLeftRight); 1293 procedure SetState(Value: TCheckBoxState); 1294 function GetState: TCheckBoxState; 1295 procedure DoChange(var Msg); message LM_CHANGED; 1296 protected 1297 class procedure WSRegisterClass; override; 1298 procedure Click; override; 1299 procedure DoClickOnChange; virtual; 1300 function RetrieveState: TCheckBoxState; 1301 procedure InitializeWnd; override; 1302 procedure Toggle; virtual; 1303 function DialogChar(var Message: TLMKey): boolean; override; 1304 function GetChecked: Boolean; override; 1305 procedure SetChecked(Value: Boolean); override; 1306 procedure RealSetText(const Value: TCaption); override; 1307 procedure ApplyChanges; virtual; 1308 class function GetControlClassDefaultSize: TSize; override; 1309 procedure Loaded; override; 1310 procedure WSSetText(const AText: String); override; 1311 procedure TextChanged; override; 1312 procedure CreateParams(var Params: TCreateParams); override; 1313 public 1314 constructor Create(TheOwner: TComponent); override; 1315 public 1316 property Alignment: TLeftRight read GetAlignment write SetAlignment default taRightJustify; 1317 property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default false; 1318 property State: TCheckBoxState read GetState write SetState default cbUnchecked; 1319 property ShortCut: TShortcut read FShortCut; 1320 property ShortCutKey2: TShortcut read FShortCutKey2; 1321 property OnChange; 1322 end; 1323 1324 // Normal checkbox 1325 1326 { TCheckBox } 1327 1328 TCheckBox = class(TCustomCheckBox) 1329 public 1330 constructor Create(TheOwner: TComponent); override; 1331 published 1332 property Action; 1333 property Align; 1334 property Alignment; 1335 property AllowGrayed; 1336 property Anchors; 1337 property AutoSize default True; 1338 property BidiMode; 1339 property BorderSpacing; 1340 property Caption; 1341 property Checked; 1342 property Color nodefault; 1343 property Constraints; 1344 property DoubleBuffered; 1345 property DragCursor; 1346 property DragKind; 1347 property DragMode; 1348 property Enabled; 1349 property Font; 1350 property Hint; 1351 property OnChange; 1352 property OnChangeBounds; 1353 property OnClick; 1354 property OnContextPopup; 1355 property OnDragDrop; 1356 property OnDragOver; 1357 property OnEditingDone; 1358 property OnEndDrag; 1359 property OnEnter; 1360 property OnExit; 1361 property OnKeyPress; 1362 property OnKeyDown; 1363 property OnKeyUp; 1364 property OnMouseDown; 1365 property OnMouseEnter; 1366 property OnMouseLeave; 1367 property OnMouseMove; 1368 property OnMouseUp; 1369 property OnMouseWheel; 1370 property OnMouseWheelDown; 1371 property OnMouseWheelUp; 1372 property OnResize; 1373 property OnStartDrag; 1374 property OnUTF8KeyPress; 1375 property ParentColor; 1376 property ParentDoubleBuffered; 1377 property ParentFont; 1378 property ParentShowHint; 1379 property ParentBidiMode; 1380 property PopupMenu; 1381 property ShowHint; 1382 property State; 1383 property TabOrder; 1384 property TabStop default True; 1385 property Visible; 1386 end; 1387 1388 { TToggleBox } 1389 1390 TToggleBox = class(TCustomCheckBox) 1391 protected 1392 class procedure WSRegisterClass; override; 1393 class function GetControlClassDefaultSize: TSize; override; 1394 procedure CreateParams(var Params: TCreateParams); override; 1395 property ParentColor default false; 1396 public 1397 constructor Create(TheOwner: TComponent); override; 1398 published 1399 property AllowGrayed; 1400 property Align; 1401 property Anchors; 1402 property AutoSize; 1403 property BidiMode; 1404 property BorderSpacing; 1405 property Caption; 1406 property Checked; 1407 property Color; 1408 property Constraints; 1409 property DoubleBuffered; 1410 property DragCursor; 1411 property DragKind; 1412 property DragMode; 1413 property Enabled; 1414 property Font; 1415 property Hint; 1416 property OnChange; 1417 property OnClick; 1418 property OnContextPopup; 1419 property OnDragDrop; 1420 property OnDragOver; 1421 property OnEndDrag; 1422 property OnEnter; 1423 property OnExit; 1424 property OnMouseDown; 1425 property OnMouseEnter; 1426 property OnMouseLeave; 1427 property OnMouseMove; 1428 property OnMouseUp; 1429 property OnMouseWheel; 1430 property OnMouseWheelDown; 1431 property OnMouseWheelUp; 1432 property OnResize; 1433 property OnStartDrag; 1434 property ParentBidiMode; 1435 property ParentDoubleBuffered; 1436 property ParentFont; 1437 property ParentShowHint; 1438 property PopupMenu; 1439 property ShowHint; 1440 property State; 1441 property TabOrder; 1442 property TabStop default True; 1443 property Visible; 1444 end; 1445 1446 1447 { TRadioButton } 1448 1449 TRadioButton = class(TCustomCheckBox) 1450 protected 1451 class procedure WSRegisterClass; override; 1452 procedure ApplyChanges; override; 1453 function DialogChar(var Message: TLMKey): boolean; override; 1454 procedure RealSetText(const Value: TCaption); override; 1455 procedure DoClickOnChange; override; 1456 procedure CreateParams(var Params: TCreateParams); override; 1457 public 1458 constructor Create(TheOwner: TComponent); override; 1459 published 1460 property Align; 1461 property Alignment; 1462 property Anchors; 1463 property AutoSize default True; 1464 property BidiMode; 1465 property BorderSpacing; 1466 property Caption; 1467 property Checked; 1468 property Color; 1469 property Constraints; 1470 property DoubleBuffered; 1471 property DragCursor; 1472 property DragKind; 1473 property DragMode; 1474 property Enabled; 1475 property Font; 1476 property Hint; 1477 property OnChange; 1478 property OnChangeBounds; 1479 property OnClick; 1480 property OnContextPopup; 1481 property OnDragDrop; 1482 property OnDragOver; 1483 property OnEndDrag; 1484 property OnEnter; 1485 property OnExit; 1486 property OnKeyDown; 1487 property OnKeyPress; 1488 property OnKeyUp; 1489 property OnMouseDown; 1490 property OnMouseEnter; 1491 property OnMouseLeave; 1492 property OnMouseMove; 1493 property OnMouseUp; 1494 property OnMouseWheel; 1495 property OnMouseWheelDown; 1496 property OnMouseWheelUp; 1497 property OnResize; 1498 property OnStartDrag; 1499 property ParentBidiMode; 1500 property ParentColor; 1501 property ParentDoubleBuffered; 1502 property ParentFont; 1503 property ParentShowHint; 1504 property PopupMenu; 1505 property ShowHint; 1506 property TabOrder; 1507 property TabStop default False; 1508 property Visible; 1509 end; 1510 1511 1512 { TCustomLabel } 1513 1514 TCustomLabel = class(TGraphicControl) 1515 private 1516 FAlignment: TAlignment; 1517 FFocusControl: TWinControl; 1518 FOptimalFill: Boolean; 1519 FShowAccelChar: Boolean; 1520 FWordWrap: Boolean; 1521 FLayout: TTextLayout; 1522 FInternalSetBounds: Boolean; 1523 procedure SetAlignment(Value: TAlignment); 1524 procedure SetOptimalFill(const AValue: Boolean); 1525 protected 1526 class procedure WSRegisterClass; override; 1527 function CanTab: boolean; override; 1528 procedure DoMeasureTextPosition(var TextTop: integer; 1529 var TextLeft: integer); virtual; 1530 function HasMultiLine : boolean; 1531 procedure CalculatePreferredSize( 1532 var PreferredWidth, PreferredHeight: integer; 1533 WithThemeSpace: Boolean); override; 1534 procedure CalculateSize(MaxWidth: integer; 1535 var NeededWidth, NeededHeight: integer); 1536 procedure DoAutoSize; override; 1537 function DialogChar(var Message: TLMKey): boolean; override; 1538 procedure TextChanged; override; 1539 procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; 1540 procedure FontChanged(Sender: TObject); override; 1541 class function GetControlClassDefaultSize: TSize; override; 1542 1543 procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE; 1544 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 1545 1546 function GetLabelText: string; virtual; 1547 function GetTransparent: boolean; 1548 procedure SetColor(NewColor: TColor); override; 1549 procedure SetFocusControl(Value: TWinControl); 1550 procedure SetLayout(Value: TTextLayout); 1551 procedure SetShowAccelChar(Value: Boolean); 1552 procedure SetTransparent(NewTransparent: boolean); 1553 procedure SetWordWrap(Value: Boolean); 1554 procedure Loaded; override; 1555 procedure UpdateSize; 1556 1557 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 1558 property FocusControl: TWinControl read FFocusControl write SetFocusControl; 1559 property Layout: TTextLayout read FLayout write SetLayout default tlTop; 1560 property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default true; 1561 property Transparent: boolean read GetTransparent write SetTransparent default true; 1562 property WordWrap: Boolean read FWordWrap write SetWordWrap default false; 1563 property OptimalFill: Boolean read FOptimalFill write SetOptimalFill default false; 1564 public 1565 constructor Create(TheOwner: TComponent); override; 1566 function CalcFittingFontHeight(const TheText: string; 1567 MaxWidth, MaxHeight: Integer; 1568 out FontHeight, NeededWidth, NeededHeight: Integer): Boolean; 1569 function ColorIsStored: boolean; override; 1570 function AdjustFontForOptimalFill: Boolean; 1571 procedure Paint; override; 1572 procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override; 1573 property AutoSize default True; 1574 property Color default clNone; 1575 end; 1576 1577 1578 { TLabel } 1579 1580 TLabel = class(TCustomLabel) 1581 published 1582 property Align; 1583 property Alignment; 1584 property Anchors; 1585 property AutoSize; 1586 property BidiMode; 1587 property BorderSpacing; 1588 property Caption; 1589 property Color; 1590 property Constraints; 1591 property DragCursor; 1592 property DragKind; 1593 property DragMode; 1594 property Enabled; 1595 property FocusControl; 1596 property Font; 1597 property Layout; 1598 property ParentBidiMode; 1599 property ParentColor; 1600 property ParentFont; 1601 property ParentShowHint; 1602 property PopupMenu; 1603 property ShowAccelChar; 1604 property ShowHint; 1605 property Transparent; 1606 property Visible; 1607 property WordWrap; 1608 property OnChangeBounds; 1609 property OnClick; 1610 property OnContextPopup; 1611 property OnDblClick; 1612 property OnDragDrop; 1613 property OnDragOver; 1614 property OnEndDrag; 1615 property OnMouseDown; 1616 property OnMouseEnter; 1617 property OnMouseLeave; 1618 property OnMouseMove; 1619 property OnMouseUp; 1620 property OnMouseWheel; 1621 property OnMouseWheelDown; 1622 property OnMouseWheelUp; 1623 property OnResize; 1624 property OnStartDrag; 1625 property OptimalFill; 1626 end; 1627 1628procedure Register; 1629 1630implementation 1631 1632uses 1633 WSControls, WSStdCtrls, interfacebase; // Widgetset uses circle is allowed 1634 1635 1636type 1637 TMemoStrings = class(TStrings) 1638 private 1639 FMemo: TCustomMemo; 1640 FMemoWidgetClass: TWSCustomMemoClass; 1641 protected 1642 function Get(Index: Integer): String; override; 1643 function GetCount: Integer; override; 1644 public 1645 constructor Create(AMemo: TCustomMemo); 1646 procedure Clear; override; 1647 procedure Delete(index: Integer); override; 1648 procedure Insert(index: Integer; const S: String); override; 1649 1650 property MemoWidgetClass: TWSCustomMemoClass read FMemoWidgetClass write FMemoWidgetClass; 1651 end; 1652 1653procedure Register; 1654begin 1655 RegisterComponents('Standard',[TButton, TLabel,TEdit,TMemo,TToggleBox,TCheckBox, 1656 TRadioButton,TListBox,TComboBox,TScrollBar,TGroupBox]); 1657 RegisterComponents('Additional',[TStaticText]); 1658end; 1659 1660procedure InternalDrawItem(Control:TControl; Canvas: TCanvas; ARect:TRect; const Text: string); 1661var 1662 OldBrushStyle: TBrushStyle; 1663 OldTextStyle: TTextStyle; 1664 NewTextStyle: TTextStyle; 1665begin 1666 OldBrushStyle := Canvas.Brush.Style; 1667 Canvas.Brush.Style := bsClear; 1668 1669 OldTextStyle := Canvas.TextStyle; 1670 NewTextStyle := OldTextStyle; 1671 NewTextStyle.Layout := tlCenter; 1672 NewTextStyle.RightToLeft := Control.UseRightToLeftReading; 1673 if Control.UseRightToLeftAlignment then 1674 begin 1675 NewTextStyle.Alignment := taRightJustify; 1676 ARect.Right := ARect.Right - 2; 1677 end 1678 else 1679 begin 1680 NewTextStyle.Alignment := taLeftJustify; 1681 ARect.Left := ARect.Left + 2; 1682 end; 1683 1684 Canvas.TextStyle := NewTextStyle; 1685 1686 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Text); 1687 Canvas.Brush.Style := OldBrushStyle; 1688 Canvas.TextStyle := OldTextStyle; 1689end; 1690 1691{$I customgroupbox.inc} 1692{$I customcombobox.inc} 1693{$I customlistbox.inc} 1694{$I custommemo.inc} 1695{$I customedit.inc} 1696{$I customlabel.inc} 1697{$I customcheckbox.inc} 1698 1699{$I scrollbar.inc} 1700{$I memoscrollbar.inc} 1701{$I memostrings.inc} 1702 1703{$I buttoncontrol.inc} 1704{$I buttons.inc} 1705 1706{$I checkbox.inc} 1707{$I radiobutton.inc} 1708{$I togglebox.inc} 1709 1710{$I customstatictext.inc} 1711 1712initialization 1713 RegisterPropertyToSkip(TCustomEdit, 'TextHintFontColor','Used in a previous version of Lazarus',''); 1714 RegisterPropertyToSkip(TCustomEdit, 'TextHintFontStyle','Used in a previous version of Lazarus',''); 1715end. 1716