Alerte partiellement fonctionnelle

**faidev** · 01/08/2009, 09h56

Bonjour Developpez

j'ai un petit souci de programmation, le voici :

je viens de développer une petite application qui se connecte à une Base access pour afficher les évènements à une date choisie par un Tdatetimepicker et fait jouer une alarme et clignote une image 2 minutes avant le temps de l'évènement.
Ça fonctionne parfaitement sur 3 PC différents
Pour le quatrième PC ça fonctionne partiellement, il affiche les évènements mais l'alarme ne marche pas.

NB: 1) tous les 4 PC opèrent sous XP SP2
2) pour le quatrième PC ça fonctionne si la fenètre est réduite !!!

Voici le code de mon programme:

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
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
//-----------------------------------------------------------------
unit Unit4;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DB, ADODB, Grids, DBGrids, Buttons, ExtCtrls,
  ObjectPrinter, jpeg,mmsystem, XPMan;
 
type
  TForm4 = class(TForm)
    Label1: TLabel;
    GroupBox3: TGroupBox;
    Label5: TLabel;
    DateTimePicker1: TDateTimePicker;
    Button1: TButton;
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button5: TButton;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    ObjectPrinter1: TObjectPrinter;
    Image1: TImage;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Timer2: TTimer;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure BitBtn1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form4: TForm4;
  DateEV,tempsinitstring,uneheurestring:String;
  rouge:boolean;
  tempsinit,uneheure:ttime;
 
implementation
 
uses Unit1, Unit9;
 
{$R *.dfm}
 
procedure TForm4.FormCreate(Sender: TObject);
begin
//ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=z:\bd1.mdb;Mode=ReadWrite;Persist Security Info=False';
ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFilePath(Application.Exename)+'bd1.mdb;Mode=ReadWrite;Persist Security Info=False';
datetimepicker1.Date:=date;
DateEV:=quotedstr(datetostr(datetimepicker1.date));
caption:='Les transmissions du '+ datetostr(datetimepicker1.Date);
rouge:= true;
end;
 
procedure TForm4.Button1Click(Sender: TObject);
begin
{DateEV:=quotedstr(datetostr(datetimepicker1.date));
    adodataset1.Close;
    //adodataset1.CommandText:='SELECT * FROM EBU where DateEV='+dateEV+';' ;
    adodataset1.CommandText:='SELECT Lettre,NumeroFAX,Transmission,Evenement,Source,Destination,DateEV,HeureDeb,HeureFin,Parametres,Cle,Avise,Utilisateur,Annulation FROM EBU where DateEV='+dateEV+' order by HeureDeb;' ;
    adodataset1.Open;  }
    {
//   edit1.Text:=adodataset1.FieldValues['0'];{
ADOQuery1.SQL.Clear ;
ADOQuery1.SQL.Add('Select * From EBU ');
//ADOQuery1.SQL.Add('Select * From EBU where Numerofax='+edit7.Text+' AND DateEV='+DateEV+'');
ADOQuery1.Open;
ADOQuery1.next;
//edit1.text:=ADOQuery1.FieldByName('Transmission').AsString;
ADOQuery1.SQL.Clear;}
end;
 
procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
form1.show;
timer2.Enabled:=false;
end;
 
procedure TForm4.Button5Click(Sender: TObject);
begin
close;
//form1.Show;
end;
 
procedure TForm4.Timer1Timer(Sender: TObject);
begin
caption:='Les transmissions du '+ datetostr(datetimepicker1.Date);
timer1.Enabled:=true;
DateEV:=quotedstr(datetostr(datetimepicker1.date));
    adodataset1.Close;
    //adodataset1.CommandText:='SELECT * FROM EBU where DateEV='+dateEV+';' ;
    adodataset1.CommandText:='SELECT NumeroFAX,F,Transmission,Evenement,Source,Destination,DateEV,HeureDeb,SYST,HeureFin,Parametres,Cle,crypt,Avise,Utilisateur,Annulation FROM TOUS where DateEV='+dateEV+' order by HeureDeb;' ;
    adodataset1.Open;
    label2.Caption:=timetostr(time)+ '  HL';
end;
 
procedure TForm4.DBGrid1CellClick(Column: TColumn);
begin
form9.Show;
form9.label12.Caption:=DBGrid1.Fields[0].AsString+'  '+DBGrid1.Fields[1].AsString;
form9.label1.Caption:=DBGrid1.Fields[2].AsString;
form9.label2.Caption:=DBGrid1.Fields[3].AsString;
form9.label3.Caption:=DBGrid1.Fields[4].AsString;
form9.label4.Caption:=DBGrid1.Fields[5].AsString;
form9.label5.Caption:=DBGrid1.Fields[6].AsString;
form9.label6.Caption:=DBGrid1.Fields[7].AsString+'  '+DBGrid1.Fields[8].AsString;
form9.label7.Caption:=DBGrid1.Fields[9].AsString+'  '+DBGrid1.Fields[8].AsString;
form9.label8.Caption:=DBGrid1.Fields[10].AsString;
form9.label9.Caption:=DBGrid1.Fields[11].AsString+'  '+DBGrid1.Fields[12].AsString;
form9.label10.Caption:=DBGrid1.Fields[13].AsString;
form9.label11.Caption:=DBGrid1.Fields[14].AsString;
form9.label24.Caption:=DBGrid1.Fields[15].AsString;
end;
 
procedure TForm4.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
tempsinitstring:='00:02:00';
uneheurestring:='01:00:00';
uneheure:=strtotime(uneheurestring);
tempsinit:=strtotime(tempsinitstring);
TRY
//-------------- Couleur cellule Si Evènement annulée -------
If TDBGrid(Sender).DataSource.DataSet.FieldByName('Annulation').Asstring = 'Annulée' then
Begin
TDBGrid(Sender).Canvas.Font.style := [fsbold];
TDBGrid(Sender).Canvas.Font.Color := clred;
end;
//-----------------------------------------------------------
//-------------- Couleur cellule Si Sélctionnée -------------
If gdSelected In State Then
  Begin
    TDBGrid(Sender).Canvas.Brush.Color := clskyblue
  End;
 
//--------- Si heure deb <=  maintenant < heureFin alors cellule couleur Lime (Evènement en cours)
    IF (TDBGrid(Sender).DataSource.DataSet.FieldByName('HeureDeb').AsDateTime <= time) AND (TDBGrid(Sender).DataSource.DataSet.FieldByName('HeureFin').AsDateTime > time) Then
      begin
      // alors on met la cellule de la ligne Lime
      TDBGrid(Sender).Canvas.Brush.Color := cllime;
      form9.Color:=Cllime;
      end
    Else
    BEGIN
//------------- Si   maintenant <= heure Debut alors cellule couleur Jaune(Evènement programmée)
    If TDBGrid(Sender).DataSource.DataSet.FieldByName('HeureDeb').AsDateTime >= time then
    begin
    TDBGrid(Sender).Canvas.Brush.Color := clyellow;
    form9.Color:=Clyellow;
    end
    else
      begin
//-------------- Sinon on met la cellule à clWhite (Evènement terminée)
      TDBGrid(Sender).Canvas.Brush.Color := clWhite;
      form9.Color:=clwhite;
      end;
    END;
//------------initialisation a -2 minutes (Evènement )--------------
// Si heure deb <=  maintenant < 
    If (TDBGrid(Sender).DataSource.DataSet.FieldByName('HeureDeb').AsDateTime <= time+tempsinit) AND (TDBGrid(Sender).DataSource.DataSet.FieldByName('HeureDeb').AsDateTime > time) Then
      begin
      TDBGrid(Sender).Canvas.Font.style := [fsbold];
      TDBGrid(Sender).Canvas.Font.Color := clgreen;
      timer2.Enabled:=true;
      //timer2timer( sender );
      end
      else
      begin
      timer2.Enabled:=false;
      image2.Visible:=false;
      end;
//------------initialisation a -2 minutes --------------
  // On applique les modifications.
  TDBGrid(Sender).DefaultDrawColumnCell(rect,datacol,column,state);
EXCEPT
END;
//----------------------------
end;
 
procedure TForm4.BitBtn1Click(Sender: TObject);
begin
With ObjectPrinter1 do
begin
ClearObject;
//AddObject(DBGrid1);
AddObject(DataSource1);
Execute;
end;
end;
 
procedure TForm4.CheckBox1Click(Sender: TObject);
begin
case checkbox1.Checked of
true:
begin
      checkbox1.Caption:='Alarme ON';
      image3.Visible:=true;
      image4.Visible:=False;
end;
 
false:
begin
      checkbox1.Caption:='Alarme OFF !';
      image4.Visible:=true;
      image3.Visible:=False;
end;
 
end;    //fin case of
 
end;   //fin proc
 
procedure TForm4.Timer2Timer(Sender: TObject);
begin
case rouge of
  true:
    begin
    rouge:= not rouge;
    image2.Visible:=true;
    if checkbox1.Checked=true then
    playsound('c:\windows\Media\bip.wav', handle,SND_async);
    end;
  false:
    begin
    rouge:= not rouge;
    image2.Visible:=false;
    if checkbox1.Checked=true then
    playsound('c:\windows\Media\bip.wav', handle,SND_async);
    end;
end;
end;
 
end.
//-----------------------------------------------------------------

Merci de m'aider

**Just-Soft** · 02/08/2009, 14h31

je ne crois pas que le problème vient du code, sinon pourquoi sa marcherait sur 3/4 des PC testés ?

**sam83** · 02/08/2009, 15h44

salut à ta place je commence par vérifier l'horloge de PC 4

**edam** · 02/08/2009, 21h11

teste sa

Code :

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

1
2
3
4
5
6
procedure TForm4.Timer2Timer(Sender: TObject);
begin
    rouge:= not rouge;
    image2.Visible:=rouge;
    if checkbox1.Checked=true then windows.Beep(1000,10);
end;

quel est l'intervalle de ton timer ?
j'ai eu déjà ce problème, c'est à cause de ralantissment de playsound('c:\windows\Media\bip.wav', handle,SND_async); qui accède au fichier wav à chaque fois, je crois

, surtout avec SND_async et un PC très occupé

**faidev** · 03/08/2009, 15h25

Merci je vais tester ces exemples

Alerte partiellement fonctionnelle

Langage Delphi

Discussions similaires

Partager

Partager