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 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
| // Vérifie si l'OS est Windows Vista
function IsWindowsVista(): Boolean;
var
VerInfo: TOSVersionInfo;
begin
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(VerInfo);
Result := VerInfo.dwMajorVersion = 6;
end;
// Boîte de dialogue perso fonctionnant comme MessageDlg()
function MessageDlgPerso(const Msg: String; DlgType: TMsgDlgType = mtInformation;
Buttons: TMsgDlgButtons = [mbOk]; HelpCtx: Longint = 0): Integer; overload;
begin
Result := MessageDlgPerso('', '', Msg, DlgType, Buttons, HelpCtx);
end;
// Boîte de dialogue perso pour Vista
function MessageDlgPerso(Titre, Description, Contenu: String;
DlgType: TMsgDlgType = mtInformation; Buttons: TMsgDlgButtons = [mbOk];
HelpCtx: Longint = 0): Integer; overload;
const
// Constantes pour les icônes
TD_ICON_BLANK = 100;
TD_ICON_WARNING = IDI_WARNING;
TD_ICON_QUESTION = IDI_QUESTION;
TD_ICON_ERROR = IDI_ERROR;
TD_ICON_INFORMATION = IDI_INFORMATION;
TD_ICON_BLANK_AGAIN = TD_ICON_BLANK;
TD_ICON_SHIELD = IDI_WINLOGO;
// Constantes pour les boutons
TD_BUTTON_OK = 1;
TD_BUTTON_YES = 2;
TD_BUTTON_NO = 4;
TD_BUTTON_CANCEL = 8;
TD_BUTTON_RETRY = 16;
TD_BUTTON_CLOSE = 32;
TD_RESULT_OK = 1;
TD_RESULT_CANCEL = 2;
TD_RESULT_RETRY = 4;
TD_RESULT_YES = 6;
TD_RESULT_NO = 7;
TD_RESULT_CLOSE = 8;
var
HandleDLL: THandle;
Resultat: Integer;
Icone: PAnsiChar;
Bouttons: Integer;
MessageBoite: String;
wTitre, wDescription, wContenu: array[0..1024] of WideChar;
// Fonction de l'API Windows
TaskDialogProc: function(HWND: THandle; hInstance: THandle; cTitle,
cDescription, cContent: PWideChar; Buttons: Integer; Icon: PAnsiChar;
ResButton: PInteger): Integer; cdecl stdcall;
begin
// Si Windows Vista
if IsWindowsVista then
begin
// Charge la librairie comctl32
HandleDLL := LoadLibrary(comctl32);
if HandleDLL >= 32 then
begin
// Charge la fonction de boîte de dialogue Vista
@TaskDialogProc := GetProcAddress(HandleDLL, 'TaskDialog');
if Assigned(TaskDialogProc) then
begin
if Titre = '' then
Titre := LoadResString(Captions[DlgType]);
// Convertit les chaînes en array of WideChar
StringToWideChar(Titre, wTitre, SizeOf(wTitre));
StringToWideChar(Description, wDescription, SizeOf(wDescription));
StringToWideChar(Contenu, wContenu, SizeOf(wContenu));
// Spécifie l'icône en fonction du type de message
case DlgType of
mtWarning :
Icone := TD_ICON_WARNING;
mtError :
Icone := TD_ICON_ERROR;
mtInformation :
Icone := TD_ICON_INFORMATION;
mtConfirmation :
Icone := TD_ICON_QUESTION;
mtCustom :
Icone := TD_ICON_SHIELD;
else
Icone := '';
end;
// Spécifie les boutons en fonctions des boutons demandés
Bouttons := 0;
if mbYes in Buttons then
Bouttons := Bouttons + TD_BUTTON_YES;
if mbNo in Buttons then
Bouttons := Bouttons + TD_BUTTON_NO;
if mbOk in Buttons then
Bouttons := Bouttons + TD_BUTTON_OK;
if mbCancel in Buttons then
Bouttons := Bouttons + TD_BUTTON_CANCEL;
if mbAbort in Buttons then
Bouttons := Bouttons + TD_BUTTON_CLOSE;
if mbRetry in Buttons then
Bouttons := Bouttons + TD_BUTTON_RETRY;
// Affiche la boîte de dialogue
TaskDialogProc(GetActiveWindow(), 0, wTitre, wDescription, wContenu,
Bouttons, Icone, @Resultat);
// En fonction du résultat de la boîte de dialogue, retourne le bon
// résultat
case Resultat of
TD_RESULT_CANCEL :
Result := mrCancel;
TD_RESULT_RETRY :
Result := mrRetry;
TD_RESULT_YES :
Result := mrYes;
TD_RESULT_NO :
Result := mrNo;
TD_RESULT_CLOSE :
Result := mrAbort;
else
Result := mrOk;
end;
end;
end;
FreeLibrary(HandleDLL);
end
else
begin
// Empêche l'icône d'apparaître dans la barre des tâches
Application.Handle := GetActiveWindow();
// Créer la boîte de dialogue pour les autres OS
if Description <> '' then
MessageBoite := Description + #13#10#13#10 + Contenu
else
MessageBoite := Contenu;
with CreateMessageDialog(MessageBoite, DlgType, Buttons) do
try
HelpContext := HelpCtx;
FormStyle := fsStayOnTop;
if Titre <> '' then
Caption := Titre;
Result := ShowModal;
finally
Free;
end;
// Réinitialise le handle
Application.Handle := 0;
end;
end; |
Partager