Page 1 of 3 1 2 3 LastLast
Results 1 to 15 of 39

Thread: Survaillance-systeem bouwen met webcams, aangestuurd met Delphi

  1. #1
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141

    Survaillance-systeem bouwen met webcams, aangestuurd met Delphi

    He hallo allemaal,

    Ik heb een groot probleem... Bij mijn vriendin is in de afgelopen 4 weken al 7x poging tot inbraak gedaan (in der woning :d). Nu wilde ik de woning met diverse webcams gaan beveiligen en via sHTTP toezicht houden. Dat laatste komt is geen probleem. Hier ben ik redelijk bedreven in.

    Het probleem is dat ik de webcam(s) niet aangesproken krijg. Dit is iets wat ik nog nooit heb geprobeerd. Ik heb dit al geprobeert via de source van PsychoMark geprobeert, maar die krijg ik niet werkend op d2005. Kheb d5 en d7 reeds verkocht :s Verder heb ik Tvideo geprobeerd te recompilen naar d2005, maar zonder resultaat.

    Dus nu heb ik het via screencapture gedaan, maar dit druist in tegen mijn principes. Bovendien is het niet handig, daar de resolutie van de cams 640x480 is, en het scherm 1200x1024. Bovendien kost het onnodig schrijf ruimte en processor kracht .



    Ik hoop dat iemand me een schop in de goeie richting kan geven. Mijn vermoedens gaan uit naar twain32, maar kheb geen flouw idee hoe ik dit moet benaderen. :s


    alvast dank en sorry voor t lange verhaal

  2. #2
    1+1=b

  3. #3
    Supports INLDelphiMember Johan Stokking's Avatar
    Join Date
    Sep 2003
    Location
    Assen
    Posts
    649
    Probeer met o.a. capCreateCaptureWindow, capGrabFrame de boel handmatig aan te sturen.

    Ik ben lang op zoek geweest naar een goede componentenset, maar ik kon ook niks vinden.

    Zie: http://msdn.microsoft.com/library/de..._functions.asp

  4. #4
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141
    ik hoef ook geen component, die maak ik er wel van als ik eenmaal een begin heb... Handmatig aan sturen vind ik ook helemaal niet erg..tis wat meer werk als een component, maar goed... als het begin der is, en der is animo voor meerdere mensen, dan is het component zo gemaakt....

    Om te beginnen weet ik niet eens welke dll ik aan moet spreken. Aan de hand van PsychoMark 's proggie (de exe) ben ik der achter gekomen dat ik de wdm driver moet aanspreken. Maar welke dll dat is weet ik nog niet. Ben al een 1/2e dag aan typelibrary's en active x-ies aan t importeren en ben inmiddels toe aan een nieuwe installatie van d2005

    zodra ik een begin heb, komt de rest vanzelf wel, hoop ik.... en vanzelfsprekend post ik het dan ook hier...

  5. #5
    Senior Member PsychoMark's Avatar
    Join Date
    Nov 2001
    Location
    Raamsdonksveer
    Posts
    10,269
    In m'n laatste webcam-project gebruik ik TVideo ook niet meer, maar gewoon de Video for Windows API van Delphi-Jedi. TVideo is een simpele wrapper, dus als je die begrijpt dan is de API ook prima te volgen, alleen iets meer werk. Wel heb ik van die TVideo wat routines gebruikt om van een frame een TBitmap te maken...

    ActiveX en type libraries heb je niet nodig voor de VfW API; dit is gewoon ouderwets DLL-werk zonder interfaces...


    Mocht iemand er behoefte aan hebben dan wil ik wel een simpele applicatie maken (in D7 en 2005) om een frame van een webcam binnen te halen, maar misschien redt je 't met de juiste API ook prima
    Qui custodiet ipsos custodes

  6. #6
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141
    Die ga ik direct ff uitspitten en ik hou de geinteresseerden hier op de hoogte van de voortgang van t project. Khoop dat t lukt want over 4 uur ga ik richting m'n vriendin om de eerste webcams te plaatsen

    Iedereen alvast bedankt voor de tips en voor de geinteresseerden hou ik hier een code log bij.

  7. #7
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141
    Quote Originally Posted by screner
    Die ga ik direct ff uitspitten .....
    Dat ff kan ik wel vergeten... dat wordt dus maandag. Tis niet zo'n eenvoudige form, maar wat ik zo snel heb gezien, heeft deze wel verdacht veel overeenkomsten met de component van TVIDEO... Maar goed, iedereen een fijn weekend en tot maandag.

    Psycho, is het veel werk voor je om een eenvoudige applicatie ermee te maken? dan heb ik een begin om mee verder te werken Met name het verkrijgen van de juiste drivers is iets waar ik nog nooit mee gewerkt heb.

  8. #8
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141
    Srry, maar kon t niet hebben dus ben maar weer verder gaan zoeken.... Het is echt een "start from scratch" Projeccie Het verkrijgen van de juiste WDM drivers werkt als volgt:

    unit Unit1;

    interface
    Code:
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        ListBox1: TListBox;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    
      const
      Capturedll   = 'AVICAP32.DLL';
    
    
    
    implementation
    
    {$R *.dfm}
    
    
    function    GETWDMDRIVERNAMES(DriverIndex: UINT; Naam: LPSTR; cbName : integer;
    lpszVer: LPSTR; cbVer: integer): BOOL; stdcall; external 
    CAPTUREDLL name 'capGetDriverDescriptionA';
    
    
    
    Function GetwdmDriverList:TStringList;
    var i:integer;
        Names:array[0..80] of char;
        ver :array[0..80] of char;
    begin
     result:= TStringList.Create;
     result.Capacity:= 10;
     result.Sorted:= false;
     for i:= 0 to 9 do
       if GETWDMDRIVERNAMES( i,names,80,ver,80) then
          result.Add(StrPas(names)+ ' '+strpas(ver))
       else
         break;
     end;
    
    
    
    
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Drivers:    TStringList;
    begin
        Drivers := GetwdmDriverList();
        listbox1.Items.Assign(drivers);
        Drivers.Free();
    
        end;
    end.


    Stap 1 is dus gezet...... NEXT >>>>>>

  9. #9
    Supports INLDelphiMember Johan Stokking's Avatar
    Join Date
    Sep 2003
    Location
    Assen
    Posts
    649
    @PsychoMark
    Ik ben geinteresseerd Ik heb het al voor elkaar om op een gewenst moment een beeldje te verkrijgen van de gewenste webcam. Echter, ik krijg het nog niet voor elkaar om het beeld netjes uit te lezen. Voor zover ik weet biedt de Multimedia SDK twee opties: opslaan in het clipboard en opslaan naar een file. Is er geen mogelijkheid om bijvoorbeeld een HDC te krijgen naar de webcam?

  10. #10
    Heb je hier wat aan? Deze code stond laatst in Blaise:

    Code:
    function capCreateCaptureWindowA(WindowName: PChar;
      dwStyle: Cardinal; x,y, nWidth,nHeight: Integer;
      ParentWin: HWnd; nID: Integer): HWnd; stdcall
      external 'AVICAP32.DLL';
    procedure TForm1.FormShow (Sender: TObject);
    begin
      if WebcamHandle = 0 then
        WebcamHandle := capCreateCaptureWindowA('Blaise',
          WS_CHILD or WS_VISIBLE , 1, 1, MaxWidth, MaxHeight, Handle, 0);
    end;
    
    const
      MaxWidth = 352;
      MaxHeight = 288;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      ClientWidth := MaxWidth + 2;
      ClientHeight := MaxHeight + 2;
    end;
    
    const
      WM_CAP_DRIVER_CONNECT    = WM_USER + 10;
      WM_CAP_DRIVER_DISCONNECT = WM_USER + 11;
    
    procedure TForm1.FormShow (Sender: TObject);
    begin
      if WebcamHandle = 0 then
        WebcamHandle := capCreateCaptureWindowA('Blaise',
          WS_CHILD or WS_VISIBLE , 1, 1, MaxWidth, MaxHeight, Handle, 0);
      if WebcamHandle <> 0 then
        SendMessage(WebcamHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
    end;
    
    procedure TForm1.FormHide(Sender: TObject);
    begin
      if WebcamHandle <> 0 then
        SendMessage(WebcamHandle, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    end;
    
    const
      WM_CAP_SET_PREVIEW       = WM_USER + 50;
      WM_CAP_SET_PREVIEWRATE   = WM_USER + 52;
    
    
    procedure TForm1.Start1Click(Sender: TObject);
    begin
      if WebcamHandle <> 0 then
        if (Sender as TMenuItem).Caption = '&Start' then
        begin
          (Sender as TMenuItem).Caption := '&Stop';
          SendMessage(WebcamHandle, WM_CAP_SET_PREVIEWRATE, 1, 0);
          SendMessage(WebcamHandle, WM_CAP_SET_PREVIEW, 1, 0);
        end
        else
        begin
          (Sender as TMenuItem).Caption := '&Start';
          SendMessage(WebcamHandle, WM_CAP_SET_PREVIEW, 0, 0);
        end
    end;
    
    const
      WM_CAP_SAVEDIB           = WM_USER + 25;
    
    procedure TForm1.Capture1Click(Sender: TObject);
    begin
      if WebcamHandle <> 0 then
        SendMessage(WebcamHandle, WM_CAP_SAVEDIB, 0,
          Integer(PChar('Webcam.bmp')));
    end;
    
    const
      WM_CAP_DLG_VIDEOFORMAT   = WM_USER + 41;
    
    procedure TForm1.WebcamSettings1Click(Sender: TObject);
    begin
      if WebcamHandle <> 0 then
        SendMessage(WebcamHandle, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
    end;

  11. #11
    Senior Member screner's Avatar
    Join Date
    Jun 2005
    Location
    Oss
    Posts
    141
    @ reweij
    Code geprobeert maar heeft een component nodig... wat voor type is de webcamhandle?

    @ pshycho....
    ik ben echt de weg kwijt... Ik heb het Tvideo component nagebouwd in een proggie, maar ik ben inmiddels verdwaald.....

    Code:
    function    capGetDriverDescriptionA(
        wDriverIndex        : UINT;
        lpszName            : LPSTR;
        cbName              : integer;
        lpszVer             : LPSTR;
        cbVer               : integer
        ): BOOL; stdcall; external
    CAPTUREDLL name 'capGetDriverDescriptionA';
    
    
    
    function    capCreateCaptureWindowA(
        lpszWindowName      : LPCSTR;
        dwStyle             : DWORD;
        x, y                : integer;
        nWidth, nHeight     : integer;
        hwndParent          : HWND;
        nID                 : integer
        ): HWND; stdcall; external
    CAPTUREDLL name 'capCreateCaptureWindowA';
    
    
    function    capCreateCaptureWindowW(
        lpszWindowName      : LPCWSTR;
        dwStyle             : DWORD;
        x, y                : integer;
        nWidth, nHeight     : integer;
        hwndParent          : HWND;
        nID                 : integer
        ): HWND; stdcall; external
    CAPTUREDLL name 'capCreateCaptureWindowW';
    
    
    function    capGetDriverDescriptionW(
        wDriverIndex        : UINT;
        lpszName            : LPWSTR;
        cbName              : integer;
        lpszVer             : LPWSTR;
        cbVer               : integer
        ): BOOL; external
    CAPTUREDLL name 'capGetDriverDescriptionW';
    
    
    function    capCreateCaptureWindow(
        lpszWindowName      : LPCSTR;
        dwStyle             : DWORD;
        x, y                : integer;
        nWidth, nHeight     : integer;
        hwndParent          : HWND;
        nID                 : integer
        ): HWND; stdcall;  external
    CAPTUREDLL name 'capCreateCaptureWindow'
    
    
    Function GetwdmDriverList:TStringList;
    var i:integer;
        Names:array[0..80] of char;
        ver :array[0..80] of char;
    begin
     result:= TStringList.Create;
     result.Capacity:= 10;
     result.Sorted:= false;
     for i:= 0 to 9 do
       if capGetDriverDescriptionA( i,names,80,ver,80) then
          result.Add(StrPas(names)+ ' '+strpas(ver))
       else
         break;
     end;
    
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Drivers:    TStringList;
    newitem :Tlistitem;
    i:integer;
    begin
        Drivers := GetwdmDriverList();
        for  i := 0 to drivers.Count -1 do
            begin
            newitem :=listview1.Items.Add;
            newitem.Caption := drivers.Strings[i];
            end;
        Drivers.Free();
    
        end;
    
    
    procedure TForm1.ListView1DblClick(Sender: TObject);
    begin
    if listview1.Selected <> nil then
            begin
            setdrivername (listview1.Selected.Caption);
    
            end;
    end;
    
    
    var
     fVideoDriverName       : string;
     driverIndex           :integer;
    
    
    procedure TForm1.SetDrivername(value:string);
    var i:integer;
        name:array[0..80] of char;
        ver :array[0..80] of char;
    begin
     if fVideoDrivername = value then exit;
     for i:= 0 to 9 do
      if capGetDriverDescriptionA( i,name,80,ver,80) then
        if strpas(name) = value then
         begin
          fVideoDriverName := value;
          Driverindex:= i;
          exit;
        end;
     fVideoDrivername:= '';
     DriverIndex:= -1;
    end;
    
    
    type
     PCAPSTATUS                      = ^TCAPSTATUS;
     TCapStatusCallback = procedure (Sender:TObject;nID:integer;status:string) of object;
    
        TCAPSTATUS                      = 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          : UINT    ; // Actual number of video buffers
            wNumAudioAllocated          : UINT    ; // Actual number of audio buffers
        end;
            TCapStatusProc                  = procedure(Sender: TObject) of object;
    
    
    
    const
        WM_CAP_START                    = WM_USER;
        WM_CAP_UNICODE_START            = WM_USER + 100;
    
        WM_CAP_GET_CAPSTREAMPTR         = WM_CAP_START + 1;
    
        WM_CAP_SET_CALLBACK_ERRORW      = WM_CAP_UNICODE_START + 2;
        WM_CAP_SET_CALLBACK_STATUSW     = WM_CAP_UNICODE_START + 3;
        WM_CAP_SET_CALLBACK_ERRORA      = WM_CAP_START + 2;
        WM_CAP_SET_CALLBACK_STATUSA     = WM_CAP_START + 3;
        WM_CAP_SET_CALLBACK_ERROR       = WM_CAP_SET_CALLBACK_ERRORA;
        WM_CAP_SET_CALLBACK_STATUS      = WM_CAP_SET_CALLBACK_STATUSA;
    
        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_NAMEA         = WM_CAP_START + 12;
        WM_CAP_DRIVER_GET_VERSIONA      = WM_CAP_START + 13;
        WM_CAP_DRIVER_GET_NAMEW         = WM_CAP_UNICODE_START + 12;
        WM_CAP_DRIVER_GET_VERSIONW      = WM_CAP_UNICODE_START + 13;
        WM_CAP_DRIVER_GET_NAME          = WM_CAP_DRIVER_GET_NAMEA;
        WM_CAP_DRIVER_GET_VERSION       = WM_CAP_DRIVER_GET_VERSIONA;
    
        WM_CAP_DRIVER_GET_CAPS          = WM_CAP_START + 14;
    
        WM_CAP_FILE_SET_CAPTURE_FILEA   = WM_CAP_START + 20;
        WM_CAP_FILE_GET_CAPTURE_FILEA   = WM_CAP_START + 21;
        WM_CAP_FILE_SAVEASA             = WM_CAP_START + 23;
        WM_CAP_FILE_SAVEDIBA            = WM_CAP_START + 25;
        WM_CAP_FILE_SET_CAPTURE_FILEW   = WM_CAP_UNICODE_START + 20;
        WM_CAP_FILE_GET_CAPTURE_FILEW   = WM_CAP_UNICODE_START + 21;
        WM_CAP_FILE_SAVEASW             = WM_CAP_UNICODE_START + 23;
        WM_CAP_FILE_SAVEDIBW            = WM_CAP_UNICODE_START + 25;
        WM_CAP_FILE_SET_CAPTURE_FILE    = WM_CAP_FILE_SET_CAPTURE_FILEA;
        WM_CAP_FILE_GET_CAPTURE_FILE    = WM_CAP_FILE_GET_CAPTURE_FILEA;
        WM_CAP_FILE_SAVEAS              = WM_CAP_FILE_SAVEASA;
        WM_CAP_FILE_SAVEDIB             = WM_CAP_FILE_SAVEDIBA;
    
        // out of order to save on ifdefs
    
        WM_CAP_FILE_ALLOCATE            = WM_CAP_START + 22;
        WM_CAP_FILE_SET_INFOCHUNK       = WM_CAP_START + 24;
    
        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_DEVICEA          = WM_CAP_START + 66;
        WM_CAP_GET_MCI_DEVICEA          = WM_CAP_START + 67;
        WM_CAP_SET_MCI_DEVICEW          = WM_CAP_UNICODE_START + 66;
        WM_CAP_GET_MCI_DEVICEW          = WM_CAP_UNICODE_START + 67;
        WM_CAP_SET_MCI_DEVICE           = WM_CAP_SET_MCI_DEVICEA;
        WM_CAP_GET_MCI_DEVICE           = WM_CAP_GET_MCI_DEVICEA;
    
        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_OPENA                = WM_CAP_START + 80;
        WM_CAP_PAL_SAVEA                = WM_CAP_START + 81;
        WM_CAP_PAL_OPENW                = WM_CAP_UNICODE_START + 80;
        WM_CAP_PAL_SAVEW                = WM_CAP_UNICODE_START + 81;
        WM_CAP_PAL_OPEN                 = WM_CAP_PAL_OPENA;
        WM_CAP_PAL_SAVE                 = WM_CAP_PAL_SAVEA;
    
        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_UNICODE_END              = WM_CAP_PAL_SAVEW;
        WM_CAP_END                      = WM_CAP_UNICODE_END;
    
    
    
    
    
    var
    fhCapWnd             : THandle;
    Fdriverindex         :Integer;
    fpDriverStatus       : pCapStatus;
    fCapStatusProcedure     : TCapStatusProc;
     fcapStatusCallBack      : TCapStatusCallback;
    
    
    function    AVICapSM(hwnd: HWND; m: UINT; w: WPARAM; l: LPARAM): DWORD;
    begin
        if IsWindow(hwnd) then
            Result := SendMessage(hwnd,m,w,l)
        else
            Result := 0;
    end;
    
    
    
    function    capGetStatus(hwnd: HWND; s: PCAPSTATUS; wSize: WORD): BOOL;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_GET_STATUS, wSize, LPARAM(s)) <> 0;
    end;
    
    
    
    
    function getDriverStatus(callback:boolean):boolean;
    begin
      result := false;
      if fhCapWnd <> 0 then
      begin
      if not assigned(fpDriverstatus) then new(fpDriverStatus);
      if capGetStatus(fhCapWnd,fpdriverstatus, sizeof(TCapStatus)) then
       begin
         result:= true;
      end;
      end;
     if assigned(fCapStatusProcedure)and callback then fcapStatusProcedure (nil);
    end;
    
    
    function    capSetUserData(hwnd: HWND; lUser: DWORD): BOOL;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_SET_USER_DATA, 0, lUser) <> 0;
    end;
    
    function WCapproc(hw:THandle;messa:DWord; w:wParam; l:lParam):integer;stdcall;
     var oldwndProc:Pointer;
         parentWnd:Thandle;
     begin
        oldwndproc:=Pointer(GetWindowLong(hw,GWL_USERDATA));
        case Messa of
         WM_MOUSEMOVE,
         WM_LBUTTONDBLCLK,
         WM_LBUTTONDOWN,WM_RBUTTONDOWN,WM_MBUTTONDOWN ,
         WM_LBUTTONUP,WM_RBUTTONUP,WM_MBUTTONUP:
           begin
            ParentWnd:=Thandle(GetWindowLong(hw,GWL_HWNDPARENT));
            sendMessage(ParentWnd,messa,w,l);
            result := integer(true);
           end
        else
           result:= callWindowProc(oldwndproc,hw,messa,w,l);
       end;
    
     end;
    
    
     function    capSetCallbackOnStatus(hwnd: HWND; fpProc: TCAPSTATUSCALLBACK): BOOL;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, LPARAM(@fpProc)) <> 0;
    end;
    
    function    capGetUserData(hwnd: HWND): DWORD;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_GET_USER_DATA, 0, 0);
    end;
    
    
    
    function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : Pchar): LongInt; stdcall;
    var Control:Tpanel;
    begin
      control:=Tpanel(capGetUserData(hwnd));
      if assigned(control) then
       begin
    
       end;
      result:= 1;
    end;
    
    
    function    capDriverConnect(hwnd: HWND; i: INTeger): BOOL;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_DRIVER_CONNECT, i, 0) <> 0;
    end;
    
    function    capDriverDisconnect(hwnd: HWND): BOOL;
    begin
        Result  := AVICapSM(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0) <> 0;
    end;
    
    
    
    procedure DestroyCapWindow;
    begin
      if fhCapWnd = 0 then exit;
    //  CreateTmpFile(False);
      CapDriverDisconnect (fhCapWnd);
      SetWindowLong(fhcapWnd,GWL_WNDPROC,GetWindowLong(fhcapwnd,GWL_USERDATA)); // Old windowproc
      DestroyWindow( fhCapWnd ) ;
      fhCapWnd := 0;
    end;
    
    
    
    var
    width, height :integer;
    handle :hwnd;
    
    
    
    
    function CreateCapWindow:boolean;
     var Ex:Exception;
         savewndproc:integer;
     begin
        if fhCapWnd <> 0 then
         begin
          result:= true;
          exit;
        end;
    
       if fdriverIndex = -1 then
        begin
         Ex := Exception.Create('No capture driver selected');
         GetDriverStatus(true);
         raise ex;
         exit;
        end;
       fhCapWnd := capCreateCaptureWindow( PChar('pamel1'),
                  WS_CHILD or WS_VISIBLE , 0, 0,
                   Width, Height,
                  Handle, 5001);
       if fhCapWnd =0 then
         begin
           Ex:= Exception.Create('Can not create capture window');
           GetDriverStatus(true);
           raise ex;
           exit;
          end;
    
    // Set our own Adress to the CapWindow
     capSetUserData(fhCapwnd,integer(nil));
    // Set our own window procedure to Capture-Window
     savewndproc:=SetWindowLong(fhcapWnd,GWL_WNDPROC,integer(@WCapProc));
    // User Data for old WndProc adress
     SetWindowLong(fhcapWnd,GWL_USERDATA,savewndProc);
     // Setting callbacks as events
    
     if not capDriverConnect(fhCapWnd, fdriverIndex) then
         begin
           Ex:= Exception.Create('Can not connect capture driver with capture window');
           Destroycapwindow;
           GetDriverStatus(true);
           raise ex;
           exit;
       end;
    
    
    
    // CreateTmpFile(True);
    // capPreviewScale(fhCapWnd, fscale);
    // capPreviewRate(fhCapWnd, round( 1/fpreviewrate*1000));
     GetDriverStatus(true);
    // Sizecap;
     result:= true;
    end;


    m.a.w.... ben zééér geinteresseerd in de demo van jou.....

  12. #12
    one small step for man...
    Join Date
    Feb 2004
    Posts
    342
    @screner: De code van reweij bevat wat foutjes. Die WebcamHandle is van het type THandle. Bovendien moet je die eerste TForm1.FormShow wissen (staat er 2x in). Als je vervolgens zelf de corresponderende grafische componenten op een leeg form zet en de benodigde events selecteert/invult dan moet het werken.
    Last edited by maanlander; 22-Nov-05 at 09:31.

  13. #13
    Senior Member Henk Schreij's Avatar
    Join Date
    Sep 2002
    Location
    Heino (Raalte)
    Posts
    1,465
    Probeer toch eens Blaise 74 te pakken te krijgen (oktober 2005).
    Daarin heeft Bob Swart een artikel van 3 blz geschreven:
    EEN WEBCAM GEBRUIKEN IN DELPHI
    Met Delphi 2005 in Win32 en AVICAP32.DLL

  14. #14
    one small step for man...
    Join Date
    Feb 2004
    Posts
    342
    Bob Swart heeft vaker over webcams & Delphi gepubliceerd.
    In The Delphi Magazine Issue 109 (Sept. 2004) staat over dit overwerp een artikel van 7 paginas. Ook hier wordt de AVICAP32.DLL gebruikt.
    De sourcecode die bij dit artikel hoort kun je downloaden van de website van Bob. Kies het bestand constr109.zip.
    Last edited by maanlander; 22-Nov-05 at 14:35.

  15. #15
    Ik denk dat je deze bedoeld?

Page 1 of 3 1 2 3 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •