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

TaskDialog: implement OnHyperlinkClicked and associated property URL. Native Vista+ dialog only.

Browse Source
This commit is contained in:
Bart 2023-08-01 16:54:50 +02:00
parent b5f0aca3ea
commit a0e0744618
3 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/dialogs.pp
View File

@ -640,6 +640,7 @@ type
FOnDialogCreated: TNotifyEvent; FOnDialogCreated: TNotifyEvent;
FOnDialogDestroyed: TNotifyEvent; FOnDialogDestroyed: TNotifyEvent;
FOnExpand: TNotifyEvent; FOnExpand: TNotifyEvent;
FOnHyperlinkClicked: TNotifyEvent;
FOnRadioButtonClicked: TNotifyEvent; FOnRadioButtonClicked: TNotifyEvent;
FOnTimer: TTaskDlgTimerEvent; FOnTimer: TTaskDlgTimerEvent;
FOnVerificationClicked: TNotifyEvent; FOnVerificationClicked: TNotifyEvent;
@ -652,6 +653,7 @@ type
FSimpleQueryPasswordChar: Char; FSimpleQueryPasswordChar: Char;
FText: TTranslateString; FText: TTranslateString;
FTitle: TTranslateString; FTitle: TTranslateString;
FURL: String;
FVerificationText: TTranslateString; FVerificationText: TTranslateString;
FWidth: Integer; FWidth: Integer;
FOnButtonClicked: TTaskDlgClickEvent; FOnButtonClicked: TTaskDlgClickEvent;
@ -671,7 +673,7 @@ type
procedure DoOnTimer(TickCount: Cardinal; var Reset: Boolean); dynamic; procedure DoOnTimer(TickCount: Cardinal; var Reset: Boolean); dynamic;
procedure DoOnVerificationClicked(Checked: Boolean); dynamic; procedure DoOnVerificationClicked(Checked: Boolean); dynamic;
//procedure DoOnHelp; dynamic; //procedure DoOnHelp; dynamic;
//procedure DoOnHyperlinkClicked(const AURL: string); dynamic; procedure DoOnHyperlinkClicked(const AURL: string); dynamic;
//procedure DoOnNavigated; dynamic; //procedure DoOnNavigated; dynamic;
procedure SetRadioButtonFromRadioIndex(AIndex: Integer); procedure SetRadioButtonFromRadioIndex(AIndex: Integer);
@ -704,6 +706,7 @@ type
property Title: TTranslateString read FTitle write FTitle; property Title: TTranslateString read FTitle write FTitle;
property VerificationText: TTranslateString read FVerificationText write FVerificationText; property VerificationText: TTranslateString read FVerificationText write FVerificationText;
property Width: Integer read FWidth write FWidth default 0; property Width: Integer read FWidth write FWidth default 0;
property URL: String read FURL;
property OnButtonClicked: TTaskDlgClickEvent read FOnButtonClicked write FOnButtonClicked; property OnButtonClicked: TTaskDlgClickEvent read FOnButtonClicked write FOnButtonClicked;
property OnDialogConstructed: TNotifyEvent read FOnDialogConstructed write FOnDialogConstructed; property OnDialogConstructed: TNotifyEvent read FOnDialogConstructed write FOnDialogConstructed;
property OnDialogCreated: TNotifyEvent read FOnDialogCreated write FOnDialogCreated; property OnDialogCreated: TNotifyEvent read FOnDialogCreated write FOnDialogCreated;
@ -712,6 +715,7 @@ type
property OnExpand: TNotifyEvent read FOnExpand write FOnExpand; property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer; property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer;
property OnRadioButtonClicked: TNotifyEvent read FOnRadioButtonClicked write FOnRadioButtonClicked; property OnRadioButtonClicked: TNotifyEvent read FOnRadioButtonClicked write FOnRadioButtonClicked;
property OnHyperlinkClicked: TNotifyEvent read FOnHyperlinkClicked write FOnHyperlinkClicked;
end; end;
TTaskDialog = class(TCustomTaskDialog) TTaskDialog = class(TCustomTaskDialog)
@ -743,6 +747,7 @@ type
property OnExpand; property OnExpand;
property OnTimer; property OnTimer;
property OnRadioButtonClicked; property OnRadioButtonClicked;
property OnHyperlinkClicked;
end; end;
const const

7
lcl/include/taskdialog.inc
View File

@ -215,6 +215,13 @@ begin
FOnVerificationClicked(Self); FOnVerificationClicked(Self);
end; end;
procedure TCustomTaskDialog.DoOnHyperlinkClicked(const AURL: string);
begin
FURL := AURL;
if Assigned(FOnHyperlinkClicked) then
FOnHyperlinkClicked(Self);
end;
procedure TCustomTaskDialog.SetRadioButtonFromRadioIndex(AIndex: Integer); procedure TCustomTaskDialog.SetRadioButtonFromRadioIndex(AIndex: Integer);
begin begin
if (AIndex >= TaskDialogFirstRadioButtonIndex) and (AIndex-TaskDialogFirstRadioButtonIndex < RadioButtons.Count) then if (AIndex >= TaskDialogFirstRadioButtonIndex) and (AIndex-TaskDialogFirstRadioButtonIndex < RadioButtons.Count) then

13
lcl/interfaces/win32/win32wsdialogs.pp
View File

@ -1659,8 +1659,10 @@ type
function TaskDialogCallbackProc({%H-}hwnd: HWND; uNotification: UINT; function TaskDialogCallbackProc({%H-}hwnd: HWND; uNotification: UINT;
wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall; wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall;
var Dlg: TTaskDialog absolute dwRefData; var
CanClose, ResetTimer: Boolean; Dlg: TTaskDialog absolute dwRefData;
CanClose, ResetTimer: Boolean;
AUrl: String;
begin begin
Result := S_OK; Result := S_OK;
case uNotification of case uNotification of
@ -1706,8 +1708,11 @@ begin
lParam: Pointer to a wide-character string containing the URL of the hyperlink. lParam: Pointer to a wide-character string containing the URL of the hyperlink.
Return value: The return value is ignored. Return value: The return value is ignored.
} }
//AUrl := Utf16ToUtf8(PWideChar(lParam)); <== can this be done safely and passed to OnUrlClicked if AUrls is a local variable here?? AUrl := Utf16ToUtf8(PWideChar(lParam)); // <== can this be done safely and passed to OnUrlClicked if AUrls is a local variable here??
if IsConsole then writeln('ToDo: implement OnHyperlinkClicked'); {$PUSH}
{$ObjectChecks OFF}
TTaskDialogAccess(Dlg).DoOnHyperlinkClicked(AUrl);
{$POP}
end; end;
TDN_NAVIGATED: TDN_NAVIGATED:
begin begin