Autor |
Beitrag |
hibbert
      
Beiträge: 1007
WinServer2003, Win XP, Linux
D6 Pers, D05
|
Verfasst: 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
      
Beiträge: 299
Win*
D6 Prof
|
Verfasst: 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!!!
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 public 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 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 end;
procedure TForm1.BildMachen(Nr: integer); var SingleImageFileName : string; begin CapGrabSingleFrame; CapSetVideoLive; end;
end. |
VideoCap.Pas:
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; 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
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;
function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : LongInt): LongInt; stdcall; var TmpStr : string; dwVideoNum : Integer; begin 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..80] of Char; achDeviceVersion : array [0..100] of Char; achFileName : array [0..255] of Char; begin Result := FALSE; if gCapVideoArea = nil then exit;
Result := TRUE;
ghCapWnd := capCreateCaptureWindow( PChar('KruwoSoft'), WS_CHILD or WS_VISIBLE, 0, 0, gCapVideoArea.Width, gCapVideoArea.Height, gCapVideoArea.Handle, 0); if ghCapWnd <> 0 then begin retc := capSetCallbackOnStatus(ghCapWnd, LongInt(0)); if retc <> 0 then begin retc := capSetCallbackOnStatus(ghCapWnd, LongInt(@StatusCallbackProc)); if retc <> 0 then begin DriverIndex := 0; repeat DriverStarted := CapInitDriver( DriverIndex ); if NOT DriverStarted then DriverIndex := DriverIndex + 1; until (DriverStarted = TRUE) OR (DriverIndex >= MAXVIDDRIVERS);
if capGetDriverDescription( DriverIndex, achDeviceName, 80, achDeviceVersion, 100 ) then begin gCapVideoDriverName := string(achDeviceName); end;
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;
if capDriverConnect(ghCapWnd, Index) <> 0 then begin retc := capCaptureGetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS)); if retc <> 0 then begin CapParms.dwRequestMicroSecPerFrame := 66667; CapParms.fLimitEnabled := FALSE; CapParms.fCaptureAudio := FALSE; 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;
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; capCaptureSequence( ghCapWnd ); end;
procedure CapStop; begin if ghCapWnd = 0 then exit; 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..255] of 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:
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
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..255] of Char; begin FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle ); if FError <> 0 then begin gMciActive := FALSE;
end; end;
function MciReturnVideoCommand( TheCommand : string ) : string; var FError : LongInt; ReturnStr : array [0..255] of Char; begin FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle ); if FError <> 0 then begin gMciActive := FALSE;
end; Result := StrPas( ReturnStr ); end;
procedure MciNotify; begin if @gMciStatusProcedure <> nil then gMciStatusProcedure(nil); 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; asi : TAVIStreamInfo; begin Result := -1;
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil); if retc <> 0 then begin AVIFileExit; exit; end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0); if retc <> AVIERR_OK then begin AVIFileRelease(pfile); AVIFileExit; exit; end;
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; gapgf : PGETFRAME; lpbi : PBITMAPINFOHEADER; bits : PChar; hBmp : HBITMAP; begin Result := FALSE; CurrentPos := MciGetPos;
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil); if retc <> 0 then begin AVIFileExit; exit; end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0); 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;
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), lpbi^, CBM_INIT, bits, PBITMAPINFO(lpbi)^, DIB_RGB_COLORS ); TmpBmp.Handle := hBmp;
Result := TRUE;
AVIStreamGetFrameClose(gapgf); AVIStreamRelease(gapavi); AVIFileRelease(pfile); AVIFileExit; end;
initialization gMciVideoFileName := 'Video.avi'; gMciActive := FALSE; gMciStatusProcedure := nil; end. |
AviCap.Pas:
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 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);
WM_CAP_SET_CALLBACK_CAPCONTROL = (WM_CAP_START+ 85);
WM_CAP_END = WM_CAP_SET_CALLBACK_CAPCONTROL;
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;
type PCapDriverCaps = ^TCapDriverCaps; TCapDriverCaps = record wDeviceIndex :WORD; fHasOverlay :BOOL; fHasDlgVideoSource :BOOL; fHasDlgVideoFormat :BOOL; fHasDlgVideoDisplay :BOOL; fCaptureInitialized :BOOL; fDriverSuppliesPalettes :BOOL; hVideoIn :THANDLE; hVideoOut :THANDLE; hVideoExtIn :THANDLE; hVideoExtOut :THANDLE; end;
PCapStatus = ^TCapStatus; TCapStatus = packed record uiImageWidth :UINT; uiImageHeight :UINT; fLiveWindow :BOOL; fOverlayWindow :BOOL; fScale :BOOL; ptScroll :TPOINT; fUsingDefaultPalette :BOOL; fAudioHardware :BOOL; fCapFileExists :BOOL; dwCurrentVideoFrame :DWORD; dwCurrentVideoFramesDropped :DWORD; dwCurrentWaveSamples :DWORD; dwCurrentTimeElapsedMS :DWORD; hPalCurrent :HPALETTE; fCapturingNow :BOOL; dwReturn :DWORD; wNumVideoAllocated :WORD; wNumAudioAllocated :WORD; end;
PCaptureParms = ^TCaptureParms; TCaptureParms = record dwRequestMicroSecPerFrame :DWORD; fMakeUserHitOKToCapture :BOOL; wPercentDropForError :WORD; fYield :BOOL; dwIndexSize :DWORD; wChunkGranularity :WORD; fUsingDOSMemory :BOOL; wNumVideoRequested :WORD; fCaptureAudio :BOOL; wNumAudioRequested :WORD; vKeyAbort :WORD; fAbortLeftMouse :BOOL; fAbortRightMouse :BOOL; fLimitEnabled :BOOL; wTimeLimit :WORD; fMCIControl :BOOL; fStepMCIDevice :BOOL; dwMCIStartTime :DWORD; dwMCIStopTime :DWORD; fStepCaptureAt2x :BOOL; wStepCaptureAverageFrames :WORD; dwAudioBufferSize :DWORD; fDisableWriteCache :BOOL; AVStreamMaster :WORD; end;
PCapInfoChunk = ^TCapInfoChunk; TCapInfoChunk = record fccInfoID :FOURCC; lpData :LongInt; cbData :LongInt; end;
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;
Const CONTROLCALLBACK_PREROLL = 1; CONTROLCALLBACK_CAPTURING = 2; 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;
Const IDS_CAP_BEGIN = 300; IDS_CAP_END = 301;
IDS_CAP_INFO = 401; IDS_CAP_OUTOFMEM = 402; IDS_CAP_FILEEXISTS = 403; IDS_CAP_ERRORPALOPEN = 404; IDS_CAP_ERRORPALSAVE = 405; IDS_CAP_ERRORDIBSAVE = 406; IDS_CAP_DEFAVIEXT = 407; IDS_CAP_DEFPALEXT = 408; IDS_CAP_CANTOPEN = 409; IDS_CAP_SEQ_MSGSTART = 410; IDS_CAP_SEQ_MSGSTOP = 411;
IDS_CAP_VIDEDITERR = 412; IDS_CAP_READONLYFILE = 413; IDS_CAP_WRITEERROR = 414; IDS_CAP_NODISKSPACE = 415; IDS_CAP_SETFILESIZE = 416; IDS_CAP_SAVEASPERCENT = 417;
IDS_CAP_DRIVER_ERROR = 418;
IDS_CAP_WAVE_OPEN_ERROR = 419; IDS_CAP_WAVE_ALLOC_ERROR = 420; IDS_CAP_WAVE_PREPARE_ERROR = 421; IDS_CAP_WAVE_ADD_ERROR = 422; IDS_CAP_WAVE_SIZE_ERROR = 423;
IDS_CAP_VIDEO_OPEN_ERROR = 424; IDS_CAP_VIDEO_ALLOC_ERROR = 425; IDS_CAP_VIDEO_PREPARE_ERROR = 426; IDS_CAP_VIDEO_ADD_ERROR = 427; IDS_CAP_VIDEO_SIZE_ERROR = 428;
IDS_CAP_FILE_OPEN_ERROR = 429; IDS_CAP_FILE_WRITE_ERROR = 430; IDS_CAP_RECORDING_ERROR = 431; IDS_CAP_RECORDING_ERROR2 = 432; IDS_CAP_AVI_INIT_ERROR = 433; IDS_CAP_NO_FRAME_CAP_ERROR = 434; IDS_CAP_NO_PALETTE_WARN = 435; IDS_CAP_MCI_CONTROL_ERROR = 436; IDS_CAP_MCI_CANT_STEP_ERROR = 437; IDS_CAP_NO_AUDIO_CAP_ERROR = 438; IDS_CAP_AVI_DRAWDIB_ERROR = 439; IDS_CAP_COMPRESSOR_ERROR = 440; IDS_CAP_AUDIO_DROP_ERROR = 441;
IDS_CAP_STAT_LIVE_MODE = 500; IDS_CAP_STAT_OVERLAY_MODE = 501; IDS_CAP_STAT_CAP_INIT = 502; IDS_CAP_STAT_CAP_FINI = 503; IDS_CAP_STAT_PALETTE_BUILD = 504; IDS_CAP_STAT_OPTPAL_BUILD = 505; IDS_CAP_STAT_I_FRAMES = 506; IDS_CAP_STAT_L_FRAMES = 507; IDS_CAP_STAT_CAP_L_FRAMES = 508; IDS_CAP_STAT_CAP_AUDIO = 509; IDS_CAP_STAT_VIDEOCURRENT = 510; IDS_CAP_STAT_VIDEOAUDIO = 511; IDS_CAP_STAT_VIDEOONLY = 512; IDS_CAP_STAT_FRAMESDROPPED = 513;
const AVICAP32 = 'AVICAP32.dll';
implementation
function capGetDriverDescription; external AVICAP32 name 'capGetDriverDescriptionA'; function capCreateCaptureWindow; external AVICAP32 name 'capCreateCaptureWindowA';
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, 0, 0); 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, 0, 0); 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, 0, 0); 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, 0, 0); end;
function capDlgVideoFormat(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0); end;
function capDlgVideoSource(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0); end;
function capDlgVideoDisplay(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0); end;
function capDlgVideoCompression(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0); 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, 0, 0); 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, 0, 0); end;
function capGrabFrameNoStop(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0); end;
function capCaptureSequence(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_SEQUENCE, 0, 0); end;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_SEQUENCE_NOFILE, 0, 0); end;
function capCaptureStop(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_STOP, 0, 0); end;
function capCaptureAbort(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_ABORT, 0, 0); end;
function capCaptureSingleFrameOpen(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 0, 0); end;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 0, 0); end;
function capCaptureSingleFrame(hwnd:THandle):LongInt; begin Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME, 0, 0); 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, 0, 0); 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 Peter Lustig: Code- durch Delphi-Tags ersetzt
_________________ ----
Life is hard and then you die
|
|
Killi
      
Beiträge: 299
Win*
D6 Prof
|
Verfasst: 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 
      
Beiträge: 1007
WinServer2003, Win XP, Linux
D6 Pers, D05
|
Verfasst: 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' |
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' |
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
      
Beiträge: 299
Win*
D6 Prof
|
Verfasst: Do 04.12.03 22:22
Hmrm.......kein Plan
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 
_________________ ----
Life is hard and then you die
|
|
Killi
      
Beiträge: 299
Win*
D6 Prof
|
Verfasst: Do 04.12.03 22:24
und
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 
      
Beiträge: 1007
WinServer2003, Win XP, Linux
D6 Pers, D05
|
Verfasst: 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
      
Beiträge: 22
Windows XP Prof. SP2
Delphi 2006 Prof. (Win32)
|
Verfasst: 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
      
Beiträge: 485
|
Verfasst: Fr 02.01.04 20:14
Jo interessant!
Mir bitte bitte auch schicken 
|
|
Christian S.
      
Beiträge: 20451
Erhaltene Danke: 2264
Win 10
C# (VS 2019)
|
Verfasst: 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
      
Beiträge: 59
|
Verfasst: 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.
      
Beiträge: 20451
Erhaltene Danke: 2264
Win 10
C# (VS 2019)
|
Verfasst: 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
|
Verfasst: 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
|
Verfasst: Fr 02.04.04 21:01
hi
Ich hab den Code der oben steht etwas umgeschrieben und es funktioniert.

|
|
alcaeus
      
Beiträge: 226
|
Verfasst: Fr 30.04.04 17:05
hi!
gibts hier noch irgendwo die zip mit den fertigen units? ich hab die nirgends gefunden... 
|
|
wolle-
      
Beiträge: 128
XP Prof, Suse 9.2
D7
|
Verfasst: 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
      

Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
Verfasst: 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
|
Verfasst: 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 
|
|
alcaeus
      
Beiträge: 226
|
Verfasst: 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
      

Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
Verfasst: 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)
|
|
|