diff --git a/lcl/interfaces/gtk/gtkwsbuttons.pp b/lcl/interfaces/gtk/gtkwsbuttons.pp index d92592dd49..a98823aeac 100644 --- a/lcl/interfaces/gtk/gtkwsbuttons.pp +++ b/lcl/interfaces/gtk/gtkwsbuttons.pp @@ -60,6 +60,7 @@ type private protected public + class function CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle; override; class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; class procedure SetText(const AWinControl: TWinControl; const AText: String); override; end; @@ -161,6 +162,13 @@ end; { TGtkWSBitBtn } +function TGtkWSBitBtn.CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle; +begin + // TODO + // for now, use default + Result := TWSBitBtn.CreateHandle(AComponent, AParams); +end; + function TGtkWSBitBtn.GetText(const AWinControl: TWinControl; var AText: String): Boolean; begin // The button text is static, so let the LCL fallback to FCaption diff --git a/lcl/widgetset/README b/lcl/widgetset/README index 6167245d32..27b6bcf5c8 100644 --- a/lcl/widgetset/README +++ b/lcl/widgetset/README @@ -8,51 +8,56 @@ IMPORTANT Derivation and inheritance of classes is different then one might be used to. It wil be explained by the following -example. +examples. Suppose the following LCL class hierarchy: TLCLComponent | - v TControl | - v TWinControl the corresponding WS skeleton would be TWSLCLComponent | - v TWSControl | - v TWSWinControl When method X of TWSControl gets implemented by widgetset Q the hierarchy looks like - TWSLCLComponent | - v - TWSControl --> TQWSControl.X + TWSControl.X --> TQWSControl.X | - v TWSWinControl -When the same method X is required in TWSWinControl -inheritance doesnt work since TWSWinControl.X calls -TWSControl.X -The following can be done to get around this: -*) try to move the LCL functionality to the lowest - class -*) Implement TQWSWinControl.X by simply calling - TQWSControl.X -*) Implement the functionality of TQWSControl.X - in the TQWidgetSet and call it from both - TQWSControl.X and TQWSWinControl.X +Calling TWSWinControl.X doesn't call TQWSControl.X since +it's parent is TWSControl. This problem is solved by +modifying the class hierarchy at runtime. +When a ComponentClass is registered by RegisterWSComponent, +the class is copied and the vmt entries are adjusted so +that the hierarchy looks like: + + + TWSLCLComponent + | + TWSControl.X --> TQWSControl.X + | + TWSWinControl + +In this case, calling TWSWinControl.X will call the overriden +TQWSControl.X. The only thing which doesn't get handled is the +inherited statement. Suppose there is also a TQWSWinControl.X +which implements a few extra steps. In a normal situation one +would have called "inherited". The call to inherited is +resolved at compiletime and would in this example to a call to +TWSControl.X. That is not what we want. +To get around this, call the parent yourself: + TWSWinControlClass(ClassParent).X diff --git a/lcl/widgetset/wsactnlist.pp b/lcl/widgetset/wsactnlist.pp index 8a93a1760f..f08693bfe9 100644 --- a/lcl/widgetset/wsactnlist.pp +++ b/lcl/widgetset/wsactnlist.pp @@ -25,11 +25,22 @@ unit WSActnList; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses; type - { TWSCustomActionList } TWSCustomActionList = class(TWSLCLComponent) - private - protected - public end; { TWSActionList } TWSActionList = class(TWSCustomActionList) - private - protected - public end; @@ -60,8 +64,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsarrow.pp b/lcl/widgetset/wsarrow.pp index 36b0fda7f3..b1dab6e681 100644 --- a/lcl/widgetset/wsarrow.pp +++ b/lcl/widgetset/wsarrow.pp @@ -25,11 +25,22 @@ unit WSArrow; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSControls; type - { TWSArrow } TWSArrow = class(TWSCustomControl) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsbuttons.pp b/lcl/widgetset/wsbuttons.pp index 5676afc546..4da5efaf7e 100644 --- a/lcl/widgetset/wsbuttons.pp +++ b/lcl/widgetset/wsbuttons.pp @@ -25,11 +25,22 @@ unit WSButtons; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,29 +49,19 @@ uses WSLCLClasses, WSStdCtrls, WSControls; type - { TWSButton } TWSButton = class(TWSButtonControl) - private - protected - public end; { TWSBitBtn } TWSBitBtn = class(TWSButton) - private - protected - public end; { TWSSpeedButton } TWSSpeedButton = class(TWSGraphicControl) - private - protected - public end; @@ -68,8 +69,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wscalendar.pp b/lcl/widgetset/wscalendar.pp index 79c077b749..7bad6990ab 100644 --- a/lcl/widgetset/wscalendar.pp +++ b/lcl/widgetset/wscalendar.pp @@ -25,11 +25,22 @@ unit WSCalendar; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSControls; type - { TWSCalendar } TWSCalendar = class(TWSWinControl) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wschecklst.pp b/lcl/widgetset/wschecklst.pp index 4b0c1574e4..f4ec1442f0 100644 --- a/lcl/widgetset/wschecklst.pp +++ b/lcl/widgetset/wschecklst.pp @@ -25,11 +25,22 @@ unit WSCheckLst; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSStdCtrls; type - { TWSCheckListBox } TWSCheckListBox = class(TWSCustomListBox) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsclistbox.pp b/lcl/widgetset/wsclistbox.pp index f1c8d9aa4d..a5cd27d7a9 100644 --- a/lcl/widgetset/wsclistbox.pp +++ b/lcl/widgetset/wsclistbox.pp @@ -25,11 +25,22 @@ unit WSCListBox; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSStdCtrls; type - { TWSCListBox } TWSCListBox = class(TWSCustomListBox) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wscomctrls.pp b/lcl/widgetset/wscomctrls.pp index 116e38fef7..6b4624e49f 100644 --- a/lcl/widgetset/wscomctrls.pp +++ b/lcl/widgetset/wscomctrls.pp @@ -25,11 +25,22 @@ unit WSComCtrls; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -39,109 +50,69 @@ uses WSToolwin; type - { TWSStatusBar } TWSStatusBar = class(TWSWinControl) - private - protected - public end; { TWSTabSheet } TWSTabSheet = class(TWSCustomPage) - private - protected - public end; { TWSPageControl } TWSPageControl = class(TWSCustomNotebook) - private - protected - public end; { TWSCustomListView } TWSCustomListView = class(TWSWinControl) - private - protected - public end; { TWSListView } TWSListView = class(TWSCustomListView) - private - protected - public end; { TWSProgressBar } TWSProgressBar = class(TWSWinControl) - private - protected - public end; { TWSCustomUpDown } TWSCustomUpDown = class(TWSCustomControl) - private - protected - public end; { TWSUpDown } TWSUpDown = class(TWSCustomUpDown) - private - protected - public end; { TWSToolButton } TWSToolButton = class(TWSCustomControl) - private - protected - public end; { TWSToolBar } TWSToolBar = class(TWSToolWindow) - private - protected - public end; { TWSTrackBar } TWSTrackBar = class(TWSWinControl) - private - protected - public end; { TWSCustomTreeView } TWSCustomTreeView = class(TWSCustomControl) - private - protected - public end; { TWSTreeView } TWSTreeView = class(TWSCustomTreeView) - private - protected - public end; @@ -149,8 +120,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 5fbff933cb..c53f86ff29 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -25,11 +25,22 @@ unit WSControls; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses, WSImgList; type - { TWSDragImageList } TWSDragImageList = class(TWSCustomImageList) - private - protected - public end; { TWSControl } TWSControl = class(TWSLCLComponent) - private - protected - public class procedure SetCursor(const AControl: TControl; const ACursor: TCursor); virtual; end; @@ -61,9 +65,6 @@ type { TWSWinControl } TWSWinControl = class(TWSControl) - private - protected - public class function HasText(const AWinControl: TWinControl): Boolean; virtual; class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual; class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual; @@ -75,25 +76,16 @@ type { TWSGraphicControl } TWSGraphicControl = class(TWSControl) - private - protected - public end; { TWSCustomControl } TWSCustomControl = class(TWSWinControl) - private - protected - public end; { TWSImageList } TWSImageList = class(TWSDragImageList) - private - protected - public end; @@ -141,8 +133,6 @@ end; initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsdbctrls.pp b/lcl/widgetset/wsdbctrls.pp index b490726607..ab80c80e33 100644 --- a/lcl/widgetset/wsdbctrls.pp +++ b/lcl/widgetset/wsdbctrls.pp @@ -25,11 +25,22 @@ unit WSDbCtrls; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -39,109 +50,69 @@ uses WSCalendar, WSButtons; type - { TWSDBEdit } TWSDBEdit = class(TWSCustomMaskEdit) - private - protected - public end; { TWSDBText } TWSDBText = class(TWSLabel) - private - protected - public end; { TWSDBListBox } TWSDBListBox = class(TWSCustomListBox) - private - protected - public end; { TWSDBRadioGroup } TWSDBRadioGroup = class(TWSCustomRadioGroup) - private - protected - public end; { TWSDBCheckBox } TWSDBCheckBox = class(TWSCustomCheckBox) - private - protected - public end; { TWSDBComboBox } TWSDBComboBox = class(TWSCustomComboBox) - private - protected - public end; { TWSDBMemo } TWSDBMemo = class(TWSCustomMemo) - private - protected - public end; { TWSDBGroupBox } TWSDBGroupBox = class(TWSCustomGroupBox) - private - protected - public end; { TWSDBImage } TWSDBImage = class(TWSCustomImage) - private - protected - public end; { TWSDBCalendar } TWSDBCalendar = class(TWSCalendar) - private - protected - public end; { TWSDBCustomNavigator } TWSDBCustomNavigator = class(TWSCustomPanel) - private - protected - public end; { TWSDBNavButton } TWSDBNavButton = class(TWSSpeedButton) - private - protected - public end; { TWSDBNavigator } TWSDBNavigator = class(TWSDBCustomNavigator) - private - protected - public end; @@ -149,8 +120,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsdbgrids.pp b/lcl/widgetset/wsdbgrids.pp index 35e1915256..6d5092bbce 100644 --- a/lcl/widgetset/wsdbgrids.pp +++ b/lcl/widgetset/wsdbgrids.pp @@ -25,11 +25,22 @@ unit WSDBGrids; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses, WSGrids; type - { TWSCustomDbGrid } TWSCustomDbGrid = class(TWSCustomGrid) - private - protected - public end; { TWSdbGrid } TWSdbGrid = class(TWSCustomDbGrid) - private - protected - public end; @@ -60,8 +64,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsdialogs.pp b/lcl/widgetset/wsdialogs.pp index ae18e733ed..4e6e680a26 100644 --- a/lcl/widgetset/wsdialogs.pp +++ b/lcl/widgetset/wsdialogs.pp @@ -25,11 +25,22 @@ unit WSDialogs; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,69 +49,44 @@ uses WSLCLClasses, WSControls; type - { TWSCommonDialog } TWSCommonDialog = class(TWSLCLComponent) - private - protected - public end; { TWSFileDialog } TWSFileDialog = class(TWSCommonDialog) - private - protected - public end; { TWSOpenDialog } TWSOpenDialog = class(TWSFileDialog) - private - protected - public end; { TWSSaveDialog } TWSSaveDialog = class(TWSOpenDialog) - private - protected - public end; { TWSSelectDirectoryDialog } TWSSelectDirectoryDialog = class(TWSOpenDialog) - private - protected - public end; { TWSColorDialog } TWSColorDialog = class(TWSCommonDialog) - private - protected - public end; { TWSColorButton } TWSColorButton = class(TWSGraphicControl) - private - protected - public end; { TWSFontDialog } TWSFontDialog = class(TWSCommonDialog) - private - protected - public end; @@ -108,8 +94,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsdirsel.pp b/lcl/widgetset/wsdirsel.pp index 233f4d5364..74e82a6d58 100644 --- a/lcl/widgetset/wsdirsel.pp +++ b/lcl/widgetset/wsdirsel.pp @@ -25,11 +25,22 @@ unit WSDirSel; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSForms; type - { TWSDirSelDlg } TWSDirSelDlg = class(TWSForm) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wseditbtn.pp b/lcl/widgetset/wseditbtn.pp index 1b9d8c0e85..d77caa9e13 100644 --- a/lcl/widgetset/wseditbtn.pp +++ b/lcl/widgetset/wseditbtn.pp @@ -25,11 +25,22 @@ unit WSEditBtn; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,53 +49,34 @@ uses WSLCLClasses, WSStdCtrls; type - { TWSCustomEditButton } TWSCustomEditButton = class(TWSEdit) - private - protected - public end; { TWSEditButton } TWSEditButton = class(TWSCustomEditButton) - private - protected - public end; { TWSFileNameEdit } TWSFileNameEdit = class(TWSCustomEditButton) - private - protected - public end; { TWSDirectoryEdit } TWSDirectoryEdit = class(TWSCustomEditButton) - private - protected - public end; { TWSDateEdit } TWSDateEdit = class(TWSCustomEditButton) - private - protected - public end; { TWSCalcEdit } TWSCalcEdit = class(TWSCustomEditButton) - private - protected - public end; @@ -92,8 +84,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsextctrls.pp b/lcl/widgetset/wsextctrls.pp index e8b37092db..50f368eab4 100644 --- a/lcl/widgetset/wsextctrls.pp +++ b/lcl/widgetset/wsextctrls.pp @@ -25,11 +25,22 @@ unit WSExtCtrls; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,165 +49,104 @@ uses WSLCLClasses, WSControls, WSStdCtrls; type - { TWSCustomPage } TWSCustomPage = class(TWSWinControl) - private - protected - public end; { TWSCustomNotebook } TWSCustomNotebook = class(TWSWinControl) - private - protected - public end; { TWSPage } TWSPage = class(TWSCustomPage) - private - protected - public end; { TWSNotebook } TWSNotebook = class(TWSCustomNotebook) - private - protected - public end; { TWSShape } TWSShape = class(TWSGraphicControl) - private - protected - public end; { TWSCustomSplitter } TWSCustomSplitter = class(TWSCustomControl) - private - protected - public end; { TWSSplitter } TWSSplitter = class(TWSCustomSplitter) - private - protected - public end; { TWSPaintBox } TWSPaintBox = class(TWSGraphicControl) - private - protected - public end; { TWSCustomImage } TWSCustomImage = class(TWSGraphicControl) - private - protected - public end; { TWSImage } TWSImage = class(TWSCustomImage) - private - protected - public end; { TWSBevel } TWSBevel = class(TWSGraphicControl) - private - protected - public end; { TWSCustomRadioGroup } TWSCustomRadioGroup = class(TWSCustomGroupBox) - private - protected - public end; { TWSRadioGroup } TWSRadioGroup = class(TWSCustomRadioGroup) - private - protected - public end; { TWSCustomCheckGroup } TWSCustomCheckGroup = class(TWSCustomGroupBox) - private - protected - public end; { TWSCheckGroup } TWSCheckGroup = class(TWSCustomCheckGroup) - private - protected - public end; { TWSBoundLabel } TWSBoundLabel = class(TWSCustomLabel) - private - protected - public end; { TWSCustomLabeledEdit } TWSCustomLabeledEdit = class(TWSCustomEdit) - private - protected - public end; { TWSLabeledEdit } TWSLabeledEdit = class(TWSCustomLabeledEdit) - private - protected - public end; { TWSCustomPanel } TWSCustomPanel = class(TWSCustomControl) - private - protected - public end; { TWSPanel } TWSPanel = class(TWSCustomPanel) - private - protected - public end; @@ -204,8 +154,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsextdlgs.pp b/lcl/widgetset/wsextdlgs.pp index a10c185575..69eb6f4b5f 100644 --- a/lcl/widgetset/wsextdlgs.pp +++ b/lcl/widgetset/wsextdlgs.pp @@ -25,11 +25,22 @@ unit WSExtDlgs; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,69 +49,44 @@ uses WSLCLClasses, WSControls, WSDialogs, WSForms; type - { TWSPreviewFileControl } TWSPreviewFileControl = class(TWSWinControl) - private - protected - public end; { TWSPreviewFileDialog } TWSPreviewFileDialog = class(TWSOpenDialog) - private - protected - public end; { TWSOpenPictureDialog } TWSOpenPictureDialog = class(TWSPreviewFileDialog) - private - protected - public end; { TWSSavePictureDialog } TWSSavePictureDialog = class(TWSOpenPictureDialog) - private - protected - public end; { TWSCalculatorDialog } TWSCalculatorDialog = class(TWSCommonDialog) - private - protected - public end; { TWSCalculatorForm } TWSCalculatorForm = class(TWSForm) - private - protected - public end; { TWSCalendarDialogForm } TWSCalendarDialogForm = class(TWSForm) - private - protected - public end; { TWSCalendarDialog } TWSCalendarDialog = class(TWSCommonDialog) - private - protected - public end; @@ -108,8 +94,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsfilectrl.pp b/lcl/widgetset/wsfilectrl.pp index dd16555e1b..d8c17a7f0e 100644 --- a/lcl/widgetset/wsfilectrl.pp +++ b/lcl/widgetset/wsfilectrl.pp @@ -25,11 +25,22 @@ unit WSFileCtrl; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses, WSStdCtrls; type - { TWSCustomFileListBox } TWSCustomFileListBox = class(TWSCustomListBox) - private - protected - public end; { TWSFileListBox } TWSFileListBox = class(TWSCustomFileListBox) - private - protected - public end; @@ -60,8 +64,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsforms.pp b/lcl/widgetset/wsforms.pp index d14b570cb6..e775b85efe 100644 --- a/lcl/widgetset/wsforms.pp +++ b/lcl/widgetset/wsforms.pp @@ -25,11 +25,22 @@ unit WSForms; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,77 +49,49 @@ uses WSLCLClasses, WSControls; type - { TWSScrollingWinControl } TWSScrollingWinControl = class(TWSWinControl) - private - protected - public end; { TWSScrollBox } TWSScrollBox = class(TWSScrollingWinControl) - private - protected - public end; { TWSCustomFrame } TWSCustomFrame = class(TWSScrollingWinControl) - private - protected - public end; { TWSFrame } TWSFrame = class(TWSCustomFrame) - private - protected - public end; { TWSCustomForm } TWSCustomForm = class(TWSScrollingWinControl) - private - protected - public end; { TWSForm } TWSForm = class(TWSCustomForm) - private - protected - public end; { TWSHintWindow } TWSHintWindow = class(TWSCustomForm) - private - protected - public end; { TWSScreen } TWSScreen = class(TWSLCLComponent) - private - protected - public end; { TWSApplicationProperties } TWSApplicationProperties = class(TWSLCLComponent) - private - protected - public end; @@ -116,8 +99,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsgrids.pp b/lcl/widgetset/wsgrids.pp index 3aadfca592..3c50dedbe4 100644 --- a/lcl/widgetset/wsgrids.pp +++ b/lcl/widgetset/wsgrids.pp @@ -25,11 +25,22 @@ unit WSGrids; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,37 +49,24 @@ uses WSLCLClasses, WSMaskEdit, WSControls; type - { TWSStringCellEditor } TWSStringCellEditor = class(TWSCustomMaskEdit) - private - protected - public end; { TWSCustomGrid } TWSCustomGrid = class(TWSCustomControl) - private - protected - public end; { TWSDrawGrid } TWSDrawGrid = class(TWSCustomGrid) - private - protected - public end; { TWSStringGrid } TWSStringGrid = class(TWSDrawGrid) - private - protected - public end; @@ -76,8 +74,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsimglist.pp b/lcl/widgetset/wsimglist.pp index 0bad29fa84..f0b00c0ec5 100644 --- a/lcl/widgetset/wsimglist.pp +++ b/lcl/widgetset/wsimglist.pp @@ -25,11 +25,22 @@ unit WSImgList; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses; type - { TWSCustomImageList } TWSCustomImageList = class(TWSLCLComponent) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wslclclasses.pp b/lcl/widgetset/wslclclasses.pp index af590e0694..74d03c10da 100644 --- a/lcl/widgetset/wslclclasses.pp +++ b/lcl/widgetset/wslclclasses.pp @@ -24,22 +24,35 @@ unit WSLCLClasses; {$mode objfpc}{$H+} -interface +{.$DEFINE VerboseWSRegistration} +interface +//////////////////////////////////////////////////// +// I M P O R T A N T +//////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// uses Classes, LCLType, InterfaceBase; type - { TWSLCLComponent } +{$M+} TWSLCLComponent = class(TObject) - private - protected - public class function CreateHandle(const AComponent: TComponent; const AParams: TCreateParams): THandle; virtual; end; +{$M-} TWSLCLComponentClass = class of TWSLCLComponent; @@ -71,11 +84,19 @@ type LCLClass: TComponentClass; WSClass: TWSLCLComponentClass; VClass: Pointer; + VClassName: ShortString; 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 + VIRTUAL_VMT_COUNT = 100; + VIRTUAL_VMT_SIZE = vmtMethodStart + VIRTUAL_VMT_COUNT * SizeOf(Pointer); + var MComponentIndex: TStringList; MWSRegisterIndex: TStringList; @@ -94,18 +115,31 @@ begin idx := MWSRegisterIndex.IndexOf(cls.ClassName); if idx <> -1 then begin - Node := PClassNode(MWSRegisterIndex.Objects[idx]); - Result := Node^.WSClass; + Node := PClassNode(MWSRegisterIndex.Objects[idx]); + Result := TWSLCLComponentClass(Node^.VClass); Exit; end; cls := cls.ClassParent; end; -end; +end; + +type + TMethodNameTable = packed record + Count: DWord; + Entries: packed array[0..0] of packed record + Name: PShortstring; + Addr: Pointer; + end; + end; + PMethodNameTable = ^TMethodNameTable; + + TPointerArray = packed array[0..0] of Pointer; + PPointerArray = ^TPointerArray; procedure RegisterWSComponent(const AComponent: TComponentClass; const AWSComponent: TWSLCLComponentClass); - function FindNode(const AClass: TClass): PClassNode; + function GetNode(const AClass: TClass): PClassNode; var idx: Integer; Name: String; @@ -125,8 +159,9 @@ procedure RegisterWSComponent(const AComponent: TComponentClass; Result^.LCLClass := TComponentClass(AClass); Result^.WSClass := nil; Result^.VClass := nil; + Result^.VClassName := ''; Result^.Child := nil; - Result^.Parent := FindNode(AClass.ClassParent); + Result^.Parent := GetNode(AClass.ClassParent); if Result^.Parent = nil then begin Result^.Sibling := nil; @@ -142,32 +177,180 @@ 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); + var + ParentWSNode: PClassNode; + CommonClass: TClass; + Vvmt, Cvmt, Pvmt: PPointerArray; + Cmnt: PMethodNameTable; + SearchAddr: Pointer; + n, idx: Integer; + Processed: array[0..VIRTUAL_VMT_COUNT-1] of Boolean; + {$IFDEF VerboseWSRegistration} + Indent: String; + {$ENDIF} + begin + if ANode^.VClass = nil + then ANode^.VClass := GetMem(VIRTUAL_VMT_SIZE); + + // Initially copy the WSClass + // Tricky part, the source may get beyond read mem limit + Move(Pointer(ANode^.WSClass)^, ANode^.VClass^, VIRTUAL_VMT_SIZE); + + // Try to find the common ancestor + ParentWSNode := FindParentWSClassNode(ANode); + if ParentWSNode = nil then Exit; // nothing to do + {$IFDEF VerboseWSRegistration} + WriteLN('Virtual parent: ', ParentWSNode^.WSClass.ClassName); + {$ENDIF} + CommonClass := FindCommonAncestor(ANode^.WSClass, ParentWSNode^.WSClass); + {$IFDEF VerboseWSRegistration} + WriteLN('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} + WriteLN(Indent, '*', CommonClass.Classname, ' method count: ', Cmnt^.Count); + Indent := Indent + ' '; + {$ENDIF} + + Cvmt := Pointer(CommonClass) + vmtMethodStart; + Assert(Cmnt^.Count < VIRTUAL_VMT_COUNT, 'MethodTable count is larger that assumed VIRTUAL_VMT_COUNT'); + + // Loop though the VMT to see what is overridden + for n := 0 to Cmnt^.Count - 1 do + begin + {$IFDEF VerboseWSRegistration} + WriteLN(Indent, 'Search: ', Cmnt^.Entries[n].Name^); + {$ENDIF} + + SearchAddr := Cmnt^.Entries[n].Addr; + for idx := 0 to VIRTUAL_VMT_COUNT - 1 do + begin + if Cvmt^[idx] = SearchAddr + then begin + {$IFDEF VerboseWSRegistration} + WriteLN(Indent, 'Found at index: ', idx); + {$ENDIF} + + if Processed[idx] + then begin + {$IFDEF VerboseWSRegistration} + WriteLN(Indent, 'Procesed -> skipping'); + {$ENDIF} + Break; + end; + Processed[idx] := True; + + if (Vvmt^[idx] = SearchAddr) //original + and (Pvmt^[idx] <> SearchAddr) //overridden by parent + then begin + {$IFDEF VerboseWSRegistration} + WriteLN(Indent, Format('Updating %p -> %p', [Vvmt^[idx], Pvmt^[idx]])); + {$ENDIF} + Vvmt^[idx] := Pvmt^[idx]; + end; + + Break; + end; + if idx = VIRTUAL_VMT_COUNT - 1 + then begin + WriteLN('[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 + PPointer(ANode^.VClass + vmtParent)^ := PPointer(Pointer(ParentWSNode^.WSClass) + vmtParent)^; + // Delete methodtable entry + PPointer(ANode^.VClass + vmtMethodTable)^ := nil; + + end; + + procedure UpdateChildren(const ANode: PClassNode); + var + Node: PClassNode; + begin + Node := ANode^.Child; + while Node <> nil do + begin + if Node^.WSClass <> nil + then begin + {$IFDEF VerboseWSRegistration} + WriteLN('Update VClass for: ', Node^.WSClass.ClassName); + {$ENDIF} + CreateVClass(Node); + end; + UpdateChildren(Node); + Node := Node^.Sibling; + end; + end; + var Node: PClassNode; begin - Node := FindNode(AComponent); + Node := GetNode(AComponent); if Node = nil then Exit; if Node^.WSClass = nil then MWSRegisterIndex.AddObject(AComponent.ClassName, TObject(Node)); Node^.WSClass := AWSComponent; + {$IFDEF VerboseWSRegistration} + WriteLN('Create VClass for: ', Node^.WSClass.ClassName); + {$ENDIF} + CreateVClass(Node); + + // Since child classes may depend on us, recreate them + UpdateChildren(Node); end; -procedure FreeRegistration; -var - Node: PClassNode; +procedure DoInitialization; begin - while (MComponentIndex.Count>0) do begin - Node := PClassNode(MComponentIndex.Objects[MComponentIndex.Count-1]); - Dispose(Node); - MComponentIndex.Delete(MComponentIndex.Count-1); - end; - FreeAndNil(MComponentIndex); - FreeAndNil(MWSRegisterIndex); -end; - -initialization MComponentIndex := TStringList.Create; MComponentIndex.Sorted := True; MComponentIndex.Duplicates := dupError; @@ -175,8 +358,28 @@ initialization MWSRegisterIndex := TStringList.Create; MWSRegisterIndex.Sorted := True; MWSRegisterIndex.Duplicates := dupError; +end; + +procedure DoFinalization; +var + n: Integer; + Node: PClassNode; +begin + for n := 0 to MComponentIndex.Count - 1 do + begin + Node := PClassNode(MComponentIndex.Objects[n]); + if Node^.VClass <> nil + then Freemem(Node^.VClass); + Dispose(Node); + end; + FreeAndNil(MComponentIndex); + FreeAndNil(MWSRegisterIndex); +end; + +initialization + DoInitialization; finalization - FreeRegistration; + DoFinalization; end. diff --git a/lcl/widgetset/wsmaskedit.pp b/lcl/widgetset/wsmaskedit.pp index c994c4d2c0..e41a198d12 100644 --- a/lcl/widgetset/wsmaskedit.pp +++ b/lcl/widgetset/wsmaskedit.pp @@ -25,11 +25,22 @@ unit WSMaskEdit; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses, WSStdCtrls; type - { TWSCustomMaskEdit } TWSCustomMaskEdit = class(TWSCustomEdit) - private - protected - public end; { TWSMaskEdit } TWSMaskEdit = class(TWSCustomMaskEdit) - private - protected - public end; @@ -60,8 +64,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsmenus.pp b/lcl/widgetset/wsmenus.pp index 57ba12970a..214d6d4fe2 100644 --- a/lcl/widgetset/wsmenus.pp +++ b/lcl/widgetset/wsmenus.pp @@ -25,11 +25,22 @@ unit WSMenus; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,37 +49,24 @@ uses WSLCLClasses; type - { TWSMenuItem } TWSMenuItem = class(TWSLCLComponent) - private - protected - public end; { TWSMenu } TWSMenu = class(TWSLCLComponent) - private - protected - public end; { TWSMainMenu } TWSMainMenu = class(TWSMenu) - private - protected - public end; { TWSPopupMenu } TWSPopupMenu = class(TWSMenu) - private - protected - public end; @@ -76,8 +74,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wspairsplitter.pp b/lcl/widgetset/wspairsplitter.pp index f773814615..1751536a6e 100644 --- a/lcl/widgetset/wspairsplitter.pp +++ b/lcl/widgetset/wspairsplitter.pp @@ -25,11 +25,22 @@ unit WSPairSplitter; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,29 +49,19 @@ uses WSLCLClasses, WSControls; type - { TWSPairSplitterSide } TWSPairSplitterSide = class(TWSWinControl) - private - protected - public end; { TWSCustomPairSplitter } TWSCustomPairSplitter = class(TWSWinControl) - private - protected - public end; { TWSPairSplitter } TWSPairSplitter = class(TWSCustomPairSplitter) - private - protected - public end; @@ -68,8 +69,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsspin.pp b/lcl/widgetset/wsspin.pp index c06910d413..afb6ed9d1b 100644 --- a/lcl/widgetset/wsspin.pp +++ b/lcl/widgetset/wsspin.pp @@ -25,11 +25,22 @@ unit WSSpin; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,21 +49,14 @@ uses WSLCLClasses, WSControls; type - { TWSCustomSpinEdit } TWSCustomSpinEdit = class(TWSWinControl) - private - protected - public end; { TWSSpinEdit } TWSSpinEdit = class(TWSCustomSpinEdit) - private - protected - public end; @@ -60,8 +64,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wsstdctrls.pp b/lcl/widgetset/wsstdctrls.pp index d297e11ef2..54a87f885c 100644 --- a/lcl/widgetset/wsstdctrls.pp +++ b/lcl/widgetset/wsstdctrls.pp @@ -25,11 +25,22 @@ unit WSStdCtrls; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,165 +49,104 @@ uses WSLCLClasses, WSControls; type - { TWSScrollBar } TWSScrollBar = class(TWSWinControl) - private - protected - public end; { TWSCustomGroupBox } TWSCustomGroupBox = class(TWSCustomControl) - private - protected - public end; { TWSGroupBox } TWSGroupBox = class(TWSCustomGroupBox) - private - protected - public end; { TWSCustomComboBox } TWSCustomComboBox = class(TWSWinControl) - private - protected - public end; { TWSComboBox } TWSComboBox = class(TWSCustomComboBox) - private - protected - public end; { TWSCustomListBox } TWSCustomListBox = class(TWSWinControl) - private - protected - public end; { TWSListBox } TWSListBox = class(TWSCustomListBox) - private - protected - public end; { TWSCustomEdit } TWSCustomEdit = class(TWSWinControl) - private - protected - public end; { TWSCustomMemo } TWSCustomMemo = class(TWSCustomEdit) - private - protected - public end; { TWSEdit } TWSEdit = class(TWSCustomEdit) - private - protected - public end; { TWSMemo } TWSMemo = class(TWSCustomMemo) - private - protected - public end; { TWSCustomLabel } TWSCustomLabel = class(TWSWinControl) - private - protected - public end; { TWSLabel } TWSLabel = class(TWSCustomLabel) - private - protected - public end; { TWSButtonControl } TWSButtonControl = class(TWSWinControl) - private - protected - public end; { TWSCustomCheckBox } TWSCustomCheckBox = class(TWSButtonControl) - private - protected - public end; { TWSCheckBox } TWSCheckBox = class(TWSCustomCheckBox) - private - protected - public end; { TWSToggleBox } TWSToggleBox = class(TWSCustomCheckBox) - private - protected - public end; { TWSRadioButton } TWSRadioButton = class(TWSCustomCheckBox) - private - protected - public end; { TWSCustomStaticText } TWSCustomStaticText = class(TWSCustomControl) - private - protected - public end; { TWSStaticText } TWSStaticText = class(TWSCustomStaticText) - private - protected - public end; @@ -204,8 +154,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something diff --git a/lcl/widgetset/wstoolwin.pp b/lcl/widgetset/wstoolwin.pp index 40850c4067..af986cd9b6 100644 --- a/lcl/widgetset/wstoolwin.pp +++ b/lcl/widgetset/wstoolwin.pp @@ -25,11 +25,22 @@ unit WSToolwin; {$mode objfpc}{$H+} interface - -uses //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// +// 1) Only class methods allowed +// 2) Class methods have to be published and virtual +// 3) To get as little as posible circles, the uses +// clause should contain only those LCL units +// needed for registration. WSxxx units are OK +// 4) To improve speed, register only classes in the +// initialization section which actually +// implement something +// 5) To enable your XXX widgetset units, look at +// the uses clause of the XXXintf.pp +//////////////////////////////////////////////////// +uses +//////////////////////////////////////////////////// // To get as little as posible circles, // uncomment only when needed for registration //////////////////////////////////////////////////// @@ -38,13 +49,9 @@ uses WSLCLClasses, WSControls; type - { TWSToolWindow } TWSToolWindow = class(TWSCustomControl) - private - protected - public end; @@ -52,8 +59,6 @@ implementation initialization -//////////////////////////////////////////////////// -// I M P O R T A N T //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something