LCL: fix dbcombobox editing, issue #33164

git-svn-id: trunk@58686 -

lcl/dbctrls.pp

@@ -34,7 +34,7 @@ uses
   // LazUtils
   LazTracer, LazUtilities,
   // LCL
-  LCLStrConsts, LMessages, LCLType, LResources, GraphType, Controls, Graphics,
+  LCLStrConsts, LMessages, LCLType, LCLIntf, LResources, GraphType, Controls, Graphics,
   Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls, Calendar, ImgList;
 
 Type
@@ -714,6 +714,7 @@ Type
   TCustomDBComboBox = class(TCustomComboBox)
   private
     FDataLink: TFieldDataLink;
+    FDetectedEvents: Word;
     function GetDataField: string;
     function GetDataSource: TDataSource;
     function GetField: TField;
@@ -722,8 +723,13 @@ Type
     procedure SetDataSource(const AValue: TDataSource);
     procedure SetReadOnly(const AValue: Boolean);
     procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
+  protected
+    function DoEdit: boolean;
+    procedure DoOnCloseUp;
+    procedure LMDeferredEdit(var Message: TLMessage); message LM_DEFERREDEDIT;
   protected
     procedure CloseUp; override;
+    Procedure Select; override;
     procedure DataChange(Sender: TObject); virtual; abstract;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Change; override;
@@ -748,11 +754,9 @@ Type
 
   TDBComboBox = class(TCustomDBComboBox)
   protected
-    procedure Change; override;
     procedure DataChange(Sender: TObject); override;
     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
     procedure KeyPress(var Key: char); override;
-    procedure Select; override;
     procedure UpdateData(Sender: TObject); override;
   published
     property Align;

lcl/include/customdbcombobox.inc

@@ -15,6 +15,11 @@
 
 // included by dbctrls.pp
 
+CONST
+  DBCBEVENT_CHANGE   = 1;   // Detected change event
+  DBCBEVENT_SELECT   = 2;   // Detected select event
+  DBCBEVENT_CLOSEUP  = 4;   // Detected closeup event
+
 {TCustomDBComboBox}
 
 function TCustomDBComboBox.GetDataField: string;
@@ -34,8 +39,8 @@ end;
 
 procedure TCustomDBComboBox.Change;
 begin
-  FDataLink.Modified;
-  inherited Change;
+  FDetectedEvents := FDetectedEvents or DBCBEVENT_CHANGE;
+  PostMessage(Handle, LM_DEFERREDEDIT, 0, 0);
 end;
 
 function TCustomDBComboBox.GetReadOnly: Boolean;
@@ -43,6 +48,69 @@ begin
   Result:=FDataLink.ReadOnly;
 end;
 
+function TCustomDBComboBox.DoEdit: boolean;
+var
+  oldDataChange: TNotifyEvent;
+
+  procedure RestoreDataChange;
+  begin
+    FDataLink.OnDataChange := oldDataChange;
+    if not result then begin
+      FDatalink.Reset;
+      SelectAll;
+    end;
+  end;
+
+begin
+
+  oldDataChange := FDataLink.OnDataChange;
+  FDataLink.OnDataChange := nil;
+
+  try
+    try
+
+      result := FDatalink.Edit;
+      RestoreDataChange;
+
+      if result then begin
+        FDatalink.Modified;
+        if FDetectedEvents and DBCBEVENT_CHANGE <> 0 then
+          inherited Change;
+        if FDetectedEvents and DBCBEVENT_SELECT <> 0 then
+          inherited Select;
+      end;
+      if FDetectedEvents and DBCBEVENT_CLOSEUP <> 0 then
+        DoOnCloseUp;
+
+    except
+      on E: Exception do begin
+
+        result := false;
+        RestoreDataChange;
+        if FDetectedEvents and DBCBEVENT_CLOSEUP <> 0 then
+          DoOnCloseUp;
+
+        raise;
+      end;
+    end;
+
+  finally
+    FDetectedEvents := 0;
+  end;
+end;
+
+procedure TCustomDBComboBox.DoOnCloseUp;
+begin
+  if Assigned(OnCloseUp) then OnCloseUp(Self);
+  if AutoSelect then
+  begin
+    SelectAll;
+    if (SelText = Text) then
+      AutoSelected := True;
+  end;//End if FAutoSelect
+  FDetectedEvents := 0;   // reset because closeup may occur without editing
+end;
+
 procedure TCustomDBComboBox.SetDataField(const AValue: string);
 begin
   FDataLink.FieldName:=AValue;
@@ -64,12 +132,23 @@ begin
   Message.Result := PtrUInt(FDataLink);
 end;
 
+procedure TCustomDBComboBox.LMDeferredEdit(var Message: TLMessage);
+begin
+  DoEdit;
+end;
+
 procedure TCustomDBComboBox.CloseUp;
 begin
   if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then exit;
-  if not ReadOnly then
-    EditingDone;
- inherited CloseUp;
+  if FDetectedEvents and DBCBEVENT_CHANGE = 0 then
+    DoOnCloseUp
+  else
+    FDetectedEvents := FDetectedEvents or DBCBEVENT_CLOSEUP;
+end;
+
+procedure TCustomDBComboBox.Select;
+begin
+  FDetectedEvents := FDetectedEvents or DBCBEVENT_SELECT;
 end;
 
 procedure TCustomDBComboBox.Notification(AComponent: TComponent; Operation: TOperation);
@@ -83,7 +162,8 @@ end;
 
 procedure TCustomDBComboBox.EditingDone;
 begin
-  FDataLink.UpdateRecord;
+  if FDatalink.Editing and FDatalink.IsModified then
+    FDataLink.UpdateRecord;
   inherited EditingDone;
 end;
 
@@ -95,16 +175,7 @@ begin
     LM_PASTE:
       begin
         if FDataLink.CanModify then
-        begin
-          //LCL changes the Text before LM_PASTE is called and not after like Delphi. Issue 20330
-          //When Edit is called the Text property is reset to the previous value
-          //Add a workaround while bug is not fixed
-          FDataLink.OnDataChange := nil;
-          FDatalink.Edit;
-          FDataLink.Modified;
-          FDataLink.OnDataChange := @DataChange;
-          inherited WndProc(Message);
-        end
+          inherited WndProc(Message)
         else
           Message.Result := 1; // prevent calling default window proc
       end;

lcl/include/dbcombobox.inc

@@ -17,22 +17,6 @@ begin
   FDataLink.Field.Text := Text;
 end;
 
-procedure TDBComboBox.Change;
-begin
-  try
-    if FDataLink.CanModify then begin
-      FDataLink.OnDataChange := nil;
-      if FDataLink.Edit then begin
-        FDataLink.Field.AsString := Text;
-        FDatalink.Modified;
-      end;
-      FDataLink.OnDataChange := @Datachange;
-    end;
-  finally
-    inherited Change;
-  end;
-end;
-
 procedure TDBComboBox.DataChange(Sender: TObject);
 var
   DataLinkField: TField;
@@ -52,10 +36,6 @@ begin
     FDataLink.Reset;
     SelectAll;
     Key := VK_UNKNOWN;
-  end else
-  if Key in [VK_DELETE, VK_BACK] then begin
-    if not FDataLink.Edit then
-      Key := VK_UNKNOWN;
   end;
 end;
 
@@ -63,34 +43,9 @@ procedure TDBComboBox.KeyPress(var Key: char);
 begin
   inherited KeyPress(Key);
   case Key of
-    #8: // special keys
-      if not FDatalink.Edit then
-        Key:=#0;
-
     #32..#255: //standard keys
-      if not FieldCanAcceptKey(FDataLink.Field, Key) or not FDatalink.Edit then
+      if not FieldCanAcceptKey(FDataLink.Field, Key) then
         Key:=#0;
   end;//case
 end;
 
-procedure TDBComboBox.Select;
-begin
-  //avoid reseting text when calling select
-  FDataLink.OnDataChange := nil;
-  try
-    if FDataLink.Edit then
-    begin
-       FDataLink.Modified;
-       FDataLink.UpdateData;
-       inherited Select;
-    end
-    else
-    begin
-       // if cannot modify, let it reset
-       FDatalink.Reset;
-       DataChange(Self);
-    end;
-  finally
-    FDataLink.OnDataChange := @DataChange;
-  end;
-end;

lcl/lmessages.pp

@@ -90,6 +90,7 @@ const
 
   LM_GRABFOCUS      = LM_LCL + 80;
   LM_DRAWLISTITEM   = LM_LCL + 81;
+  LM_DEFERREDEDIT   = LM_LCL + 82;            // used in customdbcombobox
 
   // these IDs are reserved for internal messages in the interfaces
   LM_INTERFACEFIRST = LM_LCL + 99;