capture de video avec avicap32.dll

**vinse** · 05/12/2008, 01h44

bonsoir

voila je planche sa fais plus d une semaine sur l acquisition vidéo a partir d une interface dvr usb sur cette interface on peut relier 4 camera et 2 micro

tout les drivers sont installer et sa marche avec le soft propriétaire

je me suis lancer comme défi de faire un soft ou je pourrais visionner les cameras pour commencer

j ai potasser tout ce que j ai pu trouver sur le net a ce sujet

voici mon bout de code

ps soyer indulgent je débute

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
 
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
 
 
 
 
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
    fenetre : tHandle;
  fDevice: integer;
  DeviceName: array[0..80] of Char;
  DeviceVersion: array[0..100] of Char;
  Resultat : Boolean;
  fCaptureDriverName: string;
 
 
implementation
function capCreateCaptureWindowA(lpszWindowName: PChar; dwStyle: dword;
  x, y, nWidth, nHeight: word; ParentWin: dword; nId: word): dword;
  stdcall external 'AVICAP32.DLL';
function capGetDriverDescriptionA(wDriverIndex: UINT; lpszName: LPSTR;
  cbName: integer; lpszVer: LPSTR; cbVer: integer): BOOL; stdcall;
  external 'AVICAP32.DLL';
 
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
 VideoHwnd: HWND;
 
 szName, szVersion: array[0..MAX_PATH] of char;
 I :word;
  x: integer;
 
  NumeroDeWebcam:integer;
 
begin
 
capGetDriverDescriptionA(x, @szName, sizeof(szName),
      @szVersion, sizeof(szVersion));
memo1.Lines.Add('' + szName + ' - ' + szVersion + '|');
 
memo1.refresh;
 
VideoHwnd := capCreateCaptureWindowA('Video', WS_CHILD or WS_VISIBLE, 0, 0, Width, Height, Handle, 0);  
 
 
If (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then begin       
// !!!! au debug sa deconne a partir d ici sa ne connect pas le driver 
// et je sais pas comment lui faire force ou lui indiquer le driver a connecter
 
 
 
 
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, 0, 0);
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE,0, 0);
SendMessage(VideoHwnd, WM_CAP_SET_SCALE,0, 0);
sendMessage(VideoHwnd, WM_CAP_SET_OVERLAY, 0, 0);
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, 0, 0);
 
 
  end;
 
  end;
 
end.

voila je ne vois pas mon erreur a part peut etre le driver non identifier mais sa je sais pas comment faire

merci d avance

**cincap** · 05/12/2008, 11h29

Bonjour à toutes et à tous,

@ vinse, voici le code complet qui te permettra de comprendre et d'avancer avec cette Dll.

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
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, clipbrd, Jpeg, StdCtrls, ComCtrls, Menus, Buttons;
type
  Tformats =(DtBitmap,DtJpeg); // Pour le choix Des formats
  TForm1 = class(TForm)
    Image1: TImage;
    Affichage: TTimer;
    Mouvement: TLabel;
    ModeCapture: TTimer;
    Interval: TTimer;
    Label8: TLabel;
    CheckBox2: TCheckBox;
    TrackBar4: TTrackBar;
    Label9: TLabel;
    ListBox1: TListBox;
    Label1: TLabel;
    Image2: TImage;
    PopupMenu1: TPopupMenu;
    Effacer1: TMenuItem;
    SpeedButton1: TSpeedButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    MainMenu1: TMainMenu;
    Fichier1: TMenuItem;
    N2: TMenuItem;
    Enregisterimagesous1: TMenuItem;
    FichiersBitmap1: TMenuItem;
    FichiersJpeg1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    SpeedButton2: TSpeedButton;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    TrackBar1: TTrackBar;
    Label3: TLabel;
    Carre: TCheckBox;
    Ellipse: TCheckBox;
    Ligne: TCheckBox;
    GroupBox4: TGroupBox;
    Bit1: TRadioButton;
    Bit4: TRadioButton;
    Bit8: TRadioButton;
    Bit32: TRadioButton;
    Bit16: TRadioButton;
    Bit24: TRadioButton;
    PixelsFormats1: TMenuItem;
    Noirblanc1: TMenuItem;
    N16couleurs1: TMenuItem;
    N256couleurs1: TMenuItem;
    CompressionBitField1: TMenuItem;
    N24Bits1: TMenuItem;
    CompressionRVB32bits1: TMenuItem;
    Quitter2: TMenuItem;
    Panel3: TPanel;
    CheckBox3: TCheckBox;
    CheckBox1: TCheckBox;
    Label2: TLabel;
    zoom: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure AffichageTimer(Sender: TObject);
    procedure ModeCaptureTimer(Sender: TObject);
    procedure IntervalTimer(Sender: TObject);
    procedure TrackBar4Change(Sender: TObject);
    procedure Effacer1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FichiersBitmap1Click(Sender: TObject);
    procedure FichiersJpeg1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure zoomMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Quitter2Click(Sender: TObject);
    procedure Noirblanc1Click(Sender: TObject);
    procedure N16couleurs1Click(Sender: TObject);
    procedure N256couleurs1Click(Sender: TObject);
    procedure CompressionBitField1Click(Sender: TObject);
    procedure N24Bits1Click(Sender: TObject);
    procedure CompressionRVB32bits1Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure SpeedButton1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CheckBox2Click(Sender: TObject);
    procedure LigneClick(Sender: TObject);
    procedure EllipseClick(Sender: TObject);
    procedure CarreClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
  Bmp1, Bmp2 : TBitmap;
  HCam:hwnd;
  Num, NbMouvement : Integer;
  Debut : Boolean;
  MaxSensi : Integer;
  image:integer;
  Formats:Tformats;
 enregistrement:boolean;
Function capCreateCaptureWindowA(lpszWindowName : String; dwStyle : integer; X : integer;  Y : integer;  nWidth : integer;  nHeight : integer; hwndParent : hwnd;  nID : integer):integer; stdcall; external 'C:\windows\system32\avicap32.dll';
 
implementation
 
{$R *.dfm}
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
try
// Pige rien, betement recopier
hcam:=capCreateCaptureWindowA('',0,0,0,320,240,handle,0);
sendmessage(hcam,1034,0,0);
form1.DoubleBuffered:=true;
 
listbox1.Items.LoadFromFile('Captures\numimg.sav'); // on charge la bibliotheque(TRES BASIQUE)                                                    // Laisser tjs ce fichier ds ce repertoire
 
finally
image:=listbox1.Count-1;  // Nombre de fichiers présent dedans
end;
 
trackbar1.Brush.Color:=ClSilver; // AP trackbar 1
zoom.Brush.Color:=Clsilver; // Arriere plan noir pr le progress bar
Formats:=DtJpeg;  // Jpeg est le format par default d'enregistrement de l'image
FichiersJpeg1.Checked:=True; // on le check pr montrer que c'est lui
label8.Caption:='images dans la bibliotheque '+inttostr(listbox1.Count-1); //petite information
label9.Caption:=inttostr(trackbar4.Position)+' sec'; // nous renseigne sur le choix du temps pour le mode rafale
end;
 
procedure TForm1.AffichageTimer(Sender: TObject);
var
 x : integer;
 px : integer;
 py:integer;
begin
//randomize;
// Je ne comprens absolument rien a ces 3 lignes
  sendmessage(hcam,1084,0,0);
  sendmessage(hcam,1054,0,0);
  image1.Picture.LoadFromClipboardFormat(cf_bitmap,clipboard.GetAsHandle(cf_bitmap),0);
  with image1.Picture.Bitmap do // pr pas tjs taper le meme chose,feineant moi(lol)!
  begin
  if Bit1.Checked then PixelFormat:=(pf1bit); // noir et blanc, pas nuance de gris bien different!
   if Bit4.Checked then PixelFormat:=(pf4bit); //16Couleurs
    if Bit8.Checked then PixelFormat:=(pf8bit);//256 Couleurs
     if Bit16.Checked then PixelFormat:=(pf16bit);//compression bitfield,qui est horrible chez moi
       if Bit24.Checked then  PixelFormat:=(pf24bit);//24 bits
       if Bit32.Checked then PixelFormat:=(pf32bit);//32 bits(tt couleurs je pense) PAR DEFAUT
  end;
 
  if trackbar1.Position>0 then
  begin
 
  image1.Picture.Bitmap.Canvas.Brush.Color:=ClBlack; // rempli en noir
  image1.Picture.Bitmap.Canvas.Brush.Style:=bsClear; // laisse le millieu clair
 
  //*****************************************************
  //*              Effets a 50 balles!!!!!!!!!!!        *
  //*****************************************************
  for x:=1 to trackbar1.Position * 20 do
  begin
 
  if ligne.Checked then
  begin
  px:=random(image1.Width); // longueur image1
  py:=random(image1.Height); // largeur img1
  image1.Picture.Bitmap.Canvas.LineTo(px,py); //trace une ligne alleatoirement grace a px,py sur la longueur,largeur de l'image
  end;
 
  if ellipse.Checked then
  begin
   px:=random(image1.Width);  // ...
  py:=random(image1.Height);    // ...
  image1.Picture.Bitmap.Canvas.Ellipse(px,py,px+random(15),py+random(15)); // ellipse ...
  end;
 
  if carre.Checked then
  begin
  px:=random(image1.Width); // ..
  py:=random(image1.Height);// ..
  image1.Picture.Bitmap.Canvas.Rectangle(px,py,px+random(15),py+random(15)); // carre...
  end;
  end;
  end;
 
 
  if checkbox1.Checked then
  image1.Canvas.stretchDraw(rect(image1.Width,0,0,image1.Height),Image1.Picture.Bitmap); // symetrie horizontale si la case est cochée
 
  // zoOm
  image1.Canvas.stretchDraw(rect(0,0,image1.Width+zoom.Position*10,
  image1.Height+zoom.Position*10),Image1.Picture.Bitmap);
  // Ce n'est pas un zoom ac la cam, c'est juste un ettirement de l'image!
 
   if checkbox3.Checked then // symetrie verticale si ...
   image1.Canvas.stretchDraw(rect(image1.Width,image1.Height,0,0),Image1.Picture.Bitmap);
   image1.Refresh; // Redessine le contrôle à l'écran.
  end;
 
 
procedure TForm1.ModeCaptureTimer(Sender: TObject);
var Jpg:Tjpegimage; // mettre ca pr pouvoir creer son fichier JPG
begin
if Formats=DtJpeg then  // Si on a selectionné le format JPG
Begin
Jpg:=Tjpegimage.Create; // Notre variable creer un fichier JPG
jpg.CompressionQuality:=80; // Compression du JPG (Bonne qualité)
jpg.Assign(image1.Picture.Bitmap); // on ne peut pas directement creer le JPG sinon on
                                    //a un JPG vide
                                    // Alors on Transfert le bitmap(Image1) Vers le JPG
 
if checkbox2.Checked then  // Si on a  bien selectionné Le mode rafale
begin
image:=image+1; // on ajoute 1 al la variable image(Logique,non?)
label8.Caption:='images dans la bibliotheque '+inttostr(image);  // tjs des infos
jpg.SaveToFile('Captures\'+inttostr(image)+'.jpg'); // on enregistre le fichier Jpg
listbox1.Items.Insert(0,inttostr(image)+'.jpg'); // on place le fichier ds notre listbox
listbox1.Items.SaveToFile('Captures\Numimg.sav'); // on enregistre la listbox ds le fichier Numimg.sav
end;
// Si le Format els <> de JPEG (donc Bitmap!!!) Alors
end else
begin
 
if checkbox2.Checked then  // Si on a  bien selectionné Le mode rafale
begin
image:=image+1; // on ajoute 1 al la variable image(Logique,non?)
label8.Caption:='images dans la bibliotheque '+inttostr(image);  // tjs des infos
image1.Picture.Bitmap.SaveToFile('Captures\'+inttostr(image)+'.bmp'); // on enregistre le fichier Bitmap
listbox1.Items.Insert(0,inttostr(image)+'.bmp'); // on place le fichier ds notre listbox
listbox1.Items.SaveToFile('Captures\Numimg.sav'); // on enregistre la listbox ds le fichier Numimg.sav
 
end;
end;
end;
 
procedure TForm1.IntervalTimer(Sender: TObject);
begin
if radiobutton1.Checked then  modecapture.Interval:= trackbar4.Position*1000; //secondes
if radiobutton2.Checked then  modecapture.Interval:= trackbar4.Position; // millisecondes
 
end;
 
procedure TForm1.TrackBar4Change(Sender: TObject);
begin
if radiobutton1.Checked then label9.Caption:=inttostr(trackbar4.Position)+' sec'; // Secondes
if radiobutton2.Checked then label9.Caption:=inttostr(trackbar4.Position)+' msec'; // Millisecondes
end;
 
procedure TForm1.Effacer1Click(Sender: TObject);
begin
listbox1.Items.Delete(listbox1.ItemIndex);
end;
 
procedure TForm1.ListBox1Click(Sender: TObject);
var
Fichier: string;
begin
try
     fichier:=listbox1.Items.Strings[listbox1.itemindex];
     listbox1.Items.SaveToFile('Captures\Numimg.sav');
     image2.Picture.LoadFromFile('Captures\'+listbox1.Items.Strings[listbox1.itemindex]);
     finally
 
    end;
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
var Jpg:Tjpegimage;
begin
if formats=DtJpeg then  // Si le format = JPEG(Selectionné a partir du menu)
begin
Jpg:=Tjpegimage.Create; // Jpg = creation d'une image JPG
jpg.CompressionQuality:=80; // Compression
jpg.Assign(image1.Picture.Bitmap); // Transfert le bitmap de image1 vers le JPG
image:=image+1; // rajoute 1 a la variable image(On en prend une donc...!)
label8.Caption:='images dans la bibliotheque '+inttostr(image); // infos
 
jpg.SaveToFile('Captures\'+inttostr(image)+'.jpg'); // Enregistre
listbox1.Items.Insert(0,inttostr(image)+'.jpg'); // Mis ds la listbox ....
listbox1.Items.SaveToFile('Captures\Numimg.sav'); // .... et sauvegardé ds un fichier
end else
// Sinon ...
begin
image:=image+1;  //..
label8.Caption:='images dans la bibliotheque '+inttostr(image); //..
image1.Picture.Bitmap.SaveToFile('Captures\'+inttostr(image)+'.bmp'); //..
listbox1.Items.Insert(0,inttostr(image)+'.bmp');  //..
listbox1.Items.SaveToFile('Captures\Numimg.sav');     //..
end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if ssleft in shift then
begin
Releasecapture;
perform(WM_SYSCOMMAND, $F012, 0); // on bouge la fenetre ac la souris qd fait 1 click gauche
end;
end;
 
procedure TForm1.FichiersBitmap1Click(Sender: TObject);
begin
Formats:=DtBitmap; // Selection du type de fichiers
FichiersBitmap1.Checked:=True; // on check celle la
FichiersJpeg1.Checked:=False;  // et on de-check(C pas si ca existe) l'autre
end;
 
procedure TForm1.FichiersJpeg1Click(Sender: TObject);
begin
// Idem Sauf JPG...
Formats:=DtJpeg;
FichiersBitmap1.Checked:=False;
FichiersJpeg1.Checked:=True;
end;
 
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
if radiobutton1.Checked then label9.Caption:=inttostr(trackbar4.Position)+' sec'; // Secondes
end;
 
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
if radiobutton2.Checked then label9.Caption:=inttostr(trackbar4.Position)+' msec'; // Millisecondes
 
end;
 
procedure TForm1.zoomMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if ssleft in shift then zoom.Position:=x;
end;
 
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
// pour arreter la video Appuyer sur ESC
// Le fichier se trouve a c:capture.avi
sendmessage(hcam,1086,0,0);
 
end;
 
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
label3.Caption:='Pourcentage de l''effet '+inttostr(trackbar1.Position*10);
end;
 
 
 
procedure TForm1.Quitter2Click(Sender: TObject);
begin
if MessageDlg('Voulez vous vraiment quitter?', // c est assez parlant
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then // si on appuye sur Ok , ben Cia
  begin
  showmessage('Petit-Jean Nicolas 2005 ...');
    Close;
  end;
end;
 
//********************************************************************
//*****A partir De TMainMenu, on change le pixelFormat....(affichage)*
//****************************************************************** *
 
procedure TForm1.Noirblanc1Click(Sender: TObject);
begin
Bit1.Checked:=true;
end;
 
procedure TForm1.N16couleurs1Click(Sender: TObject);
begin
Bit4.Checked:=true;
end;
 
procedure TForm1.N256couleurs1Click(Sender: TObject);
begin
Bit8.Checked:=true;
end;
 
procedure TForm1.CompressionBitField1Click(Sender: TObject);
begin
Bit16.Checked:=true;
end;
 
procedure TForm1.N24Bits1Click(Sender: TObject);
begin
Bit24.Checked:=true;
end;
 
procedure TForm1.CompressionRVB32bits1Click(Sender: TObject);
begin
Bit32.Checked:=true;
end;
 
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
with CheckBox3 do  // pr ne ps tjs recopier , j'utilise le bloc checkbox3
begin
 if Checked then
 begin
  color:=ClGray; // si elle est est selectionné On prend cette couleur
  end
 else
 begin
  color:=Clsilver; // sinon l'autre couleur
 end;
 end;
 
 end;
 
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
// idem a au dessus
with CheckBox1 do
begin
 if Checked then
 begin
  color:=ClGray; //..
  end
 else
 begin
  color:=ClSilver;   //..
 end;
 end;
 
end;
 
procedure TForm1.SpeedButton1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
with speedbutton1 do // utilisation du bloc...
begin
numglyphs:=2; // Qd on clique sur ' Capturer une image' ca change la texture
end;
end;
 
procedure TForm1.SpeedButton1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
with speedbutton1 do //..
begin
numglyphs:=1; // Qd on relache le clique sur ' Capturer une image', texture initiale
end;
end;
 
 
// ***********************************************
//          iDEM MAIS POUR ENREGISTER UNE VIDEO
// *********************************************
procedure TForm1.SpeedButton2MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
with speedbutton1 do      //..
begin
numglyphs:=2;                 //..
end;
end;
 
procedure TForm1.SpeedButton2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
with speedbutton1 do              //..
begin
numglyphs:=1;                         //..
end;
end;
 
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
with CheckBox2 do  // pr ne ps tjs recopier , j'utilise le bloc checkbox3
begin
 if Checked then
 begin
  color:=ClGray; // si elle est est selectionné On prend cette couleur
  end
 else
 begin
  color:=Clsilver; // sinon l'autre couleur
 end;
 end;
end;
 
procedure TForm1.LigneClick(Sender: TObject);
begin
with ligne do  // pr ne ps tjs recopier ...
begin
 if Checked then
 begin
  color:=ClGray; // si elle est est selectionné On prend cette couleur
  end
 else
 begin
  color:=Clsilver; // sinon l'autre couleur
 end;
 end;
end;
 
procedure TForm1.EllipseClick(Sender: TObject);
begin
with ellipse do  // pr ne ps tjs recopier ...
begin
 if Checked then
 begin
  color:=ClGray; // si elle est est selectionné On prend cette couleur
  end
 else
 begin
  color:=Clsilver; // sinon l'autre couleur
 end;
 end;
end;
 
procedure TForm1.CarreClick(Sender: TObject);
begin
with carre do  // pr ne ps tjs recopier ....
begin
 if Checked then
 begin
  color:=ClGray; // si elle est est selectionné On prend cette couleur
  end
 else
 begin
  color:=Clsilver; // sinon l'autre couleur
 end;
 end;
end;
 
end.

@+,

Cincap

**cincap** · 05/12/2008, 19h26

Je pense que dans la création de l'écran tu devrais préciser la largeur et la hauteur.

Code :

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

1
2
3
4
5
6
7
8
 
var
  Form1: TForm1;
  VideoHwnd:hwnd;
  bmp:tbitmap;
 
Function capCreateCaptureWindowA(lpszWindowName : String; dwStyle : integer; X : integer;  Y : integer;  nWidth : integer;  nHeight : integer; hwndParent : hwnd;  nID : integer):integer; stdcall; external 'C:\windows\system32\avicap32.dll';
implementation

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
 
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=true;
 
bmp:=tbitmap.Create;
bmp.Width:=320;
bmp.Height:=240;
 
image1.Width:=320;
image1.Height:=240;
 
//Handle du periph de la cam
VideoHwnd:=capCreateCaptureWindowA('Vidéo',0,0,0,320,240,handle,0);
//Connection a la cam
sendmessage(VideoHwnd,1034,0,0);
end;
 
@+,
 
Cincap

**vinse** · 06/12/2008, 02h06

le soucie n est vraiment pas la taille
mais vraiment un soucie de connection au driver

Code :

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

1
2
 
If (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then begin

a partir de la delphi 7 en mode pas a pas par en debug et l asm

j ai fais plusieurs test avec toute les source trouver sur le net rien a faire
j ai récupérer un soft qui s appel "h264WEBcam ver 3.0"

pareil aucune image aucun flux détecter même si lui as l' air de bien détecter et le driver et le matériel

en le laissant allumer et en lançant le soft propriétaire la avec h264webcam j arrive a avoir l image

et en espionnant les threads avec processus explorer je vois apparaitre ceci

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
 
 
wdmaud.drv!mxdMessage+0x122e  // driver 
 
ntkrnlpa.exe!KiUnexpectedInterrupt+0xf0
ntkrnlpa.exe!ZwYieldExecution+0x1900
ntkrnlpa.exe!ZwYieldExecution+0x196c
ntkrnlpa.exe!NtWaitForSingleObject+0x9a
ntkrnlpa.exe!KeReleaseInStackQueuedSpinLockFromDpcLevel+0xb14
ntdll.dll!KiFastSystemCallRet
kernel32.dll!WaitForSingleObject+0x12
wdmaud.drv!mxdMessage+0x129c +0x122e
kernel32.dll!GetModuleFileNameA+0x1b4
 
 
 
ADVAPI32.dll!RegDeleteKeyW+0xfd    // cette dll est crypter et fais partis de windows 
 
ntkrnlpa.exe!KiUnexpectedInterrupt+0x8d
ntkrnlpa.exe!IoDeleteDriver+0x362
ntkrnlpa.exe!KiDeliverApc+0xb3
ntkrnlpa.exe!ZwYieldExecution+0x196c
ntkrnlpa.exe!NtWaitForSingleObject+0x38c
ntkrnlpa.exe!KeReleaseInStackQueuedSpinLockFromDpcLevel+0xb14
ntdll.dll!KiFastSystemCallRet
ADVAPI32.dll!RegDeleteKeyW+0x2a2
kernel32.dll!GetModuleFileNameA+0x1b4
 
wdmaud.drv!midMessage+0x306
 
 
ntkrnlpa.exe!KiUnexpectedInterrupt+0xf0
ntkrnlpa.exe!ZwYieldExecution+0x1900
ntkrnlpa.exe!ZwYieldExecution+0x196c
ntkrnlpa.exe!NtWaitForSingleObject+0x38c
ntkrnlpa.exe!KeReleaseInStackQueuedSpinLockFromDpcLevel+0xb14
ntdll.dll!KiFastSystemCallRet
kernel32.dll!WaitForMultipleObjects+0x18
wdmaud.drv!midMessage+0x348
kernel32.dll!GetModuleFileNameA+0x1b4

ce qui me fais penser que les routine d accès au driver sont crypter et que le lancement du soft propriétaire les débloque

de plus l utilisation de quartz.dll et de qcap.dll ferait plutôt penser a du direct show mais étant débutant je cale a cet endroit

voici la fonction de la dll

function RegDeleteKeyW(hKey: HKEY; lpSubKey: PWideChar): Longint; stdcall; external 'advapi32.dll' name 'RegDeleteKeyW' index 397;

maintenant la question est comment ??

**cincap** · 06/12/2008, 09h58

Bonjour à toutes et à tous,

@Vinse, en mettant directement la commande associée avec un bouton afin d'ouvrir la boite de dialogue pour les drivers, cela ne fonctionne pas !

Code :

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

1
2
3
//Connection a la cam
sendmessage(VideoHwnd,1034,0,0);

Sinon, utilises DirectX voir le site de Paul Glagla.

Peut être aussi diminuer l'accélération matérielle de ta carte graphique !

@+,

Cincap

**anapurna** · 07/12/2008, 11h25

salut

il existe une unité pour gerer la gestion avec la dll avi
regarde du cote de l'unité VFW

ensuite il te faudra faire une truc du genre

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
 
  FCurVidHdle := capCreateCaptureWindow('Capture Window', WS_CHILD or   WS_VISIBLE, 0, 0, CaptureWidth, CaptureHeight,Panel1.Handle, 0);
  if FCurVidHdle <> 0 then
  begin
    // the second parameter is the driver index
    if capDriverConnect(FCurVidHdle, 0) then
    begin
        ....
        capPreviewRate(FCurVidHdle, 0);
        capOverlay(FCurVidHdle, True); 
        .... 
    end
    else
    begin  // no connect to driver
      DestroyWindow(FCurVidHdle);
      FCurVidHdle := 0;
    end;
  end;

@+ Phil

capture de video avec avicap32.dll

Delphi

Discussions similaires

Partager

Partager