paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 14:18:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* made ActiveDefaultButtonChanged naming more consistent with other routines

Browse Source 
* added some handle checks

git-svn-id: trunk@10733 -
This commit is contained in:
marc 2007-03-10 02:48:32 +00:00
parent c9f940ca40
commit e4deb6932e
8 changed files with 76 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/buttons.pp
View File

@ -77,11 +77,11 @@ type
protected
procedure Click; override;
procedure CreateWnd; override;
procedure DoSendBtnDefault; virtual;
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;

28
lcl/include/buttons.inc
View File

@ -49,16 +49,7 @@ begin
inherited CreateWnd;
//this is done in TWinControl
//SetText(Caption);//To ensure shortcut is set
DoSendBtnDefault;
end;
{------------------------------------------------------------------------------
procedure TCustomButton.DoSendBtnDefault;
------------------------------------------------------------------------------}
procedure TCustomButton.DoSendBtnDefault;
begin
if HandleAllocated then
TWSButtonClass(WidgetSetClass).ActiveDefaultButtonChanged(Self);
WSSetDefault;
end;
procedure TCustomButton.ControlKeyDown(var Key: Word; Shift: TShiftState);
@ -89,7 +80,7 @@ begin
if FCancel then
Form.CancelControl := Self;
end;
DoSendBtnDefault;
WSSetDefault;
end;
procedure TCustomButton.UpdateRolesForForm;
@ -149,7 +140,7 @@ begin
else
Form.DefaultControl := nil;
end;
DoSendBtnDefault;
WSSetDefault;
end;
procedure TCustomButton.SetModalResult(const AValue: TModalResult);
@ -219,7 +210,7 @@ begin
FActive := FDefault;
end;
if lPrevActive <> FActive then
DoSendBtnDefault;
WSSetDefault;
end;
procedure TCustomButton.CMUIActivate(var Message: TLMessage);
@ -258,7 +249,7 @@ begin
lForm := GetParentForm(Self);
if (lForm <> nil) and (lForm.ActiveDefaultControl = Self) then
lForm.ActiveDefaultControl := nil;
DoSendBtnDefault;
WSSetDefault;
end;
end;
end;
@ -292,6 +283,15 @@ begin
Result:=BorderSpacing.InnerBorder<>2;
end;
{------------------------------------------------------------------------------
procedure TCustomButton.DoSendBtnDefault;
------------------------------------------------------------------------------}
procedure TCustomButton.WSSetDefault;
begin
if HandleAllocated then
TWSButtonClass(WidgetSetClass).SetDefault(Self, FDefault);
end;
{ TButton }

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

@ -46,7 +46,7 @@ type
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); override;
class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
end;
{ TCarbonWSBitBtn }
@ -108,22 +108,18 @@ begin
end;
{------------------------------------------------------------------------------
Method: TCarbonWSButton.ActiveDefaultButtonChanged
Method: TCarbonWSButton.SetDefault
Params: AButton - LCL button control
Returns: Nothing
Updates default button indication
------------------------------------------------------------------------------}
class procedure TCarbonWSButton.ActiveDefaultButtonChanged(
const AButton: TCustomButton);
var
ADefault: Boolean;
class procedure TCarbonWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
begin
if not WSCheckHandleAllocated(AButton, 'ActiveDefaultButtonChanged') then Exit;
if not WSCheckHandleAllocated(AButton, 'SetDefault') then Exit;
ADefault := AButton.Default;
SetControlData(ControlRef(AButton.Handle), kControlEntireControl,
kControlPushButtonDefaultTag, SizeOf(Boolean), @ADefault);
kControlPushButtonDefaultTag, SizeOf(ADefault), @ADefault);
end;

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

@ -58,15 +58,16 @@ type
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); override;
class function GetText(const AWinControl: TWinControl; var AText: String): 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 SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont : tFont); 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 }
@ -145,9 +146,18 @@ begin
SetCallbacks(PGtkWidget(Result), WidgetInfo);
end;
class procedure TGtkWSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
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 (AButton.Active)
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
@ -160,12 +170,6 @@ begin
end;
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.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin

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

@ -32,7 +32,7 @@ uses
// LCL
SysUtils, Controls, LCLType, Forms, InterfaceBase, Buttons, LMessages, Graphics,
// Widgetset
WSButtons, WSLCLClasses;
WSProc, WSButtons, WSLCLClasses;
type
@ -44,8 +44,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
// class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); 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;
@ -61,8 +61,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
// class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); 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;
@ -147,6 +147,10 @@ class function TQtWSButton.GetText(const AWinControl: TWinControl; var AText: St
var
Str: WideString;
begin
Result := False;
if not WSCheckHandleAllocated(AWincontrol, 'GetText')
then Exit;
TQtAbstractButton(AWinControl.Handle).Text(@Str);
AText := UTF8Encode(Str);
@ -163,6 +167,9 @@ class procedure TQtWSButton.SetText(const AWinControl: TWinControl; const AText:
var
Str: WideString;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
Str := UTF8Decode(AText);
TQtAbstractButton(AWinControl.Handle).SetText(@Str);
@ -181,9 +188,8 @@ var
QColor: TQColor;
Color: TColor;
begin
if AWinControl = nil then exit;
if not AWinControl.HandleAllocated then exit;
if not WSCheckHandleAllocated(AWincontrol, 'SetColor')
then Exit;
if AWinControl.Color = CLR_INVALID then exit;
@ -261,6 +267,10 @@ class function TQtWSBitBtn.GetText(const AWinControl: TWinControl; var AText: St
var
Str: WideString;
begin
Result := False;
if not WSCheckHandleAllocated(AWincontrol, 'GetText')
then Exit;
TQtAbstractButton(AWinControl.Handle).Text(@Str);
AText := UTF8Encode(Str);
@ -278,6 +288,8 @@ class procedure TQtWSBitBtn.SetText(const AWinControl: TWinControl;
var
Str: WideString;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
Str := UTF8Decode(AText);
TQtAbstractButton(AWinControl.Handle).SetText(@Str);
@ -296,9 +308,8 @@ var
QColor: TQColor;
Color: TColor;
begin
if AWinControl = nil then exit;
if not AWinControl.HandleAllocated then exit;
if not WSCheckHandleAllocated(AWincontrol, 'SetColor')
then Exit;
if AWinControl.Color = CLR_INVALID then exit;

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

@ -35,7 +35,8 @@ uses
////////////////////////////////////////////////////
Windows, Buttons, Graphics, Controls,
////////////////////////////////////////////////////
WSControls, WSButtons, WSLCLClasses, Win32WSControls, LCLType;
WSProc, WSControls, WSButtons, WSLCLClasses,
Win32WSControls, LCLType;
type
@ -47,7 +48,7 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); override;
class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override;
end;
@ -108,12 +109,14 @@ begin
Result := Params.Window;
end;
class procedure TWin32WSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
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 AButton.Active then
if ADefault then
WindowStyle := WindowStyle or BS_DEFPUSHBUTTON
else
WindowStyle := WindowStyle or BS_PUSHBUTTON;
@ -122,6 +125,7 @@ end;
class procedure TWin32WSButton.SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word);
begin
if not WSCheckHandleAllocated(AButton, 'SetShortcut') then Exit;
// TODO: implement me!
end;
@ -515,6 +519,7 @@ end;
class procedure TWin32WSBitBtn.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: integer);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetBounds') then Exit;
TWin32WSWinControl.SetBounds(AWinControl, ALeft, ATop, AWidth, AHeight);
if TCustomBitBtn(AWinControl).Spacing = -1 then
DrawBitBtnImage(TCustomBitBtn(AWinControl), PChar(AWinControl.Caption));
@ -523,6 +528,7 @@ end;
class procedure TWin32WSBitBtn.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetFont') then Exit;
TWin32WSWinControl.SetFont(AWinControl, AFont);
DrawBitBtnImage(TCustomBitBtn(AWinControl), PChar(AWinControl.Caption));
end;
@ -530,29 +536,34 @@ end;
class procedure TWin32WSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph') then Exit;
DrawBitBtnImage(ABitBtn, PChar(ABitBtn.Caption));
end;
class procedure TWin32WSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
const AValue: TButtonLayout);
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetLayout') then Exit;
DrawBitBtnImage(ABitBtn, PChar(ABitBtn.Caption));
end;
class procedure TWin32WSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn;
const AValue: Integer);
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetMargin') then Exit;
DrawBitBtnImage(ABitBtn, PChar(ABitBtn.Caption));
end;
class procedure TWin32WSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn;
const AValue: Integer);
begin
if not WSCheckHandleAllocated(ABitBtn, 'SetSpacing') then Exit;
DrawBitBtnImage(ABitBtn, PChar(ABitBtn.Caption));
end;
class procedure TWin32WSBitBtn.SetText(const AWinControl: TWinControl; const AText: string);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetText') then Exit;
DrawBitBtnImage(TCustomBitBtn(AWinControl), PChar(AText));
end;

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

@ -43,8 +43,8 @@ type
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
// class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); 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;

4
lcl/widgetset/wsbuttons.pp
View File

@ -53,7 +53,7 @@ type
{ TWSButton }
TWSButton = class(TWSButtonControl)
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); virtual;
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;
@ -80,7 +80,7 @@ implementation
{ TWSButton }
class procedure TWSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
class procedure TWSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
begin
end;