Dialogs: fix several issues with OnShow/OnCanClose/OnClose events.

- fixes showing OnShow twice - fixes not firing TSelectDirectoryDialog.OnClose on WinXP - fixes wrong Sender in TFindDialog.OnShow - fixes firing TFontDialog.OnShow after fom closes (Windows) - fixes not firing OnShow and OnClose of TCalculatorDialog - fixes wrong Sender in TCalendarDialog.OnShow and OnCanClose - call DoXXX instead of OnXXX wherever possible - more conditioal debug output Resolves issue #0023065. Partly resolves issue #0021163. git-svn-id: trunk@52801 -
2025-06-06 22:58:42 +02:00 · 2016-08-13 18:05:25 +00:00 · 2016-08-13 18:05:25 +00:00 · cc041a51b2
commit cc041a51b2
parent 726ce4d450
5 changed files with 105 additions and 18 deletions
--- a/lcl/dialogs.pp
+++ b/lcl/dialogs.pp
@ -68,7 +68,9 @@ type
    FTitle : string;
    FUserChoice: integer;
    FHelpContext: THelpContext;
-    FCanCloseCalled: Boolean;
+    FDoCanCloseCalled: Boolean;
+    FDoShowCalled: Boolean;
+    FDoCloseCalled: Boolean;
    FClosing: boolean;
    procedure SetHandle(const AValue: THandle);
    function IsTitleStored: boolean;
@ -80,6 +82,7 @@ type
    function GetWidth: Integer; virtual;
    procedure SetHeight(const AValue: integer); virtual;
    procedure SetWidth(const AValue: integer); virtual;
+    procedure ResetShowCloseFlags;
  public
    FCompStyle : LongInt;
    constructor Create(TheOwner: TComponent); override;
--- a/lcl/extdlgs.pas
+++ b/lcl/extdlgs.pas
@ -148,6 +148,8 @@ type
    procedure SetDialogScale(AValue: integer);
  protected
    class procedure WSRegisterClass; override;
+    procedure OnDialogClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure OnDialogShow(Sender: TObject);
    procedure Change; virtual;
    procedure CalcKey(var Key: char); virtual;
    function DefaultTitle: string; override;
@ -193,6 +195,7 @@ type
    FCalendar: TCalendar;
    procedure OnDialogClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure OnDialogCloseQuery(Sender : TObject; var CanClose : boolean);
+    procedure OnDialogShow(Sender: TObject);
    procedure OnCalendarDayChanged(Sender: TObject);
    procedure OnCalendarMonthChanged(Sender: TObject);
    procedure OnCalendarYearChanged(Sender: TObject);
@ -540,6 +543,17 @@ begin
  RegisterCalculatorDialog;
 end;

+procedure TCalculatorDialog.OnDialogClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  DoClose;
+end;
+
+procedure TCalculatorDialog.OnDialogShow(Sender: TObject);
+begin
+  DoShow;
+end;
+
 function TCalculatorDialog.GetDisplay: Double;
 begin
  if Assigned(DlgForm) then
@ -592,8 +606,11 @@ begin

  DlgForm:=CreateCalculatorForm(Application, FLayout, HelpContext);
  try
+    ResetShowCloseFlags;
    (DlgForm as TCalculatorForm).OnCalcKey:= @Self.CalcKey;
    (DlgForm as TCalculatorForm).OnDisplayChange:= @Self.DisplayChange;
+    (DlgForm as TCalculatorForm).OnShow := @Self.OnDialogShow;
+    (DlgForm as TCalculatorForm).OnClose := @Self.OnDialogClose;

    if FDialogScale<>100 then
      DlgForm.ScaleBy(FDialogScale,100);
@ -689,13 +706,20 @@ end;
 procedure TCalendarDialog.OnDialogClose(Sender: TObject;
  var CloseAction: TCloseAction);
 begin
-  if Assigned(OnClose) then OnClose(Self);
+  //if Assigned(OnClose) then OnClose(Self);
+  DoClose;
 end;

 procedure TCalendarDialog.OnDialogCloseQuery(Sender: TObject;
  var CanClose: boolean);
 begin
-  if Assigned(OnCanClose) then OnCanClose(Sender, CanClose);
+  //if Assigned(OnCanClose) then OnCanClose(Sender, CanClose);
+  DoCanClose(CanClose);
+end;
+
+procedure TCalendarDialog.OnDialogShow(Sender: TObject);
+begin
+  DoShow;
 end;

 procedure TCalendarDialog.OnCalendarDayChanged(Sender: TObject);
@ -739,6 +763,7 @@ var
 begin
  DlgForm:=TForm.CreateNew(Application, 0);
  try
+    ResetShowCloseFlags;
    DlgForm.DisableAlign;
    DlgForm.Caption:=Title;
    if (csDesigning in ComponentState) then
@ -755,7 +780,7 @@ begin
    DlgForm.BorderStyle:=bsDialog;
    DlgForm.AutoScroll:=false;
    DlgForm.AutoSize:=true;
-    DlgForm.OnShow:=Self.OnShow;
+    DlgForm.OnShow := @OnDialogShow;
    DlgForm.OnClose:=@OnDialogClose;
    DlgForm.OnCloseQuery:=@OnDialogCloseQuery;

@ -832,4 +857,5 @@ begin
  end;
 end;

+
 end.
--- a/lcl/include/commondialog.inc
+++ b/lcl/include/commondialog.inc
@ -35,6 +35,7 @@ begin
    DisabledList := Screen.DisableForms(Screen.ActiveForm);
    try
      FUserChoice := mrNone;
+      ResetShowCloseFlags;
      Handle := TWSCommonDialogClass(WidgetSetClass).CreateHandle(Self);
      Result:= DoExecute;
      Close;
@ -54,7 +55,8 @@ procedure TCommonDialog.Close;
 begin
  if HandleAllocated and not FClosing then begin
    FClosing := true;
-    DoClose;
+    if not FDoCloseCalled then
+      DoClose;
    TWSCommonDialogClass(WidgetSetClass).DestroyHandle(Self);
    FHandle := 0;
    FClosing := false;
@ -63,18 +65,22 @@ end;

 procedure TCommonDialog.DoShow;
 begin
+  if FDoShowCalled then Exit;
+  FDoShowCalled := True;
  if Assigned(FOnShow) then FOnShow(Self);
 end;

 procedure TCommonDialog.DoCanClose(var CanClose: Boolean);
 begin
-  FCanCloseCalled := True;
+  FDoCanCloseCalled := True;
  if Assigned(FOnCanClose) then
    OnCanClose(Self, CanClose);
 end;

 procedure TCommonDialog.DoClose;
 begin
+  if FDoCloseCalled then Exit;
+  FDoCloseCalled := True;
  if Assigned(FOnClose) then FOnClose(Self);
 end;

@ -111,35 +117,52 @@ begin
  FWidth:=AValue;
 end;

+procedure TCommonDialog.ResetShowCloseFlags;
+begin
+  FDoShowCalled := False;
+  FDoCanCloseCalled := False;
+  FDoCloseCalled := False;
+end;
+
 function TCommonDialog.DoExecute : boolean;
 var
  CanClose: boolean;
 begin
-  FCanCloseCalled := False;
-  if Assigned(FOnShow) then
-    FOnShow(Self);
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TCommonDialog.DoExecute A']);
+  {$endif}
+  if not FDoShowCalled then
+  begin
+    {$ifdef DebugCommonDialogEvents}
+    debugln(['TCommonDialog.DoExecute calling DoShow']);
+    {$endif}
+    DoShow;
+  end;
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TCommonDialog.DoExecute before WS_ShowModal']);
+  {$endif}
  TWSCommonDialogClass(WidgetSetClass).ShowModal(Self);
  {$ifdef DebugCommonDialogEvents}
-  if (Self is TFileDialog) then debugln(['TCommonDialog.DoExecute, FCanCloseCalled=',FCanCloseCalled,' FUserChoice=',ModalResultStr[FUserChoice]]);
+  debugln(['TCommonDialog.DoExecute after WS_ShowModal, FCanCloseCalled=',FDoCanCloseCalled,' FUserChoice=',ModalResultStr[FUserChoice]]);
  {$endif}
  // can close was called from widgetset loop
-  if not FCanCloseCalled then
+  if not FDoCanCloseCalled then
  begin
    repeat
      {$ifdef DebugCommonDialogEvents}
-      if (Self is TFileDialog) then debugln(['TCommonDialog.DoExecute, FUserChoice=',ModalResultStr[FUserChoice],' Handle=',Handle]);
+      debugln(['TCommonDialog.DoExecute, FUserChoice=',ModalResultStr[FUserChoice],' Handle=',Handle]);
      {$endif}
      if (FUserChoice <> mrNone) and (Handle<>0) then
      begin
        CanClose := True;
        {$ifdef DebugCommonDialogEvents}
-        if (Self is TFileDialog) then debugln(['TCommonDialog.DoExecute calling DoCanClose']);
+        debugln(['TCommonDialog.DoExecute calling DoCanClose']);
        {$endif}
        DoCanClose(CanClose);
        if not CanClose then
          FUserChoice:=mrNone;
        {$ifdef DebugCommonDialogEvents}
-        if (Self is TFileDialog) then debugln(['TCommonDialog.DoExecute after calling DoCanClose: CanClose=',CanClose,' FUserChoice=',ModalResultStr[FUserChoice]]);
+        debugln(['TCommonDialog.DoExecute after calling DoCanClose: CanClose=',CanClose,' FUserChoice=',ModalResultStr[FUserChoice]]);
        {$endif}
      end;
      if FUserChoice <> mrNone then
@ -150,6 +173,9 @@ begin
    until false;
  end;
  Result := (FUserChoice = mrOk);
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TCommonDialog.DoExecute End']);
+  {$endif}
 end;

 function TCommonDialog.DefaultTitle: string;
--- a/lcl/include/filedialog.inc
+++ b/lcl/include/filedialog.inc
@ -46,7 +46,7 @@ begin
    inherited DoCanClose(CanClose)
  else
  begin
-    FCanCloseCalled := True;
+    FDoCanCloseCalled := True;
    CanClose := True;
  end;
 end;
@ -441,7 +441,7 @@ begin
    inherited DoCanClose(CanClose)
  else
  begin
-    FCanCloseCalled := True;
+    FDoCanCloseCalled := True;
    CanClose := True;
  end;
 end;
--- a/lcl/interfaces/win32/win32wsdialogs.pp
+++ b/lcl/interfaces/win32/win32wsdialogs.pp
@ -521,6 +521,9 @@ begin
      CDN_INITDONE:
      begin
        ExtractDataFromNotify;
+        {$ifdef DebugCommonDialogEvents}
+        debugln(['OpenFileDialogCallBack calling DoShow']);
+        {$endif}
        TOpenDialog(DlgRec^.Dialog).DoShow;
      end;
      CDN_SELCHANGE:
@ -887,6 +890,9 @@ begin
  FileDialogEvents := TFileDialogEvents.Create(AOpenDialog);
  ADialog.Advise(FileDialogEvents, @Cookie);
  try
+    {$ifdef DebugCommonDialogEvents}
+    debugln('TWin32WSOpenDialog.VistaDialogShowModal calling DoShow');
+    {$endif}
    AOpenDialog.DoShow;
    ADialog.Show(GetParentWnd);
    {$ifdef DebugCommonDialogEvents}
@ -1119,6 +1125,10 @@ begin
        nSizeMax := MaxFontSize;
      end;
    end;
+    {$ifdef DebugCommonDialogEvents}
+    debugln(['TWin32WSFontDialog.CreateHandle calling DoShow']);
+    {$endif}
+    TFontDialog(ACommonDialog).DoShow;
    UserResult := ChooseFontW(@CFW);
    // we need to update LF now
    LF.lfFaceName := UTF16ToUTF8(LFW.lfFaceName);
@ -1133,7 +1143,10 @@ begin
      Color := CF.RGBColors;
    end;
  end;
-
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSFontDialog.CreateHandle calling DoClose']);
+  {$endif}
+  TFontDialog(ACommonDialog).DoClose;
  Result := 0;
 end;

@ -1208,6 +1221,9 @@ var
  Title: widestring;
  DirName: string;
 begin
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle A']);
+  {$endif}
  DirName := '';
  InitialDir := TSelectDirectoryDialog(ACommonDialog).FileName;
  Options := TSelectDirectoryDialog(ACommonDialog).Options;
@ -1241,8 +1257,17 @@ begin
    // this value will be passed to callback proc as lpData
    lParam := Windows.LParam(PWideChar(InitialDirW));
  end;
-
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle calling DoShow']);
+  {$endif}
+  TSelectDirectoryDialog(ACommonDialog).DoShow;
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle before SHBrowseForFolder']);
+  {$endif}
  iidl := SHBrowseForFolderW(@biw);
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle after SHBrowseForFolder']);
+  {$endif}

  if Assigned(iidl) then
  begin
@ -1260,7 +1285,14 @@ begin

  CoTaskMemFree(Buffer);

+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle calling DoClose']);
+  {$endif}
+  TSelectDirectoryDialog(ACommonDialog).DoClose;
  Result := 0;
+  {$ifdef DebugCommonDialogEvents}
+  debugln(['TWin32WSSelectDirectoryDialog.CreateOldHandle End']);
+  {$endif}
 end;

 { TFileDialogEvents }