implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm

git-svn-id: trunk@5634 -

lcl/buttons.pp

@@ -78,6 +78,9 @@ type
     function ChildClassAllowed(ChildClass: TClass): boolean; override;
   public
     constructor Create(AOwner: TComponent); override;
+
+    procedure ExecuteDefaultAction; override;
+    procedure ExecuteCancelAction; override;
   published
     property Action;
     property Anchors;
@@ -330,6 +333,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.69  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.68  2004/06/30 11:07:20  micha
   implement return key clicks default button; escape key clicks cancel button
 

lcl/controls.pp

@@ -267,7 +267,9 @@ type
     csNeedsBorderPaint, // not implemented
     csParentBackground, // not implemented
     csDesignNoSmoothResize, // no WYSIWYG resizing in designer
-    csDesignFixedBounds // control can not be moved nor resized in designer
+    csDesignFixedBounds, // control can not be moved nor resized in designer
+    csHasDefaultAction, // control implements useful ExecuteDefaultAction
+    csHasCancelAction   // control implements useful ExecuteCancelAction
     );
   TControlStyle = set of TControlStyleType;
 
@@ -1000,6 +1002,8 @@ type
     constructor Create(AOwner: TComponent);override;
     destructor Destroy; override;
     Function PerformTab(ForwardTab: boolean): Boolean; Virtual;
+    procedure ExecuteDefaultAction; virtual;
+    procedure ExecuteCancelAction; virtual;
     procedure BeginDrag(Immediate: Boolean; Threshold: Integer);
     procedure BeginDrag(Immediate: Boolean);
     procedure BringToFront;
@@ -2326,6 +2330,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.219  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.218  2004/07/01 10:08:31  mattias
   made key handling more flexible
 

lcl/forms.pp

@@ -336,8 +336,8 @@ type
   private
     FActive: Boolean;
     FActiveControl: TWinControl;
-    FDefaultButton: TControl;
+    FDefaultControl: TControl;
-    FEscapeButton: TControl;
+    FCancelControl: TControl;
     FDesigner: TIDesigner;
     FDummyTextHeight: Longint;
     FFormState: TFormState;
@@ -373,8 +373,8 @@ type
     procedure SetActive(AValue: Boolean);
     procedure SetActiveControl(AWinControl: TWinControl);
     procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
-    procedure SetEscapeButton(NewButton: TControl);
+    procedure SetCancelControl(NewControl: TControl);
-    procedure SetDefaultButton(NewButton: TControl);
+    procedure SetDefaultControl(NewControl: TControl);
     procedure SetDesigner(Value : TIDesigner);
     procedure SetFormStyle(Value : TFormStyle);
     procedure SetIcon(AValue: TIcon);
@@ -450,10 +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 CancelControl: TControl read FCancelControl write SetCancelControl;
     property Caption stored IsForm;
     property Color default clBtnFace;
-    property DefaultButton: TControl read FDefaultButton write SetDefaultButton;
+    property DefaultControl: TControl read FDefaultControl write SetDefaultControl;
     property Designer: TIDesigner read FDesigner write SetDesigner;
     property FormState: TFormState read FFormState;
     property FormStyle: TFormStyle read FFormStyle write SetFormStyle

lcl/include/buttons.inc

@@ -32,7 +32,7 @@ begin
   end;
   {set the component style to csButton}
   fCompStyle := csButton;
-  ControlStyle:=ControlStyle-[csClickEvents];
+  ControlStyle:=ControlStyle-[csClickEvents]+[csHasDefaultAction,csHasCancelAction];
   TabStop := true;
   {set default alignment}
   Align := alNone;
@@ -80,9 +80,19 @@ end;
   procedure TButton.SetParent(AParent: TWinControl);
  ------------------------------------------------------------------------------}
 procedure TButton.SetParent(AParent: TWinControl);
+var
+  Form: TCustomForm;
 begin
   if Parent=AParent then exit;
   inherited SetParent(AParent);
+  Form := GetParentForm(Self);
+  if Form <> nil then
+  begin
+    if FDefault then
+      Form.DefaultControl := Self;
+    if FCancel then
+      Form.CancelControl := Self;
+  end;
   DoSendBtnDefault;
 end;
 
@@ -98,10 +108,13 @@ begin
   if FCancel = NewCancel then Exit;
   FCancel := NewCancel;
   Form := GetParentForm(Self);
+  if Form <> nil then
+  begin
     if NewCancel then
-    Form.EscapeButton := Self
+      Form.CancelControl := Self
     else
-    Form.EscapeButton := nil;
+      Form.CancelControl := nil;
+  end;
 end;
  
 {------------------------------------------------------------------------------
@@ -116,12 +129,27 @@ begin
   if FDefault = Value then Exit;
   FDefault := Value;
   Form := GetParentForm(Self);
+  if Form <> nil then
+  begin
     if Value then
-    Form.DefaultButton := Self
+      Form.DefaultControl := Self
     else
-    Form.DefaultButton := nil;
+      Form.DefaultControl := nil;
+  end;
   DoSendBtnDefault;
-End;
+end;
+
+procedure TButton.ExecuteDefaultAction;
+begin
+  if FDefault then
+    Click;
+end;
+
+procedure TButton.ExecuteCancelAction;
+begin
+  if FCancel then
+    Click;
+end;
 
 {------------------------------------------------------------------------------
   Method:  TButton.Click
@@ -182,6 +210,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.29  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.28  2004/06/30 11:07:20  micha
   implement return key clicks default button; escape key clicks cancel button
 

lcl/include/control.inc

@@ -527,6 +527,14 @@ begin
   end;
 end;
 
+procedure TControl.ExecuteDefaultAction;
+begin
+end;
+
+procedure TControl.ExecuteCancelAction;
+begin
+end;
+
 {------------------------------------------------------------------------------
   function TControl.GetFloating: Boolean;
 ------------------------------------------------------------------------------}
@@ -3191,6 +3199,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.200  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.199  2004/06/28 23:46:40  marc
   * Fixed compilation on 1.0.10
   * Fixed check for override of GetTextBuf and SetTextBuf

lcl/include/customform.inc

@@ -192,38 +192,37 @@ begin
   Result:=FKeyPreview=true;
 end;
 
-procedure TCustomForm.SetEscapeButton(NewButton: TControl);
+procedure TCustomForm.SetCancelControl(NewControl: TControl);
-var
+//var
-  lButton: TControl;
+//  lControl: TControl;
 begin
-  if NewButton <> FEscapeButton then
+  if NewControl <> FCancelControl then
   begin
     // prevent inf. recursion problems
-    lButton := FEscapeButton;
+//    lControl := FCancelControl;
-    FEscapeButton := nil;
+//    FCancelControl := nil;
-    // TODO: TControl -> TButton so we don't have to check type ?
+//    if lControl <> nil then
-    if lButton <> nil then
+//      (lControl as TControl).Cancel := false;
-      (lButton as TButton).Cancel := false;
+    FCancelControl := NewControl;
-    FEscapeButton := NewButton;
+//    if NewControl <> nil then
-    if NewButton <> nil then
+//      (NewControl as TControl).Cancel := true;
-      (NewButton as TButton).Cancel := true;
   end;
 end;
 
-procedure TCustomForm.SetDefaultButton(NewButton: TControl);
+procedure TCustomForm.SetDefaultControl(NewControl: TControl);
-var
+//var
-  lButton: TControl;
+//  lControl: TControl;
 begin
-  if NewButton <> FDefaultButton then
+  if NewControl <> FDefaultControl then
   begin
     // prevent inf. recursion problems
-    lButton := FDefaultButton;
+//    lControl := FDefaultControl;
-    FDefaultButton := nil;
+//    FDefaultControl := nil;
-    if lButton <> nil then
+//    if lControl <> nil then
-      (lButton as TButton).Default := false;
+//      (lControl as TControl).Default := false;
-    FDefaultButton := NewButton;
+    FDefaultControl := NewControl;
-    if NewButton <> nil then
+//    if NewControl <> nil then
-      (NewButton as TButton).Default := true;
+//      (NewControl as TControl).Default := true;
   end;
 end;
 
@@ -1642,6 +1641,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.142  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.141  2004/06/30 11:07:20  micha
   implement return key clicks default button; escape key clicks cancel button
 

lcl/include/wincontrol.inc

@@ -2090,26 +2090,24 @@ begin
     Key:=VK_UNKNOWN;
     PerformTab(not (ssShift in Shift));
   end;
+  // check for special actions handled ourselves  
   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 begin
+        if Form.DefaultControl <> nil then 
-          (Form.DefaultButton as TButton).Click;
+          Form.DefaultControl.ExecuteDefaultAction;
-          Key:=VK_UNKNOWN;
-        end;
       end;
       
       VK_ESCAPE:
       begin
-        if Form.EscapeButton <> nil then begin
+        if Form.CancelControl <> nil then 
-          (Form.EscapeButton as TButton).Click;
+          Form.CancelControl.ExecuteCancelAction;
-          Key:=VK_UNKNOWN;
-        end;
       end;
     end;
+    Key := VK_UNKNOWN;
   end;
 end;
 
@@ -3753,6 +3751,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.248  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.247  2004/07/01 17:55:55  mattias
   LCL navigation keys are now handled after interface handles keys
 

lcl/interfaces/win32/win32callback.inc

@@ -1153,9 +1153,12 @@ var
   LMessage: TLMessage;
   LMKey: TLMKey;
   PLMsg: PLMessage;
-  NotifyUserInput: Boolean;
+  NotifyUserInput: boolean;
+  WinProcess: boolean;
+  OwnerObject: TObject;
 begin
   // filter messages we want to send to LCL
+  WinProcess := true;
   if (Msg = WM_KILLFOCUS) or (Msg = WM_SETFOCUS) or 
      ((Msg >= WM_KEYFIRST) and (Msg <= WM_KEYLAST)) then
   begin
@@ -1195,9 +1198,25 @@ begin
     if NotifyUserInput then
       NotifyApplicationUserInput(PLMsg^.Msg);
 
-    DeliverMessage(TObject(Windows.GetProp(Window, 'AWinControl')), PLMsg^);
+    OwnerObject := TObject(Windows.GetProp(Window, 'AWinControl'));
+    DeliverMessage(OwnerObject, PLMsg^);
+
+    case Msg of
+      WM_KEYDOWN, WM_KEYUP:
+      begin
+        // if not yet processed, resend normally
+        if LMKey.CharCode <> VK_UNKNOWN then
+        begin
+          LMKey.Msg := Msg;
+          DeliverMessage(OwnerObject, LMKey);
+          // still not handled? then do default processing
+          WinProcess := LMKey.CharCode <> VK_UNKNOWN;
+        end;
+      end;
+    end;
   end;
     
+  if WinProcess then
     Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
 end;
     
@@ -1256,6 +1275,9 @@ end;
 
 {
   $Log$
+  Revision 1.124  2004/07/01 20:42:11  micha
+  implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
+
   Revision 1.123  2004/06/30 10:38:51  micha
   fix setcursor to only change cursor within client area, not on scrollbars etc.