implement active default control switching

pressing return key executes active default control action

git-svn-id: trunk@7080 -

lcl/buttons.pp

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

lcl/controls.pp

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

lcl/extctrls.pp

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

lcl/forms.pp

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

lcl/include/application.inc

@@ -1329,21 +1329,27 @@ 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)
+      if anoReturnForDefaultControl in Navigation then
-      and (Form.DefaultControl <> nil) 
+      begin
-      and ((Form.DefaultControl.Parent = nil) or (Form.DefaultControl.Parent.CanFocus))
+        lDefaultControl := Form.ActiveDefaultControl;
-      and Form.DefaultControl.Enabled and Form.DefaultControl.Visible then
+        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);
-        Form.DefaultControl.ExecuteDefaultAction;
+          lDefaultControl.ExecuteDefaultAction;
           Key := VK_UNKNOWN;
         end;
       end;
     end;
+  end;
 end;
 
 procedure TApplication.DoTabKey(AControl: TWinControl; var Key: Word;
@@ -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
 

lcl/include/buttons.inc

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

lcl/include/control.inc

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

lcl/include/customform.inc

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

lcl/interfaces/gtk/gtkwsbuttons.pp

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

lcl/interfaces/win32/win32wsbuttons.pp

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

lcl/widgetset/wsbuttons.pp

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