Discussion :

[Papy214]

Bonjour

https://www.delphibasics.info/home/d...imeoutfunction

Pas mal ce truc ...

Vious en connaissez d'autres qui seraient sympas et qui ne sertaient pas disponibles directement depuis Delphi ?

[ShaiLeTroll]

Vious en connaissez d'autres qui seraient sympas et qui ne sertaient pas disponibles directement depuis Delphi ?

Pour le "non disponible directement", tu voulais dire qu'il n'y a pas le Wrapper PAS fourni avec Delphi et le nombre de fonction non encapsulé de Windows est tout simplement colossal !
Pour MessageBoxTimeout c'est même pire que ça, elle n'est même pas présente de winuser.h (include Windows.h) soit donc de Windows.pas, car Microsoft se réserve l'utilisation mais ne doit pas spécialement la voir utiliser par d'autres programmeurs.

On n'aurait pas déjà un sujet concernant cette API ?


EDIT : Messagebox avec Timeout, même auteur, même sujet, à fusionner ! non ?

Personnaliser un MessageDlg qui se fermerait automatiquement après quelques secondes et MessageBoxTimeout et W2K

[Papy214]

Je ne me souvenais plus en avoir parlé mais de toutes façons, le lien qui renvoyait vers le détails de l'article n'est plus fonctionnel.

[ShaiLeTroll]

Je ne me souvenais plus en avoir parlé mais de toutes façons, le lien qui renvoyait vers le détails de l'article n'est plus fonctionnel.

Du coup, on risque de perdre aussi le nouveau lien, autant récupérer le code écrit par Jens Borrisholt qui il faut le préciser est conçu pour un Delphi ANSI, pour le rendre compatible avec un Delphi Unicode, il faut modifier le PChar en PAnsiChar comme ci-dessous
Avec le {$IFDEF UNICODE} la version A et W sont en phase avec la version du Delphi, même code pour les tous les Delphi

Since this function is not documented, it is not found in Windows.pas, so it has to be defined. It is identical to the MessageBox API definition except it has two more parameters, wLanguageID and dmMilliseconds.

section Interface

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
function MessageBoxTimeOut( 
      hWnd: HWND; lpText: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}; lpCaption: {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF} ; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function MessageBoxTimeOutA( 
      hWnd: HWND; lpText: PAnsiChar; lpCaption: PAnsiChar ; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
function MessageBoxTimeOutW( 
      hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar; 
      uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;
 
// this const is not defined in Windows.pas 
const 
  MB_TIMEDOUT = 32000;

section Implementation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
function MessageBoxTimeOut; external user32 name {$IFDEF UNICODE}'MessageBoxTimeoutW'{$ELSE}'MessageBoxTimeoutA'{$ENDIF}; 
function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA'; 
function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW';

Now, to call the function, it is as easy as setting the flags and making the call. There may be other results returned that I am not aware of besides the standard IDxxx return values and the MB_TIMEDOUT result defined above.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
var 
  iResult: Integer; 
  iFlags: Integer; 
begin 
  // Define a MessagBox  with an OK button and a timeout of 2 seconds 
  iFlags  := MB_OK or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;
  iResult := MessageBoxTimeout( 
   Application.Handle, 
   'Test a timeout of 2 seconds.', 
   'MessageBoxTimeout Test', iFlags, 0, 2000); 
  // iResult will = 1 (IDOK) 
  ShowMessage(IntToStr(iRet)); 
  // Define a MessageBox with a Yes and No button and a timeout of 5 seconds 
  iFlags  := MB_YESNO or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION; 
  iResult := MessageBoxTimeout( 
    Application.Handle, 
    'Test a timeout of 5 seconds.', 
    'MessageBoxTimeout Test', iFlags, 0, 5000); 
  // iResult = MB_TIMEDOUT if no buttons clicked, otherwise 
  // iResult will return the value of the button clicked 
  case iResult of 
  IDYES:  // Pressed Yes button 
    ShowMessage('Yes'); 
  IDNO:  // Pressed the No button 
    ShowMessage('No'); 
  MB_TIMEDOUT: // MessageBox timed out 
    ShowMessage('TimedOut'); 
  end; 
end;

I presume Borland will not put this into Windows.pas until Microsoft documents it but developers can get a head start on them by using the code above. It is unlikely that Microsoft will depricate this function for quite some time because all of the standard MessageBox API calls actually call MessageBoxTimeOutA or MessageBoxTimeoutW and pass $FFFFFFFF as the timeout period meaning the dialog will wait a very long time, approx 49 days!

[ShaiLeTroll]

Et pour avoir un code plus proche du MessageDlg

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
function MessageDlgTimeOut(const APrompt, ATitle: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; ATimeOut: Cardinal; out AResult: TModalResult): Boolean;
const
  ICONS: array [TMsgDlgType] of UINT = (MB_ICONWARNING, MB_ICONERROR, MB_ICONINFORMATION, MB_ICONQUESTION, 0);
var
  iFlags: Integer;
begin
  iFlags  := MB_SETFOREGROUND or MB_SYSTEMMODAL or ICONS[DlgType];
 
  if Buttons = [TMsgDlgBtn.mbOK] then
  begin
    iFlags := iFlags or MB_OK;
  end
  else if Buttons = mbOkCancel then
  begin
    iFlags := iFlags or MB_OKCANCEL;
  end
  else if (Buttons = mbYesAllNoAllCancel) or (Buttons = mbYesNoCancel) then
  begin
    iFlags := iFlags or MB_YESNOCANCEL;
  end
  else if (Buttons = mbAbortRetryIgnore) or (Buttons = mbAbortIgnore) then
  begin
    iFlags := iFlags or MB_ABORTRETRYIGNORE;
  end
  else if (Buttons = mbYesNo) then
  begin
    iFlags := iFlags or MB_YESNO;
  end
  else if (Buttons = [TMsgDlgBtn.mbRetry, TMsgDlgBtn.mbCancel]) then
  begin
    iFlags := iFlags or MB_RETRYCANCEL;
  end;
  if TMsgDlgBtn.mbHelp in Buttons then
    iFlags := iFlags or MB_HELP;
 
  AResult := MessageBoxTimeout(Application.Handle, PChar(APrompt), PChar(ATitle), iFlags, 0, ATimeOut);
  Result := AResult <> MB_TIMEDOUT;
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
const
  RES: array[idOK .. mrContinue] of string = ('OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'Yes', 'No', 'Close', 'Help', 'Try Again', 'Continue');
var
  mr: TModalResult;
begin
  if MessageDlgTimeOut('Prompt', 'Title', mtConfirmation, mbYesNo, 5000, mr) then
    ShowMessage(RES[mr])
  else
    ShowMessage('TimeOut');
end;

typiquement on écrira

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
var
  mr: TModalResult;
begin
  if MessageDlgTimeOut('Prompt', 'Title', mtConfirmation, mbYesNoCancel, 5000, mr) then
  begin
    case mr of
      mrYes: ... Faire le Truc Oui
      mrNo: ... Faire le Truc Non 
      mrCancel: ... Ne rien faire surement 
  end;
end;

[Papy214]

Toujours aussi précis et efficace ....