From baebd2261641e698898a31bec9240fd1e9a9e343 Mon Sep 17 00:00:00 2001 From: vincents Date: Mon, 25 Jun 2007 08:34:41 +0000 Subject: [PATCH] LCL: moved TButton from buttons unit to stdctrls (bug #9137), compilation tested on windows for gtk2, qt and win32 widgetset git-svn-id: trunk@11367 - --- lcl/buttons.pp | 98 +----------- lcl/include/buttons.inc | 4 +- lcl/interfaces/carbon/carbonwsbuttons.pp | 11 -- lcl/interfaces/carbon/carbonwsstdctrls.pp | 43 +++++ lcl/interfaces/fpgui/fpguiwsbuttons.pp | 50 ------ lcl/interfaces/fpgui/fpguiwsstdctrls.pp | 50 ++++++ lcl/interfaces/gtk/gtkwsbuttons.pp | 168 +------------------- lcl/interfaces/gtk/gtkwsstdctrls.pp | 185 +++++++++++++++++++++- lcl/interfaces/gtk2/gtk2wsbuttons.pp | 11 +- lcl/interfaces/gtk2/gtk2wsstdctrls.pp | 9 ++ lcl/interfaces/qt/qtwsbuttons.pp | 136 ---------------- lcl/interfaces/qt/qtwsstdctrls.pp | 138 +++++++++++++++- lcl/interfaces/win32/win32wsbuttons.pp | 69 -------- lcl/interfaces/win32/win32wsstdctrls.pp | 69 ++++++++ lcl/interfaces/wince/wincewsbuttons.pp | 109 ------------- lcl/interfaces/wince/wincewsstdctrls.pp | 106 +++++++++++++ lcl/stdctrls.pp | 99 +++++++++++- lcl/widgetset/wsbuttons.pp | 20 +-- lcl/widgetset/wsstdctrls.pp | 18 +++ 19 files changed, 718 insertions(+), 675 deletions(-) diff --git a/lcl/buttons.pp b/lcl/buttons.pp index e16daee8c4..f008199827 100644 --- a/lcl/buttons.pp +++ b/lcl/buttons.pp @@ -59,98 +59,10 @@ type needs to be changed } TNumGlyphs = 1..4; - { TCustomButton } - - TCustomButton = class(TButtonControl) - private - FCancel: Boolean; - FDefault: Boolean; - FActive: boolean; - FModalResult: TModalResult; - FShortCut: TShortcut; - procedure SetCancel(NewCancel: boolean); - procedure SetDefault(Value: Boolean); - procedure SetModalResult(const AValue: TModalResult); - procedure CMUIActivate(var Message: TLMessage); message CM_UIACTIVATE; - procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED; - procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; - protected - procedure Click; override; - procedure CreateWnd; override; - procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override; - procedure ControlKeyUp(var Key: Word; Shift: TShiftState); override; - procedure SetParent(AParent: TWinControl); override; - procedure RealSetText(const Value: TCaption); override; - procedure WSSetDefault; - function DialogChar(var Message: TLMKey): boolean; override; - function ChildClassAllowed(ChildClass: TClass): boolean; override; - function IsBorderSpacingInnerBorderStored: Boolean; override; - property ParentColor default false; - public - constructor Create(TheOwner: TComponent); override; - procedure ExecuteDefaultAction; override; - procedure ExecuteCancelAction; override; - procedure ActiveDefaultControlChanged(NewControl: TControl); override; - procedure UpdateRolesForForm; override; - public - property Active: boolean read FActive stored false; - property Default: Boolean read FDefault write SetDefault default false; - property ModalResult: TModalResult read FModalResult write SetModalResult default mrNone; - property Cancel: Boolean read FCancel write SetCancel default false; - property Color default clBtnFace; - property TabStop default true; - end; - - - { TButton } - - TButton = class(TCustomButton) - public - procedure Click; override; - published - property Action; - property Align; - property Anchors; - property AutoSize; - property BidiMode; - property BorderSpacing; - property Cancel; - property Caption; - property Color; - property Constraints; - property Default; - property DragCursor; - property DragMode; - property Enabled; - property Font; - property ParentBidiMode; - property ModalResult; - property OnChangeBounds; - property OnClick; - property OnDragDrop; - property OnDragOver; - property OnEndDrag; - property OnEnter; - property OnExit; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnMouseDown; - property OnMouseEnter; - property OnMouseLeave; - property OnMouseMove; - property OnMouseUp; - property OnResize; - property OnStartDrag; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property ShowHint; - property TabOrder; - property TabStop; - property Visible; - end; - + {Some type aliases, because TButton is now in StdCtrls, + but was in this unit in Lazarus 0.9.22 and earlier} + TCustomButton = StdCtrls.TCustomButton; + TButton = StdCtrls.TButton; { TButtonGlyph } @@ -480,11 +392,9 @@ end; procedure Register; begin - RegisterComponents('Standard',[TButton]); RegisterComponents('Additional',[TBitBtn,TSpeedButton]); end; -{$I buttons.inc} {$I bitbtn.inc} {$I buttonglyph.inc} {$I speedbutton.inc} diff --git a/lcl/include/buttons.inc b/lcl/include/buttons.inc index d620f55d63..7ca981a19e 100644 --- a/lcl/include/buttons.inc +++ b/lcl/include/buttons.inc @@ -1,4 +1,6 @@ -{%MainUnit ../buttons.pp} +{%MainUnit ../stdctrls.pp} +{ $Id$} + {****************************************************************************** TCustomButton ****************************************************************************** diff --git a/lcl/interfaces/carbon/carbonwsbuttons.pp b/lcl/interfaces/carbon/carbonwsbuttons.pp index 707d370f32..45f7526c7e 100644 --- a/lcl/interfaces/carbon/carbonwsbuttons.pp +++ b/lcl/interfaces/carbon/carbonwsbuttons.pp @@ -41,16 +41,6 @@ uses type - { TCarbonWSButton } - - TCarbonWSButton = class(TWSButton) - private - protected - public - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; - class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; - end; - { TCarbonWSBitBtn } TCarbonWSBitBtn = class(TWSBitBtn) @@ -163,7 +153,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(TCustomButton, TCarbonWSButton); RegisterWSComponent(TCustomBitBtn, TCarbonWSBitBtn); RegisterWSComponent(TCustomSpeedButton, TCarbonWSSpeedButton); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/carbon/carbonwsstdctrls.pp b/lcl/interfaces/carbon/carbonwsstdctrls.pp index 5bc16f9ddf..95d1e9d9ed 100644 --- a/lcl/interfaces/carbon/carbonwsstdctrls.pp +++ b/lcl/interfaces/carbon/carbonwsstdctrls.pp @@ -203,6 +203,16 @@ type public end; + { TCarbonWSButton } + + TCarbonWSButton = class(TWSButton) + private + protected + public + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; + class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; + end; + { TCarbonWSCustomCheckBox } TCarbonWSCustomCheckBox = class(TWSCustomCheckBox) @@ -904,6 +914,38 @@ begin TCarbonMemo(ACustomMemo.Handle).SetWordWrap(NewWordWrap); end; +{ TCarbonWSButton } + +{------------------------------------------------------------------------------ + Method: TCarbonWSButton.CreateHandle + Params: AWinControl - LCL control + AParams - Creation parameters + Returns: Handle to the control in Carbon interface + + Creates new button control in Carbon interface with the specified parameters + ------------------------------------------------------------------------------} +class function TCarbonWSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): TLCLIntfHandle; +begin + // create the Carbon button widget + Result := TLCLIntfHandle(TCarbonButton.Create(AWinControl, AParams)); +end; + +{------------------------------------------------------------------------------ + Method: TCarbonWSButton.SetDefault + Params: AButton - LCL button control + ADefault + + Sets button default indication in Carbon interface + ------------------------------------------------------------------------------} +class procedure TCarbonWSButton.SetDefault(const AButton: TCustomButton; + ADefault: Boolean); +begin + if not CheckHandle(AButton, Self, 'SetDefault') then Exit; + + TCarbonCustomButton(AButton.Handle).SetDefault(ADefault); +end; + { TCarbonWSCustomCheckBox } {------------------------------------------------------------------------------ @@ -1039,6 +1081,7 @@ initialization // RegisterWSComponent(TCustomLabel, TCarbonWSCustomLabel); // RegisterWSComponent(TLabel, TCarbonWSLabel); // RegisterWSComponent(TButtonControl, TCarbonWSButtonControl); + RegisterWSComponent(TCustomButton, TCarbonWSButton); RegisterWSComponent(TCustomCheckBox, TCarbonWSCustomCheckBox); // RegisterWSComponent(TCheckBox, TCarbonWSCheckBox); RegisterWSComponent(TToggleBox, TCarbonWSToggleBox); diff --git a/lcl/interfaces/fpgui/fpguiwsbuttons.pp b/lcl/interfaces/fpgui/fpguiwsbuttons.pp index 1166dc0948..5825eb0f51 100644 --- a/lcl/interfaces/fpgui/fpguiwsbuttons.pp +++ b/lcl/interfaces/fpgui/fpguiwsbuttons.pp @@ -36,17 +36,6 @@ uses type - { TFpGuiWSButton } - - TFpGuiWSButton = class(TWSButton) - private - protected - public - class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; - class procedure SetText(const AWinControl: TWinControl; const AText: String); override; - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; - end; - { TFpGuiWSBitBtn } TFpGuiWSBitBtn = class(TWSBitBtn) @@ -66,44 +55,6 @@ type implementation -{ TFpGuiWSButton } - -{------------------------------------------------------------------------------ - Method: TFpGuiWSButton.GetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class function TFpGuiWSButton.GetText(const AWinControl: TWinControl; - var AText: String): Boolean; -begin - Result := True; - AText := TFPGUIPrivateButton(AWinControl.Handle).GetText; -end; - -{------------------------------------------------------------------------------ - Method: TFpGuiWSButton.SetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class procedure TFpGuiWSButton.SetText(const AWinControl: TWinControl; - const AText: String); -begin - TFPGUIPrivateButton(AWinControl.Handle).SetText(AText); -end; - -{------------------------------------------------------------------------------ - Method: TFpGuiWSButton.CreateHandle - Params: None - Returns: Nothing - - Allocates memory and resources for the control and shows it - ------------------------------------------------------------------------------} -class function TFpGuiWSButton.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): TLCLIntfHandle; -begin - Result := TLCLIntfHandle(TFPGUIPrivateButton.Create(AWinControl, AParams)); -end; - initialization //////////////////////////////////////////////////// @@ -112,7 +63,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(Buttons.TCustomButton, TFpGuiWSButton); // RegisterWSComponent(TCustomBitBtn, TFpGuiWSBitBtn); // RegisterWSComponent(TCustomSpeedButton, TFpGuiWSSpeedButton); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/fpgui/fpguiwsstdctrls.pp b/lcl/interfaces/fpgui/fpguiwsstdctrls.pp index 78b46d4412..5a3fb538af 100644 --- a/lcl/interfaces/fpgui/fpguiwsstdctrls.pp +++ b/lcl/interfaces/fpgui/fpguiwsstdctrls.pp @@ -172,6 +172,17 @@ type public end; + { TFpGuiWSButton } + + TFpGuiWSButton = class(TWSButton) + private + protected + public + class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; + class procedure SetText(const AWinControl: TWinControl; const AText: String); override; + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; + end; + { TFpGuiWSCustomCheckBox } TFpGuiWSCustomCheckBox = class(TWSCustomCheckBox) @@ -376,6 +387,44 @@ begin vEdit.Text := AText; end; +{ TFpGuiWSButton } + +{------------------------------------------------------------------------------ + Method: TFpGuiWSButton.GetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class function TFpGuiWSButton.GetText(const AWinControl: TWinControl; + var AText: String): Boolean; +begin + Result := True; + AText := TFPGUIPrivateButton(AWinControl.Handle).GetText; +end; + +{------------------------------------------------------------------------------ + Method: TFpGuiWSButton.SetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class procedure TFpGuiWSButton.SetText(const AWinControl: TWinControl; + const AText: String); +begin + TFPGUIPrivateButton(AWinControl.Handle).SetText(AText); +end; + +{------------------------------------------------------------------------------ + Method: TFpGuiWSButton.CreateHandle + Params: None + Returns: Nothing + + Allocates memory and resources for the control and shows it + ------------------------------------------------------------------------------} +class function TFpGuiWSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): TLCLIntfHandle; +begin + Result := TLCLIntfHandle(TFPGUIPrivateButton.Create(AWinControl, AParams)); +end; + { TFpGuiWSCustomCheckBox } class function TFpGuiWSCustomCheckBox.RetrieveState( @@ -532,6 +581,7 @@ initialization // RegisterWSComponent(TCustomLabel, TFpGuiWSCustomLabel); // RegisterWSComponent(TLabel, TFpGuiWSLabel); // RegisterWSComponent(TButtonControl, TFpGuiWSButtonControl); + RegisterWSComponent(Buttons.TCustomButton, TFpGuiWSButton); RegisterWSComponent(TCustomCheckBox, TFpGuiWSCustomCheckBox); // RegisterWSComponent(TCheckBox, TFpGuiWSCheckBox); // RegisterWSComponent(TToggleBox, TFpGuiWSToggleBox); diff --git a/lcl/interfaces/gtk/gtkwsbuttons.pp b/lcl/interfaces/gtk/gtkwsbuttons.pp index 149a7ece87..1b87555cd7 100644 --- a/lcl/interfaces/gtk/gtkwsbuttons.pp +++ b/lcl/interfaces/gtk/gtkwsbuttons.pp @@ -50,26 +50,6 @@ type TableWidget: Pointer; end; - { TGtkWSButton } - - TGtkWSButton = class(TWSButton) - private - protected - class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; - public - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; - class procedure GetPreferredSize(const AWinControl: TWinControl; - var PreferredWidth, PreferredHeight: integer; - WithThemeSpace: Boolean); override; - class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; - - class procedure SetColor(const AWinControl: TWinControl); override; - class procedure SetFont(const AWinControl: TWinControl; const AFont : TFont); override; - class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; - class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; - class procedure SetText(const AWinControl: TWinControl; const AText: String); override; - end; - { TGtkWSBitBtn } TGtkWSBitBtn = class(TWSBitBtn) @@ -103,154 +83,10 @@ implementation uses SysUtils, GtkProc, GtkInt, GtkGlobals, - GtkWSControls; + GtkWSControls, GtkWSStdCtrls; -{ TGtkWSButton } - -function GtkWSButton_Clicked(AWidget: PGtkWidget; AInfo: PWidgetInfo): GBoolean; cdecl; -var - Msg: TLMessage; -begin - Result := CallBackDefaultReturn; - if AInfo^.ChangeLock > 0 then Exit; - Msg.Msg := LM_CLICKED; - Result := DeliverMessage(AInfo^.LCLObject, Msg) = 0; -end; - - -class function TGtkWSButton.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): TLCLIntfHandle; -var - Button: TCustomButton; - WidgetInfo: PWidgetInfo; - Allocation: TGTKAllocation; -begin - Button := AWinControl as TCustomButton; - Result := TLCLIntfHandle(gtk_button_new_with_label('button')); - if Result = 0 then Exit; - {$IFDEF DebugLCLComponents} - DebugGtkWidgets.MarkCreated(Pointer(Result),'button'); - {$ENDIF} - - WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams); - - Allocation.X := AParams.X; - Allocation.Y := AParams.Y; - Allocation.Width := AParams.Width; - Allocation.Height := AParams.Height; - gtk_widget_size_allocate(PGtkWidget(Result), @Allocation); - - SetCallbacks(PGtkWidget(Result), WidgetInfo); -end; - -class function TGtkWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; -begin - // The button text is static, so let the LCL fallback to FCaption - Result := False; -end; - -class procedure TGtkWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); -begin - if not WSCheckHandleAllocated(AButton, 'SetDefault') - then Exit; - - if ADefault - and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(AButton.Handle))) then - //gtk_widget_grab_default(pgtkwidget(handle)) - else begin - {DebugLn('LM_BTNDEFAULT_CHANGED ',TCustomButton(Sender).Name,':',Sender.ClassName,' widget can not grab default ', - ' visible=',GTK_WIDGET_VISIBLE(PGtkWidget(Handle)), - ' realized=',GTK_WIDGET_REALIZED(PGtkWidget(Handle)), - ' mapped=',GTK_WIDGET_MAPPED(PGtkWidget(Handle)), - '');} - // gtk_widget_Draw_Default(pgtkwidget(Handle)); //this isn't right but I'm not sure what to call - end; -end; - -class procedure TGtkWSButton.SetCallbacks(const AGtkWidget: PGtkWidget; - const AWidgetInfo: PWidgetInfo); -begin - TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject)); - - SignalConnect(AGtkWidget, 'clicked', @GtkWSButton_Clicked, AWidgetInfo); -end; - -class procedure TGtkWSButton.SetShortcut(const AButton: TCustomButton; - const OldShortcut, NewShortcut: TShortcut); -begin - if not WSCheckHandleAllocated(AButton, 'SetShortcut') - then Exit; - - {$IFDEF Gtk1} - Accelerate(AButton, PGtkWidget(AButton.Handle), NewShortcut, 'clicked'); - {$ENDIF} - // gtk2: shortcuts are handled by the LCL -end; - -class procedure TGtkWSButton.SetText(const AWinControl: TWinControl; const AText: String); -var - BtnWidget: PGtkButton; - LblWidget: PGtkLabel; -begin - if not WSCheckHandleAllocated(AWincontrol, 'SetText') - then Exit; - - BtnWidget := PGtkButton(AWinControl.Handle); - {$IFDEF GTK2} - LblWidget := PGtkLabel(PGtkBin(BtnWidget)^.Child); - {$ELSE} - LblWidget := PGtkLabel(BtnWidget^.Child); - {$ENDIF} - - if LblWidget = nil - then begin - Assert(False, Format('trace: [WARNING] Button %s(%s) has no label', [AWinControl.Name, AWinControl.ClassName])); - LblWidget := PGtkLabel(gtk_label_new('')); - gtk_container_add(PGtkContainer(BtnWidget), PGtkWidget(LblWidget)); - end; - - GtkWidgetSet.SetLabelCaption(LblWidget, AText - {$IFDEF Gtk1}, AWinControl,PGtkWidget(BtnWidget), 'clicked'{$ENDIF}); -end; - -class procedure TGtkWSButton.SetColor(const AWinControl: TWinControl); -var - Widget: PGTKWidget; -begin - Widget:= PGtkWidget(AWinControl.Handle); - GtkWidgetSet.SetWidgetColor(Widget, clNone, AWinControl.color, - [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); -end; - -class procedure TGtkWSButton.SetFont(const AWinControl: TWinControl; - const AFont : TFont); -var - Widget: PGTKWidget; - LblWidget: PGtkWidget; -begin - if not AWinControl.HandleAllocated then exit; - if AFont.IsDefault then exit; - - Widget:= PGtkWidget(AWinControl.Handle); - LblWidget := (pGtkBin(Widget)^.Child); - - if LblWidget<>nil then begin - GtkWidgetSet.SetWidgetColor(LblWidget, AWinControl.font.color, clNone, - [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); - GtkWidgetSet.SetWidgetFont(LblWidget, AFont); - end; -end; - -class procedure TGtkWSButton.GetPreferredSize(const AWinControl: TWinControl; - var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); -begin - GetGTKDefaultWidgetSize(AWinControl,PreferredWidth,PreferredHeight, - WithThemeSpace); - //debugln('TGtkWSButton.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight)); -end; - { TGtkWSBitBtn } { @@ -590,10 +426,8 @@ initialization // which actually implement something //////////////////////////////////////////////////// {$ifdef gtk1} - RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk1PrivateButton); RegisterWSComponent(TCustomBitBtn, TGtkWSBitBtn, TGtk1PrivateButton); // register it to fallback to default {$else} - RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk2PrivateButton); RegisterWSComponent(TCustomBitBtn, TGtkWSBitBtn, TGtk2PrivateButton); // register it to fallback to default {$endif} // RegisterWSComponent(TCustomSpeedButton, TGtkWSSpeedButton); diff --git a/lcl/interfaces/gtk/gtkwsstdctrls.pp b/lcl/interfaces/gtk/gtkwsstdctrls.pp index 8af167f388..54c58762f3 100644 --- a/lcl/interfaces/gtk/gtkwsstdctrls.pp +++ b/lcl/interfaces/gtk/gtkwsstdctrls.pp @@ -27,14 +27,16 @@ unit GtkWSStdCtrls; interface uses - Classes, SysUtils, Math, Controls, Graphics, StdCtrls, + Classes, SysUtils, Math, + LCLType, LMessages, LCLProc, Controls, Graphics, StdCtrls, {$IFDEF gtk2} - glib2, gdk2pixbuf, gdk2, gtk2, Pango, + glib2, gdk2pixbuf, gdk2, gtk2, Pango, Gtk2WSPrivate, {$ELSE} - glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache, + glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} + GtkFontCache, Gtk1WSPrivate, {$ENDIF} - WSStdCtrls, WSLCLClasses, WSProc, WSControls, GtkInt, LCLType, GtkDef, LCLProc, - GTKWinApiWindow, gtkglobals, gtkproc, gtkExtra, GtkWSPrivate, InterfaceBase; + InterfaceBase, WSStdCtrls, WSLCLClasses, WSProc, WSControls, + GtkInt, GtkDef, GTKWinApiWindow, gtkglobals, gtkproc, gtkExtra, GtkWSPrivate; type @@ -231,6 +233,30 @@ type public end; + { TGtkWSButton } + + TGtkWSButton = class(TWSButton) + private + protected + public + {SetCallbacks is made public so that it can be called from + TGtkWSBitBtn.CreateHandle. + TODO: move it to TGtkPrivateButton} + class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; + + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; + class procedure GetPreferredSize(const AWinControl: TWinControl; + var PreferredWidth, PreferredHeight: integer; + WithThemeSpace: Boolean); override; + class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; + + class procedure SetColor(const AWinControl: TWinControl); override; + class procedure SetFont(const AWinControl: TWinControl; const AFont : TFont); override; + class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; + class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; + class procedure SetText(const AWinControl: TWinControl; const AText: String); override; + end; + { TGtkWSCustomCheckBox } TGtkWSCustomCheckBox = class(TWSCustomCheckBox) @@ -920,6 +946,150 @@ begin //debugln('TGtkWSCustomStaticText.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight)); end; +{ TGtkWSButton } + +function GtkWSButton_Clicked(AWidget: PGtkWidget; AInfo: PWidgetInfo): GBoolean; cdecl; +var + Msg: TLMessage; +begin + Result := CallBackDefaultReturn; + if AInfo^.ChangeLock > 0 then Exit; + Msg.Msg := LM_CLICKED; + Result := DeliverMessage(AInfo^.LCLObject, Msg) = 0; +end; + + +class function TGtkWSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): TLCLIntfHandle; +var + Button: TCustomButton; + WidgetInfo: PWidgetInfo; + Allocation: TGTKAllocation; +begin + Button := AWinControl as TCustomButton; + Result := TLCLIntfHandle(gtk_button_new_with_label('button')); + if Result = 0 then Exit; + {$IFDEF DebugLCLComponents} + DebugGtkWidgets.MarkCreated(Pointer(Result),'button'); + {$ENDIF} + + WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams); + + Allocation.X := AParams.X; + Allocation.Y := AParams.Y; + Allocation.Width := AParams.Width; + Allocation.Height := AParams.Height; + gtk_widget_size_allocate(PGtkWidget(Result), @Allocation); + + SetCallbacks(PGtkWidget(Result), WidgetInfo); +end; + +class function TGtkWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; +begin + // The button text is static, so let the LCL fallback to FCaption + Result := False; +end; + +class procedure TGtkWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); +begin + if not WSCheckHandleAllocated(AButton, 'SetDefault') + then Exit; + + if ADefault + and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(AButton.Handle))) then + //gtk_widget_grab_default(pgtkwidget(handle)) + else begin + {DebugLn('LM_BTNDEFAULT_CHANGED ',TCustomButton(Sender).Name,':',Sender.ClassName,' widget can not grab default ', + ' visible=',GTK_WIDGET_VISIBLE(PGtkWidget(Handle)), + ' realized=',GTK_WIDGET_REALIZED(PGtkWidget(Handle)), + ' mapped=',GTK_WIDGET_MAPPED(PGtkWidget(Handle)), + '');} + // gtk_widget_Draw_Default(pgtkwidget(Handle)); //this isn't right but I'm not sure what to call + end; +end; + +class procedure TGtkWSButton.SetCallbacks(const AGtkWidget: PGtkWidget; + const AWidgetInfo: PWidgetInfo); +begin + TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject)); + + SignalConnect(AGtkWidget, 'clicked', @GtkWSButton_Clicked, AWidgetInfo); +end; + +class procedure TGtkWSButton.SetShortcut(const AButton: TCustomButton; + const OldShortcut, NewShortcut: TShortcut); +begin + if not WSCheckHandleAllocated(AButton, 'SetShortcut') + then Exit; + + {$IFDEF Gtk1} + Accelerate(AButton, PGtkWidget(AButton.Handle), NewShortcut, 'clicked'); + {$ENDIF} + // gtk2: shortcuts are handled by the LCL +end; + +class procedure TGtkWSButton.SetText(const AWinControl: TWinControl; const AText: String); +var + BtnWidget: PGtkButton; + LblWidget: PGtkLabel; +begin + if not WSCheckHandleAllocated(AWincontrol, 'SetText') + then Exit; + + BtnWidget := PGtkButton(AWinControl.Handle); + {$IFDEF GTK2} + LblWidget := PGtkLabel(PGtkBin(BtnWidget)^.Child); + {$ELSE} + LblWidget := PGtkLabel(BtnWidget^.Child); + {$ENDIF} + + if LblWidget = nil + then begin + Assert(False, Format('trace: [WARNING] Button %s(%s) has no label', [AWinControl.Name, AWinControl.ClassName])); + LblWidget := PGtkLabel(gtk_label_new('')); + gtk_container_add(PGtkContainer(BtnWidget), PGtkWidget(LblWidget)); + end; + + GtkWidgetSet.SetLabelCaption(LblWidget, AText + {$IFDEF Gtk1}, AWinControl,PGtkWidget(BtnWidget), 'clicked'{$ENDIF}); +end; + +class procedure TGtkWSButton.SetColor(const AWinControl: TWinControl); +var + Widget: PGTKWidget; +begin + Widget:= PGtkWidget(AWinControl.Handle); + GtkWidgetSet.SetWidgetColor(Widget, clNone, AWinControl.color, + [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); +end; + +class procedure TGtkWSButton.SetFont(const AWinControl: TWinControl; + const AFont : TFont); +var + Widget: PGTKWidget; + LblWidget: PGtkWidget; +begin + if not AWinControl.HandleAllocated then exit; + if AFont.IsDefault then exit; + + Widget:= PGtkWidget(AWinControl.Handle); + LblWidget := (pGtkBin(Widget)^.Child); + + if LblWidget<>nil then begin + GtkWidgetSet.SetWidgetColor(LblWidget, AWinControl.font.color, clNone, + [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); + GtkWidgetSet.SetWidgetFont(LblWidget, AFont); + end; +end; + +class procedure TGtkWSButton.GetPreferredSize(const AWinControl: TWinControl; + var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); +begin + GetGTKDefaultWidgetSize(AWinControl,PreferredWidth,PreferredHeight, + WithThemeSpace); + //debugln('TGtkWSButton.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight)); +end; + { TGtkWSCustomCheckBox } class function TGtkWSCustomCheckBox.RetrieveState( @@ -1193,6 +1363,11 @@ initialization RegisterWSComponent(TCustomEdit, TGtkWSCustomEdit); RegisterWSComponent(TCustomMemo, TGtkWSCustomMemo, TGtkPrivateScrolling); // RegisterWSComponent(TButtonControl, TGtkWSButtonControl); +{$ifdef gtk1} + RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk1PrivateButton); +{$else} + RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk2PrivateButton); +{$endif} RegisterWSComponent(TCustomCheckBox, TGtkWSCustomCheckBox); // RegisterWSComponent(TCheckBox, TGtkWSCheckBox); // RegisterWSComponent(TToggleBox, TGtkWSToggleBox); diff --git a/lcl/interfaces/gtk2/gtk2wsbuttons.pp b/lcl/interfaces/gtk2/gtk2wsbuttons.pp index 450b30d4d1..60c2a7bbf3 100644 --- a/lcl/interfaces/gtk2/gtk2wsbuttons.pp +++ b/lcl/interfaces/gtk2/gtk2wsbuttons.pp @@ -39,14 +39,6 @@ uses type - { TGtk2WSButton } - - TGtk2WSButton = class(TWSButton) - private - protected - public - end; - { TGtk2WSBitBtn } TGtk2WSBitBtn = class(TWSBitBtn) @@ -74,8 +66,7 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// -// RegisterWSComponent(TCustomButton, TGtk2WSButton); // RegisterWSComponent(TCUstomBitBtn, TGtk2WSBitBtn); // RegisterWSComponent(TCustomSpeedButton, TGtk2WSSpeedButton); //////////////////////////////////////////////////// -end. \ No newline at end of file +end. diff --git a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp index 11ea889e08..1d76357321 100644 --- a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp +++ b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp @@ -245,6 +245,14 @@ type public end; + { TGtk2WSButton } + + TGtk2WSButton = class(TWSButton) + private + protected + public + end; + { TGtk2WSCustomCheckBox } TGtk2WSCustomCheckBox = class(TGtkWSCustomCheckBox) @@ -1317,6 +1325,7 @@ initialization // RegisterWSComponent(TCustomLabel, TGtk2WSCustomLabel); // RegisterWSComponent(TLabel, TGtk2WSLabel); // RegisterWSComponent(TButtonControl, TGtk2WSButtonControl); +// RegisterWSComponent(TCustomButton, TGtk2WSButton); // RegisterWSComponent(TCustomCheckBox, TGtk2WSCustomCheckBox); RegisterWSComponent(TCustomCheckBox, TGtk2WSCustomCheckBox); // RegisterWSComponent(TToggleBox, TGtk2WSToggleBox); diff --git a/lcl/interfaces/qt/qtwsbuttons.pp b/lcl/interfaces/qt/qtwsbuttons.pp index 941cbf0c21..fd693ba828 100644 --- a/lcl/interfaces/qt/qtwsbuttons.pp +++ b/lcl/interfaces/qt/qtwsbuttons.pp @@ -41,23 +41,6 @@ uses type - { TQtWSButton } - - TQtWSButton = class(TWSButton) - private - protected - public - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; - class procedure DestroyHandle(const AWinControl: TWinControl); override; - class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; -// class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; -// class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; - class procedure SetText(const AWinControl: TWinControl; const AText: String); override; -// class procedure GetPreferredSize(const AWinControl: TWinControl; -// var PreferredWidth, PreferredHeight: integer); override; - class procedure SetColor(const AWinControl: TWinControl); override; - end; - { TQtWSBitBtn } TQtWSBitBtn = class(TWSBitBtn) @@ -88,124 +71,6 @@ implementation uses QtWSControls; -{ TQtWSButton } - -{------------------------------------------------------------------------------ - Function: TQtWSButton.CreateHandle - Params: None - Returns: Nothing - - Allocates memory and resources for the control and shows it - ------------------------------------------------------------------------------} -class function TQtWSButton.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): TLCLIntfHandle; -var - QtPushButton: TQtPushButton; - Method: TMethod; - Hook : QObject_hookH; -begin - QtPushButton := TQtPushButton.Create(AWinControl, AParams); - - // Various Events - - Hook := QObject_hook_create(QtPushButton.Widget); - - TEventFilterMethod(Method) := QtPushButton.EventFilter; - - QObject_hook_hook_events(Hook, Method); - - // OnClick Event - - QAbstractButton_clicked2_Event(Method) := QtPushButton.SlotClicked; - - QAbstractButton_hook_hook_clicked2(QAbstractButton_hook_create(QtPushButton.Widget), Method); - - // Focus - - QWidget_setFocusPolicy(QtPushButton.Widget, QtStrongFocus); - - // Returns the Handle - - Result := THandle(QtPushButton); -end; - -{------------------------------------------------------------------------------ - Function: TQtWSButton.DestroyHandle - Params: None - Returns: Nothing - - Releases allocated memory and resources - ------------------------------------------------------------------------------} -class procedure TQtWSButton.DestroyHandle(const AWinControl: TWinControl); -begin - TQtPushButton(AWinControl.Handle).Free; - - AWinControl.Handle := 0; -end; - -{------------------------------------------------------------------------------ - Function: TQtWSButton.GetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class function TQtWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; -var - Str: WideString; -begin - Result := False; - - if not WSCheckHandleAllocated(AWincontrol, 'GetText') then Exit; - - TQtAbstractButton(AWinControl.Handle).Text(@Str); - - AText := UTF8Encode(Str); - - Result := True; -end; - -{------------------------------------------------------------------------------ - Function: TQtWSButton.SetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class procedure TQtWSButton.SetText(const AWinControl: TWinControl; const AText: String); -var - Str: WideString; -begin - if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit; - - Str := UTF8Decode(AText); - - TQtAbstractButton(AWinControl.Handle).SetText(@Str); -end; - -{------------------------------------------------------------------------------ - Method: TQtWSButton.SetColor - Params: AWinControl - the calling object - - Returns: Nothing - - Sets the color of the widget. - ------------------------------------------------------------------------------} -class procedure TQtWSButton.SetColor(const AWinControl: TWinControl); -var - QColor: TQColor; - Color: TColor; -begin - if not WSCheckHandleAllocated(AWincontrol, 'SetColor') then Exit; - - if AWinControl.Color = CLR_INVALID then exit; - - // Get the color numeric value (system colors are mapped to numeric colors depending on the widget style) - Color:=ColorToRGB(AWinControl.Color); - - // Fill QColor - QColor_setRgb(@QColor,Red(Color),Green(Color),Blue(Color)); - - // Set color of the widget to QColor - TQtAbstractButton(AWinControl.Handle).SetColor(@QColor); -end; - { TQtWSBitBtn } {------------------------------------------------------------------------------ @@ -333,7 +198,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(TCustomButton, TQtWSButton); RegisterWSComponent(TCustomBitBtn, TQtWSBitBtn); // RegisterWSComponent(TCustomSpeedButton, TQtWSSpeedButton); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/qt/qtwsstdctrls.pp b/lcl/interfaces/qt/qtwsstdctrls.pp index 201654b3c9..b199e9b50c 100644 --- a/lcl/interfaces/qt/qtwsstdctrls.pp +++ b/lcl/interfaces/qt/qtwsstdctrls.pp @@ -37,7 +37,7 @@ uses // LCL Classes, StdCtrls, Controls, Graphics, Forms, SysUtils, InterfaceBase, LCLType, LCLIntf, LCLProc, // Widgetset - WSStdCtrls, WSLCLClasses; + WSProc, WSStdCtrls, WSLCLClasses; type @@ -226,6 +226,23 @@ type public end; + { TQtWSButton } + + TQtWSButton = class(TWSButton) + private + protected + public + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; + class procedure DestroyHandle(const AWinControl: TWinControl); override; + class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; +// class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; +// class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; + class procedure SetText(const AWinControl: TWinControl; const AText: String); override; +// class procedure GetPreferredSize(const AWinControl: TWinControl; +// var PreferredWidth, PreferredHeight: integer); override; + class procedure SetColor(const AWinControl: TWinControl); override; + end; + { TQtWSCustomCheckBox } TQtWSCustomCheckBox = class(TWSCustomCheckBox) @@ -941,6 +958,124 @@ begin TQtStaticText(AWinControl.Handle).SetText(@Str); end; +{ TQtWSButton } + +{------------------------------------------------------------------------------ + Function: TQtWSButton.CreateHandle + Params: None + Returns: Nothing + + Allocates memory and resources for the control and shows it + ------------------------------------------------------------------------------} +class function TQtWSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): TLCLIntfHandle; +var + QtPushButton: TQtPushButton; + Method: TMethod; + Hook : QObject_hookH; +begin + QtPushButton := TQtPushButton.Create(AWinControl, AParams); + + // Various Events + + Hook := QObject_hook_create(QtPushButton.Widget); + + TEventFilterMethod(Method) := QtPushButton.EventFilter; + + QObject_hook_hook_events(Hook, Method); + + // OnClick Event + + QAbstractButton_clicked2_Event(Method) := QtPushButton.SlotClicked; + + QAbstractButton_hook_hook_clicked2(QAbstractButton_hook_create(QtPushButton.Widget), Method); + + // Focus + + QWidget_setFocusPolicy(QtPushButton.Widget, QtStrongFocus); + + // Returns the Handle + + Result := THandle(QtPushButton); +end; + +{------------------------------------------------------------------------------ + Function: TQtWSButton.DestroyHandle + Params: None + Returns: Nothing + + Releases allocated memory and resources + ------------------------------------------------------------------------------} +class procedure TQtWSButton.DestroyHandle(const AWinControl: TWinControl); +begin + TQtPushButton(AWinControl.Handle).Free; + + AWinControl.Handle := 0; +end; + +{------------------------------------------------------------------------------ + Function: TQtWSButton.GetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class function TQtWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; +var + Str: WideString; +begin + Result := False; + + if not WSCheckHandleAllocated(AWincontrol, 'GetText') then Exit; + + TQtAbstractButton(AWinControl.Handle).Text(@Str); + + AText := UTF8Encode(Str); + + Result := True; +end; + +{------------------------------------------------------------------------------ + Function: TQtWSButton.SetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class procedure TQtWSButton.SetText(const AWinControl: TWinControl; const AText: String); +var + Str: WideString; +begin + if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit; + + Str := UTF8Decode(AText); + + TQtAbstractButton(AWinControl.Handle).SetText(@Str); +end; + +{------------------------------------------------------------------------------ + Method: TQtWSButton.SetColor + Params: AWinControl - the calling object + + Returns: Nothing + + Sets the color of the widget. + ------------------------------------------------------------------------------} +class procedure TQtWSButton.SetColor(const AWinControl: TWinControl); +var + QColor: TQColor; + Color: TColor; +begin + if not WSCheckHandleAllocated(AWincontrol, 'SetColor') then Exit; + + if AWinControl.Color = CLR_INVALID then exit; + + // Get the color numeric value (system colors are mapped to numeric colors depending on the widget style) + Color:=ColorToRGB(AWinControl.Color); + + // Fill QColor + QColor_setRgb(@QColor,Red(Color),Green(Color),Blue(Color)); + + // Set color of the widget to QColor + TQtAbstractButton(AWinControl.Handle).SetColor(@QColor); +end; + { TQtWSCustomCheckBox } {------------------------------------------------------------------------------ @@ -1394,6 +1529,7 @@ initialization // RegisterWSComponent(TCustomLabel, TQtWSCustomLabel); // RegisterWSComponent(TLabel, TQtWSLabel); // RegisterWSComponent(TButtonControl, TQtWSButtonControl); + RegisterWSComponent(TCustomButton, TQtWSButton); RegisterWSComponent(TCustomCheckBox, TQtWSCustomCheckBox); // RegisterWSComponent(TCheckBox, TQtWSCheckBox); // RegisterWSComponent(TCheckBox, TQtWSCheckBox); diff --git a/lcl/interfaces/win32/win32wsbuttons.pp b/lcl/interfaces/win32/win32wsbuttons.pp index cdf7939c97..c319d6e8e0 100644 --- a/lcl/interfaces/win32/win32wsbuttons.pp +++ b/lcl/interfaces/win32/win32wsbuttons.pp @@ -40,19 +40,6 @@ uses type - { TWin32WSButton } - - TWin32WSButton = class(TWSButton) - private - protected - public - class function CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): HWND; override; - class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override; - class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; - class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override; - end; - { TWin32WSBitBtn } TWin32WSBitBtn = class(TWSBitBtn) @@ -86,61 +73,6 @@ implementation uses Win32Int, InterfaceBase, Win32Proc; -{ TWin32WSButton } - -class function TWin32WSButton.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): HWND; -var - Params: TCreateWindowExParams; -begin - // general initialization of Params - PrepareCreateWindow(AWinControl, Params); - // customization of Params - with Params do - begin - if TCustomButton(AWinControl).Default Then - Flags := Flags or BS_DEFPUSHBUTTON - else - Flags := Flags or BS_PUSHBUTTON; - with Params do {BidiMode} - begin - if AWinControl.UseRightToLeftReading then - FlagsEx := FlagsEx or WS_EX_RTLREADING; - end; - pClassName := 'BUTTON'; - WindowTitle := StrCaption; - end; - // create window - FinishCreateWindow(AWinControl, Params, false); - Result := Params.Window; -end; - -class procedure TWin32WSButton.SetBiDiMode(const AWinControl: TWinControl; - const ABiDiMode: TBiDiMode); -begin - RecreateWnd(AWinControl); -end; - -class procedure TWin32WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); -var - WindowStyle: dword; -begin - if not WSCheckHandleAllocated(AButton, 'SetDefault') then Exit; - - WindowStyle := GetWindowLong(AButton.Handle, GWL_STYLE) and not (BS_DEFPUSHBUTTON or BS_PUSHBUTTON); - if ADefault then - WindowStyle := WindowStyle or BS_DEFPUSHBUTTON - else - WindowStyle := WindowStyle or BS_PUSHBUTTON; - Windows.SendMessage(AButton.Handle, BM_SETSTYLE, WindowStyle, 1); -end; - -class procedure TWin32WSButton.SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); -begin - if not WSCheckHandleAllocated(AButton, 'SetShortcut') then Exit; - // TODO: implement me! -end; - { TWin32WSBitBtn } const @@ -588,7 +520,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(TCustomButton, TWin32WSButton); RegisterWSComponent(TCustomBitBtn, TWin32WSBitBtn); // RegisterWSComponent(TCustomSpeedButton, TWin32WSSpeedButton); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/win32/win32wsstdctrls.pp b/lcl/interfaces/win32/win32wsstdctrls.pp index 67eb41e504..5609bf42bf 100644 --- a/lcl/interfaces/win32/win32wsstdctrls.pp +++ b/lcl/interfaces/win32/win32wsstdctrls.pp @@ -233,6 +233,19 @@ type WithThemeSpace: Boolean); override; end; + { TWin32WSButton } + + TWin32WSButton = class(TWSButton) + private + protected + public + class function CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): HWND; override; + class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override; + class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; + class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override; + end; + { TWin32WSCustomCheckBox } TWin32WSCustomCheckBox = class(TWSCustomCheckBox) @@ -1092,6 +1105,61 @@ begin end; end; +{ TWin32WSButton } + +class function TWin32WSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): HWND; +var + Params: TCreateWindowExParams; +begin + // general initialization of Params + PrepareCreateWindow(AWinControl, Params); + // customization of Params + with Params do + begin + if TCustomButton(AWinControl).Default Then + Flags := Flags or BS_DEFPUSHBUTTON + else + Flags := Flags or BS_PUSHBUTTON; + with Params do {BidiMode} + begin + if AWinControl.UseRightToLeftReading then + FlagsEx := FlagsEx or WS_EX_RTLREADING; + end; + pClassName := 'BUTTON'; + WindowTitle := StrCaption; + end; + // create window + FinishCreateWindow(AWinControl, Params, false); + Result := Params.Window; +end; + +class procedure TWin32WSButton.SetBiDiMode(const AWinControl: TWinControl; + const ABiDiMode: TBiDiMode); +begin + RecreateWnd(AWinControl); +end; + +class procedure TWin32WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); +var + WindowStyle: dword; +begin + if not WSCheckHandleAllocated(AButton, 'SetDefault') then Exit; + + WindowStyle := GetWindowLong(AButton.Handle, GWL_STYLE) and not (BS_DEFPUSHBUTTON or BS_PUSHBUTTON); + if ADefault then + WindowStyle := WindowStyle or BS_DEFPUSHBUTTON + else + WindowStyle := WindowStyle or BS_PUSHBUTTON; + Windows.SendMessage(AButton.Handle, BM_SETSTYLE, WindowStyle, 1); +end; + +class procedure TWin32WSButton.SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); +begin + if not WSCheckHandleAllocated(AButton, 'SetShortcut') then Exit; + // TODO: implement me! +end; + { TWin32WSCustomCheckBox } class function TWin32WSCustomCheckBox.CreateHandle(const AWinControl: TWinControl; @@ -1231,6 +1299,7 @@ initialization // RegisterWSComponent(TEdit, TWin32WSEdit); // RegisterWSComponent(TMemo, TWin32WSMemo); RegisterWSComponent(TButtonControl, TWin32WSButtonControl); + RegisterWSComponent(TCustomButton, TWin32WSButton); RegisterWSComponent(TCustomCheckBox, TWin32WSCustomCheckBox); // RegisterWSComponent(TCheckBox, TWin32WSCheckBox); // RegisterWSComponent(TCheckBox, TWin32WSCheckBox); diff --git a/lcl/interfaces/wince/wincewsbuttons.pp b/lcl/interfaces/wince/wincewsbuttons.pp index 8c8f46021c..e497b6d8d6 100644 --- a/lcl/interfaces/wince/wincewsbuttons.pp +++ b/lcl/interfaces/wince/wincewsbuttons.pp @@ -35,24 +35,6 @@ uses WSButtons, WSLCLClasses; type - { TWinCEWSButton } - - TWinCEWSButton = class(TWSButton) - private - protected - public - class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; - class procedure DestroyHandle(const AWinControl: TWinControl); override; - class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; -// class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; -// class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; - class procedure SetText(const AWinControl: TWinControl; const AText: String); override; -// class procedure GetPreferredSize(const AWinControl: TWinControl; -// var PreferredWidth, PreferredHeight: integer); override; - end; - - { TWinCEWBitBtn } - { TWinCEWSBitBtn } TWinCEWSBitBtn = class(TWSBitBtn) @@ -90,96 +72,6 @@ uses WinCEInt,WinCEWinAPIEmu; -{ TWinCEWSButton } - -{------------------------------------------------------------------------------ - Function: TWinCEWSButton.CreateHandle - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class function TWinCEWSButton.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): TLCLIntfHandle; -var - Params: TCreateWindowExParams; - str : array[0..255] of WideChar; -begin - {$ifdef VerboseWinCE} - WriteLn('TWinCEWSButton.CreateHandle'); - {$endif} - - // general initialization of Params - PrepareCreateWindow(AWinControl, Params); - - // customization of Params - with Params do - begin - // if TCustomButton(AWinControl).Default Then - // Flags := Flags or BS_DEFPUSHBUTTON - // else - // Flags := Flags or BS_PUSHBUTTON; - Flags := WS_CHILD or WS_VISIBLE; - pClassName := @ButtonClsName; - WindowTitle := StringToPWideChar(StrCaption); - Left := AWinControl.Left; - Top := AWinControl.Top; - Width := AWinControl.Width; - Height := AWinControl.Height; - Parent := AWinControl.Parent.Handle; - MenuHandle := 0; - end; - - // create window - FinishCreateWindow(AWinControl, Params, false); - Result := Params.Window; - - {$ifdef VerboseWinCE} - WriteLn('End Create Button. Handle = ' + IntToStr(Result) + - ' Left ' + IntToStr(AWinControl.Left) + - ' Top ' + IntToStr(AWinControl.Top) + - ' Width ' + IntToStr(AWinControl.Width) + - ' Height ' + IntToStr(AWinControl.Height) + - ' ParentHandle ' + IntToStr(AWinControl.Parent.Handle)); - {$endif} -end; - -{------------------------------------------------------------------------------ - Function: TWinCEWSButton.DestroyHandle - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class procedure TWinCEWSButton.DestroyHandle(const AWinControl: TWinControl); -begin -end; - -{------------------------------------------------------------------------------ - Function: TWinCEWSButton.GetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class function TWinCEWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; -var -tmpStr : PWideChar; -begin - tmpstr := PWideChar(SysAllocStringLen(nil,256)); - Result := Boolean(Windows.GetWindowText(AWinControl.Handle,tmpStr,256)); - AText := String(tmpStr); - SysFreeString(tmpStr); -end; - -{------------------------------------------------------------------------------ - Function: TWinCEWSButton.SetText - Params: None - Returns: Nothing - ------------------------------------------------------------------------------} -class procedure TWinCEWSButton.SetText(const AWinControl: TWinControl; const AText: String); -var -tmpStr : PWideChar; -begin - tmpstr := StringToPWideChar(AText); - Windows.SetWindowText(AWinControl.Handle,tmpStr); - FreeMem(tmpStr); -end; - { TWinCEWSBitBtn } const BUTTON_IMAGELIST_ALIGN_LEFT = 0; @@ -652,7 +544,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(TCustomButton, TWinCEWSButton); RegisterWSComponent(TCustomBitBtn, TWinCEWSBitBtn); // RegisterWSComponent(TCustomSpeedButton, TWinCEWSSpeedButton); //////////////////////////////////////////////////// diff --git a/lcl/interfaces/wince/wincewsstdctrls.pp b/lcl/interfaces/wince/wincewsstdctrls.pp index 4a0d698f88..ead38ac145 100644 --- a/lcl/interfaces/wince/wincewsstdctrls.pp +++ b/lcl/interfaces/wince/wincewsstdctrls.pp @@ -220,6 +220,21 @@ type WithThemeSpace: Boolean); override; end; + { TWinCEWSButton } + + TWinCEWSButton = class(TWSButton) + private + protected + public + class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; + class procedure DestroyHandle(const AWinControl: TWinControl); override; + class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override; +// class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override; +// class procedure SetShortcut(const AButton: TCustomButton; const OldShortcut, NewShortcut: TShortcut); override; + class procedure SetText(const AWinControl: TWinControl; const AText: String); override; +// class procedure GetPreferredSize(const AWinControl: TWinControl; +// var PreferredWidth, PreferredHeight: integer); override; + end; { TWinCEWSCustomCheckBox } TWinCEWSCustomCheckBox = class(TWSCustomCheckBox) @@ -1007,6 +1022,96 @@ begin end; +{ TWinCEWSButton } + +{------------------------------------------------------------------------------ + Function: TWinCEWSButton.CreateHandle + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class function TWinCEWSButton.CreateHandle(const AWinControl: TWinControl; + const AParams: TCreateParams): TLCLIntfHandle; +var + Params: TCreateWindowExParams; + str : array[0..255] of WideChar; +begin + {$ifdef VerboseWinCE} + WriteLn('TWinCEWSButton.CreateHandle'); + {$endif} + + // general initialization of Params + PrepareCreateWindow(AWinControl, Params); + + // customization of Params + with Params do + begin + // if TCustomButton(AWinControl).Default Then + // Flags := Flags or BS_DEFPUSHBUTTON + // else + // Flags := Flags or BS_PUSHBUTTON; + Flags := WS_CHILD or WS_VISIBLE; + pClassName := @ButtonClsName; + WindowTitle := StringToPWideChar(StrCaption); + Left := AWinControl.Left; + Top := AWinControl.Top; + Width := AWinControl.Width; + Height := AWinControl.Height; + Parent := AWinControl.Parent.Handle; + MenuHandle := 0; + end; + + // create window + FinishCreateWindow(AWinControl, Params, false); + Result := Params.Window; + + {$ifdef VerboseWinCE} + WriteLn('End Create Button. Handle = ' + IntToStr(Result) + + ' Left ' + IntToStr(AWinControl.Left) + + ' Top ' + IntToStr(AWinControl.Top) + + ' Width ' + IntToStr(AWinControl.Width) + + ' Height ' + IntToStr(AWinControl.Height) + + ' ParentHandle ' + IntToStr(AWinControl.Parent.Handle)); + {$endif} +end; + +{------------------------------------------------------------------------------ + Function: TWinCEWSButton.DestroyHandle + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class procedure TWinCEWSButton.DestroyHandle(const AWinControl: TWinControl); +begin +end; + +{------------------------------------------------------------------------------ + Function: TWinCEWSButton.GetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class function TWinCEWSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean; +var +tmpStr : PWideChar; +begin + tmpstr := PWideChar(SysAllocStringLen(nil,256)); + Result := Boolean(Windows.GetWindowText(AWinControl.Handle,tmpStr,256)); + AText := String(tmpStr); + SysFreeString(tmpStr); +end; + +{------------------------------------------------------------------------------ + Function: TWinCEWSButton.SetText + Params: None + Returns: Nothing + ------------------------------------------------------------------------------} +class procedure TWinCEWSButton.SetText(const AWinControl: TWinControl; const AText: String); +var +tmpStr : PWideChar; +begin + tmpstr := StringToPWideChar(AText); + Windows.SetWindowText(AWinControl.Handle,tmpStr); + FreeMem(tmpStr); +end; + { TWinCEWSCustomCheckBox } class function TWinCEWSCustomCheckBox.CreateHandle(const AWinControl: TWinControl; @@ -1154,6 +1259,7 @@ initialization // RegisterWSComponent(TEdit, TWinCEWSEdit); // RegisterWSComponent(TMemo, TWinCEWSMemo); // RegisterWSComponent(TButtonControl, TWinCEWSButtonControl); + RegisterWSComponent(TCustomButton, TWinCEWSButton); RegisterWSComponent(TCustomCheckBox, TWinCEWSCustomCheckBox); // RegisterWSComponent(TCheckBox, TWinCEWSCheckBox); RegisterWSComponent(TToggleBox, TWinCEWSToggleBox); diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index f81e7179f5..38eaac0bbd 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -32,7 +32,7 @@ interface uses Classes, SysUtils, LCLStrConsts, LCLType, LCLProc, LMessages, Graphics, GraphType, ExtendedStrings, LCLIntf, ClipBrd, ActnList, Controls, - Forms; + Forms, Menus; type @@ -217,7 +217,6 @@ type property OnUnDock; end; - { TCustomComboBox } TComboBoxAutoCompleteTextOption = ( cbactEnabled,//Enable Auto-Completion Feature @@ -973,6 +972,98 @@ type TButtonActionLinkClass = class of TButtonActionLink; + { TCustomButton } + + TCustomButton = class(TButtonControl) + private + FCancel: Boolean; + FDefault: Boolean; + FActive: boolean; + FModalResult: TModalResult; + FShortCut: TShortcut; + procedure SetCancel(NewCancel: boolean); + procedure SetDefault(Value: Boolean); + procedure SetModalResult(const AValue: TModalResult); + procedure CMUIActivate(var Message: TLMessage); message CM_UIACTIVATE; + procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED; + procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; + protected + procedure Click; override; + procedure CreateWnd; override; + procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override; + procedure ControlKeyUp(var Key: Word; Shift: TShiftState); override; + procedure SetParent(AParent: TWinControl); override; + procedure RealSetText(const Value: TCaption); override; + procedure WSSetDefault; + function DialogChar(var Message: TLMKey): boolean; override; + function ChildClassAllowed(ChildClass: TClass): boolean; override; + function IsBorderSpacingInnerBorderStored: Boolean; override; + property ParentColor default false; + public + constructor Create(TheOwner: TComponent); override; + procedure ExecuteDefaultAction; override; + procedure ExecuteCancelAction; override; + procedure ActiveDefaultControlChanged(NewControl: TControl); override; + procedure UpdateRolesForForm; override; + public + property Active: boolean read FActive stored false; + property Default: Boolean read FDefault write SetDefault default false; + property ModalResult: TModalResult read FModalResult write SetModalResult default mrNone; + property Cancel: Boolean read FCancel write SetCancel default false; + property Color default clBtnFace; + property TabStop default true; + end; + + + { TButton } + + TButton = class(TCustomButton) + public + procedure Click; override; + published + property Action; + property Align; + property Anchors; + property AutoSize; + property BidiMode; + property BorderSpacing; + property Cancel; + property Caption; + property Color; + property Constraints; + property Default; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property ParentBidiMode; + property ModalResult; + property OnChangeBounds; + property OnClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnResize; + property OnStartDrag; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + end; + { TCustomCheckBox } // ToDo: delete TLeftRight when in classesh.inc @@ -1360,7 +1451,7 @@ type procedure Register; begin - RegisterComponents('Standard',[TLabel,TEdit,TMemo,TToggleBox,TCheckBox, + RegisterComponents('Standard',[TButton, TLabel,TEdit,TMemo,TToggleBox,TCheckBox, TRadioButton,TListBox,TComboBox,TScrollBar,TGroupBox]); RegisterComponents('Additional',[TStaticText]); end; @@ -1380,7 +1471,9 @@ end; {$I memostrings.inc} {$I edit.inc} + {$I buttoncontrol.inc} +{$I buttons.inc} {$I checkbox.inc} diff --git a/lcl/widgetset/wsbuttons.pp b/lcl/widgetset/wsbuttons.pp index 3067c2bb5e..5887b521ad 100644 --- a/lcl/widgetset/wsbuttons.pp +++ b/lcl/widgetset/wsbuttons.pp @@ -50,15 +50,7 @@ uses type - { TWSButton } - - TWSButton = class(TWSButtonControl) - class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); virtual; - class procedure SetShortCut(const AButton: TCustomButton; const OldShortCut, NewShortCut: TShortCut); virtual; - end; - TWSButtonClass = class of TWSButton; - - { TWSBitBtn } + { TWSBitBtn } TWSBitBtnClass = class of TWSBitBtn; TWSBitBtn = class(TWSButton) @@ -79,16 +71,6 @@ implementation // TODO: Can't be virtual abstract ? -{ TWSButton } - -class procedure TWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); -begin -end; - -class procedure TWSButton.SetShortCut(const AButton: TCustomButton; const OldShortCut, NewShortCut: TShortCut); -begin -end; - { TWSCustomBitBtn } class procedure TWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; diff --git a/lcl/widgetset/wsstdctrls.pp b/lcl/widgetset/wsstdctrls.pp index f8c7239ceb..44672d57fe 100644 --- a/lcl/widgetset/wsstdctrls.pp +++ b/lcl/widgetset/wsstdctrls.pp @@ -178,6 +178,14 @@ type TWSButtonControl = class(TWSWinControl) end; + { TWSButton } + + TWSButton = class(TWSButtonControl) + class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); virtual; + class procedure SetShortCut(const AButton: TCustomButton; const OldShortCut, NewShortCut: TShortCut); virtual; + end; + TWSButtonClass = class of TWSButton; + { TWSCustomCheckBox } TWSCustomCheckBox = class(TWSButtonControl) @@ -434,6 +442,16 @@ class procedure TWSCustomStaticText.SetAlignment(const ACustomStaticText: TCusto begin end; +{ TWSButton } + +class procedure TWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean); +begin +end; + +class procedure TWSButton.SetShortCut(const AButton: TCustomButton; const OldShortCut, NewShortCut: TShortCut); +begin +end; + { TWSCustomCheckBox } class function TWSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;