100% Api, como hablamos fuera de los foros:
Código Delphi
[-]
procedure WaitDialog(const AText: PChar; ATimeOut: Cardinal = 5000);
var
wcClass: Windows.TWndClass;
hHandle: HWND;
Msg: TMsg;
hCanvas: HDC;
hFnt, hOldFont: HFONT;
hTimer: UINT;
R: TRect;
L: Cardinal;
begin
L := StrLen(AText);
ZeroMemory(@wcClass, SizeOf(TWndClass));
with wcClass do
begin
Style := CS_CLASSDC;
hInstance := SysInit.HInstance;
lpszClassName := 'WaitDlg';
lpfnWndProc := @DefWindowProc;
hbrBackGround := CTLCOLOR_MSGBOX+1;
end;
Windows.RegisterClass(wcClass);
hHandle := Windows.CreateWindowEx(WS_EX_TOOLWINDOW, wcClass.lpszClassName,
nil, WS_POPUP or WS_BORDER, 0, 0, 100, 100, 0, 0,
wcClass.hInstance, nil);
if hHandle = 0 then
RaiseLastOSError
else
try
hCanvas := GetWindowDc(hHandle);
hFnt := CreateFont(-1, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH + FF_DONTCARE, 'MS Sans Serif');
hOldFont := SelectObject(hCanvas, hFnt);
try
SetRectEmpty(R);
R.Right := GetSystemMetrics(SM_CXSCREEN);
DrawText(hCanvas, AText, L, R, DT_CALCRECT + DT_CENTER + DT_WORDBREAK);
InflateRect(R, 2, 2);
SetBkMode(hCanvas, TRANSPARENT);
SetWindowPos(hHandle, 0,
(GetSystemMetrics(SM_CXSCREEN) - R.Right) div 2,
(GetSystemMetrics(SM_CYSCREEN) - R.Bottom) div 2,
R.Right, R.Bottom, 0);
hTimer := SetTimer(hHandle, 1, ATimeOut, nil);
try
ShowWindow(hHandle, SW_SHOW);
while GetMessage(Msg, hHandle, 0, 0) do
begin
TranslateMessage(Msg);
case Msg.message of
WM_PAINT:
begin
GetClientRect(Msg.hwnd, R);
OffsetRect(R, 1, 1);
DrawText(hCanvas, PChar(AText), Length(AText), R, DT_WORDBREAK + DT_CENTER + DT_NOCLIP);
DispatchMessage(Msg);
end;
WM_CLOSE, WM_DESTROY, WM_KEYDOWN, WM_TIMER, WM_RBUTTONDOWN:
begin
KillTimer(hHandle, hTimer);
hTimer := 0;
Break;
end;
else
DispatchMessage(Msg);
end;
end;
finally
if hTimer <> 0 then
KillTimer(hHandle, hTimer);
end;
finally
SelectObject(hCanvas, hOldFont);
DeleteObject(hFnt);
end;
finally
DestroyWindow(hHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WaitDialog(PChar(Memo1.Lines.Text));
end;