Un taskdialog en trois clicks

Télécharger le projet
Commenter

Description

Tout le monde connait ce programme qui permettait de réaliser une MessageBox en cliquant sur trois ou quatre checkboxes ou boutons. Comme j'avais trouvé cela trés pratique et que j'en avais besoin pour mes propres programmes, j'ai décidé de réaliser ce petit programme qui permet de la même manière de réaliser un TaskDialog en un clin d'oeil et de fournir le source pour l'insérer dans son propre code.

Source / Exemple : 


unit TaskUnit;

interface

uses
	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, StdCtrls, Buttons, ShellAPI, ExtCtrls, pngimage, ComCtrls;

type
	TTaskForm = class(TForm)
    TestBtn: TBitBtn;
    ContentEdit: TMemo;
    TitleEdit: TEdit;
    DescriptionEdit: TEdit;
    IconGroup: TRadioGroup;
    Icone01: TImage;
    Icone02: TImage;
    Icone03: TImage;
    Icone04: TImage;
    BoutonBox: TGroupBox;
    Btn31: TBitBtn;
    Btn21: TBitBtn;
    Btn33: TBitBtn;
    Btn32: TBitBtn;
    Btn22: TBitBtn;
    Btn11: TBitBtn;
    Btn42: TBitBtn;
    Btn41: TBitBtn;
    Button1: TRadioButton;
    Button2: TRadioButton;
    Button3: TRadioButton;
    Button4: TRadioButton;
    Icone05: TImage;
    Icone06: TImage;
    Icone07: TImage;
    Icone08: TImage;
    CodeBtn: TBitBtn;
    Button5: TRadioButton;
    Btn51: TBitBtn;
    CodeMemo: TMemo;
    CopyBtn: TBitBtn;
    StatusBar: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure TestBtnClick(Sender: TObject);
    procedure BoutonClick(Sender: TObject);
    procedure CodeBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
	private
		{ Private declarations }
	public
		{ Public declarations }
	end;

const
	TD_ICON_BLANK=0;
	TD_ICON_WARNING=84;
	TD_ICON_QUESTION=99;
	TD_ICON_ERROR=98;
	TD_ICON_INFORMATION=81;
	TD_ICON_SHIELD_QUESTION=104;
	TD_ICON_SHIELD_ERROR=105;
	TD_ICON_SHIELD_OK=106;
	TD_ICON_SHIELD_WARNING=107;

  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
	TaskForm: TTaskForm;

implementation
{$R *.dfm}

function TaskDialog(AForm: TCustomForm; ATitle,
ADescription, AContent: string; Buttons,Icon: integer): integer;
var
	VerInfo: TOSVersioninfo; DLLHandle:THandle; res: integer;
	wTitle,wDescription,wContent: array[0..1024] of widechar;
	Btns:TMsgDlgButtons; DlgType:TMsgDlgType;
	TaskDialogProc:function(HWND: THandle; hInstance: THandle; cTitle, cDescription, cContent:
	pwidechar; Buttons: Integer; Icon: integer;
	ResButton: pinteger): integer; stdcall;

begin
	Result:=0;
	VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
	GetVersionEx(verinfo);
	if (verinfo.dwMajorVersion >= 6) then begin
		DLLHandle := LoadLibrary('comctl32.dll');
		if DLLHandle >= 32 then begin
			@TaskDialogProc:=GetProcAddress(DLLHandle,'TaskDialog');
			if Assigned(TaskDialogProc) then begin
				StringToWideChar(ATitle, wTitle, sizeof(wTitle));
				StringToWideChar(ADescription, wDescription, sizeof(wDescription));
				StringToWideChar(AContent, wContent, sizeof(wContent));
				TaskDialogProc(AForm.Handle, 0, wTitle, wDescription, wContent, Buttons, Icon, @res);
				Result := mrOK;
				case res 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;
				end;
			end;
			FreeLibrary(DLLHandle);
		end;
	end
	else begin
		Btns:=[];
		if Buttons and TD_BUTTON_OK=TD_BUTTON_OK then 				Btns:=Btns + [MBOK];
		if Buttons and TD_BUTTON_YES=TD_BUTTON_YES then 			Btns:=Btns + [MBYES];
		if Buttons and TD_BUTTON_NO=TD_BUTTON_NO then 				Btns:=Btns + [MBNO];
		if Buttons and TD_BUTTON_CANCEL=TD_BUTTON_CANCEL then Btns:=Btns + [MBCANCEL];
		if Buttons and TD_BUTTON_RETRY=TD_BUTTON_RETRY then 	Btns:=Btns + [MBRETRY];
		if Buttons and TD_BUTTON_CLOSE=TD_BUTTON_CLOSE then 	Btns:=Btns + [MBABORT];
		DlgType := mtCustom;
		case Icon of
			TD_ICON_WARNING : 		DlgType := mtWarning;
			TD_ICON_QUESTION : 		DlgType := mtConfirmation;
			TD_ICON_ERROR : 			DlgType := mtError;
			TD_ICON_INFORMATION: 	DlgType := mtInformation;
		end;
		Result:=MessageDlg(AContent, DlgType, Btns, 0);
	end;
end;

procedure TTaskForm.BoutonClick(Sender: TObject);
begin
	if Sender is TBitBtn then begin
		case TBitBtn(Sender).Tag of
			11:Button1.checked:=TRUE;
			21,22:Button2.checked:=TRUE;
			31,32,33:Button3.checked:=TRUE;
			41,42:Button4.checked:=TRUE;
			51,52,53:Button5.checked:=TRUE;
    end;
	end;
end;

procedure TTaskForm.CodeBtnClick(Sender: TObject);
var Titre, Description, Texte, IconStr, DlgString:String;
		CodeString:String; ResultType:Integer;
begin
	ResultType:=1;
	Titre:=Trim(TitleEdit.Text);
	Description:=Trim(DescriptionEdit.Text);
	Texte:=Trim(ContentEdit.Text);
	CodeString:='{Code généré par TaskProgram. Copyright 1995-2009 DataChris Software, Inc.}'+#13#10;
	case IconGroup.ItemIndex of
		0:IconStr:='TD_ICON_BLANK';
		1:IconStr:='TD_ICON_WARNING';
		2:IconStr:='TD_ICON_QUESTION';
		3:IconStr:='TD_ICON_ERROR';
		4:IconStr:='TD_ICON_INFORMATION';
		5:IconStr:='TD_ICON_SHIELD_QUESTION';
		6:IconStr:='TD_ICON_SHIELD_ERROR';
		7:IconStr:='TD_ICON_SHIELD_OK';
		8:IconStr:='TD_ICON_SHIELD_WARNING';
	end;
	if Button1.Checked then begin
		DlgString:='TD_BUTTON_OK';
		ResultType:=1;
  end
	else if Button2.Checked then begin
		DlgString:='TD_BUTTON_OK+TD_BUTTON_CANCEL';
		ResultType:=2;
	end
	else if Button3.Checked then begin
		DlgString:='TD_BUTTON_YES+TD_BUTTON_NO+TD_BUTTON_CANCEL';
		ResultType:=3;
	end
	else if Button4.Checked then begin
		DlgString:='TD_BUTTON_RETRY+TD_BUTTON_CANCEL';
		ResultType:=4;
	end
	else if Button5.Checked then begin
		DlgString:='TD_BUTTON_CLOSE';
		ResultType:=5;
	end;
	CodeString:=CodeString+'case TaskDialog(Self,'''+Titre+''','''+Description+''','''
	+Texte+''','+DlgString+','+IconStr+') of'+#13#10;
	case ResultType of
		1:CodeString:=CodeString+#9+'mrOk:begin'+#13#10+'end;'+#13#10+'end;';

		2:CodeString:=CodeString+#9+'mrOk:begin'+#13#10+#9+'end'+#13#10
														+#9+'else begin'+#13#10+#9+'end;'+#13#10+#9+'end;';

		3:CodeString:=CodeString+#9+'mrYes:begin'+#13#10+#9+'end;'+#13#10
														+#9+'mrNo:begin'+#13#10+#9+'end'+#13#10
														+#9+'else begin'+#13#10+#9+'end;'+#13#10+#9+'end;';

		4:CodeString:=CodeString+#9+'mrRetry:begin'+#13#10+#9+'end'+#13#10+#9
														+'else begin'+#13#10+#9+'end;'+#13#10+#9+'end;';

		5:CodeString:=CodeString+#9+'mrAbort:begin'+#13#10+'end;'+#13#10+'end;';
	end;
	CodeString:=CodeString+#13#10+'{Code généré par TaskProgram. Copyright 1995-2009 DataChris Software, Inc.}';
	TaskForm.Height:=620;
	with CodeMemo do begin
		Align:=alBottom;
		Height:=165;
		Text:=CodeString;
    Visible:=TRUE;
	end;
	CopyBtn.Visible:=TRUE;
end;

procedure TTaskForm.CopyBtnClick(Sender: TObject);
begin
	with CodeMemo do begin
		Perform(EM_SETSEL,0,-1);
		Perform(WM_COPY,0,0);
	end;
	{Code généré par TaskProgram. Copyright 1995-2009 DataChris Software, Inc.}
	case TaskDialog(self,'Copie du code','Copie effectuée','La copie du code a été effectuée correctement.'
	+'Vous pouvez maintenant aller la coller dans votre projet Delphi.',
	TD_BUTTON_OK,TD_ICON_SHIELD_OK) of
		mrOk:begin
		end;
	end;
	{Code généré par TaskProgram. Copyright 1995-2009 DataChris Software, Inc.}
end;

procedure TTaskForm.FormCreate(Sender: TObject);
var DLLName: PChar;
begin
	DLLName:='Imageres.dll';
	Icone01.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,78);
	Icone02.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,93);
	Icone03.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,92);
	Icone04.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,75);
	Icone05.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,98);
	Icone06.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,99);
	Icone07.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,100);
	Icone08.Picture.Icon.Handle:=ExtractIcon(Handle,DLLName,101);
end;

procedure TTaskForm.TestBtnClick(Sender: TObject);
var DLG_ICON,DLG_BTNS:Integer; Titre, Description, Texte:String;
begin
	DLG_ICON:=TD_ICON_WARNING;
	DLG_BTNS:=TD_BUTTON_OK;
	Titre:=Trim(TitleEdit.Text);
	Description:=Trim(DescriptionEdit.Text);
	Texte:=Trim(ContentEdit.Text);
	case IconGroup.ItemIndex of
		0:DLG_ICON:=TD_ICON_BLANK;
		1:DLG_ICON:=TD_ICON_WARNING;
		2:DLG_ICON:=TD_ICON_QUESTION;
		3:DLG_ICON:=TD_ICON_ERROR;
		4:DLG_ICON:=TD_ICON_INFORMATION;
		5:DLG_ICON:=TD_ICON_SHIELD_QUESTION;
		6:DLG_ICON:=TD_ICON_SHIELD_ERROR;
		7:DLG_ICON:=TD_ICON_SHIELD_OK;
		8:DLG_ICON:=TD_ICON_SHIELD_WARNING;
	end;
	if Button1.Checked then DLG_BTNS:=TD_BUTTON_OK
	else if Button2.Checked then DLG_BTNS:=TD_BUTTON_OK+TD_BUTTON_CANCEL
	else if Button3.Checked then DLG_BTNS:=TD_BUTTON_YES+TD_BUTTON_NO+TD_BUTTON_CANCEL
	else if Button4.Checked then DLG_BTNS:=TD_BUTTON_RETRY+TD_BUTTON_CANCEL
	else if Button5.Checked then DLG_BTNS:=TD_BUTTON_CLOSE;
	case TaskDialog(self,Titre,Description,Texte,DLG_BTNS,DLG_ICON) of
		mrYes:;
	end;
end;
END.

Conclusion :


Une partie du code a été emprunté à la Unit uVistaFuncs. Je suis en train de faire la même chose pour le dialogue plus élaboré TaskDialogIndirect et je le proposerai bientôt. Unitile de préciser que cela ne fonctionne qu'avec Vista. Vos commentaires ou corrections sont les bienvenus.
Christian
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.