1{ 2 ***************************************************************************** 3 * WSControls.pp * 4 * ------------- * 5 * * 6 * * 7 ***************************************************************************** 8 9 ***************************************************************************** 10 This file is part of the Lazarus Component Library (LCL) 11 12 See the file COPYING.modifiedLGPL.txt, included in this distribution, 13 for details about the license. 14 ***************************************************************************** 15} 16unit WSControls; 17 18{$mode objfpc}{$H+} 19{$I lcl_defines.inc} 20 21interface 22//////////////////////////////////////////////////// 23// I M P O R T A N T 24//////////////////////////////////////////////////// 25// 1) Only class methods allowed 26// 2) Class methods have to be published and virtual 27// 3) To get as little as posible circles, the uses 28// clause should contain only those LCL units 29// needed for registration. WSxxx units are OK 30// 4) To improve speed, register only classes in the 31// initialization section which actually 32// implement something 33// 5) To enable your XXX widgetset units, look at 34// the uses clause of the XXXintf.pp 35//////////////////////////////////////////////////// 36uses 37 Classes, Types, 38//////////////////////////////////////////////////// 39// To get as little as possible circles, 40// uncomment only when needed for registration 41//////////////////////////////////////////////////// 42 Controls, Graphics, LCLType, 43//////////////////////////////////////////////////// 44 WSLCLClasses, WSImgList, 45 { TODO: remove when CreateHandle/Component code moved } 46 InterfaceBase, WSFactory; 47 48const 49 DefBtnColors: array[TDefaultColorType] of TColor = ( 50 { dctBrush } clBtnFace, 51 { dctFont } clBtnText 52 ); 53type 54 { TWSDragImageListResolution } 55 56 TWSDragImageListResolution = class(TWSCustomImageListResolution) 57 published 58 class function BeginDrag(const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer): Boolean; virtual; 59 class function DragMove(const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; virtual; 60 class procedure EndDrag(const ADragImageList: TDragImageListResolution); virtual; 61 class function HideDragImage(const ADragImageList: TDragImageListResolution; 62 ALockedWindow: HWND; DoUnLock: Boolean): Boolean; virtual; 63 class function ShowDragImage(const ADragImageList: TDragImageListResolution; 64 ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; virtual; 65 end; 66 67 TWSDragImageListResolutionClass = class of TWSDragImageListResolution; 68 69 { TWSLazAccessibleObject } 70 71 TWSLazAccessibleObject = class(TWSObject) 72 public 73 class function CreateHandle(const AObject: TLazAccessibleObject): HWND; virtual; 74 class procedure DestroyHandle(const AObject: TLazAccessibleObject); virtual; 75 class procedure SetAccessibleDescription(const AObject: TLazAccessibleObject; const ADescription: string); virtual; 76 class procedure SetAccessibleValue(const AObject: TLazAccessibleObject; const AValue: string); virtual; 77 class procedure SetAccessibleRole(const AObject: TLazAccessibleObject; const ARole: TLazAccessibilityRole); virtual; 78 class procedure SetPosition(const AObject: TLazAccessibleObject; const AValue: TPoint); virtual; 79 class procedure SetSize(const AObject: TLazAccessibleObject; const AValue: TSize); virtual; 80 end; 81 TWSLazAccessibleObjectClass = class of TWSLazAccessibleObject; 82 83 { TWSControl } 84 85 TWSControl = class(TWSLCLComponent) 86 published 87 class procedure AddControl(const AControl: TControl); virtual; 88 class function GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; virtual; 89 class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; virtual; 90 class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); virtual; 91 class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual; 92 class function GetCanvasScaleFactor(const AControl: TControl): Double; virtual; 93 end; 94 95 TWSControlClass = class of TWSControl; 96 97 { TWSWinControl } 98 99 TWSZPosition = (wszpBack, wszpFront); 100 101 { TWSWinControl } 102 103 TWSWinControl = class(TWSControl) 104 published 105 class function CanFocus(const AWincontrol: TWinControl): Boolean; virtual; 106 107 class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; virtual; 108 class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; virtual; 109 class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); virtual; 110 class function GetDefaultClientRect(const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect): boolean; virtual; 111 class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; virtual; 112 class function GetDoubleBuffered(const AWinControl: TWinControl): Boolean; virtual; 113 class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual; 114 class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual; 115 116 class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); virtual; 117 class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); virtual; 118 class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); virtual; 119 class procedure SetColor(const AWinControl: TWinControl); virtual; 120 class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); virtual; 121 class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); virtual; 122 class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); virtual; 123 class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); virtual; 124 class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual; 125 class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); virtual; 126 class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); virtual; 127 128 { TODO: move AdaptBounds: it is only used in winapi interfaces } 129 class procedure AdaptBounds(const AWinControl: TWinControl; 130 var Left, Top, Width, Height: integer; var SuppressMove: boolean); virtual; 131 132 class procedure ConstraintsChange(const AWinControl: TWinControl); virtual; 133 class function CreateHandle(const AWinControl: TWinControl; 134 const AParams: TCreateParams): TLCLIntfHandle; virtual; 135 class procedure DestroyHandle(const AWinControl: TWinControl); virtual; 136 class procedure DefaultWndHandler(const AWinControl: TWinControl; var AMessage); virtual; 137 class procedure Invalidate(const AWinControl: TWinControl); virtual; 138 class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); virtual; 139 class procedure Repaint(const AWinControl: TWinControl); virtual; 140 class procedure ShowHide(const AWinControl: TWinControl); virtual; //TODO: rename to SetVisible(control, visible) 141 class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); virtual; 142 end; 143 TWSWinControlClass = class of TWSWinControl; 144 145 { TWSGraphicControl } 146 147 TWSGraphicControl = class(TWSControl) 148 published 149 end; 150 151 { TWSCustomControl } 152 153 TWSCustomControl = class(TWSWinControl) 154 published 155 end; 156 157 { TWSImageList } 158 159 TWSImageList = class(TWSDragImageListResolution) 160 published 161 end; 162 163procedure RegisterDragImageListResolution; 164procedure RegisterLazAccessibleObject; 165procedure RegisterControl; 166procedure RegisterWinControl; 167procedure RegisterGraphicControl; 168procedure RegisterCustomControl; 169 170implementation 171 172{ TWSLazAccessibleObject } 173 174class function TWSLazAccessibleObject.CreateHandle( 175 const AObject: TLazAccessibleObject): HWND; 176begin 177 Result := 0; 178end; 179 180class procedure TWSLazAccessibleObject.DestroyHandle( 181 const AObject: TLazAccessibleObject); 182begin 183 184end; 185 186class procedure TWSLazAccessibleObject.SetAccessibleDescription(const AObject: TLazAccessibleObject; const ADescription: string); 187begin 188 189end; 190 191class procedure TWSLazAccessibleObject.SetAccessibleValue(const AObject: TLazAccessibleObject; const AValue: string); 192begin 193 194end; 195 196class procedure TWSLazAccessibleObject.SetAccessibleRole(const AObject: TLazAccessibleObject; const ARole: TLazAccessibilityRole); 197begin 198 199end; 200 201class procedure TWSLazAccessibleObject.SetPosition( 202 const AObject: TLazAccessibleObject; const AValue: TPoint); 203begin 204 205end; 206 207class procedure TWSLazAccessibleObject.SetSize( 208 const AObject: TLazAccessibleObject; const AValue: TSize); 209begin 210 211end; 212 213{ TWSControl } 214 215class procedure TWSControl.AddControl(const AControl: TControl); 216begin 217end; 218 219class function TWSControl.GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; 220begin 221 Result := WidgetSet.GetControlConstraints(AConstraints); 222end; 223 224class function TWSControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; 225begin 226 Result := clDefault; 227end; 228 229class procedure TWSControl.ConstraintWidth(const AControl: TControl; 230 const AConstraints: TObject; var aWidth: integer); 231begin 232 233end; 234 235class procedure TWSControl.ConstraintHeight(const AControl: TControl; 236 const AConstraints: TObject; var aHeight: integer); 237begin 238 239end; 240 241class function TWSControl.GetCanvasScaleFactor(const AControl: TControl 242 ): Double; 243begin 244 Result := 1; 245end; 246 247{ TWSWinControl } 248 249class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl; 250 var Left, Top, Width, Height: integer; var SuppressMove: boolean); 251begin 252end; 253 254class procedure TWSWinControl.ConstraintsChange(const AWinControl: TWinControl); 255begin 256end; 257 258class function TWSWinControl.CreateHandle(const AWinControl: TWinControl; 259 const AParams: TCreateParams): TLCLIntfHandle; 260begin 261 // For now default to the old creation routines 262 Result := 0; 263end; 264 265class procedure TWSWinControl.DestroyHandle(const AWinControl: TWinControl); 266begin 267end; 268 269class procedure TWSWinControl.DefaultWndHandler(const AWinControl: TWinControl; var AMessage); 270begin 271 WidgetSet.CallDefaultWndHandler(AWinControl, AMessage); 272end; 273 274class function TWSWinControl.CanFocus(const AWincontrol: TWinControl): Boolean; 275begin 276 // lets consider that by deafult all WinControls can be focused 277 Result := True; 278end; 279 280class function TWSWinControl.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; 281begin 282 // for now default to the WinAPI version 283 Result := WidgetSet.GetClientBounds(AWincontrol.Handle, ARect); 284end; 285 286class function TWSWinControl.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; 287begin 288 // for now default to the WinAPI version 289 Result := WidgetSet.GetClientRect(AWincontrol.Handle, ARect); 290end; 291 292{------------------------------------------------------------------------------ 293 Function: TWSWinControl.GetText 294 Params: Sender: The control to retrieve the text from 295 Returns: the requested text 296 297 Retrieves the text from a control. 298 ------------------------------------------------------------------------------} 299class function TWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean; 300begin 301 Result := false; 302end; 303 304class function TWSWinControl.GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; 305var 306 S: String; 307begin 308 Result := GetText(AWinControl, S); 309 if Result 310 then ALength := Length(S); 311end; 312 313class procedure TWSWinControl.SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); 314begin 315end; 316 317class procedure TWSWinControl.GetPreferredSize(const AWinControl: TWinControl; 318 var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); 319begin 320 PreferredWidth := 0; 321 PreferredHeight := 0; 322end; 323 324class function TWSWinControl.GetDefaultClientRect( 325 const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer; 326 var aClientRect: TRect): boolean; 327begin 328 Result:=false; 329end; 330 331class function TWSWinControl.GetDesignInteractive( 332 const AWinControl: TWinControl; AClientPos: TPoint): Boolean; 333begin 334 Result := False; 335end; 336 337class function TWSWinControl.GetDoubleBuffered( 338 const AWinControl: TWinControl): Boolean; 339begin 340 Result := AWinControl.DoubleBuffered; 341end; 342 343class procedure TWSWinControl.Invalidate(const AWinControl: TWinControl); 344begin 345end; 346 347class procedure TWSWinControl.PaintTo(const AWinControl: TWinControl; ADC: HDC; 348 X, Y: Integer); 349begin 350 351end; 352 353class procedure TWSWinControl.Repaint(const AWinControl: TWinControl); 354begin 355 AWinControl.Invalidate; 356 AWinControl.Update; 357end; 358 359class procedure TWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); 360begin 361end; 362 363class procedure TWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); 364begin 365end; 366 367class procedure TWSWinControl.SetChildZPosition( 368 const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; 369 const AChildren: TFPList); 370begin 371end; 372 373class procedure TWSWinControl.SetColor(const AWinControl: TWinControl); 374begin 375end; 376 377class procedure TWSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); 378begin 379end; 380 381class procedure TWSWinControl.SetShape(const AWinControl: TWinControl; 382 const AShape: HBITMAP); 383begin 384end; 385 386class procedure TWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont); 387begin 388end; 389 390class procedure TWSWinControl.SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); 391begin 392end; 393 394class procedure TWSWinControl.SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); 395begin 396end; 397 398{------------------------------------------------------------------------------ 399 Method: TWSWinControl.SetLabel 400 Params: AWinControl - the calling object 401 AText - String to be set as label/text for a control 402 Returns: Nothing 403 404 Sets the label text on a widget 405 ------------------------------------------------------------------------------} 406class procedure TWSWinControl.SetText(const AWinControl: TWinControl; const AText: String); 407begin 408end; 409 410class procedure TWSWinControl.ShowHide(const AWinControl: TWinControl); 411begin 412end; 413 414class procedure TWSWinControl.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); 415begin 416 AWinControl.Invalidate; 417end; 418 419{ TWSDragImageListResolution } 420 421class function TWSDragImageListResolution.BeginDrag( 422 const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, 423 Y: Integer): Boolean; 424begin 425 Result := False; 426end; 427 428class function TWSDragImageListResolution.DragMove(const ADragImageList: TDragImageListResolution; 429 X, Y: Integer): Boolean; 430begin 431 Result := False; 432end; 433 434class procedure TWSDragImageListResolution.EndDrag(const ADragImageList: TDragImageListResolution); 435begin 436end; 437 438class function TWSDragImageListResolution.HideDragImage(const ADragImageList: TDragImageListResolution; 439 ALockedWindow: HWND; DoUnLock: Boolean): Boolean; 440begin 441 Result := False; 442end; 443 444class function TWSDragImageListResolution.ShowDragImage(const ADragImageList: TDragImageListResolution; 445 ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; 446begin 447 Result := False; 448end; 449 450{ WidgetSetRegistration } 451 452procedure RegisterDragImageListResolution; 453const 454 Done: Boolean = False; 455begin 456 if Done then exit; 457 if not WSRegisterDragImageListResolution then 458 RegisterWSComponent(TDragImageListResolution, TWSDragImageListResolution); 459 Done := True; 460end; 461 462procedure RegisterLazAccessibleObject; 463const 464 Done: Boolean = False; 465begin 466 if Done then exit; 467 if not WSRegisterLazAccessibleObject then 468 RegisterWSLazAccessibleObject(TWSLazAccessibleObject); 469 Done := True; 470end; 471 472procedure RegisterControl; 473const 474 Done: Boolean = False; 475begin 476 if Done then exit; 477 if not WSRegisterControl then 478 RegisterWSComponent(TControl, TWSControl); 479 Done := True; 480end; 481 482procedure RegisterWinControl; 483const 484 Done: Boolean = False; 485begin 486 if Done then exit; 487 if not WSRegisterWinControl then 488 RegisterWSComponent(TWinControl, TWSWinControl); 489 Done := True; 490end; 491 492procedure RegisterGraphicControl; 493const 494 Done: Boolean = False; 495begin 496 if Done then exit; 497 WSRegisterGraphicControl; 498// if not WSRegisterGraphicControl then 499// RegisterWSComponent(TGraphicControl, TWSGraphicControl); 500 Done := True; 501end; 502 503procedure RegisterCustomControl; 504const 505 Done: Boolean = False; 506begin 507 if Done then exit; 508 WSRegisterCustomControl; 509// if not WSRegisterCustomControl then 510// RegisterWSComponent(TCustomControl, TWSCustomControl); 511 Done := True; 512end; 513 514end. 515