lcl: add a possibility to override QuestionDlg in widgetset

git-svn-id: trunk@28445 -

lcl/dialogs.pp

@@ -702,12 +702,14 @@ begin
 end;
 
 initialization
-  Forms.MessageBoxFunction:=@ShowMessageBox;
+  Forms.MessageBoxFunction := @ShowMessageBox;
-  InterfaceBase.InputDialogFunction:=@ShowInputDialog;
+  InterfaceBase.InputDialogFunction := @ShowInputDialog;
-  InterfaceBase.PromptDialogFunction:=@ShowPromptDialog;
+  InterfaceBase.PromptDialogFunction := @ShowPromptDialog;
+  InterfaceBase.QuestionDialogFunction := @ShowQuestionDialog;
   {$I dialog_icons.lrs}
 
 finalization
-  InterfaceBase.InputDialogFunction:=nil;
+  InterfaceBase.InputDialogFunction := nil;
+  InterfaceBase.QuestionDialogFunction := nil;
 
 end.

lcl/include/intfbaselcl.inc

@@ -49,6 +49,15 @@ begin
   Result := 0;
 end;
 
+function TWidgetSet.AskUser(const aCaption, aMsg: string;
+    DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
+begin
+  if QuestionDialogFunction <> nil then
+    Result := QuestionDialogFunction(aCaption, aMsg, DlgType, Buttons, HelpCtx)
+  else
+    Result := 0;
+end;
+
 procedure TWidgetSet.CallDefaultWndHandler(Sender: TObject; var Message);
 begin
 end;
@@ -611,10 +620,10 @@ function TWidgetSet.PromptUserAtXY(const DialogCaption,
   X, Y: Longint): Longint;
 begin
   if PromptDialogFunction<>nil then
-    Result:=PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
+    Result := PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
-       Buttons, ButtonCount, DefaultIndex, EscapeResult, false, X, Y)
+       Buttons, ButtonCount, DefaultIndex, EscapeResult, False, X, Y)
   else
-    Result:=0;
+    Result := 0;
 end;
 
 function TWidgetSet.RadialArc(DC: HDC;

lcl/include/lclintf.inc

@@ -56,6 +56,11 @@ begin
   Result := WidgetSet.AllocateHWnd(Method);
 end;
 
+function AskUser(const aCaption, aMsg: string; DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
+begin
+  Result := WidgetSet.AskUser(aCaption, aMsg, DlgType, Buttons, HelpCtx);
+end;
+
 procedure CallDefaultWndHandler(Sender: TObject; var Message);
 begin
   WidgetSet.CallDefaultWndHandler(Sender,Message);

lcl/include/lclintfh.inc

@@ -41,6 +41,7 @@ function AddEventHandler(AHandle: THandle; AFlags: dword; AEventHandler: TWaitHa
 function AddProcessEventHandler(AHandle: THandle; AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function AddPipeEventHandler(AHandle: THandle; AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function AllocateHWnd(Method: TLCLWndMethod): HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function AskUser(const aCaption, aMsg: string; DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
 procedure CallDefaultWndHandler(Sender: TObject; var Message); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

lcl/include/promptdialog.inc

@@ -40,7 +40,7 @@ type
     procedure LayoutDialogSmallDevice;
     procedure Paint; override;
     constructor CreateMessageDialog(const ACaption, aMsg: string;
-      DialogType : longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
+      DialogType: Longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
     destructor Destroy; override;
   end;
 
@@ -531,7 +531,7 @@ type
     TextStyle : TTextStyle;
     MessageTxt: String;
     constructor CreateQuestionDlg(const aCaption, aMsg: string;
-      DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
+      DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
     destructor Destroy; override;
     procedure Paint; override;
     procedure LayoutDialog;
@@ -701,7 +701,7 @@ begin
 end;
 
 constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
-  DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint);
+  DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
 var
   i: Integer;
   CurBtnValue: TModalResult;
@@ -709,7 +709,6 @@ var
   NewButton: TBitBtn;
   NewKind: TBitBtnKind;
   NewCaption: String;
-  dlgId: LongInt;
   ok: Boolean;
   DefaultBtn: TBitBtn;
   HasOptions: Boolean;
@@ -863,21 +862,20 @@ begin
   end;
 
   FBitmap := nil;
-  NewCaption:=ACaption;
+  NewCaption := ACaption;
   case DlgType of
-    mtWarning, mtError, mtInformation, mtConfirmation:
+    idDialogConfirm, idDialogInfo, idDialogWarning, idDialogError:
       begin
-        dlgId := DialogIds[DlgType];
+        FBitmap := GetDialogIcon(DlgType);
-        FBitmap := GetDialogIcon(dlgId);
+        if NewCaption = '' then
-        if NewCaption='' then
+          NewCaption := GetDialogCaption(DlgType);
-          NewCaption := GetDialogCaption(dlgId);
       end;
     else
       FBitmap := GetDialogIcon(idDialogInfo);
   end;
-  if NewCaption='' then
+  if NewCaption = '' then
     NewCaption := Application.Title;
-  Caption:=NewCaption;
+  Caption := NewCaption;
   
   // find default and cancel button
   if DefaultBtn = nil then
@@ -894,8 +892,8 @@ begin
 end;
 
 
-function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
+function ShowQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
-  Buttons: array of const; HelpCtx: Longint): TModalResult;
+  Buttons: array of const; HelpCtx: Longint): LongInt;
 { Show a dialog with aCaption as Title, aMsg as Text, DlgType as Icon,
   HelpCtx as Help context and Buttons to define the shown buttons and their
   TModalResult.
@@ -924,6 +922,12 @@ begin
   end;
 end;
 
+function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
+            Buttons: array of const; HelpCtx: Longint): TModalResult;
+begin
+  Result := WidgetSet.AskUser(aCaption, aMsg, DialogIds[DlgType], Buttons, HelpCtx);
+end;
+
 function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
   Buttons: array of const; const HelpKeyword: string): TModalResult;
 begin

lcl/interfacebase.pp

@@ -163,20 +163,21 @@ type
 type
   TInputDialogFunction = function (const InputCaption, InputPrompt : String;
                              MaskInput : Boolean; var Value : String) : Boolean;
-var
+  TPromptDialogFunction = function(const DialogCaption, DialogMessage : String;
-  InputDialogFunction: TInputDialogFunction = nil;
-
-type
-  TPromptDialogFunction = Function(const DialogCaption, DialogMessage : String;
     DialogType : longint; Buttons : PLongint;
     ButtonCount, DefaultIndex, EscapeResult : Longint;
     UseDefaultPos: boolean;
     X, Y : Longint) : Longint;
-var
+  TQuestionDialogFunction = function(const aCaption, aMsg: string;
-  PromptDialogFunction: TPromptDialogFunction = nil;
+    DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
 
 var
-  WidgetSet: TWidgetSet=nil;
+  InputDialogFunction: TInputDialogFunction = nil;
+  PromptDialogFunction: TPromptDialogFunction = nil;
+  QuestionDialogFunction: TQuestionDialogFunction = nil;
+
+var
+  WidgetSet: TWidgetSet = nil;
 
 implementation