paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 15:36:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: moved TButton from buttons unit to stdctrls (bug #9137), compilation tested on windows for gtk2, qt and win32 widgetset

Browse Source 
git-svn-id: trunk@11367 -
This commit is contained in:
vincents 2007-06-25 08:34:41 +00:00
parent a30cb0f175
commit baebd22616
19 changed files with 718 additions and 675 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
lcl/buttons.pp
View File

@ -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}

4
lcl/include/buttons.inc
View File

@ -1,4 +1,6 @@
{%MainUnit ../buttons.pp}
{%MainUnit ../stdctrls.pp}
{ $Id$}
{******************************************************************************
TCustomButton
******************************************************************************

11
lcl/interfaces/carbon/carbonwsbuttons.pp
View File

@ -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);
////////////////////////////////////////////////////

43
lcl/interfaces/carbon/carbonwsstdctrls.pp
View File

@ -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);

50
lcl/interfaces/fpgui/fpguiwsbuttons.pp
View File

@ -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);
////////////////////////////////////////////////////

50
lcl/interfaces/fpgui/fpguiwsstdctrls.pp
View File

@ -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);

168
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -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);

185
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -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);

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

@ -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.
end.

9
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -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);

136
lcl/interfaces/qt/qtwsbuttons.pp
View File

@ -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);
////////////////////////////////////////////////////

138
lcl/interfaces/qt/qtwsstdctrls.pp
View File

@ -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);

69
lcl/interfaces/win32/win32wsbuttons.pp
View File

@ -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);
////////////////////////////////////////////////////

69
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -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);

109
lcl/interfaces/wince/wincewsbuttons.pp
View File

@ -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);
////////////////////////////////////////////////////

106
lcl/interfaces/wince/wincewsstdctrls.pp
View File

@ -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);

99
lcl/stdctrls.pp
View File

@ -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}

20
lcl/widgetset/wsbuttons.pp
View File

@ -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;

18
lcl/widgetset/wsstdctrls.pp
View File

@ -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;