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

LCL: fpgui: implements the Windows API function MessageBox(), issue #22865

Browse Source 
git-svn-id: trunk@38627 -
This commit is contained in:
mattias 2012-09-12 21:53:30 +00:00
parent 68fe7a297a
commit a494c8a157
3 changed files with 62 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/messagedialogs.inc
View File

@ -86,7 +86,7 @@ const
idButtonClose);
DialogResults : Array[idButtonOK..idButtonNoToAll] of TModalResult = (
mrOk, mrCancel,
mrOk, mrCancel,
mrNone{Help - when a mbHelp button is pressed the help system is started,
the dialog does not close },
mrYes, mrNo, mrClose, mrAbort, mrRetry,

59
lcl/interfaces/fpgui/fpguiwinapi.inc
View File

@ -469,6 +469,65 @@ begin
Result:=true;
end;
{ Most of the functionality is implemented. As described in MSDN:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms645505%28v=vs.85%29.aspx }
function TFpGuiWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar;
uType: Cardinal): integer;
var
Str: AnsiString;
TitleStr: AnsiString;
Buttons : TfpgMsgDlgButtons;
BtnType: Cardinal;
DlgType: Cardinal;
begin
BtnType := (uType and $0000000F); { mask the button type }
if (BtnType = MB_OKCANCEL) then
Buttons := mbOKCancel
else
if (BtnType = MB_ABORTRETRYIGNORE) then
Buttons := mbAbortRetryIgnore
else
if (BtnType = MB_YESNOCANCEL) then
Buttons := mbYesNoCancel
else
if (BtnType = MB_YESNO) then
Buttons := mbYesNo
else
if (BtnType = MB_RETRYCANCEL) then
Buttons := [mbRetry, mbCancel]
else
if (BtnType = MB_CANCELTRYCONTINUE) then
Buttons := mbAbortRetryIgnore
else
Buttons := [mbOK];
{ shoud we had a Help button too? - again as per MSDN }
if (uType and MB_HELP) = MB_HELP then
Include(Buttons, mbHelp);
Str := lpText;
TitleStr := lpCaption;
if lpCaption = nil then
TitleStr := 'Error'; // as per MSDN
DlgType := (uType and $000000F0); { mask the dialog type }
if (DlgType and MB_ICONINFORMATION) = MB_ICONINFORMATION then
TfpgMessageDialog.Information(TitleStr, Str, Buttons)
else
if (DlgType and MB_ICONWARNING) = MB_ICONWARNING then
TfpgMessageDialog.Warning(TitleStr, Str, Buttons)
else
if (DlgType and MB_ICONQUESTION) = MB_ICONQUESTION then
TfpgMessageDialog.Question(TitleStr, Str, Buttons)
else
if (DlgType and MB_ICONERROR) = MB_ICONERROR then
TfpgMessageDialog.Critical(TitleStr, Str, Buttons)
else
TfpgMessageDialog.Information(TitleStr, Str, Buttons);
end;
function TFpGuiWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var
ADC: TFpGuiDeviceContext absolute DC;

3
lcl/interfaces/fpgui/fpguiwinapih.inc
View File

@ -138,8 +138,9 @@ function IsWindowVisible(Handle: HWND): boolean; override;
procedure LeaveCriticalSection(var CritSection: TCriticalSection); override;
function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
}
function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override;
{
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override;