implement return key clicks default button; escape key clicks cancel button

git-svn-id: trunk@5623 -

lcl/buttons.pp

@@ -64,7 +64,8 @@ type
     FDefault: Boolean;
     FModalResult: TModalResult;
     FShortCut: TLMShortcut;
-    Procedure SetDefault(Value : Boolean);
+    procedure SetCancel(NewCancel: boolean);
+    procedure SetDefault(Value : Boolean);
     procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED;
   protected
     procedure Click; override;
@@ -85,7 +86,7 @@ type
     property Default : Boolean read FDefault write SetDefault default false;
     property Enabled;
     property ModalResult: TModalResult read FModalResult write FModalResult default mrNone;
-    property Cancel: Boolean read FCancel write FCancel default False;
+    property Cancel: Boolean read FCancel write SetCancel default false;
     property Caption;
     property Font;
     property TabStop default true;
@@ -329,6 +330,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.68  2004/06/30 11:07:20  micha
+  implement return key clicks default button; escape key clicks cancel button
+
   Revision 1.67  2004/05/22 14:35:32  mattias
   fixed button return key
 

lcl/controls.pp

@@ -1784,6 +1784,7 @@ uses
   WSControls, // Widgetset uses circle is allowed
 
   Forms, // the circle can't be broken without breaking Delphi compatibility
+  Buttons, // needed for clicking default and cancel buttons
   Math;  // Math is in RTL and only a few functions are used.
 
 var
@@ -2323,6 +2324,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.217  2004/06/30 11:07:20  micha
+  implement return key clicks default button; escape key clicks cancel button
+
   Revision 1.216  2004/06/29 10:23:00  micha
   fix cnkeydown to check wm_getdlgcode result
   fix win32 intf to also send wm_keydown of cn_keydown wasn't processed

lcl/forms.pp

@@ -336,6 +336,8 @@ type
   private
     FActive: Boolean;
     FActiveControl: TWinControl;
+    FDefaultButton: TControl;
+    FEscapeButton: TControl;
     FDesigner: TIDesigner;
     FDummyTextHeight: Longint;
     FFormState: TFormState;
@@ -371,6 +373,8 @@ type
     procedure SetActive(AValue: Boolean);
     procedure SetActiveControl(AWinControl: TWinControl);
     procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
+    procedure SetEscapeButton(NewButton: TControl);
+    procedure SetDefaultButton(NewButton: TControl);
     procedure SetDesigner(Value : TIDesigner);
     procedure SetFormStyle(Value : TFormStyle);
     procedure SetIcon(AValue: TIcon);
@@ -446,8 +450,10 @@ type
     property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
     property BorderStyle: TFormBorderStyle
                       read FFormBorderStyle write SetFormBorderStyle default bsSizeable;
+    property EscapeButton: TControl read FEscapeButton write SetEscapeButton;
     property Caption stored IsForm;
     property Color default clBtnFace;
+    property DefaultButton: TControl read FDefaultButton write SetDefaultButton;
     property Designer: TIDesigner read FDesigner write SetDesigner;
     property FormState: TFormState read FFormState;
     property FormStyle: TFormStyle read FFormStyle write SetFormStyle
@@ -1052,7 +1058,7 @@ implementation
 
 uses
   WSForms, // Widgetset uses circle is allowed
-  
+  Buttons,
   Math;
 
 var

lcl/include/buttons.inc

@@ -86,15 +86,40 @@ begin
   DoSendBtnDefault;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TButton.SetCancel
+  Params:  NewCancel - new cancel value
+  Returns: Nothing
+ ------------------------------------------------------------------------------}
+procedure TButton.SetCancel(NewCancel: boolean);
+var
+  Form: TCustomForm;
+begin
+  if FCancel = NewCancel then Exit;
+  FCancel := NewCancel;
+  Form := GetParentForm(Self);
+  if NewCancel then
+    Form.EscapeButton := Self
+  else
+    Form.EscapeButton := nil;
+end;
+ 
 {------------------------------------------------------------------------------
   Method:  TButton.SetDefault
   Params:  Value
   Returns: Nothing
  ------------------------------------------------------------------------------}
 procedure TButton.SetDefault(Value : Boolean);
+var
+  Form: TCustomForm;
 begin
   if FDefault = Value then Exit;
   FDefault := Value;
+  Form := GetParentForm(Self);
+  if Value then
+    Form.DefaultButton := Self
+  else
+    Form.DefaultButton := nil;
   DoSendBtnDefault;
 End;
 
@@ -157,6 +182,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.28  2004/06/30 11:07:20  micha
+  implement return key clicks default button; escape key clicks cancel button
+
   Revision 1.27  2004/06/29 14:38:28  micha
   fix default button notification win32 intf
 

lcl/include/customform.inc

@@ -192,6 +192,41 @@ begin
   Result:=FKeyPreview=true;
 end;
 
+procedure TCustomForm.SetEscapeButton(NewButton: TControl);
+var
+  lButton: TControl;
+begin
+  if NewButton <> FEscapeButton then
+  begin
+    // prevent inf. recursion problems
+    lButton := FEscapeButton;
+    FEscapeButton := nil;
+    // TODO: TControl -> TButton so we don't have to check type ?
+    if lButton <> nil then
+      (lButton as TButton).Cancel := false;
+    FEscapeButton := NewButton;
+    if NewButton <> nil then
+      (NewButton as TButton).Cancel := true;
+  end;
+end;
+
+procedure TCustomForm.SetDefaultButton(NewButton: TControl);
+var
+  lButton: TControl;
+begin
+  if NewButton <> FDefaultButton then
+  begin
+    // prevent inf. recursion problems
+    lButton := FDefaultButton;
+    FDefaultButton := nil;
+    if lButton <> nil then
+      (lButton as TButton).Default := false;
+    FDefaultButton := NewButton;
+    if NewButton <> nil then
+      (NewButton as TButton).Default := true;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method: TCustomForm.SetIcon
   Params: the new icon
@@ -1607,6 +1642,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.141  2004/06/30 11:07:20  micha
+  implement return key clicks default button; escape key clicks cancel button
+
   Revision 1.140  2004/05/22 11:06:27  mattias
   fixed grids SetBorderStyle
 

lcl/include/wincontrol.inc

@@ -2063,12 +2063,31 @@ end;
 {  TWinControl ControlKeyUp                                                    }
 {------------------------------------------------------------------------------}
 procedure TWinControl.ControlKeyDown(var Key: Word; Shift: TShiftState);
+var
+  Form: TCustomForm;
 begin
   // handle tab keys
   if (Key=VK_Tab) and ((Shift+[ssShift])=[ssShift]) and Focused then begin
     Key:=VK_UNKNOWN;
     PerformTab(not (ssShift in Shift));
   end;
+  if (Shift = []) and ((Key = VK_RETURN) or (Key = VK_ESCAPE)) then
+  begin
+    Form := GetParentForm(Self);
+    case Key of
+      VK_RETURN:
+      begin
+        if Form.DefaultButton <> nil then
+          (Form.DefaultButton as TButton).Click;
+      end;
+      
+      VK_ESCAPE:
+      begin
+        if Form.EscapeButton <> nil then
+          (Form.EscapeButton as TButton).Click;
+      end;
+    end;
+  end;
 end;
 
 {------------------------------------------------------------------------------}
@@ -3706,6 +3725,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.245  2004/06/30 11:07:20  micha
+  implement return key clicks default button; escape key clicks cancel button
+
   Revision 1.244  2004/06/29 10:23:00  micha
   fix cnkeydown to check wm_getdlgcode result
   fix win32 intf to also send wm_keydown of cn_keydown wasn't processed