paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:58:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add a possibility to override QuestionDlg in widgetset

Browse Source 
git-svn-id: trunk@28445 -
This commit is contained in:
paul 2010-11-24 08:16:34 +00:00
parent da7a65635c
commit d34e4eb1c0
6 changed files with 51 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/dialogs.pp
View File

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

15
lcl/include/intfbaselcl.inc
View File

@ -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,
Buttons, ButtonCount, DefaultIndex, EscapeResult, false, X, Y)
Result := PromptDialogFunction(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult, False, X, Y)
else
Result:=0;
Result := 0;
end;
function TWidgetSet.RadialArc(DC: HDC;

5
lcl/include/lclintf.inc
View File

@ -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);

1
lcl/include/lclintfh.inc
View File

@ -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}

32
lcl/include/promptdialog.inc
View File

@ -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(dlgId);
if NewCaption='' then
NewCaption := GetDialogCaption(dlgId);
FBitmap := GetDialogIcon(DlgType);
if NewCaption = '' then
NewCaption := GetDialogCaption(DlgType);
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;
Buttons: array of const; HelpCtx: Longint): TModalResult;
function ShowQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
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

17
lcl/interfacebase.pp
View File

@ -163,20 +163,21 @@ type
type
TInputDialogFunction = function (const InputCaption, InputPrompt : String;
MaskInput : Boolean; var Value : String) : Boolean;
var
InputDialogFunction: TInputDialogFunction = nil;
type
TPromptDialogFunction = Function(const DialogCaption, DialogMessage : String;
TPromptDialogFunction = function(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint;
ButtonCount, DefaultIndex, EscapeResult : Longint;
UseDefaultPos: boolean;
X, Y : Longint) : Longint;
var
PromptDialogFunction: TPromptDialogFunction = nil;
TQuestionDialogFunction = function(const aCaption, aMsg: string;
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