Creating a "counter" to close your "Active window", like MessageDLG using SetTimer() and PostMessage() from API Windows Code by Žarko Gajić (MVP Embarcadero)
function MessageDlgTimedAdvanced(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; const closePeriod: integer = 5000): Integer; const tickPeriod = 250; var timerCloseId, timerTickId: UINT_PTR; r : integer; peekMsg : TMsg;
procedure CloseMessageDlgCallback(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; ATicks: DWORD); stdcall; var activeWnd: HWND; begin KillTimer(AWnd, AIDEvent);
activeWnd := GetActiveWindow;
if IsWindow(activeWnd) and IsWindowEnabled(activeWnd) then PostMessage(activeWnd, WM_CLOSE, 0, 0); end; (* CloseMessageDlgCallback *)
procedure PingMessageDlgCallback(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; ATicks: DWORD); stdcall; var activeWnd : HWND; wCaption : string; wCaptionLength: integer; begin activeWnd := GetActiveWindow; if IsWindow(activeWnd) and IsWindowEnabled(activeWnd) and IsWindowVisible(activeWnd) then begin wCaptionLength := GetWindowTextLength(activeWnd); SetLength(wCaption, wCaptionLength); GetWindowText(activeWnd, PChar(wCaption), 1 + wCaptionLength); SetWindowText(activeWnd, Copy(wCaption, 1, -1 + Length(wCaption))); end else KillTimer(AWnd, AIDEvent); end; (* PingMessageDlgCallback *)
// begin if (DlgType = mtInformation) and ([mbOK] = Buttons) then begin timerCloseId := SetTimer(0, 0, closePeriod, @CloseMessageDlgCallback);
if timerCloseId <> 0 then begin timerTickId := SetTimer(0, 0, tickPeriod, @PingMessageDlgCallback);
if timerTickId <> 0 then r := HookResourceString(@SMsgDlgInformation, PChar(SMsgDlgInformation + ' ' + StringOfChar('.', closePeriod div tickPeriod))); end;
result := MessageDlg(Msg, DlgType, Buttons, HelpCtx);
if timerTickId <> 0 then begin KillTimer(0, timerTickId); UnHookResourceString(@SMsgDlgInformation, r); end;
if timerCloseId <> 0 then KillTimer(0, timerCloseId); end else result := MessageDlg(Msg, DlgType, Buttons, HelpCtx); end;
//********** procedure TForm1.Button2Click(Sender: TObject); begin MessageDlgTimedAdvanced('string', mtInformation, [mbOK], 0, 5000); // ok end;
procedure TForm1.Button1Click(Sender: TObject); begin MessageDlgTimed('string', mtInformation, [mbYes], 0, 4000); // ok end;
end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3