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

implement active default control switching

Browse Source 
pressing return key executes active default control action

git-svn-id: trunk@7080 -
This commit is contained in:
micha 2005-04-17 18:41:15 +00:00
parent d63fd7f7dd
commit fbb495bee3
11 changed files with 130 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/buttons.pp
View File

@ -65,12 +65,15 @@ type
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;
@ -84,8 +87,10 @@ type
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 Color default clBtnFace;
property Default: Boolean read FDefault write SetDefault default false;
property ModalResult: TModalResult read FModalResult write SetModalResult default mrNone;
@ -399,6 +404,10 @@ end.
{ =============================================================================
$Log$
Revision 1.94 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.93 2005/03/23 10:45:06 mattias
fixed ambigious with ambiguous

5
lcl/controls.pp
View File

@ -1057,6 +1057,7 @@ type
procedure SendToBack;
procedure SetTempCursor(Value: TCursor);
procedure UpdateRolesForForm; virtual;
procedure ActiveDefaultControlChanged(NewControl: TControl); virtual;
function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
function GetTextLen: Integer; virtual;
Procedure SetTextBuf(Buffer: PChar); virtual;
@ -2890,6 +2891,10 @@ end.
{ =============================================================================
$Log$
Revision 1.295 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.294 2005/04/04 11:43:36 mattias
fixed compilation and designtime drawing of gtkglarea

5
lcl/extctrls.pp
View File

@ -837,6 +837,7 @@ type
property Color;
property Constraints;
//property EditLabel; sub components not implemented in FCL
property EditLabel;
property Enabled;
property LabelPosition;
property LabelSpacing;
@ -996,6 +997,10 @@ end.
{
$Log$
Revision 1.135 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.134 2005/03/25 17:47:55 mattias
implemented TMemo text for gtk2, TRadioGroup.OnClick is now called whenever ItemIndex changed, so it works now also under gtk2 Delphi compatible from Andrew Haines

3
lcl/forms.pp
View File

@ -371,6 +371,7 @@ type
private
FActive: Boolean;
FActiveControl: TWinControl;
FActiveDefaultControl: TControl;
FBorderIcons: TBorderIcons;
FDefaultControl: TControl;
FCancelControl: TControl;
@ -417,6 +418,7 @@ type
function GetShowInTaskBarDefault: boolean;
procedure SetActive(AValue: Boolean);
procedure SetActiveControl(AWinControl: TWinControl);
procedure SetActiveDefaultControl(AControl: TControl);
procedure SetBorderIcons(NewIcons: TBorderIcons);
procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
procedure SetCancelControl(NewControl: TControl);
@ -517,6 +519,7 @@ type
public
property Active: Boolean read FActive;
property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
property ActiveDefaultControl: TControl read FActiveDefaultControl write SetActiveDefaultControl;
property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons
default [biSystemMenu, biMinimize, biMaximize];
property BorderStyle: TFormBorderStyle

24
lcl/include/application.inc
View File

@ -1329,18 +1329,24 @@ procedure TApplication.DoReturnKey(AControl: TWinControl; var Key: Word;
Shift: TShiftState);
var
Form: TCustomForm;
lDefaultControl: TControl;
begin
if (Shift = []) and (Key = VK_RETURN) then begin
Form := GetParentForm(AControl);
if Form<>nil then begin
if (anoReturnForDefaultControl in Navigation)
and (Form.DefaultControl <> nil)
and ((Form.DefaultControl.Parent = nil) or (Form.DefaultControl.Parent.CanFocus))
and Form.DefaultControl.Enabled and Form.DefaultControl.Visible then
if anoReturnForDefaultControl in Navigation then
begin
//debugln('TApplication.ControlKeyUp VK_RETURN ', Acontrol.Name);
Form.DefaultControl.ExecuteDefaultAction;
Key := VK_UNKNOWN;
lDefaultControl := Form.ActiveDefaultControl;
if lDefaultControl = nil then
lDefaultControl := Form.DefaultControl;
if (lDefaultControl <> nil)
and ((lDefaultControl.Parent = nil) or (lDefaultControl.Parent.CanFocus))
and lDefaultControl.Enabled and lDefaultControl.Visible then
begin
//debugln('TApplication.ControlKeyUp VK_RETURN ', Acontrol.Name);
lDefaultControl.ExecuteDefaultAction;
Key := VK_UNKNOWN;
end;
end;
end;
end;
@ -1455,6 +1461,10 @@ end;
{ =============================================================================
$Log$
Revision 1.116 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.115 2005/04/12 10:02:47 micha
when executing defaultcontrol action, check if control visible

60
lcl/include/buttons.inc
View File

@ -55,7 +55,7 @@ end;
procedure TCustomButton.DoSendBtnDefault;
begin
if HandleAllocated then
TWSButtonClass(WidgetSetClass).DefaultButtonChanged(Self);
TWSButtonClass(WidgetSetClass).ActiveDefaultButtonChanged(Self);
end;
procedure TCustomButton.ControlKeyDown(var Key: Word; Shift: TShiftState);
@ -157,7 +157,7 @@ end;
procedure TCustomButton.ExecuteDefaultAction;
begin
if FDefault then
if FActive then
Click;
end;
@ -186,6 +186,39 @@ Begin
inherited Click;
end;
procedure TCustomButton.ActiveDefaultControlChanged(NewControl: TControl);
var
lPrevActive: boolean;
lForm: TCustomForm;
begin
lPrevActive := FActive;
if NewControl = Self then
begin
FActive := true;
lForm := GetParentForm(Self);
if lForm <> nil then
lForm.ActiveDefaultControl := Self;
end else
if NewControl <> nil then
begin
FActive := false;
end else begin
FActive := FDefault;
end;
if lPrevActive <> FActive then
DoSendBtnDefault;
end;
procedure TCustomButton.CMUIActivate(var Message: TLMessage);
var
lForm: TCustomForm;
begin
lForm := GetParentForm(Self);
if lForm = nil then exit;
ActiveDefaultControlChanged(lForm.ActiveControl);
end;
{------------------------------------------------------------------------------
Method: TCustomButton.CMDefaultClicked
Params: None
@ -198,6 +231,25 @@ begin
Click;
end;
procedure TCustomButton.WMKillFocus(var Message: TLMKillFocus);
var
lForm: TCustomForm;
begin
inherited;
if FActive then
begin
FActive := FDefault;
if not FActive then
begin
lForm := GetParentForm(Self);
if (lForm <> nil) and (lForm.ActiveDefaultControl = Self) then
lForm.ActiveDefaultControl := nil;
DoSendBtnDefault;
end;
end;
end;
procedure TCustomButton.RealSetText(const Value: TCaption);
var
ParseStr : String;
@ -234,6 +286,10 @@ end;
{ =============================================================================
$Log$
Revision 1.44 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.43 2005/03/23 10:45:06 mattias
fixed ambigious with ambiguous

8
lcl/include/control.inc
View File

@ -1985,6 +1985,10 @@ begin
TWSControlClass(WidgetSetClass).SetCursor(Self, Value);
end;
procedure TControl.ActiveDefaultControlChanged(NewControl: TControl);
begin
end;
procedure TControl.UpdateRolesForForm;
begin
// called by the form when the "role" controls DefaultControl or CancelControl
@ -3512,6 +3516,10 @@ end;
{ =============================================================================
$Log$
Revision 1.255 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.254 2005/04/01 19:10:42 micha
make method Hide a member of TControl (fixes bug 707)

17
lcl/include/customform.inc
View File

@ -1165,6 +1165,19 @@ Begin
end;
end;
procedure TCustomForm.SetActiveDefaultControl(AControl: TControl);
var
lPrevControl: TControl;
begin
if AControl = FActiveDefaultControl then exit;
lPrevControl := FActiveDefaultControl;
FActiveDefaultControl := AControl;
if ((lPrevControl = nil) <> (AControl = nil))
and (FDefaultControl <> nil) then
FDefaultControl.ActiveDefaultControlChanged(AControl);
end;
{------------------------------------------------------------------------------
TCustomForm SetFormStyle
------------------------------------------------------------------------------}
@ -1916,6 +1929,10 @@ end;
{ =============================================================================
$Log$
Revision 1.183 2005/04/17 18:41:15 micha
implement active default control switching
pressing return key executes active default control action
Revision 1.182 2005/03/26 14:01:18 micha
save BorderIcons setting internally

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

@ -58,7 +58,7 @@ 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 DefaultButtonChanged(const AButton: TCustomButton); 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;
@ -136,9 +136,9 @@ begin
SetCallbacks(PGtkWidget(Result), WidgetInfo);
end;
procedure TGtkWSButton.DefaultButtonChanged(const AButton: TCustomButton);
procedure TGtkWSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
begin
if (AButton.Default)
if (AButton.Active)
and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(AButton.Handle))) then
//gtk_widget_grab_default(pgtkwidget(handle))
else begin

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

@ -47,7 +47,7 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure DefaultButtonChanged(const AButton: TCustomButton); override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); override;
class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override;
end;
@ -102,12 +102,12 @@ begin
Result := Params.Window;
end;
procedure TWin32WSButton.DefaultButtonChanged(const AButton: TCustomButton);
procedure TWin32WSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
var
WindowStyle: dword;
begin
WindowStyle := Windows.GetWindowLong(AButton.Handle, GWL_STYLE) and not (BS_DEFPUSHBUTTON or BS_PUSHBUTTON);
If AButton.Default then
If AButton.Active then
WindowStyle := WindowStyle or BS_DEFPUSHBUTTON
else
WindowStyle := WindowStyle or BS_PUSHBUTTON;

4
lcl/widgetset/wsbuttons.pp
View File

@ -53,7 +53,7 @@ type
{ TWSButton }
TWSButton = class(TWSButtonControl)
class procedure DefaultButtonChanged(const AButton: TCustomButton); virtual;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); virtual;
class procedure SetShortCut(const AButton: TCustomButton; const OldShortCut, NewShortCut: TShortCut); virtual;
end;
TWSButtonClass = class of TWSButton;
@ -80,7 +80,7 @@ implementation
{ TWSButton }
procedure TWSButton.DefaultButtonChanged(const AButton: TCustomButton);
procedure TWSButton.ActiveDefaultButtonChanged(const AButton: TCustomButton);
begin
end;