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

CustomDrawn-Windows: Fixes endless loop in PromptUser

Browse Source 
git-svn-id: trunk@48831 -
This commit is contained in:
sekelsenmat 2015-04-24 11:18:58 +00:00
parent 929fbbbbf6
commit 4a4b47c394
4 changed files with 1189 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6826,6 +6826,7 @@ lcl/interfaces/customdrawn/cocoagdiobjects.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/cocoautils.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawn_androidproc.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawn_cocoaproc.pas svneol=native#text/plain
lcl/interfaces/customdrawn/customdrawn_winextra.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawn_winproc.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawn_x11proc.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawndefines.inc svneol=native#text/pascal

1102
lcl/interfaces/customdrawn/customdrawn_winextra.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -30,7 +30,7 @@ uses
// XML
XMLRead, Dom,
// Platform specific
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
{$ifdef CD_Windows}Windows, customdrawn_WinProc, customdrawn_winextra,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaGDIObjects,Types,{$endif}
{$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc,{$ifdef CD_UseNativeText}xft, fontconfig,{$endif}{$endif}
{$ifdef CD_Android}
@ -48,7 +48,7 @@ uses
// LCL
customdrawn_common, customdrawncontrols, customdrawndrawers,
lazcanvas, lazregions, lazdeviceapis,
InterfaceBase, Themes,
InterfaceBase, Themes, Dialogs, Buttons,
Controls, Forms, lclproc, IntfGraphics, GraphType,
LCLType, LMessages, Graphics, LCLStrConsts, Menus, LazLoggerBase;

86
lcl/interfaces/customdrawn/customdrawnlclintf_win.inc
View File

@ -125,9 +125,91 @@ function TCDWidgetSet.PromptUser(const DialogCaption : string;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
var
i: Integer;
Caption: String;
TaskConfig: TTASKDIALOGCONFIG;
DialogButtons: PTASKDIALOG_BUTTON;
State: TApplicationState;
begin
Result := 0;
Application.MessageBox(PChar(DialogMessage), PChar(DialogCaption), MB_OK);
//TaskDialogIndirect is available in Vista and up, but only if app was built with manifest.
//The check for the latter is done by checking for ComCtlVersionIE6 (which is set in the manifest)
//The availability of TaskDialogIndirect does not depend on the status of ThemeServices
//Issue #0027664
if (WindowsVersion >= wvVista) and (GetFileVersion(comctl32) >= ComCtlVersionIE6) 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.MainFormHandle
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 := Windows.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));
TaskConfig.cButtons := ButtonCount;
GetMem(DialogButtons, SizeOf(TTASKDIALOG_BUTTON) * ButtonCount);
for i := 0 to ButtonCount - 1 do
begin
DialogButtons[i].nButtonID := Buttons[i];
DialogButtons[i].pszButtonText := UTF8StringToPWideChar(GetButtonCaption(Buttons[i]));
end;
TaskConfig.pButtons := DialogButtons;
//we need idButtonXX value
if DefaultIndex < ButtonCount then
TaskConfig.nDefaultButton := Buttons[DefaultIndex]
else
TaskConfig.nDefaultButton := 0;
State := SaveApplicationState;
try
Result := IDCANCEL;
TaskDialogIndirect(@TaskConfig, @Result, nil, nil);
if Result = IDCANCEL then
Result := EscapeResult;
finally
RestoreApplicationState(State);
for i := 0 to ButtonCount - 1 do
FreeMem(DialogButtons[i].pszButtonText);
FreeMem(DialogButtons);
end;
end
else
Result := inherited PromptUser(DialogCaption, DialogMessage, DialogType,
Buttons, ButtonCount, DefaultIndex, EscapeResult);
end;
{------------------------------------------------------------------------------