Autor Beitrag
hibbert
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 1007

WinServer2003, Win XP, Linux
D6 Pers, D05
BeitragVerfasst: Mi 03.12.03 23:00 
Hi,
wie kann ich das aktuelle Bild meiner Webcam anzeigen?
Es sollen aber nicht einzelne Bilder alle paar sec. abgefragt werden, sondern, sondern es soll so eine Art von LiveStream zu sehen (nur in meinem Project auf meinem Monitor...)

wie kann ich das machen und benötige ich spezielle Komponenten dazu?

thx hibbert

_________________
I kunnen väl svara endast ja eller nej
Om i viljen eller nej
Killi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 299

Win*
D6 Prof
BeitragVerfasst: Do 04.12.03 19:02 
Nee, brauchst keine Komponente dazu - ich hab ne Logitech Cam, wenn Treiber drauf sind wirds autom. erkannt - hier der Code:


UNIT1.PAS: (Falls du Pics machen willst, die Kommentare entfernen!!!
ausblenden volle Höhe Delphi-Quelltext
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:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    TBild: TTimer;
    PanelVideo2: TPanel;
    VideoLabel: TLabel;
    Panel2: TPanel;
    procedure FormShow(Sender: TObject);
    procedure Video2;
    procedure TBildTimer(Sender: TObject);
    procedure BildMachen(Nr: integer);
    procedure CapStatus(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  i: integer;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
     CapCloseDriver;
     Video2;

          i:= 1;
     TBild.Enabled:= True;
end;

procedure TForm1.Video2;
var
  MyCapStatusProc : TCapStatusProc;
begin
     // Start CAP -  Video
     CapSetVideoArea( PanelVideo2 );
     CapSetInfoLabel( VideoLabel );
     MyCapStatusProc := CAPStatus;
     CapSetStatusProcedure( MyCapStatusProc );

     if CapOpenDriver then
     begin
          CapSetCapSec(15 * 3);
    CapShow;
     end;
end;

procedure TForm1.CapStatus(Sender: TObject);
begin
     Panel2.Color := clBtnFace;
     Panel2.Refresh;
end;

procedure TForm1.TBildTimer(Sender: TObject);
begin
//     BildMachen(i);
  {   i:= i + 1;
     if i = 6 then
     begin
          TBild.Enabled:= False;
          FlirtBildWahl.Show;
     end
     else
     begin
          GBUserBild.Caption:= 'Bitte warten, Bilder werden gemacht: noch ' + IntToStr(5 - i) + '...';
     end;     }

end;

procedure TForm1.BildMachen(Nr: integer);
var
  SingleImageFileName : string;
begin
     // Save Video as Bitmap to file in TEMP-Path
//     SingleImageFileName:= ExtractFilePath(ParamStr(0)) + UserLog + '\' + IntToStr(Nr) + '.bmp';
//     CapSetSingleImageFileName( SingleImageFileName );
     CapGrabSingleFrame;
     CapSetVideoLive;
end;

end.



VideoCap.Pas:
ausblenden volle Höhe Delphi-Quelltext
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:
unit VideoCap;

interface

uses Windows, Dialogs, Controls, SysUtils, StdCtrls, MMSystem, AviCap;

const
  MAXVIDDRIVERS = 10;
  MS_FOR_15FPS  = 66;
  MS_FOR_20FPS  = 50;
  MS_FOR_30FPS  = 33;
  MS_FOR_25FPS  = 40;    // rate in msec

type
  TCapStatusProc = procedure(Sender: TObject) of object;

var
  ghCapWnd                : THandle;
  gCapVideoArea           : TWinControl;
  gCapVideoDriverName     : string;
  gdwCapNofMaxVideoFrame  : DWord;
  gCapVideoFileName       : string;
  gCapSingleImageFileName : string;
  gCapVideoInfoLabel      : TLabel;
  gCapStatusProcedure     : TCapStatusProc;

  procedure CapSetVideoArea( Container: TWinControl );
  procedure CapSetVideoFileName( FileName : string );
  procedure CapSetSingleImageFileName( FileName : string );
  procedure CapSetInfoLabel( InfoLabel : TLabel );
  procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );

  function  CapOpenDriver : Boolean;
  function  CapInitDriver( Index : Integer ): Boolean;
  procedure CapCloseDriver;
  procedure CapShow;
  procedure CapSetCapSec( NofMaxVideoFrame : Integer );
  procedure CapStart;
  procedure CapStop;
  function  CapHasDlgVFormat  : Boolean;
  function  CapHasDlgVDisplay : Boolean;
  function  CapHasDlgVSource  : Boolean;
  procedure CapDlgVFormat;
  procedure CapDlgVDisplay;
  procedure CapDlgVSource;
  procedure CapSetVideoOverlay;
  procedure CapSetVideoLive;
  procedure CapGrabSingleFrame;

implementation

(*---------------------------------------------------------------*)
(*--- C A P - V I D E O  D R I V E R  ---*)
(*---------------------------------------------------------------*)

(*---------------------------------------------------------------*)
procedure CapSetVideoArea( Container: TWinControl );
begin
  gCapVideoArea  := Container;
end;

(*---------------------------------------------------------------*)
procedure CapSetVideoFileName( FileName : string );
begin
  gCapVideoFileName := FileName;
end;

(*---------------------------------------------------------------*)
procedure CapSetSingleImageFileName( FileName : string );
begin
  gCapSingleImageFileName := FileName;
end;

(*---------------------------------------------------------------*)
procedure CapSetInfoLabel( InfoLabel : TLabel );
begin
  gCapVideoInfoLabel := InfoLabel;
end;

(*---------------------------------------------------------------*)
procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );
begin
  gCapStatusProcedure := StatusProc;
end;

(*---------------------------------------------------------------*)
(* -- Video For Windows Status Callback Function --- *)
(*---------------------------------------------------------------*)
function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : LongInt): LongInt; stdcall;
var
  TmpStr     : string;
  dwVideoNum : Integer;
begin
  //  hWnd:           Application main window handle
  //  nID:            Status code for the current status
  //  lpStatusText:   Status text string for the current status

  TmpStr := StrPas(PChar(lpsz));
  gCapVideoInfoLabel.Caption := TmpStr;
   gCapVideoInfoLabel.Refresh;

  if nID = IDS_CAP_STAT_VIDEOCURRENT then
  begin
    dwVideoNum := StrToInt( Copy(TmpStr, 0, Pos(' ', TmpStr)-1));
    if dwVideoNum >= gdwCapNofMaxVideoFrame then
    begin
      capCaptureAbort(ghCapWnd);
      if @gCapStatusProcedure <> nil then gCapStatusProcedure(nil);
    end;
  end;
  Result := 1;
end;


(*---------------------------------------------------------------*)
function CapOpenDriver : Boolean;
var
  Retc             : LongInt;
  DriverIndex      : Integer;
  DriverStarted    : boolean;
  achDeviceName    : array [0..80of Char;
  achDeviceVersion : array [0..100of Char;
  achFileName      : array [0..255of Char;
begin
  Result := FALSE;
  if gCapVideoArea = nil then exit;

  Result      := TRUE;

    // Create the Video Capture Window
  ghCapWnd := capCreateCaptureWindow( PChar('KruwoSoft'),
              WS_CHILD or WS_VISIBLE, 00,
              gCapVideoArea.Width, gCapVideoArea.Height,
              gCapVideoArea.Handle, 0);
  if ghCapWnd <> 0 then
  begin
      // Install Status-Callback-Function
    retc := capSetCallbackOnStatus(ghCapWnd, LongInt(0));
    if retc <> 0 then
    begin
      retc := capSetCallbackOnStatus(ghCapWnd, LongInt(@StatusCallbackProc));
      if retc <> 0 then
      begin
          // Open Installed Video Driver
        DriverIndex := 0;
        repeat
          DriverStarted := CapInitDriver( DriverIndex );
          if NOT DriverStarted then DriverIndex := DriverIndex + 1;
        until (DriverStarted = TRUE) OR (DriverIndex >= MAXVIDDRIVERS);

          // Keep Name of Video Driver
        if capGetDriverDescription( DriverIndex,
                                    achDeviceName,    80,
                                    achDeviceVersion, 100 ) then
        begin
          gCapVideoDriverName := string(achDeviceName);
        end;

          // Set Capture FileName
        StrPCopy(achFileName, gCapVideoFileName);
        retc := capFileSetCaptureFile(ghCapWnd, LongInt(@achFileName));
        if retc = 0 then
        begin
          showmessage(gCapVideoDriverName+': Error in capFileSetCaptureFile');
        end;
        exit;
      end;
    end;
  end;
   Result := FALSE;
  CapCloseDriver;
  ghCapWnd := 0;
end;

(*---------------------------------------------------------------*)
function CapInitDriver( Index : Integer ): Boolean;
var
  Retc             : LongInt;
  CapParms         : TCAPTUREPARMS;
begin

   Result := FALSE;
  if ghCapWnd = 0 then exit;

    // Connect to Video Capture Driver
  if capDriverConnect(ghCapWnd, Index) <> 0 then
  begin
    retc := capCaptureGetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
    if retc <> 0 then
    begin
//        CapParms.dwRequestMicroSecPerFrame := 40000;    // 25 FPS Requested capture rate
//        CapParms.dwRequestMicroSecPerFrame := 100000;    // 10 FPS Requested capture rate
      CapParms.dwRequestMicroSecPerFrame := 66667;    // 15 FPS Requested capture rate
      CapParms.fLimitEnabled    := FALSE;
      CapParms.fCaptureAudio    := FALSE;    // NO Audio
      CapParms.fMCIControl      := FALSE;
      CapParms.fYield           := TRUE;
      CapParms.vKeyAbort        := VK_ESCAPE;
      CapParms.fAbortLeftMouse  := FALSE;
      CapParms.fAbortRightMouse := FALSE;

      retc := capCaptureSetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
      if retc = 0 then exit;
    end;
    Result := TRUE;
  end;
end;

(*---------------------------------------------------------------*)
procedure CapCloseDriver;
begin
  if ghCapWnd <> 0 then
  begin
    capSetCallbackOnStatus(ghCapWnd, LongInt(0));
    capDriverDisconnect( ghCapWnd );
    DestroyWindow( ghCapWnd ) ;
    ghCapWnd := 0;
  end;
end;

(*---------------------------------------------------------------*)
procedure CapShow;
begin
  if ghCapWnd = 0 then exit;

     // Start Video overlay by default
  capPreviewScale(ghCapWnd, 1);
  capPreviewRate(ghCapWnd, MS_FOR_25FPS);
  capOverlay(ghCapWnd, 0);
  capPreview(ghCapWnd, 1);
end;

(*---------------------------------------------------------------*)
procedure CapSetCapSec( NofMaxVideoFrame : Integer );
begin
  gdwCapNofMaxVideoFrame := DWord( NofMaxVideoFrame );
end;

(*---------------------------------------------------------------*)
procedure CapStart;
begin
  if ghCapWnd = 0 then exit;
    // Start video capture to file
  capCaptureSequence( ghCapWnd );
end;

(*---------------------------------------------------------------*)
procedure CapStop;
begin
  if ghCapWnd = 0 then exit;
    // Stop video capture to file
  capCaptureAbort(ghCapWnd);
end;

(*---------------------------------------------------------------*)
function  CapHasDlgVFormat  : Boolean;
var
  CDrvCaps : TCapDriverCaps;
begin
  Result := TRUE;
  if ghCapWnd = 0 then exit;

  capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
  Result := CDrvCaps.fHasDlgVideoFormat;
end;

(*---------------------------------------------------------------*)
function  CapHasDlgVDisplay : Boolean;
var
  CDrvCaps : TCapDriverCaps;
begin
  Result := TRUE;
  if ghCapWnd = 0 then exit;

  capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
  Result := CDrvCaps.fHasDlgVideoDisplay;
end;

(*---------------------------------------------------------------*)
function  CapHasDlgVSource  : Boolean;
var
  CDrvCaps : TCapDriverCaps;
begin
  Result := TRUE;
  if ghCapWnd = 0 then exit;

  capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
  Result := CDrvCaps.fHasDlgVideoSource;
end;

(*---------------------------------------------------------------*)
procedure CapDlgVFormat;
begin
  if ghCapWnd = 0 then exit;

  capDlgVideoFormat(ghCapWnd);
end;

(*---------------------------------------------------------------*)
procedure CapDlgVDisplay;
begin
  if ghCapWnd = 0 then exit;

  capDlgVideoDisplay(ghCapWnd);
end;

(*---------------------------------------------------------------*)
procedure CapDlgVSource;
begin
  if ghCapWnd = 0 then exit;

  capDlgVideoSource(ghCapWnd);
end;

(*---------------------------------------------------------------*)
procedure CapSetVideoOverlay;
begin
  if ghCapWnd = 0 then exit;

  capPreview(ghCapWnd, 0);
  capOverlay(ghCapWnd, 1);
end;

(*---------------------------------------------------------------*)
procedure CapSetVideoLive;
begin
  if ghCapWnd = 0 then exit;

  capOverlay(ghCapWnd, 0);
  capPreviewScale(ghCapWnd, 1);
  capPreviewRate(ghCapWnd, MS_FOR_25FPS);
  capPreview(ghCapWnd, 1);
end;

(*---------------------------------------------------------------*)
procedure CapGrabSingleFrame;
var
  achSingleFileName  : array [0..255of Char;
begin
  if ghCapWnd = 0 then exit;

  capGrabFrame(ghCapWnd);
   StrPCopy(achSingleFileName, gCapSingleImageFileName);
  capFileSaveDIB(ghCapWnd, LongInt(@achSingleFileName));
end;

initialization
  ghCapWnd                := 0;
  gCapVideoArea           := nil;
  gCapVideoDriverName     := 'No Driver';
  gdwCapNofMaxVideoFrame  := 0;
  gCapVideoFileName       := 'Video.avi';
  gCapSingleImageFileName := 'Image.bmp';
  gCapVideoInfoLabel      := nil;
  gCapStatusProcedure     := nil;

end.



VideoMci.Pas:
ausblenden volle Höhe Delphi-Quelltext
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:
unit VideoMci;

interface

uses Windows, SysUtils, Graphics, Controls, MMSystem, VfW;

type
  TMciStatusProc = procedure(Sender: TObject) of object;

var
  gMciVideoArea       : TWinControl;
  gMciVideoFileName   : string;
  gMciActive          : boolean;
  gMciStatusProcedure : TMciStatusProc;
  gMciVideoHandle     : THandle;

  procedure MciSetVideoArea( Container: TWinControl );
  procedure MciSetVideoFileName( FileName : string );
  procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
  procedure MciSetVideoHandle( hVideo: THandle );

  procedure MciVideoCommand( TheCommand : string );
  function  MciReturnVideoCommand( TheCommand : string ) : string;
  procedure MciOpen;
  procedure MciClose;
  procedure MciStart;
  procedure MciStop;
  procedure MciSeek( Position : Integer );
  function  MciGetPos: Integer;
  procedure MciPlay( FromPos : Integer );
  function  MciGetNoOfFrames : Integer;
  function  MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
  procedure MciNotify;

implementation

(*---------------------------------------------------------------*)
(*--- M C I - V I D E O  D R I V E R  ---*)
(*---------------------------------------------------------------*)

uses WVideo;

(*---------------------------------------------------------------*)
procedure MciSetVideoArea( Container: TWinControl );
begin
  gMciVideoArea  := Container;
end;

(*---------------------------------------------------------------*)
procedure MciSetVideoFileName( FileName : string );
begin
  gMciVideoFileName := FileName;
end;

(*---------------------------------------------------------------*)
procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
begin
  gMciStatusProcedure := StatusProc;
end;

(*---------------------------------------------------------------*)
procedure MciSetVideoHandle( hVideo: THandle );
begin
  gMciVideoHandle := hVideo;
end;

(*---------------------------------------------------------------*)
procedure MciVideoCommand( TheCommand : string );
var
  FError    : LongInt;
  ReturnStr : array [0..255of Char;
//   ErrorStr  : array [0..127] of Char;
begin
  FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
  if FError <> 0 then
  begin
    gMciActive := FALSE;
(*
    mciGetErrorString( FError, ErrorStr, 127 );
    Showmessage(' Command : '+ TheCommand + #13 +
                ' Error   : '+ string(ErrorStr) );
*)

  end;
end;

(*---------------------------------------------------------------*)
function MciReturnVideoCommand( TheCommand : string ) : string;
var
  FError    : LongInt;
  ReturnStr : array [0..255of Char;
//   ErrorStr  : array [0..127] of Char;
begin
  FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
  if FError <> 0 then
  begin
    gMciActive := FALSE;
(*
    mciGetErrorString( FError, ErrorStr, 127 );
    Showmessage(' Command : '+ TheCommand + #13 +
                ' Error   : '+ string(ErrorStr) );
*)

  end;
  Result := StrPas( ReturnStr );
end;

(*---------------------------------------------------------------*)
procedure MciNotify;
begin
  if @gMciStatusProcedure <> nil then gMciStatusProcedure(nil);
//  PostMessage( gdwAppHwnd, Mci_REV_MSG_Status, 0, LongInt(50) );
end;

(*---------------------------------------------------------------*)
procedure MciOpen;
begin
  gMciActive := TRUE;
  if gMciActive  then MciVideoCommand( 'open '
                + gMciVideoFileName + ' alias KruwoVideo style child parent '
                + IntToStr(gMciVideoArea.Handle) + ' wait' );

  if gMciActive then MciVideoCommand( 'put KruwoVideo window at '
                                   + IntToStr(gMciVideoArea.Left-5) + ' '
                                   + IntToStr(gMciVideoArea.Top-5)  + ' '
                                   + IntToStr(gMciVideoArea.Width)  + ' '
                                   + IntToStr(gMciVideoArea.Height) + ' wait' );
  if gMciActive then MciVideoCommand( 'set KruwoVideo seek exactly off wait' );
end;

(*---------------------------------------------------------------*)
procedure MciClose;
begin
  if gMciActive then MciVideoCommand( 'close KruwoVideo wait' );
end;

(*---------------------------------------------------------------*)
procedure MciStart;
begin
   if gMciActive then MciVideoCommand( 'play KruwoVideo from 0 notify' );
end;

(*---------------------------------------------------------------*)
procedure MciStop;
begin
   if gMciActive then MciVideoCommand( 'stop KruwoVideo wait' );
end;

(*---------------------------------------------------------------*)
procedure MciSeek( Position : Integer );
begin
   if gMciActive then MciVideoCommand( 'seek KruwoVideo to '+IntToStr(Position)+' wait' );
end;

(*---------------------------------------------------------------*)
function MciGetPos: Integer;
var
  PosStr : string;
begin
  PosStr := MciReturnVideoCommand('status KruwoVideo position wait');
  if Length(PosStr) <= 0
    then Result := 0
    else Result := LongInt(StrToInt(PosStr));
end;

(*---------------------------------------------------------------*)
procedure MciPlay( FromPos : Integer );
begin
   if gMciActive then MciVideoCommand( 'play KruwoVideo from '
                                   + IntToStr(FromPos) + ' notify' );
end;


(*---------------------------------------------------------------*)
function MciGetNoOfFrames : Integer;
var
  retc       : Integer;
  pfile      : PAVIFile;
   gapavi     : PAVIStream;      // the current stream
   asi        : TAVIStreamInfo;
begin
  Result := -1;

    // Open and Save Video
  AVIFileInit;

  retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0nil);
  if retc <> 0 then
  begin
    AVIFileExit;
    exit;
  end;

  retc := AVIFileGetStream(pfile, gapavi, 00);
  if retc <> AVIERR_OK then
  begin
    AVIFileRelease(pfile);
    AVIFileExit;
    exit;
  end;

    // Get some info about this stream
  retc := AVIStreamInfo(gapavi, asi, sizeof(asi));
  if retc <> AVIERR_OK then
  begin
    AVIStreamRelease(gapavi);
    AVIFileRelease(pfile);
    AVIFileExit;
    exit;
  end;

  if asi.fccType <> streamtypeVIDEO
    then Result := -1
    else Result := asi.dwLength;

  AVIStreamRelease(gapavi);
  AVIFileRelease(pfile);
  AVIFileExit;
end;

(*---------------------------------------------------------------*)
function MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
var
  CurrentPos : Integer;
  retc       : Integer;
  pfile      : PAVIFile;
   gapavi     : PAVIStream;    // the current stream
  gapgf      : PGETFRAME;      // data for decompressing video
  lpbi       : PBITMAPINFOHEADER;
  bits       : PChar;
  hBmp       : HBITMAP;
begin
  Result := FALSE;
  CurrentPos := MciGetPos;

    // Open and Save Video
  AVIFileInit;

  retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0nil);
  if retc <> 0 then
  begin
    AVIFileExit;
    exit;
  end;

  retc := AVIFileGetStream(pfile, gapavi, 00);
  if retc <> AVIERR_OK then
  begin
    AVIFileRelease(pfile);
    AVIFileExit;
    exit;
  end;

  gapgf := AVIStreamGetFrameOpen(gapavi, nil);
  if gapgf = nil then
  begin
    AVIStreamRelease(gapavi);
    AVIFileRelease(pfile);
    AVIFileExit;
    exit;
  end;

    // Read current Frame
  lpbi := AVIStreamGetFrame(gapgf, CurrentPos);
  if lpbi = nil then
  begin
    AVIStreamGetFrameClose(gapgf);
    AVIStreamRelease(gapavi);
    AVIFileRelease(pfile);
    AVIFileExit;
    exit;
  end;

   TmpBmp.Height := lpbi.biHeight;
  TmpBmp.Width  := lpbi.biWidth;

  bits := Pointer(Integer(lpbi) + sizeof(TBITMAPINFOHEADER));
  hBmp := CreateDIBitmap(
            GetDC(gMciVideoArea.Handle), // handle of device context
             lpbi^,                // address of bitmap size and format data
             CBM_INIT,              // initialization flag
            bits,                  // address of initialization data

             PBITMAPINFO(lpbi)^,    // address of bitmap color-format data
             DIB_RGB_COLORS );     // color-data usage
  TmpBmp.Handle := hBmp;

  Result := TRUE;

   AVIStreamGetFrameClose(gapgf);
  AVIStreamRelease(gapavi);
  AVIFileRelease(pfile);
  AVIFileExit;
end;


initialization
  gMciVideoFileName   := 'Video.avi';
  gMciActive          := FALSE;
  gMciStatusProcedure := nil;
end.


AviCap.Pas:
ausblenden volle Höhe Delphi-Quelltext
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:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
unit AviCap;

interface

uses
  Windows, MMSystem, Messages;

const
  // ------------------------------------------------------------------
  //  Window Messages  WM_CAP... which can be sent to an AVICAP window
  // ------------------------------------------------------------------

  // Defines start of the message range
  WM_CAP_START                    = WM_USER;

  WM_CAP_GET_CAPSTREAMPTR         = (WM_CAP_START+  1);
  WM_CAP_SET_CALLBACK_ERROR       = (WM_CAP_START+  2);
  WM_CAP_SET_CALLBACK_STATUS      = (WM_CAP_START+  3);
  WM_CAP_SET_CALLBACK_YIELD       = (WM_CAP_START+  4);
  WM_CAP_SET_CALLBACK_FRAME       = (WM_CAP_START+  5);
  WM_CAP_SET_CALLBACK_VIDEOSTREAM = (WM_CAP_START+  6);
  WM_CAP_SET_CALLBACK_WAVESTREAM  = (WM_CAP_START+  7);
  WM_CAP_GET_USER_DATA            = (WM_CAP_START+  8);
  WM_CAP_SET_USER_DATA            = (WM_CAP_START+  9);

  WM_CAP_DRIVER_CONNECT           = (WM_CAP_START+  10);
  WM_CAP_DRIVER_DISCONNECT        = (WM_CAP_START+  11);
  WM_CAP_DRIVER_GET_NAME          = (WM_CAP_START+  12);
  WM_CAP_DRIVER_GET_VERSION       = (WM_CAP_START+  13);
  WM_CAP_DRIVER_GET_CAPS          = (WM_CAP_START+  14);

  WM_CAP_FILE_SET_CAPTURE_FILE    = (WM_CAP_START+  20);
  WM_CAP_FILE_GET_CAPTURE_FILE    = (WM_CAP_START+  21);
  WM_CAP_FILE_ALLOCATE            = (WM_CAP_START+  22);
  WM_CAP_FILE_SAVEAS              = (WM_CAP_START+  23);
  WM_CAP_FILE_SET_INFOCHUNK       = (WM_CAP_START+  24);
  WM_CAP_FILE_SAVEDIB             = (WM_CAP_START+  25);

  WM_CAP_EDIT_COPY                = (WM_CAP_START+  30);

  WM_CAP_SET_AUDIOFORMAT          = (WM_CAP_START+  35);
  WM_CAP_GET_AUDIOFORMAT          = (WM_CAP_START+  36);

  WM_CAP_DLG_VIDEOFORMAT          = (WM_CAP_START+  41);
  WM_CAP_DLG_VIDEOSOURCE          = (WM_CAP_START+  42);
  WM_CAP_DLG_VIDEODISPLAY         = (WM_CAP_START+  43);
  WM_CAP_GET_VIDEOFORMAT          = (WM_CAP_START+  44);
  WM_CAP_SET_VIDEOFORMAT          = (WM_CAP_START+  45);
  WM_CAP_DLG_VIDEOCOMPRESSION     = (WM_CAP_START+  46);

  WM_CAP_SET_PREVIEW              = (WM_CAP_START+  50);
  WM_CAP_SET_OVERLAY              = (WM_CAP_START+  51);
  WM_CAP_SET_PREVIEWRATE          = (WM_CAP_START+  52);
  WM_CAP_SET_SCALE                = (WM_CAP_START+  53);
  WM_CAP_GET_STATUS               = (WM_CAP_START+  54);
  WM_CAP_SET_SCROLL               = (WM_CAP_START+  55);

  WM_CAP_GRAB_FRAME               = (WM_CAP_START+  60);
  WM_CAP_GRAB_FRAME_NOSTOP        = (WM_CAP_START+  61);

  WM_CAP_SEQUENCE                 = (WM_CAP_START+  62);
  WM_CAP_SEQUENCE_NOFILE          = (WM_CAP_START+  63);
  WM_CAP_SET_SEQUENCE_SETUP       = (WM_CAP_START+  64);
  WM_CAP_GET_SEQUENCE_SETUP       = (WM_CAP_START+  65);
  WM_CAP_SET_MCI_DEVICE           = (WM_CAP_START+  66);
  WM_CAP_GET_MCI_DEVICE           = (WM_CAP_START+  67);
  WM_CAP_STOP                     = (WM_CAP_START+  68);
  WM_CAP_ABORT                    = (WM_CAP_START+  69);

  WM_CAP_SINGLE_FRAME_OPEN        = (WM_CAP_START+  70);
  WM_CAP_SINGLE_FRAME_CLOSE       = (WM_CAP_START+  71);
  WM_CAP_SINGLE_FRAME             = (WM_CAP_START+  72);

  WM_CAP_PAL_OPEN                 = (WM_CAP_START+  80);
  WM_CAP_PAL_SAVE                 = (WM_CAP_START+  81);
  WM_CAP_PAL_PASTE                = (WM_CAP_START+  82);
  WM_CAP_PAL_AUTOCREATE           = (WM_CAP_START+  83);
  WM_CAP_PAL_MANUALCREATE         = (WM_CAP_START+  84);

    // Following added post VFW 1.1
  WM_CAP_SET_CALLBACK_CAPCONTROL  = (WM_CAP_START+  85);

  // Defines end of the message range
  WM_CAP_END                      = WM_CAP_SET_CALLBACK_CAPCONTROL;

  // ------------------------------------------------------------------
  //  Message crackers for above
  // ------------------------------------------------------------------
function capSetCallbackOnError (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;

function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
function capGetUserData(hwnd:THandle):LongInt;
function capDriverConnect(hwnd:THandle; I: Word) : LongInt;

function capDriverDisconnect(hwnd:THandle):LongInt;
function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;

function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;

function capEditCopy(hwnd : THandle):LongInt;

function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormatSize(hwnd:THandle):LongInt;

function capDlgVideoFormat(hwnd:THandle):LongInt;
function capDlgVideoSource(hwnd:THandle):LongInt;
function capDlgVideoDisplay(hwnd:THandle):LongInt;
function capDlgVideoCompression(hwnd:THandle):LongInt;

function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetVideoFormatSize(hwnd:THandle):LongInt;
function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;

function capPreview(hwnd:THandle; f:Word):LongInt;
function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
function capOverlay(hwnd:THandle; f:Word):LongInt;
function capPreviewScale(hwnd:THandle; f:Word):LongInt;
function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;

function capGrabFrame(hwnd:THandle):LongInt;
function capGrabFrameNoStop(hwnd:THandle):LongInt;

function capCaptureSequence(hwnd:THandle):LongInt;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
function capCaptureStop(hwnd:THandle):LongInt;
function capCaptureAbort(hwnd:THandle):LongInt;

function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
function capCaptureSingleFrame(hwnd:THandle):LongInt;

function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;

function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;

function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
function capPalettePaste(hwnd:THandle):LongInt;
function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;

  // ------------------------------------------------------------------
  //  Structures
  // ------------------------------------------------------------------
type
  PCapDriverCaps = ^TCapDriverCaps;
  TCapDriverCaps = record
    wDeviceIndex            :WORD;           // Driver index in system.ini
    fHasOverlay             :BOOL;           // Can device overlay?
    fHasDlgVideoSource      :BOOL;           // Has Video source dlg?
    fHasDlgVideoFormat      :BOOL;           // Has Format dlg?
    fHasDlgVideoDisplay     :BOOL;           // Has External out dlg?
    fCaptureInitialized     :BOOL;           // Driver ready to capture?
    fDriverSuppliesPalettes :BOOL;           // Can driver make palettes?
    hVideoIn                :THANDLE;        // Driver In channel
    hVideoOut               :THANDLE;        // Driver Out channel
    hVideoExtIn             :THANDLE;        // Driver Ext In channel
    hVideoExtOut            :THANDLE;        // Driver Ext Out channel
  end;

  PCapStatus = ^TCapStatus;
  TCapStatus = packed record
    uiImageWidth                :UINT;      // Width of the image
    uiImageHeight               :UINT;      // Height of the image
    fLiveWindow                 :BOOL;      // Now Previewing video?
    fOverlayWindow              :BOOL;      // Now Overlaying video?
    fScale                      :BOOL;      // Scale image to client?
    ptScroll                    :TPOINT;    // Scroll position
    fUsingDefaultPalette        :BOOL;      // Using default driver palette?
    fAudioHardware              :BOOL;      // Audio hardware present?
    fCapFileExists              :BOOL;      // Does capture file exist?
    dwCurrentVideoFrame         :DWORD;     // # of video frames cap'td
    dwCurrentVideoFramesDropped :DWORD;     // # of video frames dropped
    dwCurrentWaveSamples        :DWORD;     // # of wave samples cap'td
    dwCurrentTimeElapsedMS      :DWORD;     // Elapsed capture duration
    hPalCurrent                 :HPALETTE;  // Current palette in use
    fCapturingNow               :BOOL;      // Capture in progress?
    dwReturn                    :DWORD;     // Error value after any operation
    wNumVideoAllocated          :WORD;      // Actual number of video buffers
    wNumAudioAllocated          :WORD;      // Actual number of audio buffers
  end;

  PCaptureParms = ^TCaptureParms;
  TCaptureParms = record                    // Default values in parenthesis
    dwRequestMicroSecPerFrame :DWORD;    // Requested capture rate
    fMakeUserHitOKToCapture   :BOOL;     // Show "Hit OK to cap" dlg?
    wPercentDropForError      :WORD;     // Give error msg if > (10%)
    fYield                    :BOOL;     // Capture via background task?
    dwIndexSize               :DWORD;    // Max index size in frames (32K)
    wChunkGranularity         :WORD;     // Junk chunk granularity (2K)
    fUsingDOSMemory           :BOOL;     // Use DOS buffers?
    wNumVideoRequested        :WORD;     // # video buffers, If 0, autocalc
    fCaptureAudio             :BOOL;     // Capture audio?
    wNumAudioRequested        :WORD;     // # audio buffers, If 0, autocalc
    vKeyAbort                 :WORD;     // Virtual key causing abort
    fAbortLeftMouse           :BOOL;     // Abort on left mouse?
    fAbortRightMouse          :BOOL;     // Abort on right mouse?
    fLimitEnabled             :BOOL;     // Use wTimeLimit?
    wTimeLimit                :WORD;     // Seconds to capture
    fMCIControl               :BOOL;     // Use MCI video source?
    fStepMCIDevice            :BOOL;     // Step MCI device?
    dwMCIStartTime            :DWORD;    // Time to start in MS
    dwMCIStopTime             :DWORD;    // Time to stop in MS
    fStepCaptureAt2x          :BOOL;     // Perform spatial averaging 2x
    wStepCaptureAverageFrames :WORD;     // Temporal average n Frames
    dwAudioBufferSize         :DWORD;    // Size of audio bufs (0 = default)
    fDisableWriteCache        :BOOL;     // Attempt to disable write cache
    AVStreamMaster            :WORD;     // Indicates whether the audio stream
                                         //   controls the clock when writing an AVI file.
  end;

  PCapInfoChunk = ^TCapInfoChunk;
  TCapInfoChunk = record
    fccInfoID :FOURCC;     // Chunk ID, "ICOP" for copyright
    lpData    :LongInt;   // pointer to data
    cbData    :LongInt;   // size of lpData
  end;

  // ------------------------------------------------------------------
  //  Callback Definitions
  // ------------------------------------------------------------------
type
  TCAPSTATUSCALLBACK  = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
  TCAPYIELDCALLBACK   = function(hWnd:HWND):LongInt; stdcall;
  TCAPERRORCALLBACK   = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
  TCAPVIDEOCALLBACK   = function(hWnd:HWND; lpVHdr:LongInt):LongInt; stdcall;
  TCAPWAVECALLBACK    = function(hWnd:HWND; lpWHdr:LongInt):LongInt; stdcall;
  TCAPCONTROLCALLBACK = function(hWnd:HWND; nState:Integer):LongInt; stdcall;

  // ------------------------------------------------------------------
  //  CapControlCallback states
  // ------------------------------------------------------------------
Const
  CONTROLCALLBACK_PREROLL         = 1;  // Waiting to start capture
  CONTROLCALLBACK_CAPTURING       = 2;   // Now capturing

  // ------------------------------------------------------------------
  //  The only exported functions from AVICAP.DLL
  // ------------------------------------------------------------------
  function capCreateCaptureWindow (
              lpszWindowName  : PChar;
              dwStyle         : DWord;
               x, y            : Integer;
              nWidth, nHeight : Integer;
              hwndParent      : THandle;
              nID             : Integer ) : THandle; stdcall;

  function capGetDriverDescription (
              wDriverIndex : DWord;
              lpszName     : PChar;
              cbName       : Integer;
              lpszVer      : PChar;

              cbVer        : Integer ) : Boolean; stdcall;

  // ------------------------------------------------------------------
  // New Information chunk IDs
  // ------------------------------------------------------------------
(*
  infotypeDIGITIZATION_TIME  = mmioStringToFOURCC(PChar('IDIT'), MMIO_TOUPPER);
  infotypeSMPTE_TIME         = mmioStringToFOURCC(PChar('ISMP'), MMIO_TOUPPER);
*)


  // ------------------------------------------------------------------
  // String IDs from status and error callbacks
  // ------------------------------------------------------------------
Const
  IDS_CAP_BEGIN               = 300(* "Capture Start" *)
  IDS_CAP_END                 = 301(* "Capture End" *)

  IDS_CAP_INFO                = 401(* "%s" *)
  IDS_CAP_OUTOFMEM            = 402(* "Out of memory" *)
  IDS_CAP_FILEEXISTS          = 403(* "File '%s' exists -- overwrite it?" *)
  IDS_CAP_ERRORPALOPEN        = 404(* "Error opening palette '%s'" *)
  IDS_CAP_ERRORPALSAVE        = 405(* "Error saving palette '%s'" *)
  IDS_CAP_ERRORDIBSAVE        = 406(* "Error saving frame '%s'" *)
  IDS_CAP_DEFAVIEXT           = 407(* "avi" *)
  IDS_CAP_DEFPALEXT           = 408(* "pal" *)
  IDS_CAP_CANTOPEN            = 409(* "Cannot open '%s'" *)
  IDS_CAP_SEQ_MSGSTART        = 410(* "Select OK to start capture\nof video sequence\nto %s." *)
  IDS_CAP_SEQ_MSGSTOP         = 411(* "Hit ESCAPE or click to end capture" *)

  IDS_CAP_VIDEDITERR          = 412(* "An error occurred while trying to run VidEdit." *)
  IDS_CAP_READONLYFILE        = 413(* "The file '%s' is a read-only file." *)
  IDS_CAP_WRITEERROR          = 414(* "Unable to write to file '%s'.\nDisk may be full." *)
  IDS_CAP_NODISKSPACE         = 415(* "There is no space to create a capture file on the specified device." *)
  IDS_CAP_SETFILESIZE         = 416(* "Set File Size" *)
  IDS_CAP_SAVEASPERCENT       = 417(* "SaveAs: %2ld%%  Hit Escape to abort." *)

  IDS_CAP_DRIVER_ERROR        = 418(* Driver specific error message *)

  IDS_CAP_WAVE_OPEN_ERROR     = 419(* "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." *)
  IDS_CAP_WAVE_ALLOC_ERROR    = 420(* "Error: Out of memory for wave buffers." *)
  IDS_CAP_WAVE_PREPARE_ERROR  = 421(* "Error: Cannot prepare wave buffers." *)
  IDS_CAP_WAVE_ADD_ERROR      = 422(* "Error: Cannot add wave buffers." *)
  IDS_CAP_WAVE_SIZE_ERROR     = 423(* "Error: Bad wave size." *)

  IDS_CAP_VIDEO_OPEN_ERROR    = 424(* "Error: Cannot open the video input device." *)
  IDS_CAP_VIDEO_ALLOC_ERROR   = 425(* "Error: Out of memory for video buffers." *)
  IDS_CAP_VIDEO_PREPARE_ERROR = 426(* "Error: Cannot prepare video buffers." *)
  IDS_CAP_VIDEO_ADD_ERROR     = 427(* "Error: Cannot add video buffers." *)
  IDS_CAP_VIDEO_SIZE_ERROR    = 428(* "Error: Bad video size." *)

  IDS_CAP_FILE_OPEN_ERROR     = 429(* "Error: Cannot open capture file." *)
  IDS_CAP_FILE_WRITE_ERROR    = 430(* "Error: Cannot write to capture file.  Disk may be full." *)
  IDS_CAP_RECORDING_ERROR     = 431(* "Error: Cannot write to capture file.  Data rate too high or disk full." *)
  IDS_CAP_RECORDING_ERROR2    = 432(* "Error while recording" *)
  IDS_CAP_AVI_INIT_ERROR      = 433(* "Error: Unable to initialize for capture." *)
  IDS_CAP_NO_FRAME_CAP_ERROR  = 434(* "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." *)
  IDS_CAP_NO_PALETTE_WARN     = 435(* "Warning: Using default palette." *)
  IDS_CAP_MCI_CONTROL_ERROR   = 436(* "Error: Unable to access MCI device." *)
  IDS_CAP_MCI_CANT_STEP_ERROR = 437(* "Error: Unable to step MCI device." *)
  IDS_CAP_NO_AUDIO_CAP_ERROR  = 438(* "Error: No audio data captured.\nCheck audio card settings." *)
  IDS_CAP_AVI_DRAWDIB_ERROR   = 439(* "Error: Unable to draw this data format." *)
  IDS_CAP_COMPRESSOR_ERROR    = 440(* "Error: Unable to initialize compressor." *)
  IDS_CAP_AUDIO_DROP_ERROR    = 441(* "Error: Audio data was lost during capture, reduce capture rate." *)

  (* status string IDs *)
  IDS_CAP_STAT_LIVE_MODE      = 500(* "Live window" *)
  IDS_CAP_STAT_OVERLAY_MODE   = 501(* "Overlay window" *)
  IDS_CAP_STAT_CAP_INIT       = 502(* "Setting up for capture - Please wait" *)
  IDS_CAP_STAT_CAP_FINI       = 503(* "Finished capture, now writing frame %ld" *)
  IDS_CAP_STAT_PALETTE_BUILD  = 504(* "Building palette map" *)
  IDS_CAP_STAT_OPTPAL_BUILD   = 505(* "Computing optimal palette" *)
  IDS_CAP_STAT_I_FRAMES       = 506(* "%d frames" *)
  IDS_CAP_STAT_L_FRAMES       = 507(* "%ld frames" *)
  IDS_CAP_STAT_CAP_L_FRAMES   = 508(* "Captured %ld frames" *)
  IDS_CAP_STAT_CAP_AUDIO      = 509(* "Capturing audio" *)
  IDS_CAP_STAT_VIDEOCURRENT   = 510(* "Captured %ld frames (%ld dropped) %d.%03d sec." *)
  IDS_CAP_STAT_VIDEOAUDIO     = 511(* "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps).  %ld audio bytes (%d,%03d sps)" *)
  IDS_CAP_STAT_VIDEOONLY      = 512(* "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps)" *)
  IDS_CAP_STAT_FRAMESDROPPED  = 513(* "Dropped %ld of %ld frames (%d.%02d%%) during capture." *)

const
  AVICAP32 = 'AVICAP32.dll';

implementation

(* Externals from AVICAP.DLL *)
function capGetDriverDescription; external AVICAP32 name 'capGetDriverDescriptionA';
function capCreateCaptureWindow;  external AVICAP32 name 'capCreateCaptureWindowA';


(* Message crackers for above *)
function capSetCallbackOnError(hwnd : THandle; fpProc:LongInt) : LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_ERROR, 0, fpProc);
end;

function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, fpProc);
end;

function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_YIELD, 0, fpProc);
end;

function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, fpProc);
end;

function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, fpProc);
end;

function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, fpProc);
end;

function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, fpProc);
end;

function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_USER_DATA, 0, lUser);
end;

function capGetUserData(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_USER_DATA, 00);
end;

function capDriverConnect(hwnd:THandle; I: Word) : LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, I, 0);
end;

function capDriverDisconnect(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DRIVER_DISCONNECT, 00);
end;

function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_NAME, wSize, szName);
end;

function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_VERSION, wSize, szVer);
end;

function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_CAPS, wSize, s);
end;

function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0, szName);
end;

function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_GET_CAPTURE_FILE, wSize, szName);
end;

function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_ALLOCATE, 0, dwSize);
end;

function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_SAVEAS, 0, szName);
end;

function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_SET_INFOCHUNK, 0, lpInfoChunk);
end;

function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_FILE_SAVEDIB, 0, szName);
end;

function capEditCopy(hwnd : THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_EDIT_COPY, 00);
end;

function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_AUDIOFORMAT, wSize, s);
end;

function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, wSize, s);
end;

function capGetAudioFormatSize(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, 00);
end;

function capDlgVideoFormat(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOFORMAT, 00);
end;

function capDlgVideoSource(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOSOURCE, 00);
end;

function capDlgVideoDisplay(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DLG_VIDEODISPLAY, 00);
end;

function capDlgVideoCompression(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 00);
end;

function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, wSize, s);
end;

function capGetVideoFormatSize(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 00);
end;

function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, wSize, s);
end;

function capPreview(hwnd:THandle; f:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_PREVIEW, f, 0);
end;

function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0);
end;

function capOverlay(hwnd:THandle; f:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_OVERLAY, f, 0);
end;

function capPreviewScale(hwnd:THandle; f:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_SCALE, f, 0);
end;

function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_STATUS, wSize, s);
end;

function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_SCROLL, 0, lpP);
end;

function capGrabFrame(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME, 00);
end;

function capGrabFrameNoStop(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 00);
end;

function capCaptureSequence(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SEQUENCE, 00);
end;

function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SEQUENCE_NOFILE, 00);
end;

function capCaptureStop(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_STOP, 00);
end;

function capCaptureAbort(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_ABORT, 00);
end;

function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 00);
end;

function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 00);
end;

function capCaptureSingleFrame(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME, 00);
end;

function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_SEQUENCE_SETUP, wSize, s);
end;

function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_SEQUENCE_SETUP, wSize, s);
end;

function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_SET_MCI_DEVICE, 0, szName);
end;

function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_GET_MCI_DEVICE, wSize, szName);
end;

function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_PAL_OPEN, 0, szName);
end;

function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_PAL_SAVE, 0, szName);
end;

function capPalettePaste(hwnd:THandle):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_PAL_PASTE, 00);
end;

function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_PAL_AUTOCREATE, iFrames, iColors);
end;

function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;
begin
  Result := SendMessage(hwnd, WM_CAP_PAL_MANUALCREATE, fGrab, iColors);
end;


end.



Probleme - mail an mich!

Moderiert von user profile iconPeter Lustig: Code- durch Delphi-Tags ersetzt

_________________
----
Life is hard and then you die
Killi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 299

Win*
D6 Prof
BeitragVerfasst: Do 04.12.03 19:03 
So siehst du genau das was die Cam sieht - als LiveStream!

_________________
----
Life is hard and then you die
hibbert Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 1007

WinServer2003, Win XP, Linux
D6 Pers, D05
BeitragVerfasst: Do 04.12.03 21:22 
mhh,
vielen dank, für diesen tollen quelltext ! Da der Text ziehmlich lang ist, treten da natürlich viele Fehler auf:
Fehler #1
Zitat:
[Fehler] Unit1.pas(34): Undefinierter Bezeichner: 'CapCloseDriver'

:arrow: uses VideoCap,VideoMci,AviCap; in die Unit 1 Einfügen (Problem gelöst)

Fehler #2
Zitat:
[Fataler Fehler] VideoMci.pas(5): Datei nicht gefunden: 'VfW.dcu'

:arrow: uses Windows, SysUtils, Graphics, Controls, MMSystem, VfW; das VfW entfernt, resultat:
Zitat:
[Fataler Fehler] VideoMci.pas(41): Datei nicht gefunden: 'WVideo.dcu'


Ich könnte das lange so weiter machen.

Ich will hier jetzt nicht an dem langen Quelltext rummeckern, ich will nur wissen, wie es nun weitergeht? Ich muss doch irgendwo diese eine .pas-Datei herbekommen...

Bitte helft mir !!

thx hibbert

_________________
I kunnen väl svara endast ja eller nej
Om i viljen eller nej
Killi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 299

Win*
D6 Prof
BeitragVerfasst: Do 04.12.03 22:22 
Hmrm.......kein Plan :oops:
Hab dir das Ganze per E-Mail geschickt...hab eigentlich nur die Dateien kopiert und hier eingefügt........naja, jetzt tuts - gucks dir mal an! Eigentlich muss dich gar nichts interessieren außer die Unit1.pas, die du selber schreibst - die muss nur die eine Datei eingebettet haben und schon tuts mit ein paar Befehlchen :-D

_________________
----
Life is hard and then you die
Killi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 299

Win*
D6 Prof
BeitragVerfasst: Do 04.12.03 22:24 
und
ausblenden Quelltext
1:
uses VideoCap,VideoMci,AviCap;					

in Unit1.pas stimmt nicht! Brauchst eigentlich nur die VideoCap, der Rest wird über die VideoCap eingebettet............die VfW oder so kenn ich selber nicht, ich hab sie auch nicht, braucht auch keiner.....den Fehler hab ich noch nie gesehn ;-)

_________________
----
Life is hard and then you die
hibbert Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 1007

WinServer2003, Win XP, Linux
D6 Pers, D05
BeitragVerfasst: Do 04.12.03 23:32 
Aber ist nun auch egal, denn du hast mir ja eine funktionierende Version per e-mail zugeschickt.

Dafür danke ich dir nocheinmal...
DANKE

Hibbert

_________________
I kunnen väl svara endast ja eller nej
Om i viljen eller nej
fränk0815
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 22

Windows XP Prof. SP2
Delphi 2006 Prof. (Win32)
BeitragVerfasst: Do 01.01.04 23:34 
Hallo, ich stehe momentan vor dem gleichen Problem und würde mich freuen wenn du mir die Units zuschicken könntest ...

Vielen Dank.
Da_Knuddelbaer
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 485



BeitragVerfasst: Fr 02.01.04 20:14 
Jo interessant! :)

Mir bitte bitte auch schicken :D
Christian S.
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 20451
Erhaltene Danke: 2264

Win 10
C# (VS 2019)
BeitragVerfasst: Fr 02.01.04 20:19 
Hallo!

Und damit auch Leuten, die zukünftig vor dem Problem stehen, geholfen wird, poste doch einfach die funktionierende Version hier oder - noch besser - in den Open Source Units.

MfG
Peter

_________________
Zwei Worte werden Dir im Leben viele Türen öffnen - "ziehen" und "drücken".
PheliX
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 59



BeitragVerfasst: Sa 03.01.04 21:16 
Hier die Sourcen... wurden mir von Hibbert zugesandt... danke dafür!

Link: www.zylinder.time2host.de/VideoCap.zip

cu

Felix
Christian S.
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 20451
Erhaltene Danke: 2264

Win 10
C# (VS 2019)
BeitragVerfasst: So 04.01.04 13:56 
Hallo!

Bitte erbarme sich doch einer und mache einen Open Source - Beitrag draus. Oder in die FAQ oder so. Auf jeden Fall, dass der Source irgendwo steht und nicht als Download, den es in zwei Wochen vielleicht schon gar nicht mehr gibt.

MfG
Peter

_________________
Zwei Worte werden Dir im Leben viele Türen öffnen - "ziehen" und "drücken".
benbalzer
Hält's aus hier
Beiträge: 5



BeitragVerfasst: So 04.01.04 20:12 
Hallo!
Ich habe auch schon länger nach einer Lösung gesucht, um ein Bild von einer Webcam einzulesen, bin auch immer nur auf diese und eine sehr ähnliche Ausführung gestoßen.

Allerdings verstehe ich von diesem Code (insgesamt knapp 1000 Zeilen) sehr wenig. Und da ich es für eine Schularbeit brauche ist dieses Verständnis unabdingbar.

Kennt jemand vielleicht noch eine kürzere einfache Methode?
Es müssen keine "Tricks" eingebaut sein, einfach das Bild der USB-Webcam in einem Delphi-Programm. Keine Schneide,Foto etc. Möglichkeiten.

Viele Grüße,

ben
TwoFace
Hält's aus hier
Beiträge: 6



BeitragVerfasst: Fr 02.04.04 21:01 
hi

Ich hab den Code der oben steht etwas umgeschrieben und es funktioniert.

:D
alcaeus
half ontopic starofftopic starofftopic starofftopic starofftopic starofftopic starofftopic starofftopic star
Beiträge: 226



BeitragVerfasst: Fr 30.04.04 17:05 
hi!
gibts hier noch irgendwo die zip mit den fertigen units? ich hab die nirgends gefunden... :oops:
wolle-
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 128

XP Prof, Suse 9.2
D7
BeitragVerfasst: Sa 12.02.05 14:27 
Ich hätte sie auch gerne!

Bitte

vielleicht zuschicken oder so - der link daoben läuft nicht..
GTA-Place
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: So 01.05.05 09:07 
Bei mir funktioniert es, deshalb werde ich es demnächst in "Open Source Units" stellen.

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
elektron
Hält's aus hier
Beiträge: 2



BeitragVerfasst: Fr 22.07.05 10:27 
hi,

wäre echt toll, wenn jemand die funktionierenden Units mal hochladen könnte. Bei mir treten leider die selben Fehler auf wie bei hibbert.
In den Open Source Units hab ich sie halt auch nicht gefunden.

Danke :lol:
alcaeus
half ontopic starofftopic starofftopic starofftopic starofftopic starofftopic starofftopic starofftopic star
Beiträge: 226



BeitragVerfasst: Fr 22.07.05 11:31 
Obwohl ich es nicht mehr brauche, hatte ich das Thema wohl doch noch in meiner Watchlist.
In der DP gibt es dazu einen Loesungsweg, der komplett ueber die Windows Capture-Methods geht: klick
Es ist keine besonders tolle Loesung (IMO), aber sie funktioniert wenigstens.
Alternativ koennte man es auch ueber DirectShow loesen, bzw. unter .NET ueber Managed DirectX, aber damit habe ich mich noch nicht wirklich beschaeftigt.
Hoffe es hilft dem einen oder anderen.

Greetz
alcaeus
GTA-Place
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
EE-Regisseur
Beiträge: 5248
Erhaltene Danke: 2

WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
BeitragVerfasst: Fr 22.07.05 13:26 
Die hier geht ja auch, wenn ich mal dazu kommen würde, die Units komplett hochzuladen.

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)