1{ $Id: FPGUIwsprivate.pp 10697 2007-02-27 23:17:33Z marc $ } 2{ 3 ------------------------------------------ 4 FPGUIwsprivate.pp - FPGUI internal classes 5 ------------------------------------------ 6 7 @created(Thu Feb 1st WET 2007) 8 @lastmod($Date: 2007-02-27 18:17:33 -0500 (Tue, 27 Feb 2007) $) 9 @author(Marc Weustink <marc@@lazarus.dommelstein.net>) 10 11 This unit contains the private class hierarchy for the fpgui implemetation 12 This hierarchy reflects (more or less) the widget hierarchy 13 14 ***************************************************************************** 15 This file is part of the Lazarus Component Library (LCL) 16 17 See the file COPYING.modifiedLGPL.txt, included in this distribution, 18 for details about the license. 19 ***************************************************************************** 20} 21 22unit fpguiwsprivate; 23{.$DEFINE VerboseFPGUIPrivate} 24{.$DEFINE FPGUIDEBUGFOCUS} 25 26// Define base widget, possible values: BASEWIDGET_WIDGET, BASEWIDGET_SCROLLFRAME, BASEWIDGET_PANEL 27{$DEFINE BASEWIDGET_WIDGET} 28{$mode delphi} 29 30interface 31 32uses 33 // LCL 34 LCLType, LMessages, LCLProc, Controls, Classes, SysUtils, Forms, 35 LCLIntf, Menus, Dialogs, ExtCtrls, Graphics, StdCtrls, 36 // widgetset 37 WSControls, WSLCLClasses, WSProc, 38 // interface 39 fpg_main, 40 fpg_widget, fpg_form, fpg_button, fpg_combobox, fpg_editcombo, fpg_dialogs, 41 fpg_edit, fpg_checkbox, fpg_radiobutton, fpg_tab, fpg_memo, 42 fpg_menu, fpg_label, fpg_listbox, fpg_panel, fpg_scrollbar, fpg_splitter, 43 fpg_popupwindow, fpg_base, fpg_progressbar, fpguiproc, fpg_stylemanager, 44 fpg_scrollframe 45 ; 46 47 48type 49 50 IContainer = interface(IInterface) 51 procedure AddChild(AWidget: TfpgWidget); 52 procedure RemoveChild(AWidget: TfpgWidget); 53 end; 54 55 { TFPGUIPrivate } 56 57 TFPGUIPrivate = class(TInterfacedObject) 58 function _AddRef : longint;stdcall; 59 function _Release : longint;stdcall; 60 end; 61 62 { To access protected properties of TfpgWidget } 63 64 { TFPGWidgetHack } 65 66 TFPGWidgetHack = class(TfpgWidget) 67 protected 68 end; 69 70 { TFPGUIPrivateWidget } 71 { Private class for widgets } 72 73 TFPGUIPrivateWidget = class(TFPGUIPrivate) 74 private 75 FWidget: TfpgWidget; 76 FLCLObject: TWinControl; 77 FDC: HDC; 78 FEntered: Boolean; 79 FDefaultCursor: TMouseCursor; 80 function GetEnabled: Boolean; 81 function GetFont: TFont; virtual; 82 function GetVisible: Boolean; 83 function GetWidgetProtected: TFPGWidgetHack; 84 procedure SetDC(const AValue: HDC); 85 procedure SetEnabled(const AValue: Boolean); 86 procedure SetFont(const AValue: TFont); virtual; 87 procedure SetVisible(const AValue: Boolean); 88 { Handlers for default properties common to all TfpgWidget descendants} 89 procedure PaintHandler(Sender: TObject); virtual; 90 procedure ClickHandler(Sender: TObject); 91 procedure EnterHandler(Sender: TObject); 92 procedure ExitHandler(Sender: TObject); 93 procedure ResizeHandler(Sender: TObject); 94 procedure KeyCharHandler(Sender: TObject; AChar: TfpgChar; var Consumed: boolean); 95 procedure KeyPressHandler(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); 96 procedure MouseMoveHandler(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint); 97 procedure MouseEnterHandler(Sender: TObject); 98 procedure MouseExitHandler(Sender: TObject); 99 procedure MouseDownHandler(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 100 procedure MouseUpHandler(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 101 102 procedure MsgDeactivate(var fpgmsg: TfpgMessageRec); message FPGM_DEACTIVATE; 103 procedure MsgActivate(var fpgmsg: TfpgMessageRec); message FPGM_ACTIVATE; 104 procedure MsgMove(var fpgmsg: TfpgMessageRec); message FPGM_MOVE; 105 procedure MsgKeyRelease(var fpgmsg: TfpgMessageRec); message FPGM_KEYRELEASE; 106 procedure MsgDoubleClick(var fpgmsg: TfpgMessageRec); message FPGM_DOUBLECLICK; 107 procedure MsgMouseScroll(var fpgmsg: TfpgMessageRec); message FPGM_SCROLL; 108 procedure MsgUser(var fpgmsg: TfpgMessageRec); message FPGM_USER; 109 // procedure MsgMouseMove(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEMOVE; 110 // procedure MsgMouseDown(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEDOWN; 111 // procedure MsgMouseUp(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEUP; 112 // procedure MsgMouseEnter(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEENTER; 113 // procedure MsgMouseExit(var fpgmsg: TfpgMessageRec); message FPGM_MOUSEEXIT; 114 // procedure MsgPaint(var fpgmsg: TfpgMessageRec); message FPGM_PAINT; 115 // procedure MsgResize(var fpgmsg: TfpgMessageRec); message FPGM_RESIZE; 116 // procedure MsgKeyChar(var fpgmsg: TfpgMessageRec); message FPGM_KEYCHAR; 117 // procedure MsgKeyPress(var fpgmsg: TfpgMessageRec); message FPGM_KEYPRESS; 118 protected 119 { Helper methods for descendents } 120 function GetParentContainerWidget: TfpgWidget; 121 function GetParentContainerPrivateWidgetFocusable: TFPGUIPrivateWidget; 122 procedure SetWidgetPosition(AWidget: TfpgWidget; AX, AY: Integer); virtual; 123 public 124 { Constructors / Destructors } 125 constructor Create(ALCLObject: TWinControl; const AParams: TCreateParams); virtual; 126 destructor Destroy; override; 127 { Virtual methods } 128 procedure CreateWidget(const AParams: TCreateParams); virtual; 129 procedure SetEvents; virtual; 130 procedure UnSetEvents; virtual; 131 function HasStaticText: Boolean; virtual; 132 procedure SetText(const AText: String); virtual; 133 function GetText: String; virtual; 134 procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; 135 WithThemeSpace: Boolean); virtual; 136 procedure GetClientRect(var ARect: TRect); virtual; 137 procedure GetDefaultClientRect(var ARect: TRect); virtual; 138 procedure GetWindowRect(var ARect: TRect); virtual; 139 procedure AdjustRectXY(var AfpgRect: TfpgRect); virtual; 140 procedure AdjustRectXYToInterface(var ARect: TRect); virtual; 141 procedure AdjustPointXY(var APoint: TPoint); virtual; 142 procedure AdjustPointXYToInterface(var APoint: TPoint); virtual; 143 procedure SetCursor(const aCursor: integer); virtual; 144 { Non-Virtual } 145 procedure SetSize(AWidth, AHeight: LongInt); 146 procedure SetPosition(AX, AY: Integer); 147 procedure SetFocus; 148 procedure Paint; virtual; 149 procedure Clear; virtual; 150 procedure Invalidate; virtual; 151 public 152 { Properties } 153 property LCLObject: TWinControl read FLCLObject; 154 property Visible: Boolean read GetVisible write SetVisible; 155 property Widget: TfpgWidget read FWidget write FWidget; 156 property WidgetProtected: TFPGWidgetHack read GetWidgetProtected; 157 property Enabled: Boolean read GetEnabled write SetEnabled; 158 property Font: TFont read GetFont write SetFont; 159 property DC: HDC read FDC write SetDC; 160 end; 161 162 163 { TFPGUIPrivateContainer } 164 { Private class for containers } 165 166 TFPGUIPrivateContainer = class(TFPGUIPrivateWidget, IContainer) 167 private 168 protected 169 public 170 constructor Create(ALCLObject: TWinControl; const AParams: TCreateParams); override; 171 // IContainer 172 procedure AddChild(AWidget: TfpgWidget); 173 procedure RemoveChild(AWidget: TfpgWidget); 174 end; 175 176 177 { TFPGUIPrivateBin } 178 { Private class for bins } 179 180 TFPGUIPrivateBin = class(TFPGUIPrivateContainer) 181 private 182 protected 183 public 184 end; 185 186 187 { TFPGUIPrivateWindow } 188 { Private class for windows } 189 190 TFPGUIPrivateWindow = class(TFPGUIPrivateBin) 191 private 192 { Event Handlers } 193 procedure CloseHandler(Sender: TObject; var CloseAction: TCloseAction); 194 procedure MsgResize(var fpgmsg: TfpgMessageRec); message FPGM_RESIZE; 195 protected 196 public 197 { Constructors / Destructors } 198 constructor Create(ALCLObject: TWinControl; const AParams: TCreateParams); override; 199 destructor Destroy; override; 200 { Virtual methods } 201 procedure CreateWidget(const AParams: TCreateParams); override; 202 procedure SetEvents; override; 203 procedure UnSetEvents; override; 204 function HasStaticText: Boolean; override; 205 procedure SetWidgetPosition(AWidget: TfpgWidget; AX, AY: Integer); override; 206 procedure SetText(const AText: String); override; 207 function GetText: String; override; 208 procedure GetClientRect(var ARect: TRect); override; 209 procedure GetDefaultClientRect(var ARect: TRect); override; 210 procedure AdjustRectXY(var AfpgRect: TfpgRect); override; 211 procedure AdjustRectXYToInterface(var ARect: TRect); override; 212 procedure AdjustPointXY(var APoint: TPoint); override; 213 procedure AdjustPointXYToInterface(var APoint: TPoint); override; 214 public 215 MenuBar: TfpgMenuBar; 216 { Other methods } 217 function Form: TfpgForm; 218 procedure SetFormBorderStyle(const AFormBorderStyle: TFormBorderStyle); 219 end; 220 221 222 { TFPGUIPrivateDialog } 223 { Private class for dialogs } 224 225 { TFPGUIPrivateCommonDialog } 226 227 TFPGUIPrivateCommonDialog = class(TFPGUIPrivate) 228 private 229 FDialog: TfpgBaseDialog; 230 FLCLDialog: TCommonDialog; 231 protected 232 procedure CreateDialog; virtual; 233 function InternalShowDialog: Boolean; virtual; 234 procedure UpdatePropsBefore; virtual; 235 procedure UpdatePropsAfter; virtual; 236 public 237 constructor Create(ALCLDialog: TCommonDialog); virtual; 238 destructor Destroy; override; 239 240 function ShowDialog: Boolean; 241 242 property Dialog: TfpgBaseDialog read FDialog write FDialog; 243 property LCLDialog: TCommonDialog read FLCLDialog; 244 end; 245 246 { TFPGUIPrivateFileDialog } 247 248 { TFPGUIPrivateFontDialog } 249 250 TFPGUIPrivateFontDialog = class(TFPGUIPrivateCommonDialog) 251 protected 252 procedure CreateDialog; override; 253 function InternalShowDialog: Boolean; override; 254 procedure UpdatePropsBefore; override; 255 procedure UpdatePropsAfter; override; 256 public 257 function FontDialog: TfpgFontSelectDialog; 258 end; 259 260 { TFPGUIPrivateColorDialog } 261 262 TFPGUIPrivateColorDialog = class(TFPGUIPrivateCommonDialog) 263 protected 264 procedure CreateDialog; override; 265// function InternalShowDialog: Boolean; override; 266 procedure UpdatePropsBefore; override; 267 procedure UpdatePropsAfter; override; 268 public 269 function ColorDialog: TfpgColorSelectDialog; 270 end; 271 272 { TFPGUIPrivateFileDialog } 273 274 TFPGUIPrivateFileDialog = class(TFPGUIPrivateCommonDialog) 275 private 276 protected 277 procedure UpdatePropsBefore; override; 278 procedure UpdatePropsAfter; override; 279 procedure CreateDialog; override; 280 public 281 function FileDialog: TfpgFileDialog; 282 function LCLFileDialog: TFileDialog; 283 end; 284 285 { TFPGUIOpenDialog } 286 { Private class for dialogs } 287 288 { TFPGUIPrivateOpenDialog } 289 290 TFPGUIPrivateOpenDialog = class(TFPGUIPrivateFileDialog) 291 private 292 protected 293 function InternalShowDialog: Boolean; override; 294 public 295 end; 296 297 { TFPGUIPrivateDialog } 298 { Private class for dialogs } 299 300 { TFPGUIPrivateSaveDialog } 301 302 TFPGUIPrivateSaveDialog = class(TFPGUIPrivateFileDialog) 303 private 304 protected 305 function InternalShowDialog: Boolean; override; 306 public 307 end; 308 309 310 { TFPGUIPrivateButton } 311 { Private class for buttons } 312 313 TFPGUIPrivateButton = class(TFPGUIPrivateWidget) 314 private 315 procedure Clicked(Sender: TObject); 316 procedure SetFont(const AValue: TFont); override; 317 protected 318 procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; 319 WithThemeSpace: Boolean); override; 320 public 321 destructor Destroy; override; 322 { Virtual methods } 323 procedure CreateWidget(const AParams: TCreateParams); override; 324 function HasStaticText: Boolean; override; 325 procedure SetText(const AText: String); override; 326 function GetText: String; override; 327 public 328 function Button: TfpgButton; 329 end; 330 331 { TFPGUIPrivateComboBox } 332 333 TFPGUIPrivateComboBox = class(TFPGUIPrivateWidget) 334 private 335 procedure SetFont(const AValue: TFont); override; 336 protected 337 procedure HandleChange(Sender: TObject); 338 procedure HandleDropDown(Sender: TObject); 339 procedure HandleCloseUp(Sender: TObject); 340 public 341 { Virtual methods } 342 procedure CreateWidget(const AParams: TCreateParams); override; 343 procedure SetEvents; override; 344 function HasStaticText: Boolean; override; 345 procedure SetText(const AText: String); override; 346 function GetText: String; override; 347 public 348 { Other methods } 349 function ComboBox: TfpgEditCombo; 350 end; 351 352 353 { TFPGUIPrivateEdit } 354 355 TFPGUIPrivateEdit = class(TFPGUIPrivateWidget) 356 private 357 procedure SetFont(const AValue: TFont); override; 358 protected 359 public 360 { Virtual methods } 361 procedure CreateWidget(const AParams: TCreateParams); override; 362 function HasStaticText: Boolean; override; 363 procedure SetText(const AText: String); override; 364 function GetText: String; override; 365 procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; 366 public 367 { Other methods } 368 function Edit: TfpgEdit; 369 end; 370 371 { TFPGUIPrivateCheckBox } 372 373 TFPGUIPrivateCheckBox = class(TFPGUIPrivateWidget) 374 private 375 procedure SetFont(const AValue: TFont); override; 376 protected 377 procedure HandleChange(Sender: TObject); 378 public 379 { Virtual methods } 380 procedure CreateWidget(const AParams: TCreateParams); override; 381 function HasStaticText: Boolean; override; 382 procedure SetText(const AText: String); override; 383 function GetText: String; override; 384 procedure SetEvents; override; 385 procedure GetPreferredSize(var PreferredWidth, 386 PreferredHeight: integer; WithThemeSpace: Boolean); 387 override; 388 public 389 { Other methods } 390 function CheckBox: TfpgCheckBox; 391 end; 392 393 { TFPGUIPrivateRadioButton } 394 395 TFPGUIPrivateRadioButton = class(TFPGUIPrivateWidget) 396 private 397 procedure SetFont(const AValue: TFont); override; 398 protected 399 public 400 { Virtual methods } 401 procedure CreateWidget(const AParams: TCreateParams); override; 402 function HasStaticText: Boolean; override; 403 procedure SetText(const AText: String); override; 404 function GetText: String; override; 405 procedure GetPreferredSize(var PreferredWidth, 406 PreferredHeight: integer; WithThemeSpace: Boolean); 407 override; 408 public 409 { Other methods } 410 function RadioButton: TfpgRadioButton; 411 end; 412 413 { TFPGUIPrivateListBox } 414 415 TFPGUIPrivateListBox = class(TFPGUIPrivateWidget) 416 private 417 function GetItemIndex: integer; 418 procedure SetItemIndex(const AValue: integer); 419 procedure SetFont(const AValue: TFont); override; 420 protected 421 procedure SelectionChangeHandler(Sender: TObject); 422 procedure DoubleClickHandler(Sender: TObject; AButton: fpg_main.TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 423 public 424 { Virtual methods } 425 procedure CreateWidget(const AParams: TCreateParams); override; 426 function HasStaticText: Boolean; override; 427 procedure SetEvents; override; 428 public 429 { Other methods } 430 function ListBox: TfpgListBox; 431 property ItemIndex: integer read GetItemIndex write SetItemIndex; 432 end; 433 434 { TFPGUIPrivateGroupBox } 435 436 TFPGUIPrivateGroupBox = class(TFPGUIPrivateContainer) 437 private 438 procedure SetFont(const AValue: TFont); override; 439 protected 440 public 441 { Virtual methods } 442 procedure CreateWidget(const AParams: TCreateParams); override; 443 function HasStaticText: Boolean; override; 444 procedure SetWidgetPosition(AWidget: TfpgWidget; AX, AY: Integer); override; 445 procedure SetText(const AText: String); override; 446 function GetText: String; override; 447 procedure AdjustPointXYToInterface(var APoint: TPoint); override; 448 public 449 { Other methods } 450 function GroupBox: TfpgGroupBox; 451 end; 452 453 { TFPGUIPrivateCustomPanel } 454 455 TFPGUIPrivateCustomPanel = class(TFPGUIPrivateContainer) 456 private 457 procedure SetFont(const AValue: TFont); override; 458 protected 459 procedure PaintHandler(Sender: TObject); override; 460 public 461 { Virtual methods } 462 procedure CreateWidget(const AParams: TCreateParams); override; 463 function HasStaticText: Boolean; override; 464 procedure SetWidgetPosition(AWidget: TfpgWidget; AX, AY: Integer); override; 465 procedure AdjustRectXY(var AfpgRect: TfpgRect); override; 466 procedure AdjustPointXY(var APoint: TPoint); override; 467 procedure AdjustRectXYToInterface(var ARect: TRect); override; 468 procedure AdjustPointXYToInterface(var APoint: TPoint); override; 469 public 470 { Other methods } 471 procedure SetText(const AText: String); override; 472 function Panel: TfpgPanel; 473 end; 474 475 { TFPGUIPrivatePageControl } 476 477 TFPGUIPrivatePageControl = class(TFPGUIPrivateWidget) 478 private 479 protected 480 public 481 { Virtual methods } 482 procedure CreateWidget(const AParams: TCreateParams); override; 483 end; 484 485 { TFPGUIPrivateMemo } 486 487 TFPGUIPrivateMemo = class(TFPGUIPrivateWidget) 488 private 489 procedure SetFont(const AValue: TFont); override; 490 protected 491 public 492 { Virtual methods } 493 procedure CreateWidget(const AParams: TCreateParams); override; 494 function HasStaticText: Boolean; override; 495 procedure SetText(const AText: String); override; 496 function GetText: String; override; 497 procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; 498 public 499 { Other methods } 500 function Memo: TfpgMemo; 501 function GetStrings: TStrings; 502 end; 503 504 { TFPGUIPrivatePopUpMenu } 505 506 TFPGUIPrivatePopUpMenu = class(TFPGUIPrivateWidget) 507 private 508 FLCLMenu: TPopUpMenu; 509 FItems: TMenuItem; 510 protected 511 public 512 { Constructors / Destructors } 513 constructor Create(ALCLObject: TPopUpMenu; AItems: TMenuItem); reintroduce; 514 destructor Destroy; override; 515 { Virtual methods } 516 public 517 { Other methods } 518 function PopUpMenu: TfpgPopUpMenu; 519 procedure PopUp(X, Y: Integer); 520 end; 521 522 { TFPGUIPrivateScrollBar } 523 524 TFPGUIPrivateScrollBar = class(TFPGUIPrivateWidget) 525 private 526 function GetHorizontal: Boolean; 527 function GetMax: integer; 528 function GetMin: integer; 529 function GetPosition: integer; 530 procedure ScrollHandler(Sender: TObject; position: integer); 531 procedure SetHorizontal(AValue: Boolean); 532 procedure SetMax(AValue: integer); 533 procedure SetMin(AValue: integer); 534 procedure SetPosition(AValue: integer); 535 protected 536 function DeliverMessage(var Msg): LRESULT; 537 public 538 { Virtual methods } 539 procedure CreateWidget(const AParams: TCreateParams); override; 540 public 541 function ScrollBar: TfpgScrollBar; 542 property Min: integer read GetMin write SetMin; 543 property Max: integer read GetMax write SetMax; 544 property Position: integer read GetPosition write SetPosition; 545 property Horizontal: Boolean read GetHorizontal write SetHorizontal; 546 end; 547 548 TFPGUIPrivateProgressBar = class(TFPGUIPrivateWidget) 549 public 550 procedure CreateWidget(const AParams: TCreateParams); override; 551 public 552 function ProgressBar: TfpgProgressBar; 553 end; 554 555 { TFPGUIPrivateSplitter } 556 557 TFPGUIPrivateSplitter = class(TFPGUIPrivateWidget) 558 public 559 procedure CreateWidget(const AParams: TCreateParams); override; 560 public 561 function Splitter: TfpgSplitter; 562 end; 563 564 { TFPGUIPrivateStaticText } 565 566 TFPGUIPrivateStaticText = class(TFPGUIPrivateWidget) 567 private 568 procedure SetFont(const AValue: TFont); override; 569 public 570 procedure CreateWidget(const AParams: TCreateParams); override; 571 function HasStaticText: Boolean; override; 572 procedure SetText(const AText: String); override; 573 function GetText: String; override; 574 public 575 function StaticText: TfpgLabel; 576 end; 577 578 { TFPGUIPrivateScrollingWinControl } 579 580 TFPGUIPrivateScrollingWinControl = class(TFPGUIPrivateContainer) 581 public 582 procedure CreateWidget(const AParams: TCreateParams); override; 583 public 584 function ScrollFrame: TfpgScrollFrame; 585 procedure Invalidate; override; 586 end; 587 588var 589 GlobalMouseCursorPos: TPoint; 590 GlobalMouseCursorPosPrivateWidget: TFPGUIPrivateWidget; 591 GlobalMouseCapturedPrivateWidget: TFPGUIPrivateWidget; 592 GlobalFocusedPrivateWidget: TFPGUIPrivateWidget; 593 594implementation 595 596uses 597 LCLMessageGlue; 598 599{ TFPGUIPrivateScrollingWinControl } 600 601procedure TFPGUIPrivateScrollingWinControl.CreateWidget( 602 const AParams: TCreateParams); 603begin 604 Widget := TfpgScrollFrame.Create(GetParentContainerWidget()); 605end; 606 607function TFPGUIPrivateScrollingWinControl.ScrollFrame: TfpgScrollFrame; 608begin 609 Result:=TfpgScrollFrame(Widget); 610end; 611 612procedure TFPGUIPrivateScrollingWinControl.Invalidate; 613begin 614 inherited Invalidate; 615 ScrollFrame.ContentFrame.Invalidate; 616end; 617 618{ TFPGUIPrivateStaticText } 619 620procedure TFPGUIPrivateStaticText.SetFont(const AValue: TFont); 621begin 622 StaticText.FontDesc:=TFontToTfpgFontDesc(AValue); 623end; 624 625procedure TFPGUIPrivateStaticText.CreateWidget(const AParams: TCreateParams); 626begin 627 Widget := TfpgLabel.Create(GetParentContainerWidget()); 628end; 629 630function TFPGUIPrivateStaticText.HasStaticText: Boolean; 631begin 632 Result:=true; 633end; 634 635procedure TFPGUIPrivateStaticText.SetText(const AText: String); 636begin 637 StaticText.Text:=AText; 638end; 639 640function TFPGUIPrivateStaticText.GetText: String; 641begin 642 Result:=StaticText.Text; 643end; 644 645function TFPGUIPrivateStaticText.StaticText: TfpgLabel; 646begin 647 Result:=TfpgLabel(Widget); 648end; 649 650{ TFPGUIPrivateSplitter } 651 652procedure TFPGUIPrivateSplitter.CreateWidget(const AParams: TCreateParams); 653begin 654 Widget := TfpgSplitter.Create(GetParentContainerWidget()); 655 Splitter.AutoSnap:=false; 656 (* 657 case FLCLObject.Align of 658 controls.TAlign.alNone: Splitter.Align:=alNone; 659 controls.TAlign.alTop: Splitter.Align:=alTop; 660 controls.TAlign.alBottom: Splitter.Align:=alBottom; 661 controls.TAlign.alLeft: Splitter.Align:=alLeft; 662 controls.TAlign.alRight: Splitter.Align:=alRight; 663 controls.TAlign.alClient: Splitter.Align:=alClient; 664 controls.TAlign.alCustom: Splitter.Align:=alNone; 665 end; 666 *) 667end; 668 669function TFPGUIPrivateSplitter.Splitter: TfpgSplitter; 670begin 671 Result:=TfpgSplitter(Widget); 672end; 673 674{ TFPGUIPrivateScrollBar } 675 676function TFPGUIPrivateScrollBar.GetHorizontal: Boolean; 677begin 678 if ScrollBar.Orientation=orHorizontal then begin 679 Result:=true; 680 end else begin 681 Result:=false; 682 end; 683end; 684 685function TFPGUIPrivateScrollBar.GetMax: integer; 686begin 687 Result:=ScrollBar.Max; 688end; 689 690function TFPGUIPrivateScrollBar.GetMin: integer; 691begin 692 Result:=ScrollBar.Min; 693end; 694 695function TFPGUIPrivateScrollBar.GetPosition: integer; 696begin 697 Result:=ScrollBar.Position; 698end; 699 700procedure TFPGUIPrivateScrollBar.ScrollHandler(Sender: TObject; 701 position: integer); 702var 703 Msg: TLMScroll; 704begin 705 FillChar(Msg{%H-}, SizeOf(Msg), #0); 706 if ScrollBar.Orientation=orHorizontal then begin 707 Msg.Msg := LM_HSCROLL; 708 end else begin 709 Msg.Msg := LM_VSCROLL; 710 end; 711 Msg.Pos:=ScrollBar.Position; 712 Msg.ScrollBar:=HWND(LCLObject); 713 Msg.ScrollCode:=4; //scPosition 714 DeliverMessage(Msg); 715end; 716 717procedure TFPGUIPrivateScrollBar.SetHorizontal(AValue: Boolean); 718begin 719 if AValue then begin 720 ScrollBar.Orientation:=orHorizontal; 721 end else begin 722 ScrollBar.Orientation:=orVertical; 723 end; 724end; 725 726procedure TFPGUIPrivateScrollBar.SetMax(AValue: integer); 727begin 728 ScrollBar.Max:=AValue; 729end; 730 731procedure TFPGUIPrivateScrollBar.SetMin(AValue: integer); 732begin 733 ScrollBar.Min:=AValue; 734end; 735 736procedure TFPGUIPrivateScrollBar.SetPosition(AValue: integer); 737begin 738 ScrollBar.Position:=AValue; 739end; 740 741function TFPGUIPrivateScrollBar.DeliverMessage(var Msg): LRESULT; 742begin 743 LCLObject.WindowProc(TLMessage(Msg)); 744 Result:=TLMessage(Msg).Result; 745end; 746 747procedure TFPGUIPrivateScrollBar.CreateWidget(const AParams: TCreateParams); 748begin 749 Widget := TfpgScrollBar.Create(GetParentContainerWidget()); 750 ScrollBar.OnScroll:=ScrollHandler; 751end; 752 753function TFPGUIPrivateScrollBar.ScrollBar: TfpgScrollBar; 754begin 755 Result:=TfpgScrollBar(Widget); 756end; 757 758{ TFPGUIPrivateColorDialog } 759 760procedure TFPGUIPrivateColorDialog.CreateDialog; 761begin 762 Dialog := TfpgColorSelectDialog.Create(nil); 763end; 764 765procedure TFPGUIPrivateColorDialog.UpdatePropsBefore; 766begin 767 inherited UpdatePropsBefore; 768 TfpgColorSelectDialog(Dialog).SelectedColor:=TColorToTfpgColor(TColorDialog(LCLDialog).Color); 769end; 770 771procedure TFPGUIPrivateColorDialog.UpdatePropsAfter; 772begin 773 inherited UpdatePropsAfter; 774 TColorDialog(LCLDialog).Color:=TTfpgColorToTColor(TfpgColorSelectDialog(Dialog).SelectedColor); 775end; 776 777function TFPGUIPrivateColorDialog.ColorDialog: TfpgColorSelectDialog; 778begin 779 Result:=TfpgColorSelectDialog(Dialog); 780end; 781 782{ TFPGUIPrivateProgressBar } 783 784procedure TFPGUIPrivateProgressBar.CreateWidget(const AParams: TCreateParams); 785begin 786 Widget := TfpgProgressBar.Create(GetParentContainerWidget()); 787end; 788 789function TFPGUIPrivateProgressBar.ProgressBar: TfpgProgressBar; 790begin 791 Result := TfpgProgressBar(Widget); 792end; 793 794{ TFPGUIPrivate } 795 796function TFPGUIPrivate._AddRef: longint; stdcall; 797begin 798 Result := -1; 799end; 800 801function TFPGUIPrivate._Release: longint; stdcall; 802begin 803 Result := -1; 804end; 805 806{ TFPGUIPrivateWidget } 807 808procedure TFPGUIPrivateWidget.SetVisible(const AValue: Boolean); 809begin 810 Widget.Visible := AValue; 811 if (AValue=false) and (GlobalFocusedPrivateWidget=Self) then begin 812 ExitHandler(Self); 813 end; 814end; 815 816procedure TFPGUIPrivateWidget.PaintHandler(Sender: TObject{; const ARect: TfpgRect}); 817var 818 AStruct: PaintStruct; 819 lDC: HDC; 820begin 821 if not Assigned(LCLObject) or not Assigned(FWidget) then exit; 822 {$ifdef VerboseFPGUIPrivate} 823 WriteLn('TFPGUIPrivateWindow.PaintHandler for ',LCLObject.Name); 824 {$endif} 825 lDC:=Self.DC; 826 FillChar(AStruct,sizeof(AStruct),0); 827 AStruct.hdc:=lDC; 828 AStruct.fRestore:=true; 829 Self.GetClientRect(AStruct.rcPaint); 830 LCLSendPaintMsg(LCLObject,lDC,@AStruct); 831end; 832 833procedure TFPGUIPrivateWidget.ClickHandler(Sender: TObject); 834begin 835 LCLSendClickedMsg(LCLObject); 836end; 837 838procedure TFPGUIPrivateWidget.EnterHandler(Sender: TObject); 839begin 840 if not FEntered then begin 841 if not Assigned(FWidget) then begin 842 GlobalFocusedPrivateWidget:=nil; 843 exit; 844 end; 845 (* 846 if not FWidget.Focusable then begin 847 writeln(TimeToStr(now),' ',FLCLObject.Name,' Not focusable ',self.Widget.Width,',',self.Widget.Height); 848 exit; 849 end; 850 *) 851 GlobalFocusedPrivateWidget:=Self; 852 FEntered:=true; 853 LCLSendSetFocusMsg(FLCLObject); 854 {$IFDEF FPGUIDEBUGFOCUS} 855 writeln(TimeToStr(now),' ','Enter ',FLCLObject.Name,' ',self.Widget.Width,',',self.Widget.Height); 856 {$ENDIF} 857 end; 858end; 859 860procedure TFPGUIPrivateWidget.ExitHandler(Sender: TObject); 861var 862 PrivateWidget: TFPGUIPrivateWidget; 863begin 864 (* 865 if not Widget.Focusable then begin 866 {$IFDEF FPGUIDEBUGFOCUS} 867 writeln(TimeToStr(now),' ','Non UNFOCUSABLE ',FLCLObject.Name); 868 {$ENDIF} 869 FEntered:=false; 870 exit; 871 end; 872 *) 873 if FEntered then begin 874 GlobalFocusedPrivateWidget:=nil; 875 FEntered:=false; 876 LCLSendKillFocusMsg(FLCLObject); 877 {$IFDEF FPGUIDEBUGFOCUS} 878 writeln(TimeToStr(now),' ','Exit Handler ',FLCLObject.Name,' ',FWidget.Focusable); 879 {$ENDIF} 880 end; 881end; 882 883procedure TFPGUIPrivateWidget.ResizeHandler(Sender: TObject); 884begin 885 if Assigned(FLCLObject) then begin 886 LCLSendSizeMsg(FLCLObject,Widget.Width,Widget.Height,SIZE_RESTORED,true); 887 end; 888end; 889 890procedure TFPGUIPrivateWidget.MouseMoveHandler(Sender: TObject; 891 AShift: TShiftState; const AMousePos: TPoint); 892var 893 lAdjustedMousePos: TPoint; 894begin 895 lAdjustedMousePos:=AMousePos; 896 AdjustPointXYToInterface(lAdjustedMousePos); 897 GlobalMouseCursorPos:=lAdjustedMousePos; 898 GlobalMouseCursorPosPrivateWidget:=Self; 899 900 LCLSendMouseMoveMsg(FLCLObject,lAdjustedMousePos.x,lAdjustedMousePos.y,AShift); 901 NotifyApplicationUserInput(FLCLObject,LM_MOUSEMOVE); 902end; 903 904procedure TFPGUIPrivateWidget.MsgDeactivate(var fpgmsg: TfpgMessageRec); 905begin 906 //Empty stub. To be implemented. 907 // No LCLMessage for deactivate 908end; 909 910procedure TFPGUIPrivateWidget.MsgActivate(var fpgmsg: TfpgMessageRec); 911begin 912 LCLSendActivateMsg(LCLObject,1,false,HWND(Self)); 913end; 914 915(* 916procedure TFPGUIPrivateWidget.MsgPaint(var fpgmsg: TfpgMessageRec); 917begin 918 {$ifdef VerboseFPGUIPrivate} 919 WriteLn('TFPGUIPrivateWindow.PaintHandler for ',LCLObject.Name); 920 {$endif} 921 exit; 922 { 923 if (LCLObject is TWinControl) then 924 begin 925 FillChar(Msg, SizeOf(Msg), #0); 926 927 Msg.Msg := LM_PAINT; 928 New(AStruct); 929 FillChar(AStruct^, SizeOf(TPaintStruct), 0); 930 Msg.PaintStruct := AStruct; 931 Msg.DC := BeginPaint(THandle(Self), AStruct^); 932 933 Self.GetClientRect(Msg.PaintStruct^.rcPaint); 934 //Msg.PaintStruct^.rcPaint := fpgRectToRect(fpgmsg.Params.rect); 935 Msg.PaintStruct^.hdc := Msg.DC; 936 937 938 // send paint message 939 try 940 // Saving clip rect and clip region 941 try 942 LCLObject.WindowProc(TLMessage(Msg)); 943 finally 944 EndPaint(THandle(Self), AStruct^); 945 Dispose(AStruct); 946 end; 947 except 948 Application.HandleException(nil); 949 end; 950 end; 951 } 952end; 953*) 954 955(* 956procedure TFPGUIPrivateWidget.MsgResize(var fpgmsg: TfpgMessageRec); 957begin 958 LCLSendSizeMsg(LCLObject, fpgmsg.Params.rect.Width,fpgmsg.Params.rect.Height, SIZE_RESTORED, false); 959end; 960*) 961 962procedure TFPGUIPrivateWidget.MsgMove(var fpgmsg: TfpgMessageRec); 963var 964 P: TPoint; 965begin 966 if Assigned(LCLObject) and Assigned(FWidget) then begin 967 P:=Point(fpgmsg.Params.rect.Left,fpgmsg.Params.rect.Top); 968 if Assigned(FLCLObject.Parent) then begin 969 TFPGUIPrivateWidget(FLCLObject.Parent.Handle).AdjustPointXYToInterface(P); 970 end; 971 LCLSendMoveMsg(LCLObject, P.x, P.y,Move_Default,true); 972 end; 973end; 974 975(* 976procedure TFPGUIPrivateWidget.MsgKeyChar(var fpgmsg: TfpgMessageRec); 977var 978 lKey: string; 979 lW: Word; 980begin 981 exit; 982 lKey:=UTF8ToAnsi(fpgmsg.Params.keyboard.keychar); 983 if Length(lKey)>0 then begin 984 lW:=Byte(lKey[1]); 985 LCLSendCharEvent(LCLObject,lW,0,true,false,true); 986 // Changing keychar and keycode does nothing in target widget. 987 end; 988end; 989*) 990 991(* 992procedure TFPGUIPrivateWidget.MsgKeyPress(var fpgmsg: TfpgMessageRec); 993var 994 lKey: Word; 995begin 996 lKey:=KeycodeToWindowsVirtKey(fpgmsg.Params.keyboard.keycode); 997 LCLSendKeyDownEvent(LCLObject, lKey, fpgmsg.Params.keyboard.keycode, true, true); 998end; 999*) 1000 1001procedure TFPGUIPrivateWidget.MsgKeyRelease(var fpgmsg: TfpgMessageRec); 1002var 1003 lKey: Word; 1004begin 1005 lKey:=KeycodeToWindowsVirtKey(fpgmsg.Params.keyboard.keycode); 1006 LCLSendKeyUpEvent(LCLObject, lKey, fpgmsg.Params.keyboard.keycode, True, True); 1007end; 1008 1009function fpgMouseButtonToTButton(AButton: Word): Controls.TMouseButton; overload; 1010begin 1011 case AButton of 1012 MOUSE_LEFT: Result := Controls.mbLeft; 1013 MOUSE_MIDDLE: Result := Controls.mbMiddle; 1014 MOUSE_RIGHT: Result := Controls.mbRight; 1015 else 1016 Result := Controls.mbExtra1; 1017 1018 end; 1019end; 1020 1021function fpgMouseButtonToTButton(AButton: TMouseButton): Controls.TMouseButton; overload; 1022begin 1023 case AButton of 1024 mbLeft: Result := Controls.mbLeft; 1025 mbRight: Result := Controls.mbRight; 1026 mbMiddle: Result := Controls.mbMiddle; 1027 otherwise 1028 Result := Controls.mbExtra1; 1029 end; 1030end; 1031 1032 1033(* 1034procedure TFPGUIPrivateWidget.MsgMouseDown(var fpgmsg: TfpgMessageRec); 1035var 1036 TmpRect: TRect; 1037begin 1038 TmpRect.TopLeft:=Point(fpgmsg.Params.mouse.x,fpgmsg.Params.mouse.y); 1039 AdjustRectXYToInterface(TmpRect); 1040 LCLSendMouseDownMsg(LCLObject, TmpRect.Left, TmpRect.Top,fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), fpgmsg.Params.mouse.shiftstate); 1041end; 1042*) 1043 1044(* 1045procedure TFPGUIPrivateWidget.MsgMouseUp(var fpgmsg: TfpgMessageRec); 1046var 1047 p: TPoint; 1048 ss: TShiftState; 1049 TmpRect: TRect; 1050begin 1051 TmpRect.TopLeft:=Point(fpgmsg.Params.mouse.x,fpgmsg.Params.mouse.y); 1052 AdjustRectXYToInterface(TmpRect); 1053 LCLSendMouseUpMsg(LCLObject, TmpRect.Left, TmpRect.Top,fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), fpgmsg.Params.mouse.shiftstate); 1054 ss:=fpgmsg.Params.mouse.shiftstate; 1055 if not (ssShift in ss) then 1056 if not (ssAlt in ss) then 1057 if not (ssCtrl in ss) then 1058 if (fpgmsg.Params.mouse.Buttons=MOUSE_RIGHT) then begin 1059 if Assigned(LCLObject.PopupMenu) then begin 1060 p.x:=fpgmsg.Params.mouse.x; 1061 p.y:=fpgmsg.Params.mouse.y; 1062 ClientToScreen(HWND(Self),p); 1063 LCLObject.PopupMenu.PopUp(p.x,p.y); 1064 end; 1065 end; 1066end; 1067*) 1068 1069(* 1070procedure TFPGUIPrivateWidget.MsgMouseMove(var fpgmsg: TfpgMessageRec); 1071var 1072 lTmpPoint: TPoint; 1073begin 1074 lTmpPoint:=Point(fpgmsg.Params.mouse.x,fpgmsg.Params.mouse.y); 1075 AdjustPointXY(lTmpPoint); 1076 lTmpPoint:=Self.FWidget.WindowToScreen(Self.FWidget,lTmpPoint); 1077 GlobalMouseCursorPos:=lTmpPoint; 1078 GlobalMouseCursorPosPrivateWidget:=Self; 1079end; 1080*) 1081 1082procedure TFPGUIPrivateWidget.MsgDoubleClick(var fpgmsg: TfpgMessageRec); 1083begin 1084 LCLSendMouseMultiClickMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y, fpgMouseButtonToTButton(fpgmsg.Params.mouse.Buttons), 2, fpgmsg.Params.mouse.shiftstate); 1085end; 1086 1087(* 1088procedure TFPGUIPrivateWidget.MsgMouseEnter(var fpgmsg: TfpgMessageRec); 1089begin 1090 if Assigned(LCLObject) then begin 1091 LCLSendMouseEnterMsg(LCLObject); 1092 end; 1093end; 1094*) 1095 1096(* 1097procedure TFPGUIPrivateWidget.MsgMouseExit(var fpgmsg: TfpgMessageRec); 1098begin 1099 if Assigned(LCLObject) then begin 1100 LCLSendMouseLeaveMsg(LCLObject); 1101 end; 1102end; 1103*) 1104 1105procedure TFPGUIPrivateWidget.MsgMouseScroll(var fpgmsg: TfpgMessageRec); 1106begin 1107 if Assigned(LCLObject) then begin 1108 LCLSendMouseWheelMsg(LCLObject, fpgmsg.Params.mouse.x, fpgmsg.Params.mouse.y,fpgmsg.Params.mouse.delta, fpgmsg.Params.mouse.shiftstate); 1109 end; 1110end; 1111 1112procedure TFPGUIPrivateWidget.MsgUser(var fpgmsg: TfpgMessageRec); 1113var 1114 lNewMessage: LMessages.TLMessage; 1115begin 1116 // User message. User message is in Param1, and wParam and lParam in Param 2/3 1117 lNewMessage.msg:=LM_USER+fpgmsg.Params.user.Param1; 1118 lNewMessage.wParam:=fpgmsg.Params.user.Param2; 1119 lNewMessage.lParam:=fpgmsg.Params.user.Param3; 1120 LCLObject.WindowProc(lNewMessage); 1121end; 1122 1123function TFPGUIPrivateWidget.GetParentContainerWidget: TfpgWidget; 1124begin 1125 // Note, if the Handle of the parent doesn't exist, it's automatically 1126 // created 1127 if Assigned(LCLObject) and Assigned(LCLObject.Parent) then begin 1128 Result := TFPGUIPrivateContainer(LCLObject.Parent.Handle).Widget; 1129 if Result is TfpgScrollFrame then begin 1130 Result:=TfpgScrollFrame(Result).ContentFrame; 1131 end 1132 end else begin 1133 Result := nil; 1134 end; 1135end; 1136 1137function TFPGUIPrivateWidget.GetParentContainerPrivateWidgetFocusable: TFPGUIPrivateWidget; 1138begin 1139 if Assigned(LCLObject) and Assigned(LCLObject.Parent) then begin 1140 Result := TFPGUIPrivateContainer(LCLObject.Parent.Handle); 1141 if not Result.Widget.Focusable then begin 1142 Result:=nil; 1143 end; 1144 end else begin 1145 Result := nil; 1146 end; 1147end; 1148 1149function TFPGUIPrivateWidget.GetVisible: Boolean; 1150begin 1151 Result := Widget.Visible; 1152end; 1153 1154function TFPGUIPrivateWidget.GetEnabled: Boolean; 1155begin 1156 Result:=FWidget.Enabled; 1157end; 1158 1159function TFPGUIPrivateWidget.GetFont: TFont; 1160begin 1161 Result:=nil; 1162end; 1163 1164function TFPGUIPrivateWidget.GetWidgetProtected: TFPGWidgetHack; 1165begin 1166 Result := TFPGWidgetHack(FWidget); 1167end; 1168 1169procedure TFPGUIPrivateWidget.MouseDownHandler(Sender: TObject; 1170 AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 1171var 1172 TmpPoint: TPoint; 1173begin 1174 TmpPoint:=AMousePos; 1175 AdjustPointXYToInterface(TmpPoint); 1176 LCLSendMouseDownMsg(LCLObject, TmpPoint.x, TmpPoint.y,fpgMouseButtonToTButton(AButton), AShift); 1177 // A mouse move message must be sent or click visual effect is not working in LCL 1178 LCLSendMouseMoveMsg(LCLObject, TmpPoint.x, TmpPoint.y,AShift); 1179end; 1180 1181procedure TFPGUIPrivateWidget.MouseUpHandler(Sender: TObject; 1182 AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 1183var 1184 lPopupPoint: TPoint; 1185 lTmpPoint: TPoint; 1186begin 1187 lTmpPoint:=AMousePos; 1188 AdjustPointXYToInterface(lTmpPoint); 1189 LCLSendMouseUpMsg(LCLObject, lTmpPoint.x, lTmpPoint.y,fpgMouseButtonToTButton(AButton), AShift); 1190 if not (ssShift in AShift) then 1191 if not (ssAlt in AShift) then 1192 if not (ssCtrl in AShift) then 1193 if (AButton=mbRight) then begin 1194 if Assigned(LCLObject.PopupMenu) then begin 1195 lPopupPoint:=lTmpPoint; 1196 ClientToScreen(HWND(Self),lPopupPoint); 1197 LCLObject.PopupMenu.PopUp(lPopupPoint.x,lPopupPoint.y); 1198 end; 1199 end; 1200end; 1201 1202procedure TFPGUIPrivateWidget.MouseExitHandler(Sender: TObject); 1203begin 1204 if Assigned(LCLObject) then begin 1205 LCLSendMouseLeaveMsg(LCLObject); 1206 end; 1207end; 1208 1209procedure TFPGUIPrivateWidget.MouseEnterHandler(Sender: TObject); 1210begin 1211 if Assigned(LCLObject) then begin 1212 LCLSendMouseEnterMsg(LCLObject); 1213 end; 1214end; 1215 1216procedure TFPGUIPrivateWidget.KeyPressHandler(Sender: TObject; 1217 var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); 1218var 1219 lKey: Word; 1220begin 1221 lKey:=KeycodeToWindowsVirtKey(KeyCode); 1222 LCLSendKeyDownEvent(LCLObject, lKey, lKey, true, true); 1223end; 1224 1225procedure TFPGUIPrivateWidget.KeyCharHandler(Sender: TObject; AChar: TfpgChar; 1226 var Consumed: boolean); 1227var 1228 lKey: string; 1229 lW: Word; 1230begin 1231 lKey:=UTF8ToAnsi(AChar); 1232 if Length(lKey)>0 then begin 1233 lW:=Byte(lKey[1]); 1234 LCLSendCharEvent(LCLObject,lW,0,true,false,true); 1235 // Changing keychar and keycode does nothing in target widget. 1236 if lW=0 then begin 1237 Consumed:=true; 1238 end; 1239 end; 1240end; 1241 1242procedure TFPGUIPrivateWidget.SetDC(const AValue: HDC); 1243begin 1244 FDC:=AValue; 1245end; 1246 1247procedure TFPGUIPrivateWidget.SetEnabled(const AValue: Boolean); 1248begin 1249 Widget.Enabled:=AValue; 1250end; 1251 1252procedure TFPGUIPrivateWidget.SetFont(const AValue: TFont); 1253begin 1254 //Widget does not have a default font for all widgets, one 1255 //by one must be implemented. 1256end; 1257 1258constructor TFPGUIPrivateWidget.Create(ALCLObject: TWinControl; const AParams: TCreateParams); 1259begin 1260 FLCLObject := ALCLObject; 1261 1262 CreateWidget(AParams); 1263 1264 if (AParams.Style and WS_VISIBLE)=0 then begin 1265 Self.Widget.Visible:=false; 1266 end; 1267 if (AParams.Style and WS_DISABLED)=WS_DISABLED then begin 1268 Self.Widget.Enabled:=false; 1269 end; 1270 1271 Self.Widget.Width:=AParams.Width; 1272 Self.Widget.Height:=AParams.Height; 1273 1274 SetEvents; 1275end; 1276 1277destructor TFPGUIPrivateWidget.Destroy; 1278begin 1279 if (FWidget <> nil) then begin 1280 UnSetEvents; 1281 //Be sure that if the object is the active object in parent 1282 //unset the activewidget. Anothe possibility is to forward 1283 //active widget to next in parent 1284 if FWidget.Parent<>nil then begin 1285 if FWidget.Parent.ActiveWidget=FWidget then begin 1286 FWidget.Parent.ActiveWidget:=nil; 1287 end; 1288 end; 1289 FreeAndNil(FWidget); 1290 end; 1291 if GlobalMouseCursorPosPrivateWidget=Self then begin 1292 GlobalMouseCursorPosPrivateWidget:=nil; 1293 end; 1294 if GlobalMouseCapturedPrivateWidget=Self then begin 1295 GlobalMouseCapturedPrivateWidget:=nil; 1296 end; 1297 if Assigned(FLCLObject) and Assigned(FWidget) then begin 1298 if Assigned(FLCLObject.Parent) then begin 1299 TFPGUIPrivateWidget(FLCLObject.Parent.Handle).Invalidate; 1300 end; 1301 end; 1302 inherited Destroy; 1303end; 1304 1305procedure TFPGUIPrivateWidget.CreateWidget(const AParams: TCreateParams); 1306begin 1307{$IFDEF BASEWIDGET_WIDGET} 1308 Widget := TfpgWidget.Create(GetParentContainerWidget()); 1309{$ELSE} 1310 {$IFDEF BASEWIDGET_SCROLLFRAME} 1311 Widget := TfpgScrollFrame.Create(GetParentContainerWidget()); 1312 {$ELSE} 1313 {$IFDEF BASEWIDGET_PANEL} 1314 Widget := TfpgPanel.Create(GetParentContainerWidget()); 1315 TfpgPanel(Widget).Style:=bsFlat; 1316 TfpgPanel(Widget).Text:=''; 1317 TfpgPanel(Widget).ParentBackgroundColor:=false; 1318 {$ELSE} 1319 Syntax error, choose WIDGET,SCROLLFRAME or PANEL for BASEWIDGET 1320 {$ENDIF} 1321 {$ENDIF} 1322{$ENDIF} 1323end; 1324 1325procedure TFPGUIPrivateWidget.SetEvents; 1326begin 1327 WidgetProtected.OnPaint := PaintHandler; 1328 WidgetProtected.OnClick := ClickHandler; 1329 WidgetProtected.OnResize := ResizeHandler; 1330 WidgetProtected.OnEnter := EnterHandler; 1331 WidgetProtected.OnExit := ExitHandler; 1332 WidgetProtected.OnKeyPress := KeyPressHandler; 1333 WidgetProtected.OnKeyChar := KeyCharHandler; 1334 WidgetProtected.OnMouseEnter := MouseEnterHandler; 1335 WidgetProtected.OnMouseExit := MouseExitHandler; 1336 WidgetProtected.OnMouseMove := MouseMoveHandler; 1337 WidgetProtected.OnMouseDown := MouseDownHandler; 1338 WidgetProtected.OnMouseUp := MouseUpHandler; 1339 1340 // Messages which can not be handled as Widget events. 1341 fpgApplication.SetMessageHook(Widget, FPGM_MOVE, Self); 1342 fpgApplication.SetMessageHook(Widget, FPGM_KEYRELEASE, Self); 1343 fpgApplication.SetMessageHook(Widget, FPGM_ACTIVATE, Self); 1344 fpgApplication.SetMessageHook(Widget, FPGM_DEACTIVATE, Self); 1345 fpgApplication.SetMessageHook(Widget, FPGM_DOUBLECLICK, Self); 1346 fpgApplication.SetMessageHook(Widget, FPGM_CLOSE, Self); 1347 fpgApplication.SetMessageHook(Widget, FPGM_SCROLL, Self); 1348 fpgApplication.SetMessageHook(Widget, FPGM_POPUPCLOSE, Self); 1349 fpgApplication.SetMessageHook(Widget, FPGM_HINTTIMER, Self); 1350 // fpgApplication.SetMessageHook(Widget, FPGM_KEYCHAR, Self); 1351 // fpgApplication.SetMessageHook(Widget, FPGM_MOUSEENTER, Self); 1352 // fpgApplication.SetMessageHook(Widget, FPGM_MOUSEEXIT, Self); 1353 // fpgApplication.SetMessageHook(Widget, FPGM_RESIZE, Self); 1354 // fpgApplication.SetMessageHook(Widget, FPGM_KEYPRESS, Self); 1355 // fpgApplication.SetMessageHook(Widget, FPGM_PAINT, Self); 1356 // fpgApplication.SetMessageHook(Widget, FPGM_MOUSEMOVE, Self); 1357 // fpgApplication.SetMessageHook(Widget, FPGM_MOUSEDOWN, Self); 1358 // fpgApplication.SetMessageHook(Widget, FPGM_MOUSEUP, Self); 1359end; 1360 1361procedure TFPGUIPrivateWidget.UnSetEvents; 1362begin 1363 fpgApplication.UnSetMessageHook(Widget, FPGM_MOVE, Self); 1364 fpgApplication.UnSetMessageHook(Widget, FPGM_KEYRELEASE, Self); 1365 fpgApplication.UnSetMessageHook(Widget, FPGM_ACTIVATE, Self); 1366 fpgApplication.UnSetMessageHook(Widget, FPGM_DEACTIVATE, Self); 1367 fpgApplication.UnSetMessageHook(Widget, FPGM_DOUBLECLICK, Self); 1368 fpgApplication.UnSetMessageHook(Widget, FPGM_CLOSE, Self); 1369 fpgApplication.UnSetMessageHook(Widget, FPGM_SCROLL, Self); 1370 fpgApplication.UnSetMessageHook(Widget, FPGM_POPUPCLOSE, Self); 1371 fpgApplication.UnSetMessageHook(Widget, FPGM_HINTTIMER, Self); 1372end; 1373 1374procedure TFPGUIPrivateWidget.SetSize(AWidth, AHeight: LongInt); 1375begin 1376 FWidget.SetPosition(FWidget.Left, FWidget.Top, AWidth, AHeight); 1377 FLCLObject.InvalidateClientRectCache(true); 1378 LCLSendSizeMsg(FLCLObject,AWidth,AHeight,SIZE_RESTORED,false); 1379end; 1380 1381procedure TFPGUIPrivateWidget.SetPosition(AX, AY: Integer); 1382begin 1383 if (FWidget.Parent<>nil) then begin 1384 //Request parent object to put the widget coordinates. This is needed for 1385 //widgets like TForm which reduces its clientrect when a menubar is visible. 1386 TFPGUIPrivateWidget(FLCLObject.Parent.Handle).SetWidgetPosition(FWidget,AX,AY); 1387 end else begin 1388 SetWidgetPosition(FWidget,AX,AY); 1389 end; 1390 LCLSendMoveMsg(FLCLObject,AX,AY,Move_Default,false); 1391end; 1392 1393procedure TFPGUIPrivateWidget.SetWidgetPosition(AWidget: TfpgWidget; AX, 1394 AY: Integer); 1395begin 1396 if AWidget=nil then exit; 1397 AWidget.SetPosition(AX,AY,AWidget.Width,AWidget.Height); 1398end; 1399 1400function TFPGUIPrivateWidget.HasStaticText: Boolean; 1401begin 1402 Result := False; 1403end; 1404 1405procedure TFPGUIPrivateWidget.SetText(const AText: String); 1406begin 1407 //Do nothing, empty stub 1408end; 1409 1410function TFPGUIPrivateWidget.GetText: String; 1411begin 1412 Result := ''; 1413end; 1414 1415procedure TFPGUIPrivateWidget.GetPreferredSize(var PreferredWidth, 1416 PreferredHeight: integer; WithThemeSpace: Boolean); 1417begin 1418 PreferredWidth:=0; 1419 PreferredHeight:=0; 1420end; 1421 1422procedure TFPGUIPrivateWidget.GetClientRect(var ARect: TRect); 1423var 1424 CLRect: TfpgRect; 1425begin 1426 //ClientRect must have Left and Top = (0,0) 1427 CLRect:=FWidget.GetClientRect; 1428 ARect.Left:=0; 1429 ARect.Top:=0; 1430 ARect.Right:=CLRect.Width; 1431 ARect.Bottom:=CLRect.Height; 1432end; 1433 1434procedure TFPGUIPrivateWidget.GetDefaultClientRect(var ARect: TRect); 1435var 1436 CLRect: TfpgRect; 1437begin 1438 //ClientRect must have Left and Top = (0,0) 1439 CLRect:=FWidget.GetClientRect; 1440 ARect.Left:=0; 1441 ARect.Top:=0; 1442 ARect.Right:=CLRect.Width; 1443 ARect.Bottom:=CLRect.Height; 1444end; 1445 1446procedure TFPGUIPrivateWidget.GetWindowRect(var ARect: TRect); 1447begin 1448 ARect:=fpgRectToRect(FWidget.GetBoundsRect); 1449end; 1450 1451procedure TFPGUIPrivateWidget.AdjustRectXY(var AfpgRect: TfpgRect); 1452begin 1453 //By default widgets do not need adjust, except form with menu, groupbox,... 1454end; 1455 1456procedure TFPGUIPrivateWidget.AdjustRectXYToInterface(var ARect: TRect); 1457begin 1458 //By default widgets do not need adjust, except form with menu, groupbox,... 1459end; 1460 1461procedure TFPGUIPrivateWidget.AdjustPointXY(var APoint: TPoint); 1462begin 1463 //By default widgets do not need adjust, except form with menu, groupbox,... 1464end; 1465 1466procedure TFPGUIPrivateWidget.AdjustPointXYToInterface(var APoint: TPoint); 1467begin 1468 //By default widgets do not need adjust, except form with menu, groupbox,... 1469end; 1470 1471procedure TFPGUIPrivateWidget.SetCursor(const aCursor: integer); 1472var 1473 c: integer; 1474begin 1475 c:=integer(High(TMouseCursor)); 1476 if (aCursor<=c) and (aCursor>=0) then begin 1477 if TMouseCursor(aCursor)=mcDefault then begin 1478 FWidget.MouseCursor:=FDefaultCursor; 1479 end else begin 1480 FWidget.MouseCursor:=TMouseCursor(aCursor); 1481 end; 1482 end else begin 1483 FWidget.MouseCursor:=mcDefault; 1484 end; 1485end; 1486 1487procedure TFPGUIPrivateWidget.SetFocus; 1488begin 1489 if Widget.Focusable then begin 1490 {$IFDEF FPGUIDEBUGFOCUS} 1491 writeln(FLCLObject.Name,' FOCUS / Focused: ',Widget.Focused,' Focusable: ',Widget.Focusable); 1492 {$ENDIF} 1493 Widget.SetFocus; 1494 end else begin 1495 {$IFDEF FPGUIDEBUGFOCUS} 1496 writeln(FLCLObject.Name,' FOCUS FAIL / Focused: ',Widget.Focused,' Focusable: ',Widget.Focusable); 1497 {$ENDIF} 1498 end; 1499end; 1500 1501procedure TFPGUIPrivateWidget.Paint; 1502 procedure RecursviveInvalidate(const aComponent: TComponent); 1503 var 1504 j: integer; 1505 c: TComponent; 1506 begin 1507 for j := 0 to Pred(aComponent.ComponentCount) do 1508 begin 1509 c:=aComponent.Components[j]; 1510 if c is TfpgWidget then begin 1511 RecursviveInvalidate(c); 1512 TfpgWidget(c).Invalidate; 1513 end; 1514 end; 1515 end; 1516begin 1517 if Assigned(FWidget) then begin 1518 RecursviveInvalidate(FWidget); 1519 FWidget.Invalidate; 1520 end; 1521end; 1522 1523procedure TFPGUIPrivateWidget.Clear; 1524begin 1525 //Do nothing by now, introduces flickering 1526 (* 1527 Widget.Canvas.BeginDraw(false); 1528 Widget.Canvas.FillRectangle(Widget.GetClientRect); 1529 Widget.Canvas.EndDraw; 1530 *) 1531end; 1532 1533procedure TFPGUIPrivateWidget.Invalidate; 1534begin 1535 Widget.Invalidate; 1536end; 1537 1538{ TFPGUIPrivateContainer } 1539 1540constructor TFPGUIPrivateContainer.Create(ALCLObject: TWinControl; 1541 const AParams: TCreateParams); 1542begin 1543 inherited Create(ALCLObject, AParams); 1544end; 1545 1546procedure TFPGUIPrivateContainer.AddChild(AWidget: TfpgWidget); 1547begin 1548// fFixed.AddWidget(AWidget, 0, 0); 1549end; 1550 1551procedure TFPGUIPrivateContainer.RemoveChild(AWidget: TfpgWidget); 1552begin 1553// fFixed.RemoveChild(AWidget); 1554end; 1555 1556{ TFPGUIPrivateWindow } 1557 1558{------------------------------------------------------------------------------ 1559 Method: TFPGUIPrivateWindow.Form 1560 Params: None 1561 Returns: Nothing 1562 ------------------------------------------------------------------------------} 1563function TFPGUIPrivateWindow.Form: TfpgForm; 1564begin 1565 Result := TfpgForm(Widget); 1566end; 1567 1568function TFPGUIPrivateWindow.HasStaticText: Boolean; 1569begin 1570 Result := True; 1571end; 1572 1573procedure TFPGUIPrivateWindow.SetWidgetPosition(AWidget: TfpgWidget; AX, 1574 AY: Integer); 1575begin 1576 if MenuBar.Visible then 1577 AWidget.SetPosition(AX,AY+MenuBar.Height,AWidget.Width,AWidget.Height) 1578 else 1579 AWidget.SetPosition(AX,AY,AWidget.Width,AWidget.Height); 1580end; 1581 1582procedure TFPGUIPrivateWindow.CloseHandler(Sender: TObject; 1583 var CloseAction: TCloseAction); 1584begin 1585 ClosePopups; 1586 CloseAction := caFree; 1587 if LCLSendCloseQueryMsg(LCLObject) = 0 then begin 1588 CloseAction := caNone; 1589 end; 1590end; 1591 1592procedure TFPGUIPrivateWindow.MsgResize(var fpgmsg: TfpgMessageRec); 1593begin 1594 if (fpgmsg.Sender is TfpgMenuBar) then begin 1595 //Invalidate clientRectCache to force LCL to recalibrate 1596 //the available space in the form after a menubar visibility change. 1597 //Children are needed to invalidate for TLabel and others custom draw. 1598 FLCLObject.InvalidateClientRectCache(true); 1599 end; 1600 {$IFDEF VerboseFPGUIPrivate} 1601 WriteLn('[TFPGUIPrivateWindow.MsgResize]',DebugMessage(fpgmsg)); 1602 {$ENDIF} 1603 LCLSendSizeMsg(FLCLObject,fpgmsg.Params.rect.Width,fpgmsg.Params.rect.Height,SIZE_RESTORED,true); 1604end; 1605 1606{------------------------------------------------------------------------------ 1607 Method: TFPGUIPrivateWindow.Create 1608 Params: None 1609 Returns: Nothing 1610 ------------------------------------------------------------------------------} 1611constructor TFPGUIPrivateWindow.Create(ALCLObject: TWinControl; const AParams: TCreateParams); 1612var 1613 FormWidget: TfpgForm; 1614begin 1615 inherited Create(ALCLObject, AParams); 1616 FormWidget:=Form; 1617 FormWidget.WindowPosition:=wpUser; //User controled by LCL 1618 FormWidget.SetPosition(AParams.X,AParams.Y,AParams.Width,AParams.Height); 1619// Form.InsertChild(fFixed); 1620end; 1621 1622{------------------------------------------------------------------------------ 1623 Method: TFPGUIPrivateWindow.CreateWidget 1624 Params: None 1625 Returns: Nothing 1626 ------------------------------------------------------------------------------} 1627procedure TFPGUIPrivateWindow.CreateWidget(const AParams: TCreateParams); 1628begin 1629 {$IFDEF VerboseFPGUIPrivate} 1630 WriteLn('[TFPGUIPrivateWindow.CreateWidget]'); 1631 {$ENDIF} 1632 1633 Widget := TfpgForm.Create(nil); 1634 1635 MenuBar := TfpgMenuBar.Create(Widget); 1636 MenuBar.Visible := false; 1637 MenuBar.Focusable:=false; 1638 1639end; 1640 1641{------------------------------------------------------------------------------ 1642 Method: TFPGUIPrivateWindow.SetEvents 1643 Params: None 1644 Returns: Nothing 1645 ------------------------------------------------------------------------------} 1646procedure TFPGUIPrivateWindow.SetEvents; 1647begin 1648 inherited SetEvents; 1649 fpgApplication.SetMessageHook(Widget, FPGM_RESIZE, Self); 1650 Form.OnClose := CloseHandler; 1651end; 1652 1653procedure TFPGUIPrivateWindow.UnSetEvents; 1654begin 1655 fpgApplication.UnsetMessageHook(Widget, FPGM_RESIZE, Self); 1656 inherited UnSetEvents; 1657end; 1658 1659{------------------------------------------------------------------------------ 1660 Method: TFPGUIPrivateWindow.Destroy 1661 Params: None 1662 Returns: Nothing 1663 ------------------------------------------------------------------------------} 1664destructor TFPGUIPrivateWindow.Destroy; 1665begin 1666 {$IFDEF VerboseFPGUIPrivate} 1667 WriteLn('[TFPGUIPrivateWindow.Destroy]'); 1668 {$ENDIF} 1669 1670 // Call unsetevents because setting Widget:=nil prevent the call 1671 // to UnSetEvents in base class Destroy 1672// UnSetEvents; 1673 // Instead of destroying the form immediately, we call Close 1674 // which will do a delayed close 1675 Form.OnClose:=nil; //Disconnect the handler 1676 Form.Close; 1677// Form.Free; 1678 1679 // By setting the Widget to nil we prevent it's future 1680 // destruction 1681// Widget:=nil; 1682 inherited Destroy; 1683end; 1684 1685{------------------------------------------------------------------------------ 1686 Method: TFPGUIPrivateWindow.SetText 1687 Params: None 1688 Returns: Nothing 1689 ------------------------------------------------------------------------------} 1690procedure TFPGUIPrivateWindow.SetText(const AText: String); 1691begin 1692 Form.WindowTitle := AText; 1693end; 1694 1695{------------------------------------------------------------------------------ 1696 Method: TFPGUIPrivateWindow.GetText 1697 Params: None 1698 Returns: Nothing 1699 ------------------------------------------------------------------------------} 1700function TFPGUIPrivateWindow.GetText: String; 1701begin 1702 Result := Form.WindowTitle; 1703end; 1704 1705procedure TFPGUIPrivateWindow.GetClientRect(var ARect: TRect); 1706begin 1707 if MenuBar.Visible then begin 1708 ARect:=Rect(0,0,FWidget.Width,FWidget.Height-MenuBar.Height); 1709 end else begin 1710 ARect:=Rect(0,0,FWidget.Width,FWidget.Height); 1711 end; 1712end; 1713 1714procedure TFPGUIPrivateWindow.GetDefaultClientRect(var ARect: TRect); 1715begin 1716 inherited GetDefaultClientRect(ARect); 1717 if MenuBar.Visible then begin 1718 ARect.Bottom:=ARect.Bottom-MenuBar.Height; 1719 end; 1720end; 1721 1722procedure TFPGUIPrivateWindow.AdjustRectXY(var AfpgRect: TfpgRect); 1723begin 1724 if MenuBar.Visible then begin 1725 AfpgRect.Top:=AfpgRect.Top+MenuBar.Height; 1726 end; 1727end; 1728 1729procedure TFPGUIPrivateWindow.AdjustRectXYToInterface(var ARect: TRect); 1730begin 1731 if MenuBar.Visible then begin 1732 ARect.Top:=ARect.Top-MenuBar.Height; 1733 end; 1734end; 1735 1736procedure TFPGUIPrivateWindow.AdjustPointXY(var APoint: TPoint); 1737begin 1738 if MenuBar.Visible then begin 1739 APoint.y:=APoint.y+MenuBar.Height; 1740 end; 1741end; 1742 1743procedure TFPGUIPrivateWindow.AdjustPointXYToInterface(var APoint: TPoint); 1744begin 1745 if MenuBar.Visible then begin 1746 APoint.y:=APoint.y-MenuBar.Height; 1747 end; 1748end; 1749 1750(* 1751procedure TFPGUIPrivateWindow.PaintHandler(Sender: TObject); 1752var 1753 AStruct: TPaintStruct; 1754 DC: HDC; 1755begin 1756 DC:=GetDC(THandle(Self)); 1757 FillByte(AStruct,sizeof(AStruct),0); 1758 AStruct.fErase:=true; 1759 AStruct.hdc:=DC; 1760 GetClientRect(AStruct.rcPaint); 1761 LCLSendPaintMsg(Self.LCLObject,DC,@AStruct); 1762 ReleaseDC(THandle(Self),DC); 1763end; 1764*) 1765 1766procedure TFPGUIPrivateWindow.SetFormBorderStyle( 1767 const AFormBorderStyle: TFormBorderStyle); 1768begin 1769 case AFormBorderStyle of 1770 controls.bsNone: Widget.WindowAttributes:=Widget.WindowAttributes+[waBorderless]; 1771 controls.bsSingle: Widget.WindowAttributes:=Widget.WindowAttributes-[waBorderless,waSizeable]; 1772 controls.bsSizeable: Widget.WindowAttributes:=Widget.WindowAttributes+[waSizeable]; 1773 controls.bsDialog: Widget.WindowAttributes:=Widget.WindowAttributes-[waSizeable,waBorderless]; 1774 controls.bsToolWindow: Widget.WindowAttributes:=Widget.WindowAttributes-[waSizeable,waBorderless]; 1775 controls.bsSizeToolWin: Widget.WindowAttributes:=Widget.WindowAttributes-[waBorderless]; 1776 end; 1777 if not (waSizeable in Widget.WindowAttributes) then begin 1778 Form.Sizeable:=false; 1779 end else begin 1780 Form.Sizeable:=true; 1781 end; 1782end; 1783 1784{ TFPGUIPrivateButton } 1785 1786{------------------------------------------------------------------------------ 1787 Method: TFPGUIPrivateButton.Clicked 1788 Params: None 1789 Returns: Nothing 1790 ------------------------------------------------------------------------------} 1791procedure TFPGUIPrivateButton.Clicked(Sender: TObject); 1792begin 1793 LCLSendClickedMsg(LCLObject); 1794end; 1795 1796procedure TFPGUIPrivateButton.SetFont(const AValue: TFont); 1797begin 1798 Button.FontDesc:=TFontToTfpgFontDesc(AValue); 1799 if AValue.Color=clDefault then begin 1800 Button.TextColor:=clText1; 1801 end else begin 1802 Button.TextColor:=TColorToTfpgColor(AValue.Color); 1803 end; 1804end; 1805 1806procedure TFPGUIPrivateButton.GetPreferredSize(var PreferredWidth, 1807 PreferredHeight: integer; WithThemeSpace: Boolean); 1808begin 1809 PreferredWidth:=Button.Font.TextWidth(Button.Text)+15+15; 1810 PreferredHeight:=Button.Font.Height+5+5; 1811end; 1812 1813destructor TFPGUIPrivateButton.Destroy; 1814begin 1815 if Button.ImageName<>'' then begin 1816 fpgImages.DeleteImage(Button.ImageName,true); 1817 end; 1818 inherited Destroy; 1819end; 1820 1821{------------------------------------------------------------------------------ 1822 Method: TFPGUIPrivateButton.Button 1823 Params: None 1824 Returns: Nothing 1825 ------------------------------------------------------------------------------} 1826function TFPGUIPrivateButton.Button: TfpgButton; 1827begin 1828 Result := TfpgButton(Widget); 1829end; 1830 1831{------------------------------------------------------------------------------ 1832 Method: TFPGUIPrivateButton.CreateWidget 1833 Params: None 1834 Returns: Nothing 1835 ------------------------------------------------------------------------------} 1836procedure TFPGUIPrivateButton.CreateWidget(const AParams: TCreateParams); 1837begin 1838{$IFDEF VerboseFPGUIPrivate} 1839 WriteLn('[TFPGUIPrivateButton.CreateWidget]'); 1840{$ENDIF} 1841 Widget := TfpgButton.Create(GetParentContainerWidget()); 1842end; 1843 1844function TFPGUIPrivateButton.HasStaticText: Boolean; 1845begin 1846 Result := True; 1847end; 1848 1849{------------------------------------------------------------------------------ 1850 Method: TFPGUIPrivateButton.SetText 1851 Params: None 1852 Returns: Nothing 1853 ------------------------------------------------------------------------------} 1854procedure TFPGUIPrivateButton.SetText(const AText: String); 1855begin 1856 Button.Text := AText; 1857end; 1858 1859{------------------------------------------------------------------------------ 1860 Method: TFPGUIPrivateButton.GetText 1861 Params: None 1862 Returns: Nothing 1863 ------------------------------------------------------------------------------} 1864function TFPGUIPrivateButton.GetText: String; 1865begin 1866 Result := Button.Text; 1867end; 1868 1869{ TFPGUIPrivateComboBox } 1870 1871{------------------------------------------------------------------------------ 1872 Method: TFPGUIPrivateComboBox.ComboBox 1873 Params: None 1874 Returns: Nothing 1875 ------------------------------------------------------------------------------} 1876function TFPGUIPrivateComboBox.ComboBox: TfpgEditCombo; 1877begin 1878 Result := TfpgEditCombo(Widget); 1879end; 1880 1881procedure TFPGUIPrivateComboBox.SetFont(const AValue: TFont); 1882begin 1883 ComboBox.FontDesc:=TFontToTfpgFontDesc(AValue); 1884end; 1885 1886procedure TFPGUIPrivateComboBox.HandleChange(Sender: TObject); 1887begin 1888 LCLSendSelectionChangedMsg(LCLObject); 1889end; 1890 1891procedure TFPGUIPrivateComboBox.HandleDropDown(Sender: TObject); 1892begin 1893 LCLSendDropDownMsg(LCLObject); 1894end; 1895 1896procedure TFPGUIPrivateComboBox.HandleCloseUp(Sender: TObject); 1897begin 1898 LCLSendCloseUpMsg(LCLObject); 1899end; 1900 1901{------------------------------------------------------------------------------ 1902 Method: TFPGUIPrivateComboBox.CreateWidget 1903 Params: None 1904 Returns: Nothing 1905 ------------------------------------------------------------------------------} 1906procedure TFPGUIPrivateComboBox.CreateWidget(const AParams: TCreateParams); 1907begin 1908 Widget := TfpgEditCombo.Create(GetParentContainerWidget()); 1909 ComboBox.AutoCompletion:=true; 1910 ComboBox.AllowNew:=TAllowNew.anNo; 1911end; 1912 1913procedure TFPGUIPrivateComboBox.SetEvents; 1914begin 1915 inherited SetEvents; 1916 ComboBox.OnChange := HandleChange; 1917 ComboBox.OnDropDown := HandleDropDown; 1918 ComboBox.OnCloseUp := HandleCloseUp; 1919end; 1920 1921function TFPGUIPrivateComboBox.HasStaticText: Boolean; 1922begin 1923 Result:=true; 1924end; 1925 1926procedure TFPGUIPrivateComboBox.SetText(const AText: String); 1927begin 1928 ComboBox.Text:=AText; 1929end; 1930 1931function TFPGUIPrivateComboBox.GetText: String; 1932begin 1933 Result:=ComboBox.Text; 1934end; 1935 1936{ TFPGUIPrivateEdit } 1937 1938procedure TFPGUIPrivateEdit.SetFont(const AValue: TFont); 1939begin 1940 Edit.FontDesc:=TFontToTfpgFontDesc(AValue); 1941end; 1942 1943{------------------------------------------------------------------------------ 1944 Method: TFPGUIPrivateEdit.CreateWidget 1945 Params: None 1946 Returns: Nothing 1947 ------------------------------------------------------------------------------} 1948procedure TFPGUIPrivateEdit.CreateWidget(const AParams: TCreateParams); 1949begin 1950 Widget := TfpgEdit.Create(GetParentContainerWidget()); 1951 TfpgEdit(Widget).IgnoreMouseCursor:=true; 1952 FDefaultCursor:=mcIBeam; 1953end; 1954 1955function TFPGUIPrivateEdit.HasStaticText: Boolean; 1956begin 1957 Result := True; 1958end; 1959 1960{------------------------------------------------------------------------------ 1961 Method: TFPGUIPrivateEdit.Edit 1962 Params: None 1963 Returns: Nothing 1964 ------------------------------------------------------------------------------} 1965function TFPGUIPrivateEdit.Edit: TfpgEdit; 1966begin 1967 Result := TfpgEdit(Widget); 1968end; 1969 1970{------------------------------------------------------------------------------ 1971 Method: TFPGUIPrivateEdit.SetText 1972 Params: None 1973 Returns: Nothing 1974 ------------------------------------------------------------------------------} 1975procedure TFPGUIPrivateEdit.SetText(const AText: String); 1976begin 1977 Edit.Text := AText; 1978end; 1979 1980{------------------------------------------------------------------------------ 1981 Method: TFPGUIPrivateEdit.GetText 1982 Params: None 1983 Returns: Nothing 1984 ------------------------------------------------------------------------------} 1985function TFPGUIPrivateEdit.GetText: String; 1986begin 1987 Result := Edit.Text; 1988end; 1989 1990procedure TFPGUIPrivateEdit.GetPreferredSize(var PreferredWidth, 1991 PreferredHeight: integer; WithThemeSpace: Boolean); 1992begin 1993 PreferredWidth:=0; 1994 PreferredHeight:=0; 1995end; 1996 1997{ TFPGUIPrivateCheckBox } 1998 1999function TFPGUIPrivateCheckBox.CheckBox: TfpgCheckBox; 2000begin 2001 Result := TfpgCheckBox(Widget); 2002end; 2003 2004procedure TFPGUIPrivateCheckBox.SetFont(const AValue: TFont); 2005begin 2006 CheckBox.FontDesc:=TFontToTfpgFontDesc(AValue); 2007end; 2008 2009procedure TFPGUIPrivateCheckBox.HandleChange(Sender: TObject); 2010begin 2011 LCLSendChangedMsg(LCLObject); 2012end; 2013 2014procedure TFPGUIPrivateCheckBox.CreateWidget(const AParams: TCreateParams); 2015begin 2016 Widget := TfpgCheckBox.Create(GetParentContainerWidget()); 2017end; 2018 2019function TFPGUIPrivateCheckBox.HasStaticText: Boolean; 2020begin 2021 Result := True; 2022end; 2023 2024procedure TFPGUIPrivateCheckBox.SetText(const AText: String); 2025begin 2026 CheckBox.Text := AText; 2027end; 2028 2029function TFPGUIPrivateCheckBox.GetText: String; 2030begin 2031 Result := CheckBox.Text; 2032end; 2033 2034procedure TFPGUIPrivateCheckBox.SetEvents; 2035begin 2036 inherited SetEvents; 2037 CheckBox.OnChange := HandleChange; 2038end; 2039 2040procedure TFPGUIPrivateCheckBox.GetPreferredSize(var PreferredWidth, 2041 PreferredHeight: integer; WithThemeSpace: Boolean); 2042begin 2043 PreferredWidth:=CheckBox.Font.TextWidth(CheckBox.Text)+24; //This is hardcoded in fpgui for image 2044 PreferredHeight:=CheckBox.Font.Height+2; 2045end; 2046 2047{ TFPGUIPrivateRadioButton } 2048 2049function TFPGUIPrivateRadioButton.RadioButton: TfpgRadioButton; 2050begin 2051 Result := TfpgRadioButton(Widget); 2052end; 2053 2054procedure TFPGUIPrivateRadioButton.SetFont(const AValue: TFont); 2055begin 2056 RadioButton.FontDesc:=TFontToTfpgFontDesc(AValue); 2057end; 2058 2059procedure TFPGUIPrivateRadioButton.CreateWidget(const AParams: TCreateParams); 2060begin 2061 Widget := TfpgRadioButton.Create(GetParentContainerWidget()); 2062end; 2063 2064function TFPGUIPrivateRadioButton.HasStaticText: Boolean; 2065begin 2066 Result := True; 2067end; 2068 2069procedure TFPGUIPrivateRadioButton.SetText(const AText: String); 2070begin 2071 RadioButton.Text := AText; 2072end; 2073 2074function TFPGUIPrivateRadioButton.GetText: String; 2075begin 2076 Result := RadioButton.Text; 2077end; 2078 2079procedure TFPGUIPrivateRadioButton.GetPreferredSize(var PreferredWidth, 2080 PreferredHeight: integer; WithThemeSpace: Boolean); 2081var 2082 lDimensions: TPoint; 2083begin 2084 lDimensions.x:=RadioButton.Width; 2085 lDimensions.y:=RadioButton.Height; 2086 //Autosize=true forces the control to calculate its preferred size. 2087 RadioButton.AutoSize:=true; 2088 if PreferredHeight<RadioButton.Font.Height then begin 2089 PreferredHeight:=RadioButton.Font.Height+2; 2090 end; 2091 RadioButton.AutoSize:=false; 2092 RadioButton.Width:=lDimensions.x; 2093 RadioButton.Height:=lDimensions.y; 2094end; 2095 2096{ TFPGUIPrivateNotebook } 2097 2098procedure TFPGUIPrivatePageControl.CreateWidget(const AParams: TCreateParams); 2099begin 2100 Widget := TfpgPageControl.Create(GetParentContainerWidget()); 2101end; 2102 2103{ TFPGUIPrivateMemo } 2104 2105procedure TFPGUIPrivateMemo.SetFont(const AValue: TFont); 2106begin 2107 Memo.FontDesc:=TFontToTfpgFontDesc(AValue); 2108end; 2109 2110procedure TFPGUIPrivateMemo.CreateWidget(const AParams: TCreateParams); 2111var 2112 lMemo: TfpgMemo; 2113begin 2114 lMemo := TfpgMemo.Create(GetParentContainerWidget()); 2115 Widget:=lMemo; 2116// Not supported by memo ?? 2117// lMemo.IgnoreMouseCursor:=true; 2118 FDefaultCursor:=mcIBeam; 2119end; 2120 2121function TFPGUIPrivateMemo.HasStaticText: Boolean; 2122begin 2123 Result := True; 2124end; 2125 2126function TFPGUIPrivateMemo.Memo: TfpgMemo; 2127begin 2128 Result := TfpgMemo(Widget); 2129end; 2130 2131procedure TFPGUIPrivateMemo.SetText(const AText: String); 2132begin 2133 Memo.Text := AText; 2134end; 2135 2136function TFPGUIPrivateMemo.GetText: String; 2137begin 2138 Result := Memo.Text; 2139end; 2140 2141procedure TFPGUIPrivateMemo.GetPreferredSize(var PreferredWidth, 2142 PreferredHeight: integer; WithThemeSpace: Boolean); 2143begin 2144 PreferredHeight:=0; 2145 PreferredWidth:=0; 2146end; 2147 2148function TFPGUIPrivateMemo.GetStrings: TStrings; 2149begin 2150 Result:=Memo.Lines; 2151end; 2152 2153{ TFPGUIPrivatePopUpMenu } 2154 2155constructor TFPGUIPrivatePopUpMenu.Create(ALCLObject: TPopUpMenu; AItems: TMenuItem); 2156begin 2157 FLCLMenu := ALCLObject; 2158 FItems := AItems; 2159 2160 // CreateWidget 2161 2162 Widget := TfpgPopUpMenu.Create(nil); 2163end; 2164 2165destructor TFPGUIPrivatePopUpMenu.Destroy; 2166begin 2167 PopUpMenu.Close; 2168 Inherited; 2169end; 2170 2171function TFPGUIPrivatePopUpMenu.PopUpMenu: TfpgPopUpMenu; 2172begin 2173 Result := TfpgPopUpMenu(Widget); 2174end; 2175 2176procedure TFPGUIPrivatePopUpMenu.PopUp(X, Y: Integer); 2177begin 2178 PopUpMenu.ShowAt(X, Y); 2179end; 2180 2181{ TFPGUIPrivateCommonDialog } 2182 2183constructor TFPGUIPrivateCommonDialog.Create(ALCLDialog: TCommonDialog); 2184begin 2185 FLCLDialog := ALCLDialog; 2186 CreateDialog; 2187end; 2188 2189destructor TFPGUIPrivateCommonDialog.Destroy; 2190begin 2191 Dialog.Free; 2192 inherited Destroy; 2193end; 2194 2195procedure TFPGUIPrivateCommonDialog.CreateDialog; 2196begin 2197 Dialog := TfpgBaseDialog.Create(nil); 2198end; 2199 2200function TFPGUIPrivateCommonDialog.InternalShowDialog: Boolean; 2201var 2202 ResultCode: TfpgModalResult; 2203begin 2204 ResultCode:=Dialog.ShowModal; 2205 case ResultCode of 2206 mrNone: Result:=false; 2207(* mrOK: ; 2208 mrCancel: ; 2209 mrYes: ; 2210 mrNo: ; 2211 mrAbort: ; 2212 mrRetry: ; 2213 mrIgnore: ; 2214 mrAll: ; 2215 mrNoToAll: ; 2216 mrYesToAll: ;*) 2217 else 2218 Result:=true; 2219 end; 2220end; 2221 2222procedure TFPGUIPrivateCommonDialog.UpdatePropsBefore; 2223begin 2224 Dialog.WindowTitle := LCLDialog.Title; 2225end; 2226 2227procedure TFPGUIPrivateCommonDialog.UpdatePropsAfter; 2228begin 2229 2230end; 2231 2232function TFPGUIPrivateCommonDialog.ShowDialog: Boolean; 2233begin 2234 UpdatePropsBefore; 2235 Result := InternalShowDialog; 2236 { TODO : Map fpguimodalresult to LCL expected modal result } 2237 case Dialog.ModalResult of 2238 mrNone: LCLDialog.UserChoice:=controls.mrClose; 2239 mrOK: LCLDialog.UserChoice:=controls.mrOK; 2240 mrCancel: LCLDialog.UserChoice:=controls.mrCancel; 2241 mrYes: LCLDialog.UserChoice:=controls.mrYes; 2242 mrNo: LCLDialog.UserChoice:=controls.mrNo; 2243 mrAbort: LCLDialog.UserChoice:=controls.mrAbort; 2244 mrRetry: LCLDialog.UserChoice:=controls.mrRetry; 2245 mrIgnore: LCLDialog.UserChoice:=controls.mrIgnore; 2246 mrAll: LCLDialog.UserChoice:=controls.mrAll; 2247 mrNoToAll: LCLDialog.UserChoice:=controls.mrNoToAll; 2248 mrYesToAll: LCLDialog.UserChoice:=controls.mrYesToAll; 2249 mrHelp: LCLDialog.UserChoice:=controls.mrClose; 2250 otherwise 2251 LCLDialog.UserChoice:=controls.mrClose; 2252 end; 2253 UpdatePropsAfter; 2254end; 2255 2256{ TFPGUIPrivateFileDialog } 2257 2258procedure TFPGUIPrivateFileDialog.UpdatePropsBefore; 2259begin 2260 inherited UpdatePropsBefore; 2261 FileDialog.Filter := LCLFileDialog.Filter; 2262 if Length(LCLFileDialog.FileName) <> 0 then 2263 FileDialog.FileName := LCLFileDialog.FileName 2264 else 2265 FileDialog.FileName := LCLFileDialog.InitialDir; 2266end; 2267 2268procedure TFPGUIPrivateFileDialog.UpdatePropsAfter; 2269begin 2270 inherited UpdatePropsAfter; 2271 LCLFileDialog.FileName := FileDialog.FileName; 2272 //LCLFileDialog.Files.Assign(FileDialog.); 2273end; 2274 2275procedure TFPGUIPrivateFileDialog.CreateDialog; 2276begin 2277 Dialog := TfpgFileDialog.Create(nil); 2278end; 2279 2280function TFPGUIPrivateFileDialog.FileDialog: TfpgFileDialog; 2281begin 2282 Result :=TfpgFileDialog(Dialog); 2283end; 2284 2285function TFPGUIPrivateFileDialog.LCLFileDialog: TFileDialog; 2286begin 2287 Result := TFileDialog(LCLDialog) ; 2288end; 2289 2290{ TFPGUIPrivateOpenDialog } 2291 2292function TFPGUIPrivateOpenDialog.InternalShowDialog: Boolean; 2293begin 2294 Result:=FileDialog.RunOpenFile; 2295end; 2296 2297{ TFPGUIPrivateSaveDialog } 2298 2299function TFPGUIPrivateSaveDialog.InternalShowDialog: Boolean; 2300begin 2301 Result:=FileDialog.RunSaveFile; 2302end; 2303 2304{ TFPGUIPrivateFontDialog } 2305 2306procedure TFPGUIPrivateFontDialog.CreateDialog; 2307begin 2308 Dialog := TfpgFontSelectDialog.Create(nil); 2309end; 2310 2311function TFPGUIPrivateFontDialog.InternalShowDialog: Boolean; 2312begin 2313 Result:=Boolean(FontDialog.ShowModal); 2314end; 2315 2316procedure TFPGUIPrivateFontDialog.UpdatePropsBefore; 2317begin 2318 inherited; 2319end; 2320 2321procedure TFPGUIPrivateFontDialog.UpdatePropsAfter; 2322begin 2323 inherited; 2324end; 2325 2326function TFPGUIPrivateFontDialog.FontDialog: TfpgFontSelectDialog; 2327begin 2328 Result := TfpgFontSelectDialog(Dialog); 2329end; 2330 2331{ TFPGUIPrivateListBox } 2332 2333function TFPGUIPrivateListBox.GetItemIndex: integer; 2334begin 2335 Result:=ListBox.FocusItem; 2336end; 2337 2338procedure TFPGUIPrivateListBox.SetItemIndex(const AValue: integer); 2339begin 2340 ListBox.FocusItem:=AValue; 2341end; 2342 2343procedure TFPGUIPrivateListBox.SetFont(const AValue: TFont); 2344begin 2345 ListBox.FontDesc:=TFontToTfpgFontDesc(AValue); 2346end; 2347 2348procedure TFPGUIPrivateListBox.SelectionChangeHandler(Sender: TObject); 2349begin 2350 LCLSendSelectionChangedMsg(FLCLObject); 2351end; 2352 2353procedure TFPGUIPrivateListBox.DoubleClickHandler(Sender: TObject; 2354 AButton: fpg_main.TMouseButton; AShift: TShiftState; const AMousePos: TPoint); 2355begin 2356 LCLSendMouseMultiClickMsg(FLCLObject,AMousePos.x,AMousePos.y,controls.TMouseButton(AButton),2,AShift); 2357end; 2358 2359procedure TFPGUIPrivateListBox.CreateWidget(const AParams: TCreateParams); 2360begin 2361 Widget:=TfpgListBox.Create(GetParentContainerWidget()); 2362 if (AParams.ExStyle and WS_EX_CLIENTEDGE)=WS_EX_CLIENTEDGE then begin 2363 ListBox.PopupFrame:=false; 2364 end else begin 2365 ListBox.PopupFrame:=true; 2366 end; 2367end; 2368 2369function TFPGUIPrivateListBox.HasStaticText: Boolean; 2370begin 2371 Result:=false; 2372end; 2373 2374procedure TFPGUIPrivateListBox.SetEvents; 2375begin 2376 inherited SetEvents; 2377 ListBox.OnChange:=SelectionChangeHandler; 2378 ListBox.OnDoubleClick:=DoubleClickHandler; 2379end; 2380 2381function TFPGUIPrivateListBox.ListBox: TfpgListBox; 2382begin 2383 Result:=TfpgListBox(FWidget); 2384end; 2385 2386{ TFPGUIPrivateGroupBox } 2387 2388procedure TFPGUIPrivateGroupBox.SetFont(const AValue: TFont); 2389begin 2390 GroupBox.FontDesc:=TFontToTfpgFontDesc(AValue); 2391end; 2392 2393procedure TFPGUIPrivateGroupBox.CreateWidget(const AParams: TCreateParams); 2394begin 2395 Widget:=TfpgGroupBox.Create(GetParentContainerWidget()); 2396end; 2397 2398function TFPGUIPrivateGroupBox.HasStaticText: Boolean; 2399begin 2400 Result:=true; 2401end; 2402 2403procedure TFPGUIPrivateGroupBox.SetWidgetPosition(AWidget: TfpgWidget; AX, 2404 AY: Integer); 2405var 2406 CLRect: TfpgRect; 2407begin 2408 CLRect:=FWidget.GetClientRect; 2409 AWidget.SetPosition(AX+CLRect.Left,AY+CLRect.Top,AWidget.Width,AWidget.Height); 2410end; 2411 2412procedure TFPGUIPrivateGroupBox.SetText(const AText: String); 2413begin 2414 GroupBox.Text:=AText; 2415end; 2416 2417function TFPGUIPrivateGroupBox.GetText: String; 2418begin 2419 Result:=GroupBox.Text; 2420end; 2421 2422procedure TFPGUIPrivateGroupBox.AdjustPointXYToInterface(var APoint: TPoint); 2423var 2424 CLRect: TfpgRect; 2425begin 2426 CLRect:=FWidget.GetClientRect; 2427 APoint.x:=APoint.x-CLRect.Left; 2428 APoint.y:=APoint.y-CLRect.Top; 2429end; 2430 2431function TFPGUIPrivateGroupBox.GroupBox: TfpgGroupBox; 2432begin 2433 Result:=TfpgGroupBox(FWidget); 2434end; 2435 2436{ TFPGUIPrivateCustomPanel } 2437 2438procedure TFPGUIPrivateCustomPanel.SetFont(const AValue: TFont); 2439begin 2440 Panel.FontDesc:=TFontToTfpgFontDesc(AValue); 2441end; 2442 2443procedure TFPGUIPrivateCustomPanel.PaintHandler(Sender: TObject); 2444var 2445 lRect: TfpgRect; 2446 lCustomPanel: TPanel; 2447 j: integer; 2448begin 2449 lRect:=FWidget.GetClientRect; 2450 lCustomPanel:=TPanel(FLCLObject); 2451 if (lCustomPanel.BorderStyle<>TBorderStyle.bsNone) and (lCustomPanel.BorderWidth>0) then begin 2452 for j := 0 to Pred(lCustomPanel.BorderWidth) do begin 2453 FWidget.Canvas.DrawRectangle(lRect); 2454 InflateRect(lRect,-1,-1); 2455 end; 2456 end; 2457 if lCustomPanel.BevelOuter<>TPanelBevel.bvNone then begin 2458 for j := 0 to Pred(lCustomPanel.BevelWidth) do begin 2459 if lCustomPanel.BevelOuter=TPanelBevel.bvLowered then begin 2460 FWidget.Canvas.DrawBevel(lRect,false); 2461 end else if lCustomPanel.BevelOuter=TPanelBevel.bvRaised then begin 2462 FWidget.Canvas.DrawBevel(lRect,true); 2463 end; 2464 InflateRect(lRect,-1,-1); 2465 end; 2466 end; 2467 if lCustomPanel.BevelInner<>TPanelBevel.bvNone then begin 2468 for j := 0 to Pred(lCustomPanel.BevelWidth) do begin 2469 if lCustomPanel.BevelInner=TPanelBevel.bvLowered then begin 2470 FWidget.Canvas.DrawBevel(lRect,false); 2471 end else if lCustomPanel.BevelInner=TPanelBevel.bvRaised then begin 2472 FWidget.Canvas.DrawBevel(lRect,true); 2473 end; 2474 InflateRect(lRect,-1,-1); 2475 end; 2476 end; 2477 inherited; 2478end; 2479 2480procedure TFPGUIPrivateCustomPanel.CreateWidget(const AParams: TCreateParams); 2481begin 2482 FWidget:=TfpgPanel.Create(GetParentContainerWidget()); 2483 Panel.Text:=''; 2484 Panel.Style:=bsFlat; 2485 Panel.ParentBackgroundColor:=false; 2486end; 2487 2488function TFPGUIPrivateCustomPanel.HasStaticText: Boolean; 2489begin 2490 Result:=true; 2491end; 2492 2493procedure TFPGUIPrivateCustomPanel.SetWidgetPosition(AWidget: TfpgWidget; AX, 2494 AY: Integer); 2495var 2496 CLRect: TfpgRect; 2497begin 2498 CLRect:=FWidget.GetClientRect; 2499 AWidget.SetPosition(AX+CLRect.Left,AY+CLRect.Top,AWidget.Width,AWidget.Height); 2500end; 2501 2502procedure TFPGUIPrivateCustomPanel.AdjustRectXY(var AfpgRect: TfpgRect); 2503var 2504 CLRect: TfpgRect; 2505begin 2506 CLRect:=FWidget.GetClientRect; 2507 AfpgRect.Top:=AfpgRect.Top+CLRect.Top; 2508 AfpgRect.Left:=AfpgRect.Left+CLRect.Left; 2509end; 2510 2511procedure TFPGUIPrivateCustomPanel.AdjustPointXY(var APoint: TPoint); 2512var 2513 CLRect: TfpgRect; 2514begin 2515 CLRect:=FWidget.GetClientRect; 2516 APoint.x:=APoint.x+CLRect.Left; 2517 APoint.y:=APoint.y+CLRect.Top; 2518end; 2519 2520procedure TFPGUIPrivateCustomPanel.AdjustRectXYToInterface(var ARect: TRect); 2521var 2522 CLRect: TfpgRect; 2523begin 2524 CLRect:=FWidget.GetClientRect; 2525 ARect.Top:=ARect.Top-CLRect.Top; 2526 ARect.Left:=ARect.Left-CLRect.Left; 2527end; 2528 2529procedure TFPGUIPrivateCustomPanel.AdjustPointXYToInterface(var APoint: TPoint); 2530var 2531 CLRect: TfpgRect; 2532begin 2533 CLRect:=FWidget.GetClientRect; 2534 APoint.x:=APoint.x-CLRect.Left; 2535 APoint.y:=APoint.y-CLRect.Top; 2536end; 2537 2538procedure TFPGUIPrivateCustomPanel.SetText(const AText: String); 2539begin 2540 Panel.Text := AText; 2541end; 2542 2543function TFPGUIPrivateCustomPanel.Panel: TfpgPanel; 2544begin 2545 Result:=TfpgPanel(FWidget); 2546end; 2547 2548end. 2549 2550