Discussion :

[Bruno13]

Re-Bonjour à tous,

me revoilà pour mon probleme de fenetre popup. J'ai choisi le code suivant pour l'affichage de ma fenetre :

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
procedure TAlerte.Timer1Timer(Sender: TObject);
begin
  while Top<>Screen.WorkAreaHeight+Height do
   Begin
    Top:=Top+1;
    Application.processMessages;
  End;
  close;
end;
 
procedure TAlerte.FormShow(Sender: TObject);
begin
  Left:=Screen.WorkAreaWidth-Width-5;
  Top:=Screen.WorkAreaHeight+Height;
  PlaySound('notify.wav', handle, SND_ASYNC);
end;
 
procedure TAlerte.FormActivate(Sender: TObject);
begin
  while Top<>Screen.WorkAreaHeight-Height do
  Begin
     Top:=Top-1;
     Application.processMessages;
  End;
  Timer1.Enabled:=True;
end;

j'ai ajouté un AlphaBlend, et aussi un petit son d'avertissement mais voilà ma fenetre n'est pas entierement dessinée, son cadre est noir.
J'ai essayé un repaint et un refresh mais hélas rien à faire. Il reste noir même lorsque le timer fait redescendre celle-ci.

Quelqu'un peut-il me conseiller sur ce que je dois faire ?


Merci à tous,
Bruno

[Fabrice ROUXEL 1]

Une version qui fonctionne pour les possesseurs de Delphi5 (si si il y en a):

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
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
procedure TAlerte.FormCreate(Sender: TObject);
begin
  BorderStyle     := bsNone;
  Left            :=Screen.DesktopWidth - Width-2;
  Top             :=Screen.DesktopHeight + Height;
  Timer1.Interval := 10000;
  Timer1.Enabled  := False;
end;

 procedure TAlerte.FormActivate(Sender: TObject);
begin

while Top<>Screen.DesktopHeight-Height do
begin
  Update;
  Top := Top-1;
  Sleep(2);
end;
  Timer1.Enabled := True;
end;

 procedure TAlerte.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
  while Top<>Screen.DesktopHeight+Height do
  begin
    Top := Top+1;
    Sleep(2);
  end
finally
  Action := CaFree;
  Alerte := nil;
end;
end;

 procedure TAlerte.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  Close;
end;

 procedure TAlerte.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Alerte.Close;
end;

 procedure TAlerte.FormPaint(Sender: TObject);
var
   OTopColor, OBottomColor   : TColor;
   ITopColor, IBottomColor   : TColor;
   Orec,Irec                 : TRect;
begin
   OTopColor         := clBtnface;
   OBottomColor      := clBlack;
   ITopColor         := clBtnHighlight;
   IBottomColor      := clBtnShadow;
   Orec              := Rect(0,0,width,Height);
   Irec              := Rect(1,1,width-1,Height-1);
   Frame3D(Canvas, Orec , OTopColor, OBottomColor, 1);
   Frame3D(Canvas, Irec , ITopColor, IBottomColor, 1);
end;

------------------------------------------
Le code appelant depuis une autre fiche:

begin
  if Alerte = nil then
    Alerte := TAlerte.Create(Self);
  Alerte.show;
end;

[Fabrice ROUXEL 1]

Et toujours d'après le code de Pascal JANKOWSKI, version BDS2005:

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
procedure TForm2.FormCreate(Sender: TObject);
begin
  Left            := Screen.WorkAreaWidth-Width -10;
  Top             := Screen.WorkAreaHeight + Height;
  AlphaBlend      := True;
  AlphaBlendValue := 0;
  Timer1.Interval := 10000;
 end;

 procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
  step: byte;
begin
  step := 4;
  try
    while Top<>Screen.WorkAreaHeight+Height do
    begin
      Top:=Top+1;
      Sleep(1);
      if (Top mod 10 = 0) and (AlphaBlendValue >= (0+step)) then
        AlphaBlendValue := AlphaBlendValue - step;
    end;
  finally
    Action := CaFree;
    Form2 := nil;
end;
end;

 procedure TForm2.FormActivate(Sender: TObject);
var
  step: byte;
begin
 step := 4;
  while Top<>Screen.WorkAreaHeight-Height do
  begin
    Top:=Top-1;
    Sleep(1);
    if (Top mod 10 = 0) and  (AlphaBlendValue <= (255-step)) then
      AlphaBlendValue := AlphaBlendValue + step;
  end;
  AlphaBlendValue := 255;
  Timer1.Enabled := True;
end;

 procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  Close;
end;

 procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Timer1.Enabled := False;
  Close;
end;

[Bruno13]

Fabrice, bizarrement chez moi sous D7 cela ne fonctionne pas :'( la fenetre s'affiche d'un seul coup. mais parcontre elle est bien dessiné.

Avez vous une solution par rapport à mon code ? j'ai essayé le update mais hélas rien :'(

[Fabrice ROUXEL 1]

Elle s'affiche d'un seul coup parce que le processeur calcule vite.

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TAlerte.FormActivate(Sender: TObject);
begin
  while Top<>Screen.WorkAreaHeight-Height do
  Begin
     Top:=Top-1;
sleep(2);
     Application.processMessages;
  End;
  Timer1.Enabled:=True;
end;

[Bruno13]

Non, je veux dire l'affichage est ok, le defilement aussi mais ma fenetre est noir, j'ai essayé le sleep mais hélas rien n'y fait :'(

[Bruno13]

Si je prends l'exemple ci-dessus de Pascal et que je fais un showmodal au lieu d'un show tout simplement alors on arrive à ce que j'obtiens comme contour de ma fenetre noir.

Et le ShowModal m'interesse bcp plus car je veux que mon appli principale ne fasse rien d'autre et soit bloquée pendant le temps de l'affichage du popup.

[anapurna]

salut

force le rafraichissement de la form avec l'instruction refresh

@+ phil

[aityahia]

Fabrice, bizarrement chez moi sous D7 cela ne fonctionne pas :'( la fenetre s'affiche d'un seul coup. mais parcontre elle est bien dessiné.

Avez vous une solution par rapport à mon code ? j'ai essayé le update mais hélas rien :'(

Salut moi j'ai fais un copier coller du code de Fabrice et sa marche très bien.

[Pascal Jankowski]

Je viens de bricoler rapidement un exemple

Comme promis le code de l'unité pjPopupSH (très peu documentée et je m'en excuse, cela a été écrit il y a 10 minutes)

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
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
unit pjPopupSH;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, 
  Forms, Dialogs, ExtCtrls;
 
type
  TPopupSH = class(TComponent)
  private
    Ftimer: TTimer;
    FparentControl: TWinControl;
    Fopen: boolean;
    FonOpen: TNotifyEvent;
    FonClose: TNotifyEvent;
    Fdelay: cardinal;
    Fstep: byte;
    Finit: boolean;
    FonInit: TNotifyEvent;
    Ffadding: boolean;
    Fwait: boolean;
    procedure Settimer(const Value: TTimer);
    procedure SetparentControl(const Value: TWinControl);
    procedure Setopen(const Value: boolean);
    procedure Setdelay(const Value: cardinal);
    procedure Setstep(const Value: byte);
    procedure Setinit(const Value: boolean);
    procedure Setfadding(const Value: boolean);
    procedure Setwait(const Value: boolean);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy;
    property timer:TTimer read Ftimer write Settimer;
    property delay:cardinal read Fdelay write Setdelay;
    property step:byte read Fstep write Setstep;
    property fadding:boolean read Ffadding write Setfadding;
    property parentControl:TWinControl read FparentControl
                    write SetparentControl default nil;
    property wait:boolean read Fwait write Setwait default false;
    property init:boolean read Finit write Setinit default false;
    property onInit:TNotifyEvent read FonInit write FonInit;
    property open:boolean read Fopen write Setopen default false;
    property onOpen:TNotifyEvent read FonOpen write FonOpen;
    property onClose:TNotifyEvent read FonClose write FonClose;
    // Evénement par défaut dans la classe
    procedure doInit(Sender: TObject);
    procedure doOpen(Sender: TObject);
    procedure doClose(Sender: TObject);
    procedure doTimer(Sender: TObject);
  end;
 
  function CreatePopupEffect(winControl: TWinControl;_delay: cardinal;
                                 fading:boolean = true):TPopupSH;
 
implementation
 
function CreatePopupEffect;
begin
  Result := TPopupSH.Create(winControl);
  with Result do
  try
    FparentControl := winControl;
    delay := _delay;
    step := 1; //valeur par défaut: Immuable
    fadding := fading;
  finally
    init := true;
  end;
end;
 
{ TPopupSH }
 
constructor TPopupSH.Create(AOwner: TComponent);
begin
  Ftimer := TTimer.Create(AOwner);
  onInit := doInit;
  onOpen := doOpen;
  onClose := doClose;
  FTimer.Enabled := false;
  FTimer.OnTimer := doTimer;
end;
 
destructor TPopupSH.Destroy;
begin
  onInit := nil;
  onOpen := nil;
  onClose := nil;
  FTimer.Free;
end;
 
procedure TPopupSH.doClose(Sender: TObject);
begin
  Ftimer.Enabled := false;
  with TForm(FparentControl) do
  try
    if height < 255
      then while AlphaBlendValue > height do
             AlphaBlendValue := AlphaBlendValue - Fstep;
    while Top < Screen.WorkAreaHeight+Height do
    begin
      Top:=Top+1;
      if Ffadding and (AlphaBlendValue >= Fstep) then
        AlphaBlendValue := AlphaBlendValue - Fstep;
      Application.ProcessMessages;
    end;
  finally
  end;
end;
 
procedure TPopupSH.doInit(Sender: TObject);
begin
  if assigned(FparentControl) then
  with TForm(FparentControl) do
  begin
    Left := Screen.WorkAreaWidth-Width -10;
    Top := Screen.WorkAreaHeight;
  end
  else showMessage('Veuillez assigner un parent');
end;
 
procedure TPopupSH.doOpen(Sender: TObject);
begin
  with TForm(FparentControl) do
  begin
    while Top > Screen.WorkAreaHeight-Height do
    begin
      Top:=Top-1;
      if Ffadding and (AlphaBlendValue < 255) then
         AlphaBlendValue := AlphaBlendValue + Fstep;
      //Attention surtout pas de processMessages ici car il faut empecher
      //toute interruption avant la fin de ce process
    end;
    while AlphaBlendValue < 255 do
      AlphaBlendValue := AlphaBlendValue + Fstep;
    Timer.Enabled := True;
  end;
end;
 
procedure TPopupSH.doTimer(Sender: TObject);
begin
  Timer.Enabled := False;
  if assigned(FparentControl)
    then TForm(FparentControl).Close;
end;
 
procedure TPopupSH.Setdelay(const Value: cardinal);
begin
  Fdelay := Value;
  Ftimer.Interval := Fdelay;
end;
 
procedure TPopupSH.Setfadding(const Value: boolean);
begin
  Ffadding := Value;
  TForm(FparentControl).AlphaBlend := Ffadding;
  if Ffadding then TForm(FparentControl).AlphaBlendValue := 0
    else TForm(FparentControl).AlphaBlendValue := 255;
end;
 
procedure TPopupSH.Setinit(const Value: boolean);
begin
  Finit := Value;
  if assigned(FonInit) and Finit
    then FonInit(Self);
end;
 
procedure TPopupSH.Setopen(const Value: boolean);
begin
  Fopen := Value;
  if assigned(FonOpen) and Fopen
    then FonOpen(Self);
  if assigned(FonClose) and not Fopen
    then FonClose(Self);
end;
 
procedure TPopupSH.SetparentControl(const Value: TWinControl);
begin
  FparentControl := Value;
end;
 
procedure TPopupSH.Setstep(const Value: byte);
begin
  Fstep := Value;
end;
 
procedure TPopupSH.Settimer(const Value: TTimer);
begin
  Ftimer := Value;
end;
 
procedure TPopupSH.Setwait(const Value: boolean);
begin
  Fwait := Value;
  Ftimer.Enabled := not Fwait;
end;
 
end.

Maintenant comment faire pour utiliser cette classe.
Rien de plus facile.
1) On crée une nouvelle fiche pour delphi Win32

Puis on recopie le code suivant :

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
unit upopup;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, pjPopupSH;
type
 TAlerte = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    popupEffect:TPopupSH;
  end;
 
implementation
{$R *.dfm}
 
procedure TAlerte.FormCreate(Sender: TObject);
begin
  //2000 pour un timer de 2 secondes
  popupEffect := CreatePopupEffect(Self,2000);
  //Pour supprimer l'effet de fadding
  //popupEffect := CreatePopupEffect(Self,2000,false);
end;
 
procedure TAlerte.FormActivate(Sender: TObject);
begin
  //On lance l'effet d'ouverture
  popupEffect.open := true;
end;
 
procedure TAlerte.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   // On désactive tout événement qui peut déclancher un événement
   // dans popupEffect
 OnMouseDown := nil;
  try
    popupEffect.open := false;
  finally
    popupEffect.Free; //devrait être dans onDestoy
    action := caFree;
  end;
end;
 
procedure TAlerte.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case button of
    // bouton droit pour modifier le flag d'attente
   mbLeft : popupEffect.wait := not popupEffect.wait;
    //bouton gauche on referme la fenêtre Alerte
   mbRight : close;
  end;
end;
 
end.

On active la fenêtre de popup de la façon suivante :

Code :

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

with TAlerte.Create(Self) do show;

Cordialement

[Pascal Jankowski]

Et le ShowModal m'interesse bcp plus car je veux que mon appli principale ne fasse rien d'autre et soit bloquée pendant le temps de l'affichage du popup.

C'est dommage, car un popup n'est qu'un avertissement. D'autre part les utilisateurs n'aiment pas être bloqués par un simple message. Cela va à l'encontre de le philosophie des popup, non?

Il faut toujours penser à ne jamais contraindre qui que ce soit. Enfin, c'est mon opinion cela n'engage donc que moi.

Cordialement

[evarisnea]

salut,
à tout hasard, je signale qu'il existe un composant pour les Popup dans la JVCL, et que ce composant fonctionne très bien

[Bruno13]

Je ne dirais que 2 mots : MERCI PASCAL !!!

j'ai même ajouté un petit dingdong pour que l'utilisateur soit averti.

En ce qui concerne le showmodal, en fait mon appli n'est rien d'autre qu'un deamon qui fait 3 connexions toutes les 30 minutes et cela ne dure que 10s grand max.

Merci Encore Fabrice !

[aityahia]

avant d'afficher le popup il faut toujours vérifier l'existence d'une autre instance de la fenêtre pour éviter plus popup superposer

[Pascal Jankowski]

Et pourquoi pas modifier la classe que j'ai fourni afin de pouvoir créer plusieurs popup qui ne supperposent pas mais qui s'affichent distinctement à l'écran. De plus ajouter ce qu'il faut pour gérer les messages qui seront affichés.

C'est un petit jeu qui peut être amusant. Avis aux amateurs
Qui relève le défi ?

Je rappelle que la classe peut être énormément améliorée (cela a été écrit en 10 minutes) donc très perfectible.


Cordialement