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

lcl: redo QuestionDialog buttons usage, move buttons to outer class for use in widgetsets

Browse Source 
win32: implement QuestionDialog for Vista+ systems

git-svn-id: trunk@28448 -
This commit is contained in:
paul 2010-11-24 10:12:28 +00:00
parent fdc4ea1c18
commit ab02ee49aa
7 changed files with 386 additions and 181 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/intfbaselcl.inc
View File

@ -49,11 +49,11 @@ begin
Result := 0;
end;
function TWidgetSet.AskUser(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
function TWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
if QuestionDialogFunction <> nil then
Result := QuestionDialogFunction(aCaption, aMsg, DlgType, Buttons, HelpCtx)
Result := QuestionDialogFunction(DialogCaption, DialogMessage, DialogType, Buttons, HelpCtx)
else
Result := 0;
end;

6
lcl/include/lclintf.inc
View File

@ -1,4 +1,4 @@
{%MainUnit ../lclintf.pp}
{%MainUnit ../lclintf.pas}
{ $Id$
******************************************************************************
All interface communication related stuff goes here.
@ -56,9 +56,9 @@ begin
Result := WidgetSet.AllocateHWnd(Method);
end;
function AskUser(const aCaption, aMsg: string; DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
Result := WidgetSet.AskUser(aCaption, aMsg, DlgType, Buttons, HelpCtx);
Result := WidgetSet.AskUser(DialogCaption, DialogMessage, DialogType, Buttons, HelpCtx);
end;
procedure CallDefaultWndHandler(Sender: TObject; var Message);

2
lcl/include/lclintfh.inc
View File

@ -41,7 +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}
function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; 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}

319
lcl/include/promptdialog.inc
View File

@ -531,12 +531,11 @@ type
TextStyle : TTextStyle;
MessageTxt: String;
constructor CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
destructor Destroy; override;
procedure Paint; override;
procedure LayoutDialog;
function ShowModal: TModalResult; override;
function FindButton(Order: array of TModalResult): TBitBtn;
end;
{ TQuestionDlg }
@ -676,43 +675,14 @@ begin
Result := inherited ShowModal;
end;
function TQuestionDlg.FindButton(Order: array of TModalResult): TBitBtn;
var
i: Integer;
CurValue: TModalResult;
j: Integer;
begin
if FButtons = nil then
begin
Result := nil;
Exit;
end;
for i := Low(Order) to High(Order) do
begin
CurValue := Order[i];
for j := 0 to FButtons.Count - 1 do
begin
Result := TBitBtn(FButtons[j]);
if Result.ModalResult = CurValue then
Exit;
end;
end;
Result := nil;
end;
constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
var
i: Integer;
CurBtnValue: TModalResult;
CurBtnCaption, CurOptions: String;
i: integer;
CurBtn: TDialogButton;
NewButton: TBitBtn;
NewKind: TBitBtnKind;
NewCaption: String;
ok: Boolean;
DefaultBtn: TBitBtn;
HasOptions: Boolean;
IsDefault: Boolean;
begin
inherited Create(nil);
PopupMode := pmAuto;
@ -732,135 +702,6 @@ begin
ShowPrefix := True;
end;
ok := false;
try
DefaultBtn:=nil;
i:=Low(Buttons);
while i <= High(Buttons) do
begin
if Buttons[i].VType <> vtInteger then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
+IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
if Buttons[i].VType = vtInteger then
begin
// get TModalResult
CurBtnValue := Buttons[i].VInteger;
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue));
inc(i);
// get button caption
CurBtnCaption := '';
if (i <= High(Buttons)) then
begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
case Buttons[i].VType of
vtString: CurBtnCaption := Buttons[i].VString^;
vtAnsiString: CurBtnCaption := AnsiString(Buttons[i].VAnsiString);
vtChar: CurBtnCaption := Buttons[i].VChar;
vtPChar: CurBtnCaption := Buttons[i].VPChar;
vtPWideChar: CurBtnCaption := Buttons[i].VPWideChar;
vtWideChar: CurBtnCaption := Buttons[i].VWideChar;
vtWidestring: CurBtnCaption := WideString(Buttons[i].VWideString);
else
dec(i); // prevent the following inc(i)
end;
inc(i);
end;
// get options
CurOptions := '';
IsDefault := False;
if (i<=High(Buttons)) then
begin
//debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
HasOptions := True;
case Buttons[i].VType of
vtString: CurOptions := Buttons[i].VString^;
vtAnsiString: CurOptions := AnsiString(Buttons[i].VAnsiString);
vtChar: CurOptions := Buttons[i].VChar;
vtPChar: CurOptions := Buttons[i].VPChar;
vtPWideChar: CurOptions := Buttons[i].VPWideChar;
vtWideChar: CurOptions := Buttons[i].VWideChar;
vtWidestring: CurOptions := WideString(Buttons[i].VWideString);
else
HasOptions := False;
end;
if HasOptions then
begin
if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
+IntToStr(i)+' but "'+CurOptions+'" found.');
if DefaultBtn<>nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault := True;
inc(i);
end;
end;
//DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption,' CurOptions="',CurOptions,'"');
if CurBtnCaption = '' then
begin
// find default caption
case CurBtnValue of
mrOk : CurBtnCaption := rsmbOk;
mrCancel : CurBtnCaption := rsmbCancel;
mrYes : CurBtnCaption := rsmbYes;
mrNo : CurBtnCaption := rsmbNo;
mrAbort : CurBtnCaption := rsmbAbort;
mrRetry : CurBtnCaption := rsmbRetry;
mrIgnore : CurBtnCaption := rsmbIgnore;
mrAll : CurBtnCaption := rsmbAll;
mrYesToAll : CurBtnCaption := rsmbYesToAll;
mrNoToAll : CurBtnCaption := rsmbNoToAll;
end;
end;
if CurBtnCaption = '' then
raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
// get button kind
case curBtnValue of
mrOk: NewKind := bkOK;
mrCancel: NewKind := bkCancel;
mrYes: NewKind := bkYes;
mrNo: NewKind := bkNo;
mrAbort: NewKind := bkAbort;
mrRetry: NewKind := bkRetry;
mrIgnore: NewKind := bkIgnore;
mrAll: NewKind := bkAll;
mrNoToAll: NewKind := bkNoToAll;
mrYesToAll: NewKind := bkYesToAll;
else
NewKind := bkCustom;
end;
// add button
if FButtons = nil then
FButtons := TList.Create;
NewButton := TBitBtn.Create(Self);
with NewButton do
begin
AutoSize := False;
Anchors := [akLeft, akBottom];
ModalResult := curBtnValue;
Layout := blGlyphLeft;
Kind := NewKind;
Caption := curBtnCaption;
Parent := Self;
Default := IsDefault;
end;
if IsDefault then
DefaultBtn := NewButton;
FButtons.Add(NewButton);
end
else
raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
end;
ok := True;
finally
if not Ok then
FreeAndNil(FButtons);
end;
FBitmap := nil;
NewCaption := ACaption;
case DlgType of
@ -876,12 +717,43 @@ begin
if NewCaption = '' then
NewCaption := Application.Title;
Caption := NewCaption;
// find default and cancel button
if DefaultBtn = nil then
DefaultBtn := FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
DefaultControl := DefaultBtn;
CancelControl := FindButton([mrAbort, mrCancel, mrNo, mrIgnore, mrNoToAll, mrYes, mrOk, mrRetry, mrAll, mrYesToAll])
for i := 0 to Buttons.Count - 1 do
begin
CurBtn := Buttons[i];
// get button kind
case CurBtn.ModalResult of
mrOk: NewKind := bkOK;
mrCancel: NewKind := bkCancel;
mrYes: NewKind := bkYes;
mrNo: NewKind := bkNo;
mrAbort: NewKind := bkAbort;
mrRetry: NewKind := bkRetry;
mrIgnore: NewKind := bkIgnore;
mrAll: NewKind := bkAll;
mrNoToAll: NewKind := bkNoToAll;
mrYesToAll: NewKind := bkYesToAll;
else
NewKind := bkCustom;
end;
NewButton := TBitBtn.Create(Self);
with NewButton do
begin
AutoSize := False;
Anchors := [akLeft, akBottom];
ModalResult := CurBtn.ModalResult;
Layout := blGlyphLeft;
Kind := NewKind;
Caption := CurBtn.Caption;
Parent := Self;
Default := CurBtn.Default;
Cancel := CurBtn.Cancel;
end;
if FButtons = nil then
FButtons := TList.Create;
FButtons.Add(NewButton);
end;
end;
destructor TQuestionDlg.Destroy;
@ -893,7 +765,7 @@ end;
function ShowQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
Buttons: array of const; HelpCtx: Longint): LongInt;
Buttons: TDialogButtons; 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,8 +796,113 @@ end;
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
Buttons: array of const; HelpCtx: Longint): TModalResult;
var
DialogButtons: TDialogButtons;
i: integer;
CurBtnValue: TModalResult;
CurBtnCaption, CurOptions: String;
HasOptions: Boolean;
IsDefault: Boolean;
NewButton: TDialogButton;
begin
Result := WidgetSet.AskUser(aCaption, aMsg, DialogIds[DlgType], Buttons, HelpCtx);
DialogButtons := TDialogButtons.Create(TDialogButton);
try
i := Low(Buttons);
while i <= High(Buttons) do
begin
if Buttons[i].VType <> vtInteger then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
+IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
if Buttons[i].VType = vtInteger then
begin
// get TModalResult
CurBtnValue := Buttons[i].VInteger;
inc(i);
// get button caption
CurBtnCaption := '';
if (i <= High(Buttons)) then
begin
case Buttons[i].VType of
vtString: CurBtnCaption := Buttons[i].VString^;
vtAnsiString: CurBtnCaption := AnsiString(Buttons[i].VAnsiString);
vtChar: CurBtnCaption := Buttons[i].VChar;
vtPChar: CurBtnCaption := Buttons[i].VPChar;
vtPWideChar: CurBtnCaption := Buttons[i].VPWideChar;
vtWideChar: CurBtnCaption := Buttons[i].VWideChar;
vtWidestring: CurBtnCaption := WideString(Buttons[i].VWideString);
else
dec(i); // prevent the following inc(i)
end;
inc(i);
end;
// get options
CurOptions := '';
IsDefault := False;
if (i <= High(Buttons)) then
begin
HasOptions := True;
case Buttons[i].VType of
vtString: CurOptions := Buttons[i].VString^;
vtAnsiString: CurOptions := AnsiString(Buttons[i].VAnsiString);
vtChar: CurOptions := Buttons[i].VChar;
vtPChar: CurOptions := Buttons[i].VPChar;
vtPWideChar: CurOptions := Buttons[i].VPWideChar;
vtWideChar: CurOptions := Buttons[i].VWideChar;
vtWidestring: CurOptions := WideString(Buttons[i].VWideString);
else
HasOptions := False;
end;
if HasOptions then
begin
if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
+IntToStr(i)+' but "'+CurOptions+'" found.');
if DialogButtons.DefaultButton <> nil then
raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
IsDefault := True;
inc(i);
end;
end;
if CurBtnCaption = '' then
begin
// find default caption
case CurBtnValue of
mrOk : CurBtnCaption := rsmbOk;
mrCancel : CurBtnCaption := rsmbCancel;
mrYes : CurBtnCaption := rsmbYes;
mrNo : CurBtnCaption := rsmbNo;
mrAbort : CurBtnCaption := rsmbAbort;
mrRetry : CurBtnCaption := rsmbRetry;
mrIgnore : CurBtnCaption := rsmbIgnore;
mrAll : CurBtnCaption := rsmbAll;
mrYesToAll : CurBtnCaption := rsmbYesToAll;
mrNoToAll : CurBtnCaption := rsmbNoToAll;
end;
end;
if CurBtnCaption = '' then
raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
NewButton := DialogButtons.Add;
with NewButton do
begin
Caption := CurBtnCaption;
ModalResult := CurBtnValue;
end;
if IsDefault then
DialogButtons.DefaultButton := NewButton;
end
else
raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
end;
if DialogButtons.DefaultButton = nil then
DialogButtons.DefaultButton := DialogButtons.FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
DialogButtons.CancelButton := DialogButtons.FindButton([mrAbort, mrCancel, mrNo, mrIgnore, mrNoToAll, mrYes, mrOk, mrRetry, mrAll, mrYesToAll]);
Result := WidgetSet.AskUser(aCaption, aMsg, DialogIds[DlgType], DialogButtons, HelpCtx);
finally
DialogButtons.Free;
end;
end;
function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;

143
lcl/interfacebase.pp
View File

@ -83,6 +83,47 @@ type
lcLMHelpSupport // support for LM_HELP command
);
{ TDialogButton }
TDialogButton = class(TCollectionItem)
private
FCaption: string;
FModalResult: LongInt;
function GetCancel: Boolean;
function GetDefault: Boolean;
procedure SetCancel(const AValue: Boolean);
procedure SetDefault(const AValue: Boolean);
protected
function GetDisplayName: string; override;
procedure SetCaption(const AValue: string); virtual;
public
constructor Create(ACollection: TCollection); override;
property Caption: string read FCaption write SetCaption;
property Cancel: Boolean read GetCancel write SetCancel;
property Default: Boolean read GetDefault write SetDefault;
property ModalResult: LongInt read FModalResult write FModalResult;
end;
{ TDialogButtons }
TDialogButtons = class(TCollection)
protected
FCancelButton: TDialogButton;
FDefaultButton: TDialogButton;
function GetItem(Index: Integer): TDialogButton;
procedure SetCancelButton(const AValue: TDialogButton); virtual;
procedure SetDefaultButton(const Value: TDialogButton); virtual;
procedure SetItem(Index: Integer; const Value: TDialogButton);
public
destructor Destroy; override;
function Add: TDialogButton;
function FindButton(AModalResult: LongInt): TDialogButton;
function FindButton(Order: array of LongInt): TDialogButton;
property DefaultButton: TDialogButton read FDefaultButton write SetDefaultButton;
property CancelButton: TDialogButton read FCancelButton write SetCancelButton;
property Items[Index: Integer]: TDialogButton read GetItem write SetItem; default;
end;
type
TWSTimerProc = procedure of object;
@ -169,7 +210,7 @@ type
UseDefaultPos: boolean;
X, Y : Longint) : Longint;
TQuestionDialogFunction = function(const aCaption, aMsg: string;
DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
var
InputDialogFunction: TInputDialogFunction = nil;
@ -185,6 +226,106 @@ const
UNKNOWN_VK_PREFIX = 'Word(''';
UNKNOWN_VK_POSTFIX = ''')';
{ TDialogButtons }
procedure TDialogButtons.SetCancelButton(const AValue: TDialogButton);
begin
FCancelButton := AValue;
end;
function TDialogButtons.GetItem(Index: Integer): TDialogButton;
begin
Result := TDialogButton(inherited GetItem(Index));
end;
procedure TDialogButtons.SetDefaultButton(const Value: TDialogButton);
begin
FDefaultButton := Value;
end;
procedure TDialogButtons.SetItem(Index: Integer; const Value: TDialogButton);
begin
inherited SetItem(Index, Value);
end;
destructor TDialogButtons.Destroy;
begin
inherited Destroy;
end;
function TDialogButtons.Add: TDialogButton;
begin
Result := TDialogButton(inherited Add);
end;
function TDialogButtons.FindButton(AModalResult: LongInt): TDialogButton;
var
i: Integer;
begin
for i := 0 to Count - 1 do
if Items[i].ModalResult = AModalResult then
Exit(Items[i]);
Result := nil;
end;
function TDialogButtons.FindButton(Order: array of LongInt): TDialogButton;
var
i: Integer;
begin
for i := Low(Order) to High(Order) do
begin
Result := FindButton(Order[i]);
if Result <> nil then
Exit;
end;
Result := nil;
end;
{ TDialogButton }
procedure TDialogButton.SetCaption(const AValue: string);
begin
FCaption := AValue;
end;
function TDialogButton.GetDefault: Boolean;
begin
Result := TDialogButtons(Collection).DefaultButton = Self;
end;
function TDialogButton.GetCancel: Boolean;
begin
Result := TDialogButtons(Collection).CancelButton = Self;
end;
procedure TDialogButton.SetCancel(const AValue: Boolean);
begin
if AValue then
TDialogButtons(Collection).CancelButton := Self
else
TDialogButtons(Collection).CancelButton := nil;
end;
procedure TDialogButton.SetDefault(const AValue: Boolean);
begin
if AValue then
TDialogButtons(Collection).DefaultButton := Self
else
TDialogButtons(Collection).DefaultButton := nil;
end;
function TDialogButton.GetDisplayName: string;
begin
Result := FCaption;
end;
constructor TDialogButton.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FCaption := '';
FModalResult := 0;
end;
{$I interfacebase.inc}
{$I intfbasewinapi.inc}
{$I intfbaselcl.inc}

88
lcl/interfaces/win32/win32lclintf.inc
View File

@ -328,6 +328,90 @@ begin
Self.SetWindowLong(Result, GWL_WNDPROC, PtrInt(@CallbackAllocateHWnd))
end;
function TWin32WidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
var
i: Integer;
Caption: String;
TaskConfig: TTASKDIALOGCONFIG;
DialogButtons: PTASKDIALOG_BUTTON;
State: TApplicationState;
begin
if (WindowsVersion >= wvVista) and ThemeServices.ThemesEnabled then
begin
FillChar(TaskConfig, SizeOf(TaskConfig), 0);
TaskConfig.cbSize := SizeOf(TaskConfig);
// if we skip hwndParent our form will be a root window - with the taskbar item and icon
// this is unwanted
if Assigned(Screen.ActiveCustomForm) then
TaskConfig.hwndParent := Screen.ActiveCustomForm.Handle
else
if Assigned(Application.MainForm) then
TaskConfig.hwndParent := Application.MainForm.Handle
else
TaskConfig.hwndParent := AppHandle;
TaskConfig.hInstance := HInstance;
TaskConfig.dwFlags := TDF_ALLOW_DIALOG_CANCELLATION;
if DialogCaption <> '' then
Caption := DialogCaption
else
case DialogType of
idDialogConfirm,
idDialogInfo,
idDialogWarning,
idDialogError: Caption := GetDialogCaption(DialogType);
else
Caption := Application.Title;
end;
TaskConfig.pszWindowTitle := PWideChar(UTF8ToUTF16(Caption));
case DialogType of
idDialogConfirm:
begin
TaskConfig.hMainIcon := LoadIcon(0, IDI_QUESTION);
TaskConfig.dwFlags := TaskConfig.dwFlags or TDF_USE_HICON_MAIN;
end;
idDialogInfo: TaskConfig.pszMainIcon := TD_INFORMATION_ICON;
idDialogWarning: TaskConfig.pszMainIcon := TD_WARNING_ICON;
idDialogError: TaskConfig.pszMainIcon := TD_ERROR_ICON;
idDialogShield: TaskConfig.pszMainIcon := TD_SHIELD_ICON;
else
TaskConfig.dwFlags := TaskConfig.dwFlags or TDF_USE_HICON_MAIN;
end;
TaskConfig.pszContent := PWideChar(UTF8ToUTF16(DialogMessage));
// question dialog button magic :)
TaskConfig.cButtons := Buttons.Count;
GetMem(DialogButtons, SizeOf(TTASKDIALOG_BUTTON) * TaskConfig.cButtons);
for i := 0 to TaskConfig.cButtons - 1 do
begin
DialogButtons[i].nButtonID := Buttons[i].ModalResult;
DialogButtons[i].pszButtonText := UTF8StringToPWideChar(Buttons[i].Caption);
end;
TaskConfig.pButtons := DialogButtons;
if Assigned(Buttons.DefaultButton) then
TaskConfig.nDefaultButton := Buttons.DefaultButton.Index;
State := SaveApplicationState;
try
Result := IDCANCEL;
TaskDialogIndirect(@TaskConfig, @Result, nil, nil);
if (Result = IDCANCEL) and Assigned(Buttons.CancelButton) then
Result := Buttons.CancelButton.ModalResult;
finally
RestoreApplicationState(State);
for i := 0 to TaskConfig.cButtons - 1 do
FreeMem(DialogButtons[i].pszButtonText);
FreeMem(DialogButtons);
end;
end
else
Result := inherited AskUser(DialogCaption, DialogMessage, DialogType,
Buttons, HelpCtx);
end;
{------------------------------------------------------------------------------
Method: TWin32WidgetSet.DeallocateHWnd
Params: Wnd - A Window handle, that was created with AllocateHWnd
@ -656,7 +740,9 @@ begin
State := SaveApplicationState;
try
if TaskDialogIndirect(@TaskConfig, @Result, nil, nil) <> S_OK then
Result := IDCANCEL;
TaskDialogIndirect(@TaskConfig, @Result, nil, nil);
if Result = IDCANCEL then
Result := EscapeResult;
finally
RestoreApplicationState(State);

3
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -36,6 +36,7 @@ function AddPipeEventHandler(AHandle: THandle;
function AddProcessEventHandler(AHandle: THandle;
AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override;
function AllocateHWnd(Method: TLCLWndMethod): HWND; override;
function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt; override;
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
@ -57,7 +58,7 @@ function GetDesignerDC(WindowHandle: HWND): HDC; override;
function IntfSendsUTF8KeyPress: boolean; override;
function IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; override;
function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint; override;
function PromptUser(const DialogCaption, DialogMessage: String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint; override;
function RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean = False): Boolean; override;
function RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean; override;