Boite de dialogue modale [Résolu]

Wiska 15 Messages postés vendredi 30 mai 2008Date d'inscription 13 août 2012 Dernière intervention - 18 mai 2009 à 16:25 - Dernière réponse : JulioDelphi 2354 Messages postés dimanche 5 octobre 2003Date d'inscription 18 novembre 2010 Dernière intervention
- 19 mai 2009 à 11:28
Bonjour,
Voici mon problème:
Je cherche à créer une fonction permettant d'afficher une fenêtre( type messagebox) et ayant pour but de ce comporter comme une boite de dialogue classique à la différence que celle-ci renvoie une valeur par défaut (dans mon cas -1) en l'absence de réaction de l'utilisateur au bout d'un certain temps (ex: 30 secondes).
l'ennuie c'est que je ne vois pas par ou commencer...
j'ai penser à créer une form avec un composant timer et à créer une sorte de compte à rebour au bout duquel une action se passe.
voici mon code (bidon) actuel:

unit Comm_FenetreModale;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IniFiles;


type
  TForm1 = class(TForm)
    ButtonOK: TButton;
    ButtonPasOK: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    Image1: TImage;
    LabelTime: TLabel;
    LabelTime2: TLabel;
    procedure ButtonPasOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure ButtonOKClick(Sender: TObject);
  private
         FFirstTick : integer;
  public
    { Déclarations publiques }
  end;


var
  Form1: TForm1;
  GTotalTime:Integer;


implementation


{$R *.dfm}


const
     GMillisecondsPerDay=3600*1000*24;


//==============================================================================
procedure TForm1.ButtonPasOKClick(Sender: TObject);
//------------------------------------------------------------------------------
begin
     Close;
end;


//==============================================================================
procedure TForm1.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
begin
     FFirstTick := GetTickCount;
     Timer1Timer(sender);
end;


//==============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
begin
     //
end;


//==============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
var
   t,u : integer;
begin
     GTotalTime:=30000;
     t:=Integer(GetTickCount)-FFirstTick;
     u:=GTotalTime-t;
     LabelTime  .Caption := TimeToStr(u/GMillisecondsPerDay);
     LabelTime2 .Caption := TimeToStr(t/GMillisecondsPerDay);
     if u < 0 then
     begin
          Label1.Color := clRed;
          // ( valeur à retourner lorsque le décompte est fini par exemple -1)
     end;
end;

Je suis ouvert à toute critique (constructive) et à toute aide.
ps: j'ai que 3 mois de pratique sous delphi alors soyé indulgent. merci d'avance.
Afficher la suite 

Votre réponse

5 réponses

Meilleure réponse
JulioDelphi 2354 Messages postés dimanche 5 octobre 2003Date d'inscription 18 novembre 2010 Dernière intervention - 18 mai 2009 à 16:32
3
Merci
Salut
Ne peut-on pas simplement faire ouvrir une vraie boite modale et lui envoyer un message de fermeture avec sendmessage après 30sec?

Merci JulioDelphi 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 76 internautes ce mois-ci

Commenter la réponse de JulioDelphi
Meilleure réponse
cs_cantador 4996 Messages postés dimanche 26 février 2006Date d'inscription 27 mars 2018 Dernière intervention - 18 mai 2009 à 17:17
3
Merci
bonsoir,

un petit coup d'oeil sur cette source de cirec + la remarque de JulioDelphi

http://www.delphifr.com/codes/MESSAGEBOX-MESSAGEDLG-EXPERT-CODE-NOUVELLE-VERSION-MISE-JOUR_33820.aspx

cantador

Merci cs_cantador 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 76 internautes ce mois-ci

Commenter la réponse de cs_cantador
Meilleure réponse
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 18 mai 2009 à 17:56
3
Merci
unit UFrmDownTimed;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TFrmTimedForm = class(TForm)
  private
    fTimer    : TTimer;
    fButton   : TButton;
    fDownTimed: boolean;
    fDownTime : LongWord;
    fTimeCount: LongWord;
    procedure SetDownTime(const Value: LongWord);
    procedure SetDownTimed(const Value: boolean);
  protected
    procedure DoTimer(Sender: TObject);
    procedure DoButtonClick(Sender: TObject);
  public
    property DownTimed : boolean  read fDownTimed write SetDownTimed default true;
    property DownTime  : LongWord read fDownTime  write SetDownTime  default 30;
    function Execute: Boolean;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;

var
  FrmTimedForm: TFrmTimedForm;

implementation

{$R *.dfm}

const
  CaptionText = '(Temps restant : %.2d:%.2d)';

constructor TFrmTimedForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  BorderStyle         := bsDialog;
  FormStyle           := fsStayOnTop;
  DefaultMonitor      := dmActiveForm;
  Position            := poMainFormCenter;
  SetDownTime(30);

  fTimer              := TTimer.Create(Self);
  fTimer.Enabled      := false;
  fTimer.Interval     := 1000;
  fTimer.OnTimer      := DoTimer;

  fButton             := TButton.Create(Self);
  fButton.Parent      := self;
  fButton.Caption     := 'Ok';
  fButton.ModalResult := mrOk;
  fButton.OnClick     := DoButtonClick;
  fButton.SetBounds((ClientWidth shr 1)-40, (ClientHeight-29), 80, 21);
end;

destructor TFrmTimedForm.Destroy;
begin
  fTimer.Enabled := false;

  fButton.Free;
  fTimer.Free;
  inherited;
end;

procedure TFrmTimedForm.DoButtonClick(Sender: TObject);
begin
  ///
end;

procedure TFrmTimedForm.DoTimer(Sender: TObject);
var T : LongWord;
begin
  inc(fTimeCount);
  T := fDownTime-fTimeCount;
  Caption := format(CaptionText,[T div 60, T mod 60]);
  if fTimeCount >= fDownTime then
    ModalResult := mrCancel;
end;

function TFrmTimedForm.Execute: boolean;
begin
  BringToFront;

  Caption        := format(CaptionText,[fDownTime div 60, fDownTime mod 60]);
  fTimeCount     := 0;
  fTimer.Enabled := fDownTimed;  result         :ShowModal mrOk;
  fTimer.Enabled := false;
end;

procedure TFrmTimedForm.SetDownTime(const Value: LongWord);
begin
  if (fDownTime <> Value) then
  begin
    fDownTime := Value;
    if Value < 5 then
      fDownTime := 5
    else
    if Value > 120 then
      fDownTime := 120;
    Caption := format(CaptionText,[fDownTime div 60, fDownTime mod 60]);
  end;
end;

procedure TFrmTimedForm.SetDownTimed(const Value: boolean);
begin
  if fDownTimed <> Value then
    fDownTimed := Value;
end;

end.

Merci f0xi 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 76 internautes ce mois-ci

Commenter la réponse de f0xi
Meilleure réponse
Wiska 15 Messages postés vendredi 30 mai 2008Date d'inscription 13 août 2012 Dernière intervention - 19 mai 2009 à 11:21
3
Merci
Merci à JulioDelphi, Cantador et Foxi pour vos réponse j'ai trouver une solution de mon coté.
Je vous l'expose:

Je crée une fenêtre bidon avec un Tbutton sur lequel je vais tester une fonction crée dans  FenetreModale:

uses FenetreModale;
(...)

procedure TForm1.Button1Click(Sender: TObject);
var
     rep : integer;
begin
     rep := MessageDlgTimeOut('Voulez-vous confirmer l''action? (5" pour repondre)',mtConfirmation,[mbYes,MbNo],5) ;
     Button1.Caption:=IntToStr(rep);
end;

et voici la fonction en elle même dans FentreModale:

type
    TMyDlgTimer = class(TObject)
       class procedure aDlgTimer(Sender: TObject);
    end;
(...)

//==============================================================================
class procedure TMyDlgTimer.aDlgTimer(Sender: TObject); // export;
//------------------------------------------------------------------------------
var
     ix:integer;
begin
     if   ((Sender as TTimer).Owner) is TForm then
     with ((Sender as TTimer).Owner) as TForm do
     begin
          ix:=pos('[',Caption);
          if ix=0
          then Caption:=Caption             +' ['+IntToStr(Tag)+'"]'
          else Caption:=Copy(Caption,1,ix-2)+' ['+IntToStr(Tag)+'"]';
          Tag:=Tag-1;
          BringToFront;
          if Tag<0 then
             ModalResult := -1; // provoque la fermeture de la boite de dialogue
     end;
end;


//==============================================================================
function MessageDlgTimeOut
         ( const msg     : string
         ;       dlgType : TMsgDlgType
         ;       buttons : TMsgDlgButtons
         ;       timeOut : integer
         ) : integer;
// Joue le même rôle que la fonction standard MessageDlg, sauf en l'absence de
// réaction de l'utilisateur, la fenetre se ferme au bout de 'timeout' secondes
// et la fonction renvoie alors la valeur spéciale (-1)
//------------------------------------------------------------------------------
var
     aMsgDialog : TForm;
     aTimer     : TTimer;
begin
     aMsgDialog := CreateMessageDialog(msg, dlgType, buttons);
     aTimer     := TTimer.Create(aMsgDialog);
     aMsgDialog.Tag:=timeOut;
     try
          with ATimer do
          begin
               interval := 1000; // 1 seconde
               // On relie l'évènement OnTimer à la procédure DlgTimer de notre fiche appelante
               aTimer.OnTimer:=TMyDlgTimer.aDlgTimer;
          end;
          // affichage de la boite de dialogue
          result := aMsgDialog.ShowModal;
     finally
          // libération de la boite de dialogue
          aTimer.OnTimer:=nil;
          aMsgDialog.Free;
     end;
end;

Je précise, j'ai trouvé ce source dans la FAQ de developpez.com
et je l'ai modifié pour mon cas personnel.

Voila, si sa peut servir à quelqu'un... Ne vous génez pas!

Merci Wiska 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 76 internautes ce mois-ci

Commenter la réponse de Wiska
Meilleure réponse
JulioDelphi 2354 Messages postés dimanche 5 octobre 2003Date d'inscription 18 novembre 2010 Dernière intervention - 19 mai 2009 à 11:28
3
Merci
Super bravo de rien merci

Merci JulioDelphi 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 76 internautes ce mois-ci

Commenter la réponse de JulioDelphi

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.