paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 14:58:13 +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;
FOnDialogDestroyed: TNotifyEvent;
FOnExpand: TNotifyEvent;
FOnHyperlinkClicked: TNotifyEvent;
FOnRadioButtonClicked: TNotifyEvent;
FOnTimer: TTaskDlgTimerEvent;
FOnVerificationClicked: TNotifyEvent;
@ -652,6 +653,7 @@ type
FSimpleQueryPasswordChar: Char;
FText: TTranslateString;
FTitle: TTranslateString;
FURL: String;
FVerificationText: TTranslateString;
FWidth: Integer;
FOnButtonClicked: TTaskDlgClickEvent;
@ -671,7 +673,7 @@ type
procedure DoOnTimer(TickCount: Cardinal; var Reset: Boolean); dynamic;
procedure DoOnVerificationClicked(Checked: Boolean); dynamic;
//procedure DoOnHelp; dynamic;
//procedure DoOnHyperlinkClicked(const AURL: string); dynamic;
procedure DoOnHyperlinkClicked(const AURL: string); dynamic;
//procedure DoOnNavigated; dynamic;
procedure SetRadioButtonFromRadioIndex(AIndex: Integer);
@ -704,6 +706,7 @@ type
property Title: TTranslateString read FTitle write FTitle;
property VerificationText: TTranslateString read FVerificationText write FVerificationText;
property Width: Integer read FWidth write FWidth default 0;
property URL: String read FURL;
property OnButtonClicked: TTaskDlgClickEvent read FOnButtonClicked write FOnButtonClicked;
property OnDialogConstructed: TNotifyEvent read FOnDialogConstructed write FOnDialogConstructed;
property OnDialogCreated: TNotifyEvent read FOnDialogCreated write FOnDialogCreated;
@ -712,6 +715,7 @@ type
property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer;
property OnRadioButtonClicked: TNotifyEvent read FOnRadioButtonClicked write FOnRadioButtonClicked;
property OnHyperlinkClicked: TNotifyEvent read FOnHyperlinkClicked write FOnHyperlinkClicked;
end;
TTaskDialog = class(TCustomTaskDialog)
@ -743,6 +747,7 @@ type
property OnExpand;
property OnTimer;
property OnRadioButtonClicked;
property OnHyperlinkClicked;
end;
const

7
lcl/include/taskdialog.inc
View File

@ -215,6 +215,13 @@ begin
FOnVerificationClicked(Self);
end;
procedure TCustomTaskDialog.DoOnHyperlinkClicked(const AURL: string);
begin
FURL := AURL;
if Assigned(FOnHyperlinkClicked) then
FOnHyperlinkClicked(Self);
end;
procedure TCustomTaskDialog.SetRadioButtonFromRadioIndex(AIndex: Integer);
begin
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;
wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall;
var Dlg: TTaskDialog absolute dwRefData;
CanClose, ResetTimer: Boolean;
var
Dlg: TTaskDialog absolute dwRefData;
CanClose, ResetTimer: Boolean;
AUrl: String;
begin
Result := S_OK;
case uNotification of
@ -1706,8 +1708,11 @@ begin
lParam: Pointer to a wide-character string containing the URL of the hyperlink.
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??
if IsConsole then writeln('ToDo: implement OnHyperlinkClicked');
AUrl := Utf16ToUtf8(PWideChar(lParam)); // <== can this be done safely and passed to OnUrlClicked if AUrls is a local variable here??
{$PUSH}
{$ObjectChecks OFF}
TTaskDialogAccess(Dlg).DoOnHyperlinkClicked(AUrl);
{$POP}
end;
TDN_NAVIGATED:
begin