paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 11:19:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Reverts changes to the handling of vclass due to issues in gtk2

Browse Source 
git-svn-id: trunk@55146 -
This commit is contained in:
sekelsenmat 2017-06-01 19:36:16 +00:00
parent 0280aea023
commit 5c1106e76b
23 changed files with 473 additions and 1743 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/interfaces/cocoa/cocoawscomctrls.pas
View File

@ -178,9 +178,9 @@ type
published
end;
{ TCocoaWSToolBar }
{ TCarbonWSToolBar }
TCocoaWSToolBar = class(TWSToolBar)
TCarbonWSToolBar = class(TWSToolBar)
published
//class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;

2
lcl/interfaces/gtk2/gtk2callback.inc
View File

@ -272,7 +272,7 @@ begin
if TheWinControl<>nil then
begin
TheWinControl.CNPreferredSizeChanged;
GetGtkPrivate(TheWinControl).UpdateCursor(WinWidgetInfo);
TGtkPrivateWidgetClass(TheWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WinWidgetInfo);
ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
if (TheWinControl is TCustomPage)

11
lcl/interfaces/gtk2/gtk2wscontrols.pp
View File

@ -770,16 +770,19 @@ begin
// simple
Child := TWinControlHack(AChild);
if ANewPos <= 0 then // bottom
GetGtkPrivate(Child).SetZPosition(Child, wszpBack)
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpBack)
else
GetGtkPrivate(Child).SetZPosition(Child, wszpFront);
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpFront);
end else
begin
for n := 1 to AChildren.Count - 1 do
begin
Child := TWinControlHack(AChildren[n]);
if Child.HandleAllocated then
GetGtkPrivate(Child).SetZPosition(Child, wszpBack);
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpBack);
end;
end;
end;
@ -795,7 +798,7 @@ begin
if WidgetInfo^.ControlCursor <> ACursor then
begin
WidgetInfo^.ControlCursor := ACursor;
GetGtkPrivate(AWinControl).UpdateCursor(WidgetInfo);
TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
end;
end;

26
lcl/interfaces/gtk2/gtk2wsprivate.pp
View File

@ -40,13 +40,10 @@ type
{ TGtkPrivate } // GTK1WS Legacy!
{ Generic base class, don't know if it is needed }
TGtkPrivateClass = class of TGtkPrivate;
TGtkPrivate = class(TWSPrivate)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual; abstract;
class procedure UpdateCursor(AInfo: PWidgetInfo); virtual; abstract;
end;
{ TGtkPrivateWidget }
@ -56,8 +53,8 @@ type
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
class procedure UpdateCursor(AInfo: PWidgetInfo); virtual;
end;
TGtkPrivateWidgetClass = class of TGtkPrivateWidget;
@ -167,6 +164,7 @@ type
{ TGtk2PrivateWidget }
{ Private class for gtkwidgets }
TGtk2PrivateWidget = class(TGtkPrivateWidget)
private
protected
@ -206,6 +204,7 @@ type
{ TGtk2PrivateDialog }
{ Private class for gtkdialogs }
TGtk2PrivateDialog = class(TGtkPrivateDialog)
private
protected
@ -215,6 +214,7 @@ type
{ TGtk2PrivateButton }
{ Private class for gtkbuttons }
TGtk2PrivateButton = class(TGtkPrivateButton)
private
protected
@ -257,29 +257,15 @@ procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
ASetDefault: Boolean);
procedure SetGlobalCursor(Cursor: HCURSOR);
function GetGtkPrivate(AWinControl: TWinControl): TGtkPrivateClass;
implementation
uses
Gtk2Extra, buttons, stdctrls, comctrls;
Gtk2Extra;
{$I Gtk2PrivateWidget.inc}
{$I Gtk2PrivateList.inc}
function GetGtkPrivate(AWinControl: TWinControl): TGtkPrivateClass;
begin
if AWinControl is TScrollingWinControl then Exit(TGtkPrivateScrollingWinControl);
if AWinControl is TCustomBitBtn then Exit(TGtk2PrivateButton);
if AWinControl is TCustomTabControl then Exit(TGtk2PrivateNotebook);
if AWinControl is TCustomButton then Exit(TGtk2PrivateButton);
if AWinControl is TCustomMemo then Exit(TGtkPrivateScrolling);
if AWinControl is TCustomEdit then Exit(TGtkPrivateEntry);
if AWinControl is TCustomListBox then Exit(TGtk2PrivateList);
if AWinControl is TWinControl then Exit(TGtkPrivateWidget);
Result := nil;
end;
{ TGtkPrivateScrolling }
{ temp class to keep things working }

2
lcl/interfaces/win32/win32wsfactory.pas
View File

@ -264,7 +264,7 @@ end;
function RegisterFontDialog: Boolean; alias : 'WSRegisterFontDialog';
begin
RegisterWSComponent(TFontDialog, TWin32WSFontDialog);
RegisterWSComponent(TFontDialog, TWin32WSFontDialog, nil, True);
Result := True;
end;

18
lcl/widgetset/wsbuttons.pp
View File

@ -47,12 +47,8 @@ type
{ TWSBitBtn }
TWSBitBtnClass = class of TWSBitBtn;
TWSBitBtn = class(TWSButton_CallWS)
private class var
FWSBitBtn_Impl: TWSBitBtnClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSBitBtn = class(TWSButton)
published
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); virtual;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); virtual;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); virtual;
@ -81,16 +77,6 @@ uses
{ TWSCustomBitBtn }
class function TWSBitBtn.GetImplementation: TWSObjectClass;
begin
Result:= FWSBitBtn_Impl;
end;
class procedure TWSBitBtn.SetImplementation(AImpl: TWSObjectClass);
begin
FWSBitBtn_Impl := TWSBitBtnClass(AImpl);
end;
class procedure TWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TButtonGlyph);
begin

20
lcl/widgetset/wscalendar.pp
View File

@ -45,13 +45,8 @@ uses
type
{ TWSCustomCalendar }
TWSCustomCalendarClass = class of TWSCustomCalendar;
TWSCustomCalendar = class(TWSWinControl_CallWS)
private class var
FWSCustomCalendar_Impl: TWSCustomCalendarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomCalendar = class(TWSWinControl)
published
class function GetDateTime(const ACalendar: TCustomCalendar): TDateTime; virtual;
class function HitTest(const ACalendar: TCustomCalendar; const APoint: TPoint): TCalendarPart; virtual;
class function GetCurrentView(const ACalendar: TCustomCalendar): TCalendarView; virtual;
@ -59,6 +54,7 @@ type
class procedure SetDisplaySettings(const ACalendar: TCustomCalendar;
const ADisplaySettings: TDisplaySettings); virtual;
end;
TWSCustomCalendarClass = class of TWSCustomCalendar;
{ WidgetSetRegistration }
@ -69,16 +65,6 @@ implementation
uses
LResources;
class function TWSCustomCalendar.GetImplementation: TWSObjectClass;
begin
Result:=FWSCustomCalendar_Impl;
end;
class procedure TWSCustomCalendar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomCalendar_Impl := TWSCustomCalendarClass(AImpl);
end;
class function TWSCustomCalendar.GetDateTime(const ACalendar: TCustomCalendar): TDateTime;
begin
Result := 0.0;

22
lcl/widgetset/wschecklst.pp
View File

@ -45,13 +45,8 @@ uses
type
{ TWSCustomCheckListBox }
TWSCustomCheckListBoxClass = class of TWSCustomCheckListBox;
TWSCustomCheckListBox = class(TWSCustomListBox_CallWS)
private class var
FWSCustomCheckListBox_Impl: TWSCustomCheckListBoxClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomCheckListBox = class(TWSCustomListBox)
published
class function GetCheckWidth(const ACheckListBox: TCustomCheckListBox):
integer; virtual;
class function GetItemEnabled(const ACheckListBox: TCustomCheckListBox;
@ -67,6 +62,7 @@ type
class procedure SetState(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AState: TCheckBoxState); virtual;
end;
TWSCustomCheckListBoxClass = class of TWSCustomCheckListBox;
{ WidgetSetRegistration }
@ -74,18 +70,8 @@ type
implementation
class function TWSCustomCheckListBox.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomCheckListBox_Impl;
end;
class procedure TWSCustomCheckListBox.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomCheckListBox_Impl := TWSCustomCheckListBoxClass(AImpl);
end;
class function TWSCustomCheckListBox.GetCheckWidth(
const ACheckListBox: TCustomCheckListBox): integer;
const ACheckListBox: TCustomCheckListBox): Integer;
begin
Result := 0;
end;

152
lcl/widgetset/wscomctrls.pp
View File

@ -47,31 +47,15 @@ type
{ TWSCustomPage }
TWSCustomPageClass = class of TWSCustomPage;
TWSCustomPage = class(TWSWinControl_CallWS)
private class var
FWSCustomPage_Impl: TWSCustomPageClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomPage = class(TWSWinControl)
published
class procedure UpdateProperties(const ACustomPage: TCustomPage); virtual;
end;
{ TWSCustomPage_CallWS }
TWSCustomPage_CallWS = class(TWSCustomPage)
public
class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
end;
{ TWSCustomTabControl }
TWSCustomTabControlClass = class of TWSCustomTabControl;
TWSCustomTabControl = class(TWSWinControl_CallWS)
private class var
FWSCustomTabControl_Impl: TWSCustomTabControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomTabControl = class(TWSWinControl)
published
class procedure AddPage(const ATabControl: TCustomTabControl; const AChild: TCustomPage; const AIndex: integer); virtual;
class procedure MovePage(const ATabControl: TCustomTabControl; const AChild: TCustomPage; const NewIndex: integer); virtual;
class procedure RemovePage(const ATabControl: TCustomTabControl; const AIndex: integer); virtual;
@ -89,16 +73,13 @@ type
class procedure ShowTabs(const ATabControl: TCustomTabControl; AShowTabs: boolean); virtual;
class procedure UpdateProperties(const ATabControl: TCustomTabControl); virtual;
end;
TWSCustomTabControlClass = class of TWSCustomTabControl;
{ TWSStatusBar }
TWSStatusBarClass = class of TWSStatusBar;
TWSStatusBar = class(TWSWinControl_CallWS)
private class var
FWSStatusBar_Impl: TWSStatusBarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSStatusBar = class(TWSWinControl)
published
class procedure PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure SetPanelText(const AStatusBar: TStatusBar; PanelIndex: integer); virtual;
class procedure SetSizeGrip(const AStatusBar: TStatusBar; SizeGrip: Boolean); virtual;
@ -108,8 +89,8 @@ type
{ TWSTabSheet }
TWSTabSheet = class(TWSCustomPage_CallWS)
public
TWSTabSheet = class(TWSCustomPage)
published
class function GetDefaultColor(const AControl: TControl;
const ADefaultColorType: TDefaultColorType): TColor; override;
end;
@ -124,13 +105,8 @@ type
TWSListViewItemChange = (lvicText, lvicImage);
TWSListViewItemChanges = set of TWSListViewItemChange;
TWSCustomListViewClass = class of TWSCustomListView;
TWSCustomListView = class(TWSWinControl_CallWS)
private class var
FWSCustomListView_Impl: TWSCustomListViewClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomListView = class(TWSWinControl)
published
// Column
class procedure ColumnDelete(const ALV: TCustomListView; const AIndex: Integer); virtual;
class function ColumnGetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn): Integer; virtual;
@ -197,6 +173,8 @@ type
class procedure SetViewStyle(const ALV: TCustomListView; const Avalue: TViewStyle); virtual;
end;
TWSCustomListViewClass = class of TWSCustomListView;
{ TWSListView }
TWSListView = class(TWSCustomListView)
@ -206,12 +184,8 @@ type
{ TWSProgressBar }
TWSProgressBarClass = class of TWSProgressBar;
TWSProgressBar = class(TWSWinControl_CallWS)
private class var
FWSProgressBar_Impl: TWSProgressBarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSProgressBar = class(TWSWinControl)
published
class procedure ApplyChanges(const AProgressBar: TCustomProgressBar); virtual;
class procedure SetPosition(const AProgressBar: TCustomProgressBar; const NewPosition: integer); virtual;
class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); virtual;
@ -239,12 +213,8 @@ type
TWSToolbarClass = class of TWSToolbar;
TWSToolBar = class(TWSToolWindow)
private class var
FWSToolBar_Impl: TWSToolbarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
{$ifdef OldToolbar}
published
{$ifdef OldToolbar}
class function GetButtonCount(const AToolBar: TToolBar): integer; virtual;
class procedure InsertToolButton(const AToolBar: TToolbar; const AControl: TControl); virtual;
class procedure DeleteToolButton(const AToolBar: TToolbar; const AControl: TControl); virtual;
@ -253,19 +223,15 @@ type
{ TWSTrackBar }
TWSTrackBarClass = class of TWSTrackBar;
TWSTrackBar = class(TWSWinControl_CallWS)
private class var
FWSTrackBar_Impl: TWSTrackBarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSTrackBar = class(TWSWinControl)
published
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); virtual;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; virtual;
class procedure SetOrientation(const ATrackBar: TCustomTrackBar; const AOrientation: TTrackBarOrientation); virtual;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); virtual;
class procedure SetTick(const ATrackBar: TCustomTrackBar; const ATick: integer); virtual;
end;
TWSTrackBarClass = class of TWSTrackBar;
{ TWSCustomTreeView }
@ -307,40 +273,12 @@ end;
{ TWSCustomPage }
class function TWSCustomPage.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomPage_Impl;
end;
class procedure TWSCustomPage.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomPage_Impl := TWSCustomPageClass(AImpl);
end;
class procedure TWSCustomPage.UpdateProperties(const ACustomPage: TCustomPage);
begin
end;
{ TWSCustomPage_CallWS }
class procedure TWSCustomPage_CallWS.UpdateProperties(
const ACustomPage: TCustomPage);
begin
FWSCustomPage_Impl.UpdateProperties(ACustomPage);
end;
{ TWSCustomTabControl }
class function TWSCustomTabControl.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomTabControl_Impl;
end;
class procedure TWSCustomTabControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomTabControl_Impl := TWSCustomTabControlClass(AImpl);
end;
{ -----------------------------------------------------------------------------
Method: TWSCustomTabControl.AddPage
Params: ATabControl - A notebook control
@ -461,16 +399,6 @@ end;
{ TWSStatusBar }
class function TWSStatusBar.GetImplementation: TWSObjectClass;
begin
Result:= FWSStatusBar_Impl;
end;
class procedure TWSStatusBar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSStatusBar_Impl := TWSStatusBarClass(AImpl);
end;
class procedure TWSStatusBar.PanelUpdate(const AStatusBar: TStatusBar; PanelIndex: integer);
begin
end;
@ -495,16 +423,6 @@ end;
{ TWSCustomListView }
class function TWSCustomListView.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomListView_Impl;
end;
class procedure TWSCustomListView.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomListView_Impl := TWSCustomListViewClass(AImpl);
end;
class procedure TWSCustomListView.ColumnDelete(const ALV: TCustomListView;
const AIndex: Integer);
begin
@ -804,16 +722,6 @@ end;
{ TWSProgressBar }
class function TWSProgressBar.GetImplementation: TWSObjectClass;
begin
Result:= FWSProgressBar_Impl;
end;
class procedure TWSProgressBar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSProgressBar_Impl := TWSProgressBarClass(AImpl);
end;
class procedure TWSProgressBar.ApplyChanges(const AProgressBar: TCustomProgressBar);
begin
end;
@ -830,16 +738,6 @@ end;
{ TWSToolbar }
class function TWSToolBar.GetImplementation: TWSObjectClass;
begin
Result:= FWSToolBar_Impl;
end;
class procedure TWSToolBar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSToolBar_Impl := TWSToolBarClass(AImpl);
end;
{$ifdef OldToolbar}
class function TWSToolbar.GetButtonCount(const AToolBar: TToolBar): integer;
@ -859,16 +757,6 @@ end;
{ TWSTrackBar }
class function TWSTrackBar.GetImplementation: TWSObjectClass;
begin
Result:= FWSTrackBar_Impl;
end;
class procedure TWSTrackBar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSTrackBar_Impl := TWSTrackBarClass(AImpl);
end;
class procedure TWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
begin
end;

397
lcl/widgetset/wscontrols.pp
View File

@ -53,13 +53,8 @@ const
type
{ TWSDragImageList }
TWSDragImageListClass = class of TWSDragImageList;
TWSDragImageList = class(TWSCustomImageList_CallWS)
private class var
FWSDragImageList_Impl: TWSDragImageListClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSDragImageList = class(TWSCustomImageList)
published
class function BeginDrag(const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean; virtual;
class function DragMove(const ADragImageList: TDragImageList; X, Y: Integer): Boolean; virtual;
class procedure EndDrag(const ADragImageList: TDragImageList); virtual;
@ -69,15 +64,12 @@ type
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; virtual;
end;
TWSDragImageListClass = class of TWSDragImageList;
{ TWSLazAccessibleObject }
TWSLazAccessibleObjectClass = class of TWSLazAccessibleObject;
TWSLazAccessibleObject = class(TWSObject)
private class var
FWSLazAccessibleObject_Impl: TWSLazAccessibleObjectClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
class function CreateHandle(const AObject: TLazAccessibleObject): HWND; virtual;
class procedure DestroyHandle(const AObject: TLazAccessibleObject); virtual;
class procedure SetAccessibleDescription(const AObject: TLazAccessibleObject; const ADescription: string); virtual;
@ -86,16 +78,12 @@ type
class procedure SetPosition(const AObject: TLazAccessibleObject; const AValue: TPoint); virtual;
class procedure SetSize(const AObject: TLazAccessibleObject; const AValue: TSize); virtual;
end;
TWSLazAccessibleObjectClass = class of TWSLazAccessibleObject;
{ TWSControl }
TWSControlClass = class of TWSControl;
TWSControl = class(TWSLCLComponent)
private class var
FWSControl_Impl: TWSControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class procedure AddControl(const AControl: TControl); virtual;
class function GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; virtual;
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; virtual;
@ -103,16 +91,7 @@ type
class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); virtual;
end;
{ TWSControl_CallWS }
TWSControl_CallWS = class(TWSControl)
public
class procedure AddControl(const AControl: TControl); override;
class function GetConstraints(const AControl: TControl; const AConstraints: TObject): Boolean; override;
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
class procedure ConstraintWidth(const AControl: TControl; const AConstraints: TObject; var aWidth: integer); override;
class procedure ConstraintHeight(const AControl: TControl; const AConstraints: TObject; var aHeight: integer); override;
end;
TWSControlClass = class of TWSControl;
{ TWSWinControl }
@ -120,13 +99,8 @@ type
{ TWSWinControl }
TWSWinControlClass = class of TWSWinControl;
TWSWinControl = class(TWSControl_CallWS)
private class var
FWSWinControl_Impl: TWSWinControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSWinControl = class(TWSControl)
published
class function CanFocus(const AWincontrol: TWinControl): Boolean; virtual;
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; virtual;
@ -164,64 +138,18 @@ type
class procedure ShowHide(const AWinControl: TWinControl); virtual; //TODO: rename to SetVisible(control, visible)
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); virtual;
end;
{ TWSWinControl_CallWS }
TWSWinControl_CallWS = class(TWSWinControl)
public
class function CanFocus(const AWincontrol: TWinControl): Boolean; override;
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
class function GetDefaultClientRect(const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect): boolean; override;
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; override;
class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
{ TODO: move AdaptBounds: it is only used in winapi interfaces }
class procedure AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean); override;
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure DefaultWndHandler(const AWinControl: TWinControl; var AMessage); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure Repaint(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
TWSWinControlClass = class of TWSWinControl;
{ TWSGraphicControl }
TWSGraphicControl = class(TWSControl_CallWS)
TWSGraphicControl = class(TWSControl)
published
end;
{ TWSCustomControl }
TWSCustomControlClass = class of TWSCustomControl;
TWSCustomControl = class(TWSWinControl_CallWS)
private class var
FWSCustomControl_Impl: TWSCustomControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomControl = class(TWSWinControl)
published
end;
{ TWSImageList }
@ -241,16 +169,6 @@ implementation
{ TWSLazAccessibleObject }
class function TWSLazAccessibleObject.GetImplementation: TWSObjectClass;
begin
Result:= FWSLazAccessibleObject_Impl;
end;
class procedure TWSLazAccessibleObject.SetImplementation(AImpl: TWSObjectClass);
begin
FWSLazAccessibleObject_Impl := TWSLazAccessibleObjectClass(AImpl);
end;
class function TWSLazAccessibleObject.CreateHandle(
const AObject: TLazAccessibleObject): HWND;
begin
@ -292,16 +210,6 @@ end;
{ TWSControl }
class function TWSControl.GetImplementation: TWSObjectClass;
begin
Result := FWSControl_Impl;
end;
class procedure TWSControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSControl_Impl := TWSControlClass(AImpl);
end;
class procedure TWSControl.AddControl(const AControl: TControl);
begin
end;
@ -328,67 +236,8 @@ begin
end;
{ TWSControl_CallWS }
class procedure TWSControl_CallWS.AddControl(const AControl: TControl);
begin
FWSControl_Impl.AddControl(AControl);
end;
class function TWSControl_CallWS.GetConstraints(const AControl: TControl;
const AConstraints: TObject): Boolean;
begin
Result := FWSControl_Impl.GetConstraints(AControl, AConstraints);
end;
class function TWSControl_CallWS.GetDefaultColor(const AControl: TControl;
const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := FWSControl_Impl.GetDefaultColor(AControl, ADefaultColorType);
end;
class procedure TWSControl_CallWS.ConstraintWidth(const AControl: TControl;
const AConstraints: TObject; var aWidth: integer);
begin
FWSControl_Impl.ConstraintWidth(AControl, AConstraints, aWidth);
end;
class procedure TWSControl_CallWS.ConstraintHeight(const AControl: TControl;
const AConstraints: TObject; var aHeight: integer);
begin
FWSControl_Impl.ConstraintHeight(AControl, AConstraints, aHeight);
end;
{ TWSWinControl }
class function TWSWinControl.GetImplementation: TWSObjectClass;
begin
Result := FWSWinControl_Impl;
end;
class procedure TWSWinControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSWinControl_Impl := TWSWinControlClass(AImpl);
end;
class function TWSWinControl.CanFocus(const AWincontrol: TWinControl): Boolean;
begin
// lets consider that by deafult all WinControls can be focused
Result := True;
end;
class function TWSWinControl.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
// for now default to the WinAPI version
Result := WidgetSet.GetClientBounds(AWincontrol.Handle, ARect);
end;
class function TWSWinControl.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
// for now default to the WinAPI version
Result := WidgetSet.GetClientRect(AWincontrol.Handle, ARect);
end;
class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer; var SuppressMove: boolean);
begin
@ -414,6 +263,24 @@ begin
WidgetSet.CallDefaultWndHandler(AWinControl, AMessage);
end;
class function TWSWinControl.CanFocus(const AWincontrol: TWinControl): Boolean;
begin
// lets consider that by deafult all WinControls can be focused
Result := True;
end;
class function TWSWinControl.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
// for now default to the WinAPI version
Result := WidgetSet.GetClientBounds(AWincontrol.Handle, ARect);
end;
class function TWSWinControl.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
// for now default to the WinAPI version
Result := WidgetSet.GetClientRect(AWincontrol.Handle, ARect);
end;
{------------------------------------------------------------------------------
Function: TWSWinControl.GetText
Params: Sender: The control to retrieve the text from
@ -535,198 +402,8 @@ begin
AWinControl.Invalidate;
end;
{ TWSWinControl_CallWS }
class function TWSWinControl_CallWS.CanFocus(const AWincontrol: TWinControl
): Boolean;
begin
Result:= FWSWinControl_Impl.CanFocus(AWincontrol);
end;
class function TWSWinControl_CallWS.GetClientBounds(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result:= FWSWinControl_Impl.GetClientBounds(AWincontrol, ARect);
end;
class function TWSWinControl_CallWS.GetClientRect(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result:= FWSWinControl_Impl.GetClientRect(AWincontrol, ARect);
end;
class procedure TWSWinControl_CallWS.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
FWSWinControl_Impl.GetPreferredSize(AWinControl, PreferredWidth, PreferredHeight,
WithThemeSpace);
end;
class function TWSWinControl_CallWS.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;
begin
Result:= FWSWinControl_Impl.GetDefaultClientRect(AWinControl, aLeft, aTop, aWidth,
aHeight, aClientRect);
end;
class function TWSWinControl_CallWS.GetDesignInteractive(
const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
begin
Result:= FWSWinControl_Impl.GetDesignInteractive(AWinControl, AClientPos);
end;
class function TWSWinControl_CallWS.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
begin
Result:= FWSWinControl_Impl.GetText(AWinControl, AText);
end;
class function TWSWinControl_CallWS.GetTextLen(const AWinControl: TWinControl;
var ALength: Integer): Boolean;
begin
Result:= FWSWinControl_Impl.GetTextLen(AWinControl, ALength);
end;
class procedure TWSWinControl_CallWS.SetBiDiMode(
const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading,
UseRightToLeftScrollBar: Boolean);
begin
FWSWinControl_Impl.SetBiDiMode(AWinControl, UseRightToLeftAlign,
UseRightToLeftReading, UseRightToLeftScrollBar);
end;
class procedure TWSWinControl_CallWS.SetBorderStyle(
const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
FWSWinControl_Impl.SetBorderStyle(AWinControl, ABorderStyle);
end;
class procedure TWSWinControl_CallWS.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
begin
FWSWinControl_Impl.SetBounds(AWinControl, ALeft, ATop, AWidth, AHeight);
end;
class procedure TWSWinControl_CallWS.SetColor(const AWinControl: TWinControl);
begin
FWSWinControl_Impl.SetColor(AWinControl);
end;
class procedure TWSWinControl_CallWS.SetChildZPosition(const AWinControl,
AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList
);
begin
FWSWinControl_Impl.SetChildZPosition(AWinControl, AChild, AOldPos, ANewPos, AChildren);
end;
class procedure TWSWinControl_CallWS.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
begin
FWSWinControl_Impl.SetFont(AWinControl, AFont);
end;
class procedure TWSWinControl_CallWS.SetPos(const AWinControl: TWinControl;
const ALeft, ATop: Integer);
begin
FWSWinControl_Impl.SetPos(AWinControl, ALeft, ATop);
end;
class procedure TWSWinControl_CallWS.SetSize(const AWinControl: TWinControl;
const AWidth, AHeight: Integer);
begin
FWSWinControl_Impl.SetSize(AWinControl, AWidth, AHeight);
end;
class procedure TWSWinControl_CallWS.SetText(const AWinControl: TWinControl;
const AText: String);
begin
FWSWinControl_Impl.SetText(AWinControl, AText);
end;
class procedure TWSWinControl_CallWS.SetCursor(const AWinControl: TWinControl;
const ACursor: HCursor);
begin
FWSWinControl_Impl.SetCursor(AWinControl, ACursor);
end;
class procedure TWSWinControl_CallWS.SetShape(const AWinControl: TWinControl;
const AShape: HBITMAP);
begin
FWSWinControl_Impl.SetShape(AWinControl, AShape);
end;
class procedure TWSWinControl_CallWS.AdaptBounds(
const AWinControl: TWinControl; var Left, Top, Width, Height: integer;
var SuppressMove: boolean);
begin
FWSWinControl_Impl.AdaptBounds(AWinControl, Left, Top, Width, Height, SuppressMove);
end;
class procedure TWSWinControl_CallWS.ConstraintsChange(
const AWinControl: TWinControl);
begin
FWSWinControl_Impl.ConstraintsChange(AWinControl);
end;
class function TWSWinControl_CallWS.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
begin
Result:= FWSWinControl_Impl.CreateHandle(AWinControl, AParams);
end;
class procedure TWSWinControl_CallWS.DestroyHandle(
const AWinControl: TWinControl);
begin
FWSWinControl_Impl.DestroyHandle(AWinControl);
end;
class procedure TWSWinControl_CallWS.DefaultWndHandler(
const AWinControl: TWinControl; var AMessage);
begin
FWSWinControl_Impl.DefaultWndHandler(AWinControl, AMessage);
end;
class procedure TWSWinControl_CallWS.Invalidate(const AWinControl: TWinControl);
begin
FWSWinControl_Impl.Invalidate(AWinControl);
end;
class procedure TWSWinControl_CallWS.PaintTo(const AWinControl: TWinControl;
ADC: HDC; X, Y: Integer);
begin
FWSWinControl_Impl.PaintTo(AWinControl, ADC, X, Y);
end;
class procedure TWSWinControl_CallWS.Repaint(const AWinControl: TWinControl);
begin
FWSWinControl_Impl.Repaint(AWinControl);
end;
class procedure TWSWinControl_CallWS.ShowHide(const AWinControl: TWinControl);
begin
FWSWinControl_Impl.ShowHide(AWinControl);
end;
class procedure TWSWinControl_CallWS.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
begin
FWSWinControl_Impl.ScrollBy(AWinControl, DeltaX, DeltaY);
end;
{ TWSDragImageList }
class function TWSDragImageList.GetImplementation: TWSObjectClass;
begin
Result:= FWSDragImageList_Impl;
end;
class procedure TWSDragImageList.SetImplementation(AImpl: TWSObjectClass);
begin
FWSDragImageList_Impl := TWSDragImageListClass(AImpl);
end;
class function TWSDragImageList.BeginDrag(const ADragImageList: TDragImageList;
Window: HWND; AIndex, X, Y: Integer): Boolean;
begin
@ -755,18 +432,6 @@ begin
Result := False;
end;
{ TWSCustomControl }
class function TWSCustomControl.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomControl_Impl;
end;
class procedure TWSCustomControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomControl_Impl := TWSCustomControlClass(AImpl);
end;
{ WidgetSetRegistration }
procedure RegisterDragImageList;

22
lcl/widgetset/wsdesigner.pp
View File

@ -35,20 +35,16 @@ interface
////////////////////////////////////////////////////
uses
Classes, RubberBand,
WsControls, WSFactory, WSLCLClasses;
WsControls, WSFactory;
type
{ TWsCustomRubberBand }
TWsCustomRubberBandClass = class of TWsCustomRubberBand;
TWsCustomRubberBand = class(TWSWinControl_CallWS)
private class var
FWSCustomRubberBand_Impl: TWsCustomRubberBandClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWsCustomRubberBand = class(TWsWinControl)
published
class procedure SetShape(ARubberBand: TCustomRubberBand; AShape: TRubberBandShape); virtual; overload;
end;
TWsCustomRubberBandClass = class of TWsCustomRubberBand;
{ WidgetSetRegistration }
@ -58,16 +54,6 @@ implementation
{ TWsCustomRubberBand }
class function TWsCustomRubberBand.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomRubberBand_Impl;
end;
class procedure TWsCustomRubberBand.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomRubberBand_Impl := TWsCustomRubberBandClass(AImpl);
end;
class procedure TWsCustomRubberBand.SetShape(ARubberBand: TCustomRubberBand;
AShape: TRubberBandShape);
begin

206
lcl/widgetset/wsdialogs.pp
View File

@ -48,77 +48,42 @@ type
TWSCommonDialogClass = class of TWSCommonDialog;
TWSCommonDialog = class(TWSLCLComponent)
public class var
FWSCommonDialog_WSClass: TWSCommonDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
WSCommonDialog_WSClass: TWSCommonDialogClass;
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; virtual;
class procedure ShowModal(const ACommonDialog: TCommonDialog); virtual;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); virtual;
class function QueryWSEventCapabilities(const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; virtual;
end;
TWSCommonDialog_CallWS = class(TWSCommonDialog)
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
class function QueryWSEventCapabilities(const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override;
end;
{ TWSFileDialog }
TWSFileDialogClass = class of TWSFileDialog;
TWSFileDialog = class(TWSCommonDialog_CallWS)
public class var
FWSFileDialog_WSClass: TWSFileDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSFileDialog = class(TWSCommonDialog)
published
end;
{ TWSOpenDialog }
TWSOpenDialogClass = class of TWSOpenDialog;
TWSOpenDialog = class(TWSFileDialog)
public class var
FWSOpenDialog_WSClass: TWSOpenDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
end;
{ TWSSaveDialog }
TWSSaveDialogClass = class of TWSSaveDialog;
TWSSaveDialog = class(TWSOpenDialog)
public class var
FWSSaveDialog_WSClass: TWSSaveDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
end;
{ TWSSelectDirectoryDialog }
TWSSelectDirectoryDialogClass = class of TWSSelectDirectoryDialog;
TWSSelectDirectoryDialog = class(TWSOpenDialog)
public class var
FWSSelectDirectoryDialog_WSClass: TWSSelectDirectoryDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
end;
{ TWSColorDialog }
TWSColorDialogClass = class of TWSColorDialog;
TWSColorDialog = class(TWSCommonDialog_CallWS)
public class var
FWSColorDialog_WSClass: TWSColorDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSColorDialog = class(TWSCommonDialog)
published
end;
{ TWSColorButton }
@ -129,13 +94,12 @@ type
{ TWSFontDialog }
TWSFontDialogClass = class of TWSFontDialog;
TWSFontDialog = class(TWSCommonDialog_CallWS)
public class var
FWSFontDialog_WSClass: TWSFontDialogClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSFontDialog = class(TWSCommonDialog)
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
class function QueryWSEventCapabilities(const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override;
end;
{ WidgetSetRegistration }
@ -154,16 +118,6 @@ implementation
uses
LResources;
class function TWSCommonDialog.GetImplementation: TWSObjectClass;
begin
Result := FWSCommonDialog_WSClass;
end;
class procedure TWSCommonDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCommonDialog_WSClass := TWSCommonDialogClass(AImpl);
end;
class function TWSCommonDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
Result := 0;
@ -183,99 +137,55 @@ class procedure TWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
end;
{ TWSCommonDialog_CallWS }
class function TWSCommonDialog_CallWS.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
Result := FWSCommonDialog_WSClass.CreateHandle(ACommonDialog);
end;
class procedure TWSCommonDialog_CallWS.ShowModal(const ACommonDialog: TCommonDialog);
begin
FWSCommonDialog_WSClass.ShowModal(ACommonDialog);
end;
class procedure TWSCommonDialog_CallWS.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
FWSCommonDialog_WSClass.DestroyHandle(ACommonDialog);
end;
class function TWSCommonDialog_CallWS.QueryWSEventCapabilities(
const ACommonDialog: TCommonDialog): TCDWSEventCapabilities;
begin
Result := FWSCommonDialog_WSClass.QueryWSEventCapabilities(ACommonDialog);
end;
{ TWSFileDialog }
class function TWSFileDialog.GetImplementation: TWSObjectClass;
begin
Result:= FWSFileDialog_WSClass;
end;
class procedure TWSFileDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSFileDialog_WSClass := TWSFileDialogClass(AImpl);
end;
{ TWSOpenDialog }
class function TWSOpenDialog.GetImplementation: TWSObjectClass;
begin
Result:= FWSOpenDialog_WSClass;
end;
class procedure TWSOpenDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSOpenDialog_WSClass := TWSOpenDialogClass(AImpl);
end;
{ TWSSaveDialog }
class function TWSSaveDialog.GetImplementation: TWSObjectClass;
begin
Result:= FWSSaveDialog_WSClass;
end;
class procedure TWSSaveDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSSaveDialog_WSClass := TWSSaveDialogClass(AImpl);
end;
{ TWSSelectDirectoryDialog }
class function TWSSelectDirectoryDialog.GetImplementation: TWSObjectClass;
begin
Result:= FWSSelectDirectoryDialog_WSClass;
end;
class procedure TWSSelectDirectoryDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSSelectDirectoryDialog_WSClass := TWSSelectDirectoryDialogClass(AImpl);
end;
{ TWSColorDialog }
class function TWSColorDialog.GetImplementation: TWSObjectClass;
begin
Result:= FWSColorDialog_WSClass;
end;
class procedure TWSColorDialog.SetImplementation(AImpl: TWSObjectClass);
begin
FWSColorDialog_WSClass := TWSColorDialogClass(AImpl);
end;
{ TWSFontDialog }
class function TWSFontDialog.GetImplementation: TWSObjectClass;
class function TWSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
Result:= FWSFontDialog_WSClass;
if WSCommonDialog_WSClass = nil then
WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog));
if WSCommonDialog_WSClass <> nil then
begin
Result := WSCommonDialog_WSClass.CreateHandle(ACommonDialog);
Exit;
end;
Result:=inherited CreateHandle(ACommonDialog)
end;
class procedure TWSFontDialog.SetImplementation(AImpl: TWSObjectClass);
class procedure TWSFontDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
FWSFontDialog_WSClass := TWSFontDialogClass(AImpl);
if WSCommonDialog_WSClass = nil then
WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog));
if WSCommonDialog_WSClass <> nil then
begin
WSCommonDialog_WSClass.ShowModal(ACommonDialog);
Exit;
end;
inherited ShowModal(ACommonDialog);
end;
class procedure TWSFontDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
begin
if WSCommonDialog_WSClass = nil then
WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog));
if WSCommonDialog_WSClass <> nil then
begin
WSCommonDialog_WSClass.DestroyHandle(ACommonDialog);
Exit;
end;
inherited DestroyHandle(ACommonDialog);
end;
class function TWSFontDialog.QueryWSEventCapabilities(
const ACommonDialog: TCommonDialog): TCDWSEventCapabilities;
begin
if WSCommonDialog_WSClass = nil then
WSCommonDialog_WSClass := TWSCommonDialogClass(FindWSComponentClass(TCommonDialog));
if WSCommonDialog_WSClass <> nil then
begin
Result := WSCommonDialog_WSClass.QueryWSEventCapabilities(ACommonDialog);
Exit;
end;
Result:=inherited QueryWSEventCapabilities(ACommonDialog);
end;
{ WidgetSetRegistration }

57
lcl/widgetset/wsextctrls.pp
View File

@ -52,7 +52,7 @@ type
{ TWSNotebook }
TWSNotebook = class(TWSCustomControl)
public
published
class function GetDefaultColor(const AControl: TControl;
const ADefaultColorType: TDefaultColorType): TColor; override;
end;
@ -125,13 +125,8 @@ type
{ TWSCustomLabeledEdit }
TWSCustomLabeledEditClass = class of TWSCustomLabeledEdit;
TWSCustomLabeledEdit = class(TWSCustomEdit_CallWS)
private class var
FWSCustomLabeledEdit_Impl: TWSCustomLabeledEditClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomLabeledEdit = class(TWSCustomEdit)
published
end;
{ TWSLabeledEdit }
@ -143,7 +138,7 @@ type
{ TWSCustomPanel }
TWSCustomPanel = class(TWSCustomControl)
public
published
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end;
@ -154,13 +149,8 @@ type
{ TWSCustomTrayIcon }
TWSCustomTrayIconClass = class of TWSCustomTrayIcon;
TWSCustomTrayIcon = class(TWSLCLComponent)
public class var
FWSCustomTrayIcon_WSClass: TWSCustomTrayIconClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; virtual;
class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; virtual;
class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); virtual;
@ -168,6 +158,7 @@ type
class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; virtual;
class function GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; virtual;
end;
TWSCustomTrayIconClass = class of TWSCustomTrayIcon;
{ WidgetSetRegistration }
@ -192,37 +183,8 @@ begin
Result:=DefBtnColors[ADefaultColorType];
end;
{ TWSCustomLabeledEdit }
class function TWSCustomLabeledEdit.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomLabeledEdit_Impl;
end;
class procedure TWSCustomLabeledEdit.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomLabeledEdit_Impl := TWSCustomLabeledEditClass(AImpl);
end;
{ TWSCustomPanel }
class function TWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := DefBtnColors[ADefaultColorType];
end;
{ TWSCustomTrayIcon }
class function TWSCustomTrayIcon.GetImplementation: TWSObjectClass;
begin
Result := FWSCustomTrayIcon_WSClass;
end;
class procedure TWSCustomTrayIcon.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomTrayIcon_WSClass := TWSCustomTrayIconClass(AImpl);
end;
class function TWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
begin
Result := False;
@ -377,4 +339,11 @@ begin
Done := True;
end;
{ TWSCustomPanel }
class function TWSCustomPanel.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := DefBtnColors[ADefaultColorType];
end;
end.

21
lcl/widgetset/wsextdlgs.pp
View File

@ -45,13 +45,8 @@ uses
type
{ TWSPreviewFileControl }
TWSPreviewFileControlClass = class of TWSPreviewFileControl;
TWSPreviewFileControl = class(TWSWinControl_CallWS)
private class var
FWSPreviewFileControl_Impl: TWSPreviewFileControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSPreviewFileControl = class(TWSWinControl)
published
end;
{ TWSPreviewFileDialog }
@ -110,18 +105,6 @@ type
implementation
{ TWSPreviewFileControl }
class function TWSPreviewFileControl.GetImplementation: TWSObjectClass;
begin
Result:= FWSPreviewFileControl_Impl;
end;
class procedure TWSPreviewFileControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSPreviewFileControl_Impl := TWSPreviewFileControlClass(AImpl);
end;
{ WidgetSetRegistration }
procedure RegisterPreviewFileControl;

184
lcl/widgetset/wsforms.pp
View File

@ -47,12 +47,8 @@ type
{ TWSScrollingWinControl }
TWSScrollingWinControlClass = class of TWSScrollingWinControl;
TWSScrollingWinControl = class(TWSWinControl_CallWS)
private class var
FWSScrollingWinControl_Impl: TWSScrollingWinControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSScrollingWinControl = class(TWSWinControl)
published
// procedure ScrollBy is moved to TWSWinControl.
end;
@ -76,13 +72,8 @@ type
{ TWSCustomForm }
TWSCustomFormClass = class of TWSCustomForm;
TWSCustomForm = class(TWSScrollingWinControl)
private class var
FWSCustomForm_Impl: TWSCustomFormClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class procedure CloseModal(const ACustomForm: TCustomForm); virtual;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); virtual;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean;
@ -111,60 +102,18 @@ type
class function Tile(const AForm: TCustomForm): Boolean; virtual;
class function MDIChildCount(const AForm: TCustomForm): Integer; virtual;
end;
{ TWSCustomForm_CallWS }
TWSCustomForm_CallWS = class(TWSCustomForm)
public
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean;
const Alpha: Byte); override;
class procedure SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
class procedure SetModalResult(const ACustomForm: TCustomForm; ANewValue: TModalResult); override;
class procedure SetRealPopupParent(const ACustomForm: TCustomForm;
const APopupParent: TCustomForm); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
//class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
{mdi support}
{class function ActiveMDIChild(const AForm: TCustomForm): TCustomForm; virtual;
class function Cascade(const AForm: TCustomForm): Boolean; virtual;
class function GetClientHandle(const AForm: TCustomForm): HWND; virtual;
class function GetMDIChildren(const AForm: TCustomForm; AIndex: Integer): TCustomForm; virtual;
class function Next(const AForm: TCustomForm): Boolean; virtual;
class function Previous(const AForm: TCustomForm): Boolean; virtual;
class function Tile(const AForm: TCustomForm): Boolean; virtual;
class function MDIChildCount(const AForm: TCustomForm): Integer; virtual;}
end;
TWSCustomFormClass = class of TWSCustomForm;
{ TWSForm }
TWSFormClass = class of TWSForm;
TWSForm = class(TWSCustomForm_CallWS)
private class var
FWSForm_Impl: TWSFormClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSForm = class(TWSCustomForm)
published
end;
{ TWSHintWindow }
TWSHintWindowClass = class of TWSHintWindow;
TWSHintWindow = class(TWSCustomForm_CallWS)
private class var
FWSHintWindow_Impl: TWSHintWindowClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSHintWindow = class(TWSCustomForm)
published
end;
{ TWSScreen }
@ -189,30 +138,8 @@ type
implementation
{ TWSScrollingWinControl }
class function TWSScrollingWinControl.GetImplementation: TWSObjectClass;
begin
Result:= FWSScrollingWinControl_Impl;
end;
class procedure TWSScrollingWinControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSScrollingWinControl_Impl := TWSScrollingWinControlClass(AImpl);
end;
{ TWSCustomForm }
class function TWSCustomForm.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomForm_Impl;
end;
class procedure TWSCustomForm.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomForm_Impl := TWSCustomFormClass(AImpl);
end;
class procedure TWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
begin
end;
@ -326,101 +253,6 @@ begin
Result := False;
end;
{ TWSCustomForm_CallWS }
class procedure TWSCustomForm_CallWS.CloseModal(const ACustomForm: TCustomForm);
begin
FWSCustomForm_Impl.CloseModal(ACustomForm);
end;
class procedure TWSCustomForm_CallWS.SetAllowDropFiles(
const AForm: TCustomForm; AValue: Boolean);
begin
FWSCustomForm_Impl.SetAllowDropFiles(AForm, AValue);
end;
class procedure TWSCustomForm_CallWS.SetAlphaBlend(
const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte);
begin
FWSCustomForm_Impl.SetAlphaBlend(ACustomForm, AlphaBlend, Alpha);
end;
class procedure TWSCustomForm_CallWS.SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons);
begin
FWSCustomForm_Impl.SetBorderIcons(AForm, ABorderIcons);
end;
class procedure TWSCustomForm_CallWS.SetFormBorderStyle(
const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle);
begin
FWSCustomForm_Impl.SetFormBorderStyle(AForm, AFormBorderStyle);
end;
class procedure TWSCustomForm_CallWS.SetFormStyle(const AForm: TCustomform;
const AFormStyle, AOldFormStyle: TFormStyle);
begin
FWSCustomForm_Impl.SetFormStyle(AForm, AFormStyle, AOldFormStyle);
end;
class procedure TWSCustomForm_CallWS.SetIcon(const AForm: TCustomForm;
const Small, Big: HICON);
begin
FWSCustomForm_Impl.SetIcon(AForm, Small, Big);
end;
class procedure TWSCustomForm_CallWS.ShowModal(const ACustomForm: TCustomForm);
begin
FWSCustomForm_Impl.ShowModal(ACustomForm);
end;
class procedure TWSCustomForm_CallWS.SetModalResult(
const ACustomForm: TCustomForm; ANewValue: TModalResult);
begin
FWSCustomForm_Impl.SetModalResult(ACustomForm, ANewValue);
end;
class procedure TWSCustomForm_CallWS.SetRealPopupParent(
const ACustomForm: TCustomForm; const APopupParent: TCustomForm);
begin
FWSCustomForm_Impl.SetRealPopupParent(ACustomForm, APopupParent);
end;
class procedure TWSCustomForm_CallWS.SetShowInTaskbar(const AForm: TCustomForm;
const AValue: TShowInTaskbar);
begin
FWSCustomForm_Impl.SetShowInTaskbar(AForm, AValue);
end;
class procedure TWSCustomForm_CallWS.SetZPosition(
const AWinControl: TWinControl; const APosition: TWSZPosition);
begin
FWSCustomForm_Impl.SetZPosition(AWinControl, APosition);
end;
{ TWSForm }
class function TWSForm.GetImplementation: TWSObjectClass;
begin
Result:= FWSForm_Impl;
end;
class procedure TWSForm.SetImplementation(AImpl: TWSObjectClass);
begin
FWSForm_Impl := TWSFormClass(AImpl);
end;
{ TWSHintWindow }
class function TWSHintWindow.GetImplementation: TWSObjectClass;
begin
Result:= FWSHintWindow_Impl;
end;
class procedure TWSHintWindow.SetImplementation(AImpl: TWSObjectClass);
begin
FWSHintWindow_Impl := TWSHintWindowClass(AImpl);
end;
{ WidgetSetRegistration }

18
lcl/widgetset/wsgrids.pp
View File

@ -46,18 +46,14 @@ uses
type
{ TWSCustomGrid }
TWSCustomGridClass = class of TWSCustomgrid;
TWSCustomGrid = class(TWSCustomControl)
private class var
FWSCustomGrid_Impl: TWSCustomGridClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class procedure SendCharToEditor(AEditor:TWinControl; Ch: TUTF8Char); virtual;
class function InvalidateStartY(const FixedHeight, RowOffset: Integer): integer; virtual;
class function GetEditorBoundsFromCellRect(ACanvas: TCanvas;
const ACellRect: TRect; const AColumnLayout: TTextLayout): TRect; virtual;
end;
TWSCustomGridClass = class of TWSCustomgrid;
{ WidgetSetRegistration }
@ -73,16 +69,6 @@ type
{ TWSCustomGrid }
class function TWSCustomGrid.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomGrid_Impl;
end;
class procedure TWSCustomGrid.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomGrid_Impl := TWSCustomGridClass(AImpl);
end;
class procedure TWSCustomGrid.SendCharToEditor(AEditor:TWinControl;
Ch: TUTF8Char);
var

82
lcl/widgetset/wsimglist.pp
View File

@ -41,13 +41,8 @@ uses
type
{ TWSCustomImageList }
TWSCustomImageListClass = class of TWSCustomImageList;
TWSCustomImageList = class(TWSLCLReferenceComponent)
private class var
FWSCustomImageList_Impl: TWSCustomImageListClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class procedure Clear(AList: TCustomImageList); virtual;
class function CreateReference(AList: TCustomImageList; ACount, AGrow, AWidth,
AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference; virtual;
@ -63,23 +58,9 @@ type
class procedure Replace(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); virtual;
end;
TWSCustomImageListClass = class of TWSCustomImageList;
{ TWSCustomImageList_CallWS }
TWSCustomImageList_CallWS = class(TWSCustomImageList)
public
class procedure Clear(AList: TCustomImageList); override;
class function CreateReference(AList: TCustomImageList; ACount, AGrow, AWidth,
AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference; override;
class procedure Delete(AList: TCustomImageList; AIndex: Integer); override;
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
class procedure Insert(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
class procedure Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); override;
class procedure Replace(AList: TCustomImageList; AIndex: Integer; AData: PRGBAQuad); override;
end;
procedure RegisterCustomImageList;
procedure RegisterCustomImageList;
implementation
@ -172,16 +153,6 @@ end;
{ TWSCustomImageList }
class function TWSCustomImageList.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomImageList_Impl;
end;
class procedure TWSCustomImageList.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomImageList_Impl := TWSCustomImageListClass(AImpl);
end;
class procedure TWSCustomImageList.Clear(AList: TCustomImageList);
begin
if not WSCheckReferenceAllocated(AList, 'Clear')
@ -281,53 +252,6 @@ begin
TDefaultImageListImplementor(AList.Reference.Ptr)[AIndex] := ABitmap;
end;
{ TWSCustomImageList_CallWS }
class procedure TWSCustomImageList_CallWS.Clear(AList: TCustomImageList);
begin
FWSCustomImageList_Impl.Clear(AList);
end;
class function TWSCustomImageList_CallWS.CreateReference(
AList: TCustomImageList; ACount, AGrow, AWidth, AHeight: Integer;
AData: PRGBAQuad): TWSCustomImageListReference;
begin
Result:= FWSCustomImageList_Impl.CreateReference(AList, ACount, AGrow, AWidth, AHeight, AData);
end;
class procedure TWSCustomImageList_CallWS.Delete(AList: TCustomImageList;
AIndex: Integer);
begin
FWSCustomImageList_Impl.Delete(AList, AIndex);
end;
class procedure TWSCustomImageList_CallWS.Draw(AList: TCustomImageList;
AIndex: Integer; ACanvas: TCanvas; ABounds: TRect; ABkColor,
ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle;
AImageType: TImageType);
begin
FWSCustomImageList_Impl.Draw(AList, AIndex, ACanvas, ABounds, ABkColor, ABlendColor,
ADrawEffect, AStyle, AImageType);
end;
class procedure TWSCustomImageList_CallWS.Insert(AList: TCustomImageList;
AIndex: Integer; AData: PRGBAQuad);
begin
FWSCustomImageList_Impl.Insert(AList, AIndex, AData);
end;
class procedure TWSCustomImageList_CallWS.Move(AList: TCustomImageList;
ACurIndex, ANewIndex: Integer);
begin
FWSCustomImageList_Impl.Move(AList, ACurIndex, ANewIndex);
end;
class procedure TWSCustomImageList_CallWS.Replace(AList: TCustomImageList;
AIndex: Integer; AData: PRGBAQuad);
begin
FWSCustomImageList_Impl.Replace(AList, AIndex, AData);
end;
{ WidgetSetRegistration }
procedure RegisterCustomImageList;

14
lcl/widgetset/wslazdeviceapis.pas
View File

@ -47,11 +47,7 @@ type
TWSLazDeviceAPIsClass = class of TWSLazDeviceAPIs;
TWSLazDeviceAPIs = class(TWSObject)
private class var
FWSLazDeviceAPIs_Impl: TWSLazDeviceAPIsClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
class procedure RequestPositionInfo(AMethod: TLazPositionMethod); virtual;
//
class procedure SendMessage(AMsg: TLazDeviceMessage); virtual;
@ -84,16 +80,6 @@ end;
{ TWSLazDeviceAPIs }
class function TWSLazDeviceAPIs.GetImplementation: TWSObjectClass;
begin
Result:= FWSLazDeviceAPIs_Impl;
end;
class procedure TWSLazDeviceAPIs.SetImplementation(AImpl: TWSObjectClass);
begin
FWSLazDeviceAPIs_Impl := TWSLazDeviceAPIsClass(AImpl);
end;
class procedure TWSLazDeviceAPIs.RequestPositionInfo(AMethod: TLazPositionMethod);
begin

288
lcl/widgetset/wslclclasses.pp
View File

@ -56,20 +56,15 @@ type
{ For non-TComponent WS objects }
TWSObjectClass = class of TWSObject;
{ TWSObject }
TWSObject = class(TObject)
public
class function GetImplementation: TWSObjectClass; virtual;
class procedure SetImplementation(AImpl: TWSObjectClass); virtual;
end;
TWSObjectClass = class of TWSObject;
{ TWSLCLComponent }
{$M+}
TWSLCLComponent = class(TWSObject)
TWSLCLComponent = class(TObject)
public
class function WSPrivate: TWSPrivateClass; //inline;
end;
@ -88,7 +83,8 @@ type
function FindWSComponentClass(const AComponent: TComponentClass): TWSLCLComponentClass;
procedure RegisterWSComponent(const AComponent: TComponentClass;
const AWSComponent: TWSLCLComponentClass;
const AWSPrivate: TWSPrivateClass = nil);
const AWSPrivate: TWSPrivateClass = nil;
const ANewRegistration: Boolean = False);
// Only for non-TComponent based objects
function GetWSLazAccessibleObject: TWSObjectClass;
procedure RegisterWSLazAccessibleObject(const AWSObject: TWSObjectClass);
@ -110,9 +106,22 @@ type
TClassNode = record
LCLClass: TComponentClass;
WSClass: TWSLCLComponentClass;
VClass: TWSLCLComponentClass;
VClass: Pointer;
VClassName: ShortString;
VClassNew: Boolean; // Indicates that VClass=WSClass, VClass is not created during runtime
Parent: PClassNode;
Child: PClassNode;
Sibling: PClassNode;
end;
const
// To my knowledge there is no way to tell the size of the
// VMT of a given class.
// Assume we have no more than 100 virtual entries
// 12.10.2013 - changed to 128, since we cannot add more methods in ws classes.zeljko.
VIRTUAL_VMT_COUNT = 128;
VIRTUAL_VMT_SIZE = vmtMethodStart + VIRTUAL_VMT_COUNT * SizeOf(Pointer);
const
// vmtAutoTable is something Delphi 2 and not used, we 'borrow' the vmt entry
vmtWSPrivate = vmtAutoTable;
@ -148,11 +157,27 @@ begin
end;
end;
type
TMethodNameTableEntry = packed record
Name: PShortstring;
Addr: Pointer;
end;
TMethodNameTable = packed record
Count: DWord;
Entries: packed array[0..9999999] of TMethodNameTableEntry;
end;
PMethodNameTable = ^TMethodNameTable;
TPointerArray = packed array[0..9999999] of Pointer;
PPointerArray = ^TPointerArray;
// ANewRegistration - If true, VClass is not created during runtime,
// but instead normal, Object Pascal class creation is used
procedure RegisterWSComponent(const AComponent: TComponentClass;
const AWSComponent: TWSLCLComponentClass;
const AWSPrivate: TWSPrivateClass = nil);
const AWSPrivate: TWSPrivateClass = nil;
const ANewRegistration: Boolean = False);
function GetNode(const AClass: TClass): PClassNode;
var
@ -174,6 +199,18 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
Result^.LCLClass := TComponentClass(AClass);
Result^.WSClass := nil;
Result^.VClass := nil;
Result^.VClassName := '';
Result^.VClassNew := False;
Result^.Child := nil;
Result^.Parent := GetNode(AClass.ClassParent);
if Result^.Parent = nil
then begin
Result^.Sibling := nil;
end
else begin
Result^.Sibling := Result^.Parent^.Child;
Result^.Parent^.Child := Result;
end;
MComponentIndex.AddObject(Name, TObject(Result));
end
else begin
@ -181,12 +218,207 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
end;
end;
function FindParentWSClassNode(const ANode: PClassNode): PClassNode;
begin
Result := ANode^.Parent;
while Result <> nil do
begin
if Result^.WSClass <> nil then Exit;
Result := Result^.Parent;
end;
Result := nil;
end;
function FindCommonAncestor(const AClass1, AClass2: TClass): TClass;
begin
Result := AClass1;
if AClass2.InheritsFrom(Result)
then Exit;
Result := AClass2;
while Result <> nil do
begin
if AClass1.InheritsFrom(Result)
then Exit;
Result := Result.ClassParent;
end;
Result := nil;
end;
procedure CreateVClass(const ANode: PClassNode; AOldPrivate: TClass = nil);
var
ParentWSNode: PClassNode;
CommonClass: TClass;
Vvmt, Cvmt, Pvmt: PPointerArray;
Cmnt: PMethodNameTable;
SearchAddr: Pointer;
n, idx: Integer;
WSPrivate, OrgPrivate: TClass;
Processed: array[0..VIRTUAL_VMT_COUNT-1] of Boolean;
{$IFDEF VerboseWSRegistration}
Indent: String;
{$ENDIF}
begin
if AWSPrivate = nil
then WSPrivate := TWSPrivate
else WSPrivate := AWSPrivate;
if ANode^.VClass = nil
then begin
ANode^.VClass := GetMem(VIRTUAL_VMT_SIZE)
end
else begin
// keep original WSPrivate (only when different than default class)
OrgPrivate := PClass(ANode^.VClass + vmtWSPrivate)^;
if (OrgPrivate <> nil) and (OrgPrivate <> AOldPrivate) and OrgPrivate.InheritsFrom(WSPrivate)
then begin
{$IFDEF VerboseWSRegistration}
DebugLn('Keep org private: ', WSPrivate.ClassName, ' -> ', OrgPrivate.Classname);
{$ENDIF}
WSPrivate := OrgPrivate;
end;
end;
// Initially copy the WSClass
// Tricky part, the source may get beyond read mem limit
Move(Pointer(ANode^.WSClass)^, ANode^.VClass^, VIRTUAL_VMT_SIZE);
// Set WSPrivate class
ParentWSNode := FindParentWSClassNode(ANode);
if ParentWSNode = nil
then begin
// nothing to do
PClass(ANode^.VClass + vmtWSPrivate)^ := WSPrivate;
{$IFDEF VerboseWSRegistration}
DebugLn('Virtual parent: nil, WSPrivate: ', PClass(ANode^.VClass + vmtWSPrivate)^.ClassName);
{$ENDIF}
Exit;
end;
if WSPrivate = TWSPrivate
then begin
if ParentWSNode^.VClass = nil
then begin
DebugLN('[WARNING] Missing VClass for: ', ParentWSNode^.WSClass.ClassName);
PClass(ANode^.VClass + vmtWSPrivate)^ := TWSPrivate;
end
else PClass(ANode^.VClass + vmtWSPrivate)^ := PClass(ParentWSNode^.VClass + vmtWSPrivate)^;
end
else PClass(ANode^.VClass + vmtWSPrivate)^ := WSPrivate;
{$IFDEF VerboseWSRegistration}
DebugLn('Virtual parent: ', ParentWSNode^.WSClass.ClassName, ', WSPrivate: ', PClass(ANode^.VClass + vmtWSPrivate)^.ClassName);
{$ENDIF}
// Try to find the common ancestor
CommonClass := FindCommonAncestor(ANode^.WSClass, ParentWSNode^.WSClass);
{$IFDEF VerboseWSRegistration}
DebugLn('Common: ', CommonClass.ClassName);
Indent := '';
{$ENDIF}
Vvmt := ANode^.VClass + vmtMethodStart;
Pvmt := ParentWSNode^.VClass + vmtMethodStart;
FillChar(Processed[0], SizeOf(Processed), 0);
while CommonClass <> nil do
begin
Cmnt := PPointer(Pointer(CommonClass) + vmtMethodTable)^;
if Cmnt <> nil
then begin
{$IFDEF VerboseWSRegistration_methods}
DebugLn(Indent, '*', CommonClass.Classname, ' method count: ', IntToStr(Cmnt^.Count));
Indent := Indent + ' ';
{$ENDIF}
Cvmt := Pointer(CommonClass) + vmtMethodStart;
Assert(Cmnt^.Count < VIRTUAL_VMT_COUNT, 'MethodTable count is larger than assumed VIRTUAL_VMT_COUNT');
// Loop through the VMT to see what is overridden
for n := 0 to Cmnt^.Count - 1 do
begin
SearchAddr := Cmnt^.Entries[n].Addr;
{$IFDEF VerboseWSRegistration_methods}
DebugLn('%sSearch: %s (%p)', [Indent, Cmnt^.Entries[n].Name^, SearchAddr]);
{$ENDIF}
for idx := 0 to VIRTUAL_VMT_COUNT - 1 do
begin
if Cvmt^[idx] = SearchAddr
then begin
{$IFDEF VerboseWSRegistration_methods}
DebugLn('%sFound at index: %d (v=%p p=%p)', [Indent, idx, Vvmt^[idx], Pvmt^[idx]]);
{$ENDIF}
if Processed[idx]
then begin
{$IFDEF VerboseWSRegistration_methods}
DebugLn(Indent, 'Processed -> skipping');
{$ENDIF}
Break;
end;
Processed[idx] := True;
if (Vvmt^[idx] = SearchAddr) //original
and (Pvmt^[idx] <> SearchAddr) //overridden by parent
then begin
{$IFDEF VerboseWSRegistration_methods}
DebugLn('%sUpdating %p -> %p', [Indent, Vvmt^[idx], Pvmt^[idx]]);
{$ENDIF}
Vvmt^[idx] := Pvmt^[idx];
end;
Break;
end;
if idx = VIRTUAL_VMT_COUNT - 1
then begin
DebugLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', CommonClass.ClassName, '"');
Break;
end;
end;
end;
end;
CommonClass := Commonclass.ClassParent;
end;
// Adjust classname
ANode^.VClassName := '(V)' + ANode^.WSClass.ClassName;
PPointer(ANode^.VClass + vmtClassName)^ := @ANode^.VClassName;
// Adjust classparent
{$IF (FPC_FULLVERSION >= 30101)}
PPointer(ANode^.VClass + vmtParent)^ := @ParentWSNode^.WSClass;
{$ELSE}
PPointer(ANode^.VClass + vmtParent)^ := ParentWSNode^.WSClass;
{$ENDIF}
// Delete methodtable entry
PPointer(ANode^.VClass + vmtMethodTable)^ := nil;
end;
procedure UpdateChildren(const ANode: PClassNode; AOldPrivate: TClass);
var
Node: PClassNode;
begin
Node := ANode^.Child;
while Node <> nil do
begin
if (Node^.WSClass <> nil) and (not Node^.VClassNew) then
begin
{$IFDEF VerboseWSRegistration}
DebugLn('Update VClass for: ', Node^.WSClass.ClassName);
{$ENDIF}
CreateVClass(Node, AOldPrivate);
end;
UpdateChildren(Node, AOldPrivate);
Node := Node^.Sibling;
end;
end;
var
Node: PClassNode;
OldPrivate: TClass;
begin
AWSComponent.SetImplementation(AWSComponent);
if MWSRegisterIndex = nil then
DoInitialization;
Node := GetNode(AComponent);
@ -195,14 +427,28 @@ begin
if Node^.WSClass = nil
then MWSRegisterIndex.AddObject(AComponent.ClassName, TObject(Node));
Node^.WSClass := AWSComponent;
Node^.VClass := AWSComponent;
if ANewRegistration then
begin
Node^.VClass := AWSComponent;
Node^.VClassNew := True;
Exit;
end;
// childclasses "inherit" the private from their parent
// the child privates should only be updated when their private is still
// the same as their parents
if Node^.VClass = nil
then OldPrivate := nil
else OldPrivate := PClass(Pointer(Node^.VClass) + vmtWSPrivate)^;
else OldPrivate := PClass(Node^.VClass + vmtWSPrivate)^;
{$IFDEF VerboseWSRegistration}
DebugLn('Create VClass for: ', AComponent.ClassName, ' -> ', Node^.WSClass.ClassName);
{$ENDIF}
CreateVClass(Node);
// Since child classes may depend on us, recreate them
UpdateChildren(Node, OldPrivate);
end;
function GetWSLazAccessibleObject: TWSObjectClass;
@ -225,18 +471,6 @@ begin
WSLazDeviceAPIsClass := AWSObject;
end;
{ TWSObject }
class function TWSObject.GetImplementation: TWSObjectClass;
begin
Result := nil;
end;
class procedure TWSObject.SetImplementation(AImpl: TWSObjectClass);
begin
end;
{ TWSLCLComponent }
class function TWSLCLComponent.WSPrivate: TWSPrivateClass; //inline;
@ -328,6 +562,8 @@ begin
for n := 0 to MComponentIndex.Count - 1 do
begin
Node := PClassNode(MComponentIndex.Objects[n]);
if (Node^.VClass <> nil) and (not Node^.VClassNew) then
Freemem(Node^.VClass);
Dispose(Node);
end;
FreeAndNil(MComponentIndex);

52
lcl/widgetset/wsmenus.pp
View File

@ -47,13 +47,8 @@ uses
type
{ TWSMenuItem }
TWSMenuItemClass = class of TWSMenuItem;
TWSMenuItem = class(TWSLCLComponent)
private class var
FWSMenuItem_Impl: TWSMenuItemClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class function OpenCommand: LongInt; virtual;
class procedure CloseCommand(ACommand: LongInt); virtual;
class procedure AttachMenu(const AMenuItem: TMenuItem); virtual;
@ -68,16 +63,13 @@ type
class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; virtual;
class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: TBitmap); virtual;
end;
TWSMenuItemClass = class of TWSMenuItem;
{ TWSMenu }
TWSMenuClass = class of TWSMenu;
TWSMenu = class(TWSLCLComponent)
private class var
FWSMenu_Impl: TWSMenuClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class function CreateHandle(const AMenu: TMenu): HMENU; virtual;
class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); virtual;
@ -91,15 +83,11 @@ type
{ TWSPopupMenu }
TWSPopupMenuClass = class of TWSPopupMenu;
TWSPopupMenu = class(TWSMenu)
private class var
FWSPopupMenu_Impl: TWSPopupMenuClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); virtual;
end;
TWSPopupMenuClass = class of TWSPopupMenu;
function WSCheckMenuItem(const AMenuItem: TMenuItem;
const AProcName: String): Boolean;
@ -128,16 +116,6 @@ end;
{ TWSMenuItem }
class function TWSMenuItem.GetImplementation: TWSObjectClass;
begin
Result:= FWSMenuItem_Impl;
end;
class procedure TWSMenuItem.SetImplementation(AImpl: TWSObjectClass);
begin
FWSMenuItem_Impl := TWSMenuItemClass(AImpl);
end;
class function TWSMenuItem.OpenCommand: LongInt;
begin
Result := UniqueCommand;
@ -203,16 +181,6 @@ end;
{ TWSMenu }
class function TWSMenu.GetImplementation: TWSObjectClass;
begin
Result:= FWSMenu_Impl;
end;
class procedure TWSMenu.SetImplementation(AImpl: TWSObjectClass);
begin
FWSMenu_Impl := TWSMenuClass(AImpl);
end;
class function TWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
begin
Result := 0;
@ -226,16 +194,6 @@ end;
{ TWSPopupMenu }
class function TWSPopupMenu.GetImplementation: TWSObjectClass;
begin
Result:= FWSPopupMenu_Impl;
end;
class procedure TWSPopupMenu.SetImplementation(AImpl: TWSObjectClass);
begin
FWSPopupMenu_Impl := TWSPopupMenuClass(AImpl);
end;
class procedure TWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
begin
end;

41
lcl/widgetset/wspairsplitter.pp
View File

@ -43,24 +43,14 @@ uses
type
{ TWSPairSplitterSide }
TWSPairSplitterSideClass = class of TWSPairSplitterSide;
TWSPairSplitterSide = class(TWSWinControl_CallWS)
private class var
FWSPairSplitterSide_Impl: TWSPairSplitterSideClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSPairSplitterSide = class(TWSWinControl)
published
end;
{ TWSCustomPairSplitter }
TWSCustomPairSplitterClass = class of TWSCustomPairSplitter;
TWSCustomPairSplitter = class(TWSWinControl_CallWS)
private class var
FWSCustomPairSplitter_Impl: TWSCustomPairSplitterClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomPairSplitter = class(TWSWinControl)
published
class function AddSide(ASplitter: TCustomPairSplitter; ASide: TPairSplitterSide; Side: integer): Boolean; virtual;
class function RemoveSide(ASplitter: TCustomPairSplitter; ASide: TPairSplitterSide; Side: integer): Boolean; virtual;
class function SetPosition(ASplitter: TCustomPairSplitter; var NewPosition: integer): Boolean; virtual;
@ -69,6 +59,7 @@ type
class function GetSplitterCursor(ASplitter: TCustomPairSplitter; var ACursor: TCursor): Boolean; virtual;
class function SetSplitterCursor(ASplitter: TCustomPairSplitter; ACursor: TCursor): Boolean; virtual;
end;
TWSCustomPairSplitterClass = class of TWSCustomPairSplitter;
{ WidgetSetRegistration }
@ -92,30 +83,8 @@ begin
end;
end;
{ TWSPairSplitterSide }
class function TWSPairSplitterSide.GetImplementation: TWSObjectClass;
begin
Result:= FWSPairSplitterSide_Impl;
end;
class procedure TWSPairSplitterSide.SetImplementation(AImpl: TWSObjectClass);
begin
FWSPairSplitterSide_Impl := TWSPairSplitterSideClass(AImpl);
end;
{ TWSCustomPairSplitter }
class function TWSCustomPairSplitter.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomPairSplitter_Impl;
end;
class procedure TWSCustomPairSplitter.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomPairSplitter_Impl := TWSCustomPairSplitterClass(FWSCustomPairSplitter_Impl);
end;
class function TWSCustomPairSplitter.AddSide(ASplitter: TCustomPairSplitter;
ASide: TPairSplitterSide; Side: integer): Boolean;
var

20
lcl/widgetset/wsspin.pp
View File

@ -46,13 +46,8 @@ uses
type
{ TWSCustomFloatSpinEdit }
TWSCustomFloatSpinEditClass = class of TWSCustomFloatSpinEdit;
TWSCustomFloatSpinEdit = class(TWSCustomEdit_CallWS)
private class var
FWSCustomFloatSpinEdit_Impl: TWSCustomFloatSpinEditClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomFloatSpinEdit = class(TWSCustomEdit)
published
class function GetValue(const ACustomFloatSpinEdit: TCustomFloatSpinEdit): double; virtual;
(* TODO: seperation into properties instead of bulk update
@ -64,6 +59,7 @@ type
class procedure UpdateControl(const ACustomFloatSpinEdit: TCustomFloatSpinEdit); virtual;
end;
TWSCustomFloatSpinEditClass = class of TWSCustomFloatSpinEdit;
{ WidgetSetRegistration }
@ -73,16 +69,6 @@ implementation
{ TWSCustomFloatSpinEdit }
class function TWSCustomFloatSpinEdit.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomFloatSpinEdit_Impl;
end;
class procedure TWSCustomFloatSpinEdit.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomFloatSpinEdit_Impl := TWSCustomFloatSpinEditClass(AImpl);
end;
class function TWSCustomFloatSpinEdit.GetValue(const ACustomFloatSpinEdit: TCustomFloatSpinEdit): double;
begin
Result := 0.0;

557
lcl/widgetset/wsstdctrls.pp
View File

@ -47,16 +47,12 @@ uses
type
{ TWSScrollBar }
TWSScrollBarClass = class of TWSScrollBar;
TWSScrollBar = class(TWSWinControl_CallWS)
private class var
FWSScrollBar_Impl: TWSScrollBarClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSScrollBar = class(TWSWinControl)
published
class procedure SetParams(const AScrollBar: TCustomScrollBar); virtual;
class procedure SetKind(const AScrollBar: TCustomScrollBar; const AIsHorizontal: Boolean); virtual;
end;
TWSScrollBarClass = class of TWSScrollBar;
{ TWSCustomGroupBox }
@ -66,25 +62,15 @@ type
{ TWSGroupBox }
TWSGroupBoxClass = class of TWSGroupBox;
TWSGroupBox = class(TWSCustomGroupBox)
private class var
FWSGroupBox_Impl: TWSGroupBoxClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
published
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end;
{ TWSCustomComboBox }
TWSCustomComboBoxClass = class of TWSCustomComboBox;
TWSCustomComboBox = class(TWSWinControl_CallWS)
private class var
FWSCustomComboBox_Impl: TWSCustomComboBoxClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomComboBox = class(TWSWinControl)
published
class function GetDroppedDown(const ACustomComboBox: TCustomComboBox): Boolean; virtual;
class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; virtual;
class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; virtual;
@ -109,6 +95,7 @@ type
class function GetItemHeight(const ACustomComboBox: TCustomComboBox): Integer; virtual;
class procedure SetItemHeight(const ACustomComboBox: TCustomComboBox; const AItemHeight: Integer); virtual;
end;
TWSCustomComboBoxClass = class of TWSCustomComboBox;
{ TWSComboBox }
@ -118,13 +105,8 @@ type
{ TWSCustomListBox }
TWSCustomListBoxClass = class of TWSCustomListBox;
TWSCustomListBox = class(TWSWinControl_CallWS)
private class var
FWSCustomListBox_Impl: TWSCustomListBoxClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomListBox = class(TWSWinControl)
published
class procedure DragStart(const ACustomListBox: TCustomListBox); virtual;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; virtual;
@ -149,50 +131,18 @@ type
class procedure SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); virtual;
class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); virtual;
end;
{ TWSCustomListBox_CallWS }
TWSCustomListBox_CallWS = class(TWSCustomListBox)
public
class procedure DragStart(const ACustomListBox: TCustomListBox); override;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; X, Y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
class function GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): boolean; override;
class function GetScrollWidth(const ACustomListBox: TCustomListBox): Integer; override;
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override;
class function GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class procedure FreeStrings(var AStrings: TStrings); override;
class function GetTopIndex(const ACustomListBox: TCustomListBox): integer; override;
class procedure SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean); override;
class procedure SetBorder(const ACustomListBox: TCustomListBox); override;
class procedure SetColumnCount(const ACustomListBox: TCustomListBox; ACount: Integer); override;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
class procedure SetScrollWidth(const ACustomListBox: TCustomListBox; const AScrollWidth: Integer); override;
class procedure SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect, AMultiSelect: boolean); override;
class procedure SetStyle(const ACustomListBox: TCustomListBox); override;
class procedure SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); override;
class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); override;
end;
TWSCustomListBoxClass = class of TWSCustomListBox;
{ TWSListBox }
TWSListBox = class(TWSCustomListBox_CallWS)
TWSListBox = class(TWSCustomListBox)
published
end;
{ TWSCustomEdit }
TWSCustomEditClass = class of TWSCustomEdit;
TWSCustomEdit = class(TWSWinControl_CallWS)
private class var
FWSCustomEdit_Impl: TWSCustomEditClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomEdit = class(TWSWinControl)
published
class function GetCanUndo(const ACustomEdit: TCustomEdit): Boolean; virtual;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; virtual;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; virtual;
@ -218,50 +168,12 @@ type
class procedure Paste(const ACustomEdit: TCustomEdit); virtual;
class procedure Undo(const ACustomEdit: TCustomEdit); virtual;
end;
{ TWSCustomEdit_CallWS }
TWSCustomEdit_CallWS = class(TWSCustomEdit)
public
class function GetCanUndo(const ACustomEdit: TCustomEdit): Boolean; override;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
class procedure SetAlignment(const ACustomEdit: TCustomEdit; const AAlignment: TAlignment); override;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetHideSelection(const ACustomEdit: TCustomEdit; NewHideSelection: Boolean); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetNumbersOnly(const ACustomEdit: TCustomEdit; NewNumbersOnly: Boolean); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetSelText(const ACustomEdit: TCustomEdit; const NewSelText: string); override;
class procedure SetTextHint(const ACustomEdit: TCustomEdit; const ATextHint: string); override;
class function CreateEmulatedTextHintFont(const ACustomEdit: TCustomEdit): TFont; override;
class procedure Cut(const ACustomEdit: TCustomEdit); override;
class procedure Copy(const ACustomEdit: TCustomEdit); override;
class procedure Paste(const ACustomEdit: TCustomEdit); override;
class procedure Undo(const ACustomEdit: TCustomEdit); override;
//
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
end;
TWSCustomEditClass = class of TWSCustomEdit;
{ TWSCustomMemo }
TWSCustomMemoClass = class of TWSCustomMemo;
TWSCustomMemo = class(TWSCustomEdit_CallWS)
private class var
FWSCustomMemo_Impl: TWSCustomMemoClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomMemo = class(TWSCustomEdit)
published
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); virtual;
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; virtual;
class procedure FreeStrings(var AStrings: TStrings); virtual;
@ -271,10 +183,11 @@ type
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); virtual;
class procedure SetSelText(const ACustomEdit: TCustomEdit; const NewSelText: string); override;
end;
TWSCustomMemoClass = class of TWSCustomMemo;
{ TWSEdit }
TWSEdit = class(TWSCustomEdit_CallWS)
TWSEdit = class(TWSCustomEdit)
published
end;
@ -287,12 +200,8 @@ type
{ TWSCustomStaticText }
TWSCustomStaticTextClass = class of TWSCustomStaticText;
TWSCustomStaticText = class(TWSWinControl_CallWS)
private class var
FWSCustomStaticText: TWSCustomStaticTextClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomStaticText = class(TWSWinControl)
published
class procedure SetAlignment(const ACustomStaticText: TCustomStaticText; const NewAlignment: TAlignment); virtual;
class procedure SetStaticBorderStyle(const ACustomStaticText: TCustomStaticText; const NewBorderStyle: TStaticBorderStyle); virtual;
class function GetDefaultColor(const AControl: TControl;
@ -307,60 +216,30 @@ type
{ TWSButtonControl }
TWSButtonControlClass = class of TWSButtonControl;
TWSButtonControl = class(TWSWinControl_CallWS)
private class var
FWSButtonControl_Impl: TWSButtonControlClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSButtonControl = class(TWSWinControl)
published
class function GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
end;
{ TWSButtonControl_CallWS }
TWSButtonControl_CallWS = class(TWSButtonControl)
public
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
end;
{ TWSButton }
TWSButtonClass = class of TWSButton;
TWSButton = class(TWSButtonControl_CallWS)
private class var
FWSButton_Impl: TWSButtonClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSButton = class(TWSButtonControl)
published
class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); virtual;
class procedure SetShortCut(const AButton: TCustomButton; const ShortCutK1, ShortCutK2: TShortCut); virtual;
end;
{ TWSButton_CallWS }
TWSButton_CallWS = class(TWSButton)
public
class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
class procedure SetShortCut(const AButton: TCustomButton; const ShortCutK1, ShortCutK2: TShortCut); override;
end;
TWSButtonClass = class of TWSButton;
{ TWSCustomCheckBox }
TWSCustomCheckBoxClass = class of TWSCustomCheckBox;
TWSCustomCheckBox = class(TWSButtonControl_CallWS)
private class var
FWSCustomCheckBox_Impl: TWSCustomCheckBoxClass;
public
class function GetImplementation: TWSObjectClass; override;
class procedure SetImplementation(AImpl: TWSObjectClass); override;
TWSCustomCheckBox = class(TWSButtonControl)
published
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; virtual;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox; const ShortCutK1, ShortCutK2: TShortCut); virtual;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); virtual;
class procedure SetAlignment(const ACustomCheckBox: TCustomCheckBox; const NewAlignment: TLeftRight); virtual;
end;
TWSCustomCheckBoxClass = class of TWSCustomCheckBox;
{ TWSCheckBox }
@ -403,16 +282,6 @@ uses
{ TWSGroupBox }
class function TWSGroupBox.GetImplementation: TWSObjectClass;
begin
Result:= FWSGroupBox_Impl;
end;
class procedure TWSGroupBox.SetImplementation(AImpl: TWSObjectClass);
begin
FWSGroupBox_Impl := TWSGroupBoxClass(AImpl);
end;
class function TWSGroupBox.GetDefaultColor(const AControl: TControl;
const ADefaultColorType: TDefaultColorType): TColor;
begin
@ -421,16 +290,6 @@ end;
{ TWSScrollBar }
class function TWSScrollBar.GetImplementation: TWSObjectClass;
begin
Result := FWSScrollBar_Impl;
end;
class procedure TWSScrollBar.SetImplementation(AImpl: TWSObjectClass);
begin
FWSScrollBar_Impl := TWSScrollBarClass(AImpl);
end;
class procedure TWSScrollBar.SetParams(const AScrollBar: TCustomScrollBar);
begin
end;
@ -443,16 +302,6 @@ end;
{ TWSCustomListBox }
class function TWSCustomListBox.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomListBox_Impl;
end;
class procedure TWSCustomListBox.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomListBox_Impl := TWSCustomListBoxClass(AImpl);
end;
class procedure TWSCustomListBox.DragStart(const ACustomListBox: TCustomListBox);
begin
end;
@ -550,135 +399,8 @@ class procedure TWSCustomListBox.SetTopIndex(const ACustomListBox: TCustomListBo
begin
end;
{ TWSCustomListBox_CallWS }
class procedure TWSCustomListBox_CallWS.DragStart(
const ACustomListBox: TCustomListBox);
begin
FWSCustomListBox_Impl.DragStart(ACustomListBox);
end;
class function TWSCustomListBox_CallWS.GetIndexAtXY(
const ACustomListBox: TCustomListBox; X, Y: integer): integer;
begin
Result:= FWSCustomListBox_Impl.GetIndexAtXY(ACustomListBox, X, Y);
end;
class function TWSCustomListBox_CallWS.GetItemIndex(
const ACustomListBox: TCustomListBox): integer;
begin
Result:= FWSCustomListBox_Impl.GetItemIndex(ACustomListBox);
end;
class function TWSCustomListBox_CallWS.GetItemRect(
const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect
): boolean;
begin
Result:= FWSCustomListBox_Impl.GetItemRect(ACustomListBox, Index, ARect);
end;
class function TWSCustomListBox_CallWS.GetScrollWidth(
const ACustomListBox: TCustomListBox): Integer;
begin
Result:= FWSCustomListBox_Impl.GetScrollWidth(ACustomListBox);
end;
class function TWSCustomListBox_CallWS.GetSelCount(
const ACustomListBox: TCustomListBox): integer;
begin
Result:= FWSCustomListBox_Impl.GetSelCount(ACustomListBox);
end;
class function TWSCustomListBox_CallWS.GetSelected(
const ACustomListBox: TCustomListBox; const AIndex: integer): boolean;
begin
Result:= FWSCustomListBox_Impl.GetSelected(ACustomListBox, AIndex);
end;
class function TWSCustomListBox_CallWS.GetStrings(
const ACustomListBox: TCustomListBox): TStrings;
begin
Result:= FWSCustomListBox_Impl.GetStrings(ACustomListBox);
end;
class procedure TWSCustomListBox_CallWS.FreeStrings(var AStrings: TStrings);
begin
FWSCustomListBox_Impl.FreeStrings(AStrings);
end;
class function TWSCustomListBox_CallWS.GetTopIndex(
const ACustomListBox: TCustomListBox): integer;
begin
Result:= FWSCustomListBox_Impl.GetTopIndex(ACustomListBox);
end;
class procedure TWSCustomListBox_CallWS.SelectItem(
const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean);
begin
FWSCustomListBox_Impl.SelectItem(ACustomListBox, AIndex, ASelected);
end;
class procedure TWSCustomListBox_CallWS.SetBorder(
const ACustomListBox: TCustomListBox);
begin
FWSCustomListBox_Impl.SetBorder(ACustomListBox);
end;
class procedure TWSCustomListBox_CallWS.SetColumnCount(
const ACustomListBox: TCustomListBox; ACount: Integer);
begin
FWSCustomListBox_Impl.SetColumnCount(ACustomListBox, ACount);
end;
class procedure TWSCustomListBox_CallWS.SetItemIndex(
const ACustomListBox: TCustomListBox; const AIndex: integer);
begin
FWSCustomListBox_Impl.SetItemIndex(ACustomListBox, AIndex);
end;
class procedure TWSCustomListBox_CallWS.SetScrollWidth(
const ACustomListBox: TCustomListBox; const AScrollWidth: Integer);
begin
FWSCustomListBox_Impl.SetScrollWidth(ACustomListBox, AScrollWidth);
end;
class procedure TWSCustomListBox_CallWS.SetSelectionMode(
const ACustomListBox: TCustomListBox; const AExtendedSelect,
AMultiSelect: boolean);
begin
FWSCustomListBox_Impl.SetSelectionMode(ACustomListBox, AExtendedSelect, AMultiSelect);
end;
class procedure TWSCustomListBox_CallWS.SetStyle(
const ACustomListBox: TCustomListBox);
begin
FWSCustomListBox_Impl.SetStyle(ACustomListBox);
end;
class procedure TWSCustomListBox_CallWS.SetSorted(
const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean);
begin
FWSCustomListBox_Impl.SetSorted(ACustomListBox, AList, ASorted);
end;
class procedure TWSCustomListBox_CallWS.SetTopIndex(
const ACustomListBox: TCustomListBox; const NewTopIndex: integer);
begin
FWSCustomListBox_Impl.SetTopIndex(ACustomListBox, NewTopIndex);
end;
{ TWSCustomComboBox }
class function TWSCustomComboBox.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomComboBox_Impl;
end;
class procedure TWSCustomComboBox.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomComboBox_Impl := TWSCustomComboBoxClass(AImpl);
end;
class function TWSCustomComboBox.GetDroppedDown(
const ACustomComboBox: TCustomComboBox): Boolean;
begin
@ -782,17 +504,8 @@ end;
{ TWSCustomEdit }
class function TWSCustomEdit.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomEdit_Impl;
end;
class procedure TWSCustomEdit.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomEdit_Impl := TWSCustomEditClass(AImpl);
end;
class function TWSCustomEdit.GetCanUndo(const ACustomEdit: TCustomEdit): Boolean;
class function TWSCustomEdit.GetCanUndo(const ACustomEdit: TCustomEdit
): Boolean;
begin
Result := False;
end;
@ -916,152 +629,8 @@ begin
// nothing
end;
{ TWSCustomEdit_CallWS }
class function TWSCustomEdit_CallWS.GetCanUndo(const ACustomEdit: TCustomEdit): Boolean;
begin
Result := FWSCustomEdit_Impl.GetCanUndo(ACustomEdit);
end;
class function TWSCustomEdit_CallWS.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint;
begin
Result:= FWSCustomEdit_Impl.GetCaretPos(ACustomEdit);
end;
class function TWSCustomEdit_CallWS.GetSelStart(const ACustomEdit: TCustomEdit): integer;
begin
Result:= FWSCustomEdit_Impl.GetSelStart(ACustomEdit);
end;
class function TWSCustomEdit_CallWS.GetSelLength(const ACustomEdit: TCustomEdit): integer;
begin
Result:= FWSCustomEdit_Impl.GetSelLength(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.SetAlignment(
const ACustomEdit: TCustomEdit; const AAlignment: TAlignment);
begin
FWSCustomEdit_Impl.SetAlignment(ACustomEdit, AAlignment);
end;
class procedure TWSCustomEdit_CallWS.SetCaretPos(
const ACustomEdit: TCustomEdit; const NewPos: TPoint);
begin
FWSCustomEdit_Impl.SetCaretPos(ACustomEdit, NewPos);
end;
class procedure TWSCustomEdit_CallWS.SetCharCase(
const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
begin
FWSCustomEdit_Impl.SetCharCase(ACustomEdit, NewCase);
end;
class procedure TWSCustomEdit_CallWS.SetEchoMode(
const ACustomEdit: TCustomEdit; NewMode: TEchoMode);
begin
FWSCustomEdit_Impl.SetEchoMode(ACustomEdit, NewMode);
end;
class procedure TWSCustomEdit_CallWS.SetHideSelection(
const ACustomEdit: TCustomEdit; NewHideSelection: Boolean);
begin
FWSCustomEdit_Impl.SetHideSelection(ACustomEdit, NewHideSelection);
end;
class procedure TWSCustomEdit_CallWS.SetMaxLength(
const ACustomEdit: TCustomEdit; NewLength: integer);
begin
FWSCustomEdit_Impl.SetMaxLength(ACustomEdit, NewLength);
end;
class procedure TWSCustomEdit_CallWS.SetNumbersOnly(
const ACustomEdit: TCustomEdit; NewNumbersOnly: Boolean);
begin
FWSCustomEdit_Impl.SetNumbersOnly(ACustomEdit, NewNumbersOnly);
end;
class procedure TWSCustomEdit_CallWS.SetPasswordChar(
const ACustomEdit: TCustomEdit; NewChar: char);
begin
FWSCustomEdit_Impl.SetPasswordChar(ACustomEdit, NewChar);
end;
class procedure TWSCustomEdit_CallWS.SetReadOnly(
const ACustomEdit: TCustomEdit; NewReadOnly: boolean);
begin
FWSCustomEdit_Impl.SetReadOnly(ACustomEdit, NewReadOnly);
end;
class procedure TWSCustomEdit_CallWS.SetSelStart(
const ACustomEdit: TCustomEdit; NewStart: integer);
begin
FWSCustomEdit_Impl.SetSelStart(ACustomEdit, NewStart);
end;
class procedure TWSCustomEdit_CallWS.SetSelLength(
const ACustomEdit: TCustomEdit; NewLength: integer);
begin
FWSCustomEdit_Impl.SetSelLength(ACustomEdit, NewLength);
end;
class procedure TWSCustomEdit_CallWS.SetSelText(const ACustomEdit: TCustomEdit;
const NewSelText: string);
begin
FWSCustomEdit_Impl.SetSelText(ACustomEdit, NewSelText);
end;
class procedure TWSCustomEdit_CallWS.SetTextHint(
const ACustomEdit: TCustomEdit; const ATextHint: string);
begin
FWSCustomEdit_Impl.SetTextHint(ACustomEdit, ATextHint);
end;
class function TWSCustomEdit_CallWS.CreateEmulatedTextHintFont(
const ACustomEdit: TCustomEdit): TFont;
begin
Result:= FWSCustomEdit_Impl.CreateEmulatedTextHintFont(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.Cut(const ACustomEdit: TCustomEdit);
begin
FWSCustomEdit_Impl.Cut(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.Copy(const ACustomEdit: TCustomEdit);
begin
FWSCustomEdit_Impl.Copy(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.Paste(const ACustomEdit: TCustomEdit);
begin
FWSCustomEdit_Impl.Paste(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.Undo(const ACustomEdit: TCustomEdit);
begin
FWSCustomEdit_Impl.Undo(ACustomEdit);
end;
class procedure TWSCustomEdit_CallWS.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
FWSCustomEdit_Impl.GetPreferredSize(AWinControl, PreferredWidth, PreferredHeight,
WithThemeSpace);
end;
{ TWSCustomMemo }
class function TWSCustomMemo.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomMemo_Impl;
end;
class procedure TWSCustomMemo.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomMemo_Impl := TWSCustomMemoClass(AImpl);
end;
class procedure TWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
begin
end;
@ -1106,16 +675,6 @@ end;
{ TWSCustomStaticText }
class function TWSCustomStaticText.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomStaticText;
end;
class procedure TWSCustomStaticText.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomStaticText := TWSCustomStaticTextClass(AImpl);
end;
class procedure TWSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText; const NewAlignment: TAlignment);
begin
end;
@ -1135,16 +694,6 @@ end;
{ TWSButton }
class function TWSButton.GetImplementation: TWSObjectClass;
begin
Result:= FWSButton_Impl;
end;
class procedure TWSButton.SetImplementation(AImpl: TWSObjectClass);
begin
FWSButton_Impl := TWSButtonClass(AImpl);
end;
class procedure TWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
begin
end;
@ -1154,32 +703,8 @@ class procedure TWSButton.SetShortCut(const AButton: TCustomButton;
begin;
end;
{ TWSButton_CallWS }
class procedure TWSButton_CallWS.SetDefault(const AButton: TCustomButton;
ADefault: Boolean);
begin
FWSButton_Impl.SetDefault(AButton, ADefault);
end;
class procedure TWSButton_CallWS.SetShortCut(const AButton: TCustomButton;
const ShortCutK1, ShortCutK2: TShortCut);
begin
FWSButton_Impl.SetShortCut(AButton, ShortCutK1, ShortCutK2);
end;
{ TWSCustomCheckBox }
class function TWSCustomCheckBox.GetImplementation: TWSObjectClass;
begin
Result:= FWSCustomCheckBox_Impl;
end;
class procedure TWSCustomCheckBox.SetImplementation(AImpl: TWSObjectClass);
begin
FWSCustomCheckBox_Impl := TWSCustomCheckBoxClass(AImpl);
end;
class function TWSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
begin
Result := cbUnchecked;
@ -1358,29 +883,9 @@ end;
{ TWSButtonControl }
class function TWSButtonControl.GetImplementation: TWSObjectClass;
begin
Result:= FWSButtonControl_Impl;
end;
class procedure TWSButtonControl.SetImplementation(AImpl: TWSObjectClass);
begin
FWSButtonControl_Impl := TWSButtonControlClass(AImpl);
end;
class function TWSButtonControl.GetDefaultColor(const AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor;
begin
Result := DefBtnColors[ADefaultColorType];
end;
{ TWSButtonControl_CallWS }
class procedure TWSButtonControl_CallWS.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
FWSButtonControl_Impl.GetPreferredSize(AWinControl, PreferredWidth, PreferredHeight,
WithThemeSpace);
end;
end.