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 :'(

[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.