(851)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Aufzeichnen Avicap32 Cam Capture Fernseh Video Webcam

 
- Seite 1 -


Andreas Miethe, URL=www.paules-pc-forum.de/forum/helfer-tools/114963-avicap32-dll-oder-mci-webcam.html#post703893, Zeitpunkt=23.05.2009
Hallo BackBONE,

Habe noch einen älteren Code ( von 2002 ) ausgegraben.
Hoffentlich blickst Du da durch

Damit kannst Du nicht nur Wabcams aufzeichnen sondern auch TV-Karten.
KompilierenMarkierenSeparieren
##################################################
Video-Capture mit Profan
ab Profan-Version 7
ist aber mit Bereichsvariablen leicht an vorherige
Versionen anpassbar !
Alle Funktionen mit Callbacks sind bisher nicht
verwendbar (habe ich gleich weggelassen ) !
Das sind vor allem Fehlermeldungen und auch
die Statusanzeigen.
##################################################
Andreas Miethe * Februar 2002
##################################################
Definitionen
DEF capCreateCaptureWindow(8) ! avicap32.dll,capCreateCaptureWindowA
DEF capGetDriverDescription(5) ! avicap32.dll,capGetDriverDescriptionA
DEF GetButtonFaceColor(0) External(User32,GetSysColor,15)
DEF SetWindowLong(3) ! USER32,SetWindowLongA
Def GetStockObject(1) !GDI32,GetStockObject
Def SetDefaultGUIFont(1) SendMessage(&(1),$30,Val(GetStockObject($11)),1)
Def HiWord(1) Div&(&(1),$10000)
Def LoWord(1) And(&(1),$FFFF)
Def LockWindowUpdate(1) ! User32,LockWindowUpdate
Konstanten
Def &WM_Capstart 1024
Def &WM_CAP_DRIVER_CONNECT 1034
Def &WM_CAP_DRIVER_DISCONNECT 1035
Def &WM_CAP_DRIVER_GET_NAME 1036
Def &WM_CAP_DRIVER_GET_VERSION 1037
Def &WM_CAP_FILE_SET_CAPTURE_FILE 1044
Def &WM_CAP_FILE_GET_CAPTURE_FILE 1045
Def &WM_CAP_FILE_SAVEAS 1047
Def &WM_CAP_FILE_SAVEDIB 1049
Def &WM_CAP_SET_AUDIOFORMAT 1059
Def &WM_CAP_GET_AUDIOFORMAT 1060
Def &WM_CAP_DLG_VIDEOFORMAT 1065
Def &WM_CAP_DLG_VIDEOSOURCE 1066
Def &WM_CAP_DLG_VIDEODISPLAY 1067
Def &WM_CAP_GET_VIDEOFORMAT 1068
Def &WM_CAP_SET_VIDEOFORMAT 1069
Def &WM_CAP_DLG_VIDEOCOMPRESSION 1070
Def &WM_CAP_SET_PREVIEW 1074
Def &WM_CAP_SET_OVERLAY 1075
Def &WM_CAP_SET_PREVIEWRATE 1076
Def &WM_CAP_SET_SCALE 1077
Def &WM_CAP_SET_SCROLL 1079
Def &WM_CAP_GRAB_FRAME 1084
Def &WM_CAP_GRAB_FRAME_NOSTOP 1085
Def &WM_CAP_SEQUENCE 1086
Def &WM_CAP_SEQUENCE_NOFILE 1087
Def &WM_CAP_SET_SEQUENCE_SETUP 1088
Def &WM_CAP_GET_SEQUENCE_SETUP 1089
Def &WM_CAP_SET_MCI_DEVICE 1090
Def &WM_CAP_GET_MCI_DEVICE 1091
Def &WM_CAP_STOP 1092
Def &WM_CAP_ABORT 1093
Strukturen
Struct WaveFormatEx = wFormatTag%,nChannels%,nSamplesPerSec&,nAvgBytesPerSec&,
nBlockAlign%,wBitsPerSample%,cbSize%
globale Variablen
Declare CapDll&,MM&,CapWindow&,CapBMPFilename$,CapAVIFilename$
Declare DriverChoice&,OverlayButton&,CapBMPButton&
Declare VideoFormatText&
Declare SourceDialogButton&,FormatDialogButton&,KompressionDialogButton&
Declare SingleNameEdit&,AVINameEdit&
Declare StartCapButton&,StopCapButton&,EndeButton&
Declare Ende%,IsOverlay%
Declare AudioChoice&,Waveformat#,BM#
Declare T$
Prozeduren

Proc CapInit

    CapDll& = UseDll(avicap32.dll)

EndProc

Proc CapExit

    FreeDll CapDll&

EndProc

Proc GetCaptureDriverList

    Declare Treiber$,Version$,Zaehler%
    ClearList

    Whilenot zaehler% = 9 reicht fuer 10 Treiber

        Treiber$ = Space$(80)80 Zeichen werden maximal aufgenommen
        Version$ = Space$(80)80 Zeichen werden maximal aufgenommen

        If capGetDriverDescription(Zaehler%,ADDR(Treiber$),80,ADDR(Version$),80) > 0

            AddString Trim$(Treiber$)

        Endif

        Inc Zaehler%

    EndWhile

EndProc

Proc CreateCapWindow

    Parameters x%,y%,w%,h%
    CapWindow& = 0
    CapWindow& = capCreateCaptureWindow(0,$50000000,0,0,0,0,%Hwnd,0)

    Whilenot CapWindow& > 0

    wend

    SetWindowLong(CapWindow&,-20,$200)
    SetWindowPos CapWindow& = x%,y% - w%,h%

EndProc

Proc ConnectDriver

    Parameters DriverIndex%
    Return Sendmessage(CapWindow&,1034,DriverIndex%,0)

EndProc

Proc DisconnectDriver

    Return Sendmessage(CapWindow&,&WM_CAP_DRIVER_DISCONNECT,0,0)

EndProc

Proc SetOverlay

    Parameters True%
    Return Sendmessage(CapWindow&,&WM_CAP_SET_OVERLAY,True%,0)

EndProc

Proc SetPreviev

    Parameters True%,Rate%,Scale%
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEW,True%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEWRATE,Rate%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_SCALE,Scale%,0)

EndProc

Proc GetVideoFormat

    Declare Ret$
    Dim BM#,44
    Clear BM#
    Sendmessage(CapWindow&,&WM_CAP_GET_VIDEOFORMAT,44,BM#)
    Ret$ = Str$(word(bm#,4))+,+Str$(word(bm#,8))
    Dispose BM#
    Return Ret$

EndProc

Proc CapSaveas

    Parameters Savename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEAS,0,ADDR(Savename$))

EndProc

Proc SaveAsBMP

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEDIB,0,ADDR(Filename$))

EndProc

Proc GrabFrame

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_GRAB_FRAME_NOSTOP,0,0)
    SaveAsBMP Filename$

EndProc

Proc CapStart

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SET_CAPTURE_FILE,0,addr(filename$))
    Sendmessage(CapWindow&,&WM_CAP_SEQUENCE,0,0)

EndProc

Proc CapStop

    Sendmessage(CapWindow&,&WM_CAP_STOP,0,0)

EndProc

Proc CapAbort

    Sendmessage(CapWindow&,&WM_CAP_ABORT,0,0)

EndProc

Proc VideoSourceDialog

    Sendmessage(CapWindow&,1066,0,0)

EndProc

Proc VideoFormatDialog

    Sendmessage(CapWindow&,1065,0,0)

EndProc

Proc VideoDisplayDialog

    Sendmessage(CapWindow&,1067,0,0)

EndProc

Proc VideoKompressionDialog

    Sendmessage(CapWindow&,1070,0,0)

EndProc

Proc SetWaveFormat

    Parameters Stereo%,Bits%,Samples%
    Declare GetSize&
    Dim WaveFormat#,WaveFormatEx
    GetSize& = Sendmessage(CapWindow&,1060,0,0)
    Sendmessage(CapWindow&,1060,GetSize&,WaveFormat#)

    if WaveFormat#.wFormatTag% = 1

        Case Stereo% = 0 : WaveFormat#.nChannels% = 1
        Case Stereo% = 1 : WaveFormat#.nChannels% = 2
        WaveFormat#.nSamplesPerSec& = Samples%
        Case Bits% = 8 :WaveFormat#.wBitsPerSample% = 8
        Case Bits% = 16 :WaveFormat#.wBitsPerSample% = 16
        WaveFormat#.nBlockAlign% = (WaveFormat#.nChannels% * WaveFormat#.wBitsPerSample%) / 8
        WaveFormat#.nAvgBytesPerSec& = (WaveFormat#.nSamplesPerSec& * WaveFormat#.nBlockAlign%)
        Sendmessage(CapWindow&,1059,GetSize&,WaveFormat#)

    endif

    Dispose WaveFormat#

EndProc

SetTrueColor 1
CLS GetButtonFaceColor(0)
Voreinstellungen
#################
CapInit
GetCaptureDriverList
DriverChoice& =  @Control(ComboBox,,$54000043,0,300,320,80,%hwnd,1000,%Hinstance)
SetDefaultGUIFont(DriverChoice&)
MoveListToChoice(DriverChoice&)
AudioChoice& =  @Control(ComboBox,,$54000242,0,330,320,300,%hwnd,1001,%Hinstance)
SetDefaultGUIFont(AudioChoice&)
SendMessage(DriverChoice&,$014E,0,0)Auf 1. Eintrag setzen
OverlayButton& = @Create(Button,%Hwnd,Preview,340,0,120,24)
SetDefaultGUIFont(OverlayButton&)
CapBMPButton& = @Create(Button,%Hwnd,Einzelbild fangen,340,30,120,24)
SetDefaultGUIFont(CapBMPButton&)
SourceDialogButton& = @Create(Button,%Hwnd,Video-Source,340,60,120,24)
SetDefaultGUIFont(SourceDialogButton&)
FormatDialogButton& = @Create(Button,%Hwnd,Video-Format,340,90,120,24)
SetDefaultGUIFont(FormatDialogButton&)
KompressionDialogButton& = @Create(Button,%Hwnd,Video-Kompression,340,120,120,24)
SetDefaultGUIFont(KompressionDialogButton&)
SingleNameEdit& = @Create(Edit,%Hwnd,Noname.bmp,480,30,120,24)
SetDefaultGUIFont(SingleNameEdit&)
StartCapButton& = @Create(Button,%Hwnd,Starte-Capture,340,150,120,24)
SetDefaultGUIFont(StartCapButton&)
AVINameEdit& = @Create(Edit,%Hwnd,Noname.avi,480,150,120,24)
SetDefaultGUIFont(AVINameEdit&)
StopCapButton& = @Create(Button,%Hwnd,Stop-Capture,340,180,120,24)
SetDefaultGUIFont(StopCapButton&)
EndeButton& = @Create(Button,%Hwnd,Ende,340,210,120,24)
SetDefaultGUIFont(EndeButton&)
UseCursor 2
CreateCapWindow 0,40,320,240Capture-Fenster anlegen
ConnectDriver 0 ersten Eintrag wählen
SetOverlay 1  Overlay-Modus einschalten
IsOverlay% = 1
UseCursor 0
VideoFormatText& = @Control(Static,,$54001001,0,0,320,20,%hwnd,1000,%Hinstance,0)
SetDefaultGUIFont(VideoFormatText&)
GetVideoFormatVideo-Format auslesen
SetText VideoFormatText&, Video-Format :  +Substr$(@$(0),1,,)+  X  +Substr$(@$(0),2,,)+ Pixel
T$ = Mono - 8Bit - 8.000 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 8Bit - 11.025 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 8Bit - 22,050 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 8Bit - 44.100 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 16Bit - 8.000 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 16Bit - 11.025 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 16Bit - 22,050 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Mono - 16Bit - 44.100 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 8Bit - 8.000 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 8Bit - 11.025 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 8Bit - 22,050 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 8Bit - 44.100 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 16Bit - 8.000 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 16Bit - 11.025 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 16Bit - 22,050 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ = Stereo - 16Bit - 44.100 kHz
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
SendMessage(AudioChoice&,$014E,15,0)Auf 1. Eintrag setzen
SetWaveFormat 1,16,44100
#################
Usermessages $03,$0111
SetPreviev 1,25,1
SetText OverlayButton&,Overlay
IsOverlay% = 0

Whilenot ende%

    Waitinput

    If %UMessage = $0111WM_Command

        If &ULParam = DriverChoice&

            If HiWord(&UWParam) = $01Eintrag in Choicebox gewechselt ??

                UseCursor 2
                LockWindowUpdate(%hwnd)
                DisconnectDriver
                ConnectDriver SendMessage(DriverChoice&,$0147,0,0)
                LockWindowUpdate(0)
                UseCursor 0

            endif

        ElseIf &ULParam = AudioChoice&

            If HiWord(&UWParam) = $01Eintrag in Choicebox gewechselt ??

                Case Sendmessage(AudioChoice&,$0147,0,0) = 0 :SetWaveFormat 0,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 1 :SetWaveFormat 0,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 2 :SetWaveFormat 0,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 3 :SetWaveFormat 0,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 4 :SetWaveFormat 0,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 5 :SetWaveFormat 0,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 6 :SetWaveFormat 0,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 7 :SetWaveFormat 0,16,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 8 :SetWaveFormat 1,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 9 :SetWaveFormat 1,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 10 :SetWaveFormat 1,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 11 :SetWaveFormat 1,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 12 :SetWaveFormat 1,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 13 :SetWaveFormat 1,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 14 :SetWaveFormat 1,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 15 :SetWaveFormat 1,16,44100

            endif

        Endif

    endif

    If %Umessage = $03WM_Move

        SetWindowpos CapWindow& = 0,0 - 0,0
        SetWindowpos CapWindow& = 0,40 - 320,240

    Endif

    If GetFocus(EndeButton&)

        Ende% = 1

    Elseif GetFocus (OverlayButton&)

        If IsOverlay% = 1

            SetPreviev 1,25,1
            SetText OverlayButton&,Overlay
            IsOverlay% = 0
            SetFocus(0)

        else

            SetOverlay 1
            SetText OverlayButton&,Preview
            IsOverlay% = 1
            SetFocus(0)

        Endif

    Elseif GetFocus (CapBMPButton&)

        if GetText$(SingleNameEdit&) <>

            GrabFrame GetText$(SingleNameEdit&)

        Else

            @Messagebox(Keine Bitmapname vergeben,Fehler...,64)

        Endif

    Elseif GetFocus (StartCapButton&)

        if GetText$(AVINameEdit&) <>

            Capstart F:\Noname.aviGetText$(AVINameEdit&)

        Else

            @Messagebox(Keine AVI-Name vergeben,Fehler...,64)

        Endif

    Elseif GetFocus (StopCapButton&)

        CapStop

    Elseif GetFocus (SourceDialogButton&)

        VideoSourceDialog
        SetFocus(0)

    Elseif GetFocus (FormatDialogButton&)

        VideoFormatDialog
        GetVideoFormat
        SetText VideoFormatText&, Video-Format :  +Substr$(@$(0),1,,)+  X  +Substr$(@$(0),2,,)+ Pixel
        SetFocus(0)

    Elseif GetFocus (KompressionDialogButton&)

        VideoKompressionDialog
        SetFocus(0)

    Endif

EndWhile

DisconnectDriver
CapExit
end
 
23.05.2009  ▲
Vollständiges Zitat
Absatzweise zitierenZeilenweise zitieren
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »

- Seite 2 -



p.specht

RESTAURIERT und für XProfan11.2a adaptiert.
Version R0.2ß - Bitte vorsichtig testen:
==============================
KompilierenMarkierenSeparieren
'##################################################
'Video-Capture mit Profan ab Profan-Version 7
'ist aber mit Bereichsvariablen leicht an vorherige
'Versionen anpassbar !
'Alle Funktionen mit Callbacks sind bisher nicht
'verwendbar (habe ich gleich weggelassen ) !
'Das sind vor allem Fehlermeldungen und auch
'die Statusanzeigen.
'##################################################
'Andreas Miethe * Februar 2002
'##################################################
'Definitionen
DEF capCreateCaptureWindow(8) ! "avicap32.dll","capCreateCaptureWindowA"
DEF capGetDriverDescription(5) ! "avicap32.dll","capGetDriverDescriptionA"
DEF GetButtonFaceColor(0) External("User32","GetSysColor",15)
DEF SetWindowLong(3) ! "USER32","SetWindowLongA"
Def GetStockObject(1) !"GDI32","GetStockObject"
Def SetDefaultGUIFont(1) SendMessage(&(1),$30,Val(GetStockObject($11)),1)
Def HiWord(1) &(1)\$10000
Def LoWord(1) &(1) & $FFFF
Def LockWindowUpdate(1) ! "User32","LockWindowUpdate"
'Konstanten
Def &WM_Capstart 1024
Def &WM_CAP_DRIVER_CONNECT 1034
Def &WM_CAP_DRIVER_DISCONNECT 1035
Def &WM_CAP_DRIVER_GET_NAME 1036
Def &WM_CAP_DRIVER_GET_VERSION 1037
Def &WM_CAP_FILE_SET_CAPTURE_FILE 1044
Def &WM_CAP_FILE_GET_CAPTURE_FILE 1045
Def &WM_CAP_FILE_SAVEAS 1047
Def &WM_CAP_FILE_SAVEDIB 1049
Def &WM_CAP_SET_AUDIOFORMAT 1059
Def &WM_CAP_GET_AUDIOFORMAT 1060
Def &WM_CAP_DLG_VIDEOFORMAT 1065
Def &WM_CAP_DLG_VIDEOSOURCE 1066
Def &WM_CAP_DLG_VIDEODISPLAY 1067
Def &WM_CAP_GET_VIDEOFORMAT 1068
Def &WM_CAP_SET_VIDEOFORMAT 1069
Def &WM_CAP_DLG_VIDEOCOMPRESSION 1070
Def &WM_CAP_SET_PREVIEW 1074
Def &WM_CAP_SET_OVERLAY 1075
Def &WM_CAP_SET_PREVIEWRATE 1076
Def &WM_CAP_SET_SCALE 1077
Def &WM_CAP_SET_SCROLL 1079
Def &WM_CAP_GRAB_FRAME 1084
Def &WM_CAP_GRAB_FRAME_NOSTOP 1085
Def &WM_CAP_SEQUENCE 1086
Def &WM_CAP_SEQUENCE_NOFILE 1087
Def &WM_CAP_SET_SEQUENCE_SETUP 1088
Def &WM_CAP_GET_SEQUENCE_SETUP 1089
Def &WM_CAP_SET_MCI_DEVICE 1090
Def &WM_CAP_GET_MCI_DEVICE 1091
Def &WM_CAP_STOP 1092
Def &WM_CAP_ABORT 1093
'Strukturen
Struct WaveFormatEx = wFormatTag%,nChannels%,nSamplesPerSec&,nAvgBytesPerSec&,\
nBlockAlign%,wBitsPerSample%,cbSize%
'globale Variablen
Declare CapDll&,MM&,CapWindow&,CapBMPFilename$,CapAVIFilename$
Declare DriverChoice&,OverlayButton&,CapBMPButton&
Declare VideoFormatText&
Declare SourceDialogButton&,FormatDialogButton&,KompressionDialogButton&
Declare SingleNameEdit&,AVINameEdit&
Declare StartCapButton&,StopCapButton&,EndeButton&
Declare Ende%,IsOverlay%
Declare AudioChoice&,Waveformat#,BM#
Declare T$
'Prozeduren

Proc CapInit

    CapDll& = UseDll("avicap32.dll")

EndProc

Proc CapExit

    FreeDll CapDll&

EndProc

Proc GetCaptureDriverList

    Declare Treiber$,Version$,Zaehler%
    ClearList

    Whilenot zaehler% = 9'reicht fuer 10 Treiber

        Treiber$ = Space$(80)'80 Zeichen werden maximal aufgenommen
        Version$ = Space$(80)'80 Zeichen werden maximal aufgenommen

        If capGetDriverDescription(Zaehler%,ADDR(Treiber$),80,ADDR(Version$),80) > 0

            AddString Trim$(Treiber$)

        Endif

        Inc Zaehler%

    EndWhile

EndProc

Proc CreateCapWindow

    Parameters x%,y%,w%,h%
    CapWindow& = 0
    CapWindow& = capCreateCaptureWindow(0,$50000000,0,0,0,0,%Hwnd,0)

    Whilenot CapWindow& > 0

    wend

    SetWindowLong(CapWindow&,-20,$200)
    SetWindowPos CapWindow& = x%,y% - w%,h%

EndProc

Proc ConnectDriver

    Parameters DriverIndex%
    Return Sendmessage(CapWindow&,1034,DriverIndex%,0)

EndProc

Proc DisconnectDriver

    Return Sendmessage(CapWindow&,&WM_CAP_DRIVER_DISCONNECT,0,0)

EndProc

Proc SetOverlay

    Parameters True%
    Return Sendmessage(CapWindow&,&WM_CAP_SET_OVERLAY,True%,0)

EndProc

Proc SetPreviev

    Parameters True%,Rate%,Scale%
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEW,True%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEWRATE,Rate%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_SCALE,Scale%,0)

EndProc

Proc GetVideoFormat

    Declare Ret$
    Dim BM#,44
    Clear BM#
    Sendmessage(CapWindow&,&WM_CAP_GET_VIDEOFORMAT,44,BM#)
    Ret$ = Str$(word(bm#,4))+","+Str$(word(bm#,8))
    Dispose BM#
    Return Ret$

EndProc

Proc CapSaveas

    Parameters Savename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEAS,0,ADDR(Savename$))

EndProc

Proc SaveAsBMP

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEDIB,0,ADDR(Filename$))

EndProc

Proc GrabFrame

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_GRAB_FRAME_NOSTOP,0,0)
    SaveAsBMP Filename$

EndProc

Proc CapStart

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SET_CAPTURE_FILE,0,addr(filename$))
    Sendmessage(CapWindow&,&WM_CAP_SEQUENCE,0,0)

EndProc

Proc CapStop

    Sendmessage(CapWindow&,&WM_CAP_STOP,0,0)

EndProc

Proc CapAbort

    Sendmessage(CapWindow&,&WM_CAP_ABORT,0,0)

EndProc

Proc VideoSourceDialog

    Sendmessage(CapWindow&,1066,0,0)

EndProc

Proc VideoFormatDialog

    Sendmessage(CapWindow&,1065,0,0)

EndProc

Proc VideoDisplayDialog

    Sendmessage(CapWindow&,1067,0,0)

EndProc

Proc VideoKompressionDialog

    Sendmessage(CapWindow&,1070,0,0)

EndProc

Proc SetWaveFormat

    Parameters Stereo%,Bits%,Samples%
    Declare GetSize&
    Dim WaveFormat#,WaveFormatEx
    GetSize& = Sendmessage(CapWindow&,1060,0,0)
    Sendmessage(CapWindow&,1060,GetSize&,WaveFormat#)

    if WaveFormat#.wFormatTag% = 1

        Case Stereo% = 0 : WaveFormat#.nChannels% = 1
        Case Stereo% = 1 : WaveFormat#.nChannels% = 2
        WaveFormat#.nSamplesPerSec& = Samples%
        Case Bits% = 8 :WaveFormat#.wBitsPerSample% = 8
        Case Bits% = 16 :WaveFormat#.wBitsPerSample% = 16
        WaveFormat#.nBlockAlign% = (WaveFormat#.nChannels% * WaveFormat#.wBitsPerSample%) / 8
        WaveFormat#.nAvgBytesPerSec& = (WaveFormat#.nSamplesPerSec& * WaveFormat#.nBlockAlign%)
        Sendmessage(CapWindow&,1059,GetSize&,WaveFormat#)

    endif

    Dispose WaveFormat#

EndProc

Set("TrueColor", 1)
CLS GetButtonFaceColor(0)
'Voreinstellungen
'#################
CapInit
GetCaptureDriverList
DriverChoice& =  @Control("ComboBox","",$54000043,0,300,320,80,%hwnd,1000,%Hinstance)
SetDefaultGUIFont(DriverChoice&)
MoveListToChoice(DriverChoice&)
AudioChoice& =  @Control("ComboBox","",$54000242,0,330,320,300,%hwnd,1001,%Hinstance)
SetDefaultGUIFont(AudioChoice&)
SendMessage(DriverChoice&,$014E,0,0)'Auf 1. Eintrag setzen
OverlayButton& = @Create("Button",%Hwnd,"Preview",340,0,120,24)
SetDefaultGUIFont(OverlayButton&)
CapBMPButton& = @Create("Button",%Hwnd,"Einzelbild fangen",340,30,120,24)
SetDefaultGUIFont(CapBMPButton&)
SourceDialogButton& = @Create("Button",%Hwnd,"Video-Source",340,60,120,24)
SetDefaultGUIFont(SourceDialogButton&)
FormatDialogButton& = @Create("Button",%Hwnd,"Video-Format",340,90,120,24)
SetDefaultGUIFont(FormatDialogButton&)
KompressionDialogButton& = @Create("Button",%Hwnd,"Video-Kompression",340,120,120,24)
SetDefaultGUIFont(KompressionDialogButton&)
SingleNameEdit& = @Create("Edit",%Hwnd,"Noname.bmp",480,30,120,24)
SetDefaultGUIFont(SingleNameEdit&)
StartCapButton& = @Create("Button",%Hwnd,"Starte-Capture",340,150,120,24)
SetDefaultGUIFont(StartCapButton&)
AVINameEdit& = @Create("Edit",%Hwnd,"Noname.avi",480,150,120,24)
SetDefaultGUIFont(AVINameEdit&)
StopCapButton& = @Create("Button",%Hwnd,"Stop-Capture",340,180,120,24)
SetDefaultGUIFont(StopCapButton&)
EndeButton& = @Create("Button",%Hwnd,"Ende",340,210,120,24)
SetDefaultGUIFont(EndeButton&)
UseCursor 2
CreateCapWindow 0,40,320,240'Capture-Fenster anlegen
ConnectDriver 0'ersten Eintrag wählen
SetOverlay 1'Overlay-Modus einschalten
IsOverlay% = 1
UseCursor 0
VideoFormatText& = \
@Control("Static","",$54001001,0,0,320,20,%hwnd,1000,%Hinstance,0)
SetDefaultGUIFont(VideoFormatText&)
'GetVideoFormatVideo-Format auslesen
SetText VideoFormatText&, "Video-Format : "+\
Substr$(@$(0),1,",")+" x "+Substr$(@$(0),2,",")+"Pixel"
T$ =" Mono - 8Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
SendMessage(AudioChoice&,$014E,15,0)'Auf 1. Eintrag setzen
SetWaveFormat 1,16,44100
'#################
Usermessages $03,$0111
SetPreviev 1,25,1
SetText OverlayButton&,"Overlay"
IsOverlay% = 0

Whilenot ende%

    Waitinput

    If %UMessage = $0111'WM_Command

        If &ULParam = DriverChoice&

            If HiWord(&UWParam) = $01'Eintrag in Choicebox gewechselt ??

                UseCursor 2
                LockWindowUpdate(%hwnd)
                DisconnectDriver
                ConnectDriver SendMessage(DriverChoice&,$0147,0,0)
                LockWindowUpdate(0)
                UseCursor 0

            endif

        ElseIf &ULParam = AudioChoice&

            If HiWord(&UWParam) = $01'Eintrag in Choicebox gewechselt ??

                Case Sendmessage(AudioChoice&,$0147,0,0) = 0 :SetWaveFormat 0,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 1 :SetWaveFormat 0,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 2 :SetWaveFormat 0,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 3 :SetWaveFormat 0,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 4 :SetWaveFormat 0,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 5 :SetWaveFormat 0,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 6 :SetWaveFormat 0,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 7 :SetWaveFormat 0,16,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 8 :SetWaveFormat 1,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 9 :SetWaveFormat 1,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 10 :SetWaveFormat 1,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 11 :SetWaveFormat 1,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 12 :SetWaveFormat 1,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 13 :SetWaveFormat 1,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 14 :SetWaveFormat 1,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 15 :SetWaveFormat 1,16,44100

            endif

        Endif

    endif

    If %Umessage = $03'$WM_Move

        SetWindowpos CapWindow& = 0,0 - 0,0
        SetWindowpos CapWindow& = 0,40 - 320,240

    Endif

    If GetFocus(EndeButton&)

        Ende% = 1

    Elseif GetFocus (OverlayButton&)

        If IsOverlay% = 1

            SetPreviev 1,25,1
            SetText OverlayButton&,"Overlay"
            IsOverlay% = 0
            SetFocus(0)

        else

            SetOverlay 1
            SetText OverlayButton&,"Preview"
            IsOverlay% = 1
            SetFocus(0)

        Endif

    Elseif GetFocus (CapBMPButton&)

        if GetText$(SingleNameEdit&) <> ""

            GrabFrame GetText$(SingleNameEdit&)

        Else

            @Messagebox("Keine Bitmapname vergeben","Fehler...",64)

        Endif

    Elseif GetFocus (StartCapButton&)

        if GetText$(AVINameEdit&) <> ""

            Capstart F:\Noname.aviGetText$(AVINameEdit&)

        Else

            @Messagebox("Keine AVI-Name vergeben","Fehler...",64)

        Endif

    Elseif GetFocus (StopCapButton&)

        CapStop

    Elseif GetFocus (SourceDialogButton&)

        VideoSourceDialog
        SetFocus(0)

    Elseif GetFocus (FormatDialogButton&)

        VideoFormatDialog
        GetVideoFormat
        SetText VideoFormatText&,"Video-Format : "+\
        Substr$(@$(0),1,",")+" x "+Substr$(@$(0),2,",")+"Pixel"
        SetFocus(0)

    Elseif GetFocus (KompressionDialogButton&)

        VideoKompressionDialog
        SetFocus(0)

    Endif

EndWhile

DisconnectDriver
CapExit
End
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
09.10.2018  ▲
Vollständiges Zitat
Absatzweise zitierenZeilenweise zitieren
 



 
- Seite 1 -



Hans
Hermann
...die USB-Cam wird unter Arbeitsplatz --> Scanner und Kameras als "USB-Videogerät" angezeigt und zeigt nach Doppelklick die momentanen Bilder...

Nenne doch bitte einige USB-Fabrikate/Modelle, mit denen die Anzeige funktioniert -- DANKE!
 
01.07.2009  ▲
 



Microsoft und Herkules, bei letzterem die 3,99Euro, die 7,99Euro und die 16,99Euro-Varianten funktionieren bei mir definitiv.
 
01.07.2009  ▲
 




Hans
Hermann
> 3,99Euro - 7,99Euro - 16,99Euro
Habe leider keine derartigen Preise bei Hercules gefunden. Gibts da evtl. auch Typenbezeichnungen?
 
01.07.2009  ▲
 



Ich kauf solche bein Conrad, Classic steht z.B. drauf.

Imho funktionierte mit obigen Code bisher "jede" Cam, nur eben diese eine von Dir leider nicht.

Welche genau ist das?
 
01.07.2009  ▲
 




Hans
Hermann
Besagte Webcam ist eine Megapixel D251 (Shenzen Xinyi Jingye Tec [xinyi2008.com]) und ein chinesisches Massenprodukt, welches neuerdings auf dem europäischen Markt unter vielen Aliasen auch via Ebay verscherbelt wird.

Habe die "Classic"-Kamera bestellt und will versuchen, den Unterschied zu finden...
 
02.07.2009  ▲
 



 
- Seite 2 -


Jau!
 
02.07.2009  ▲
 



USB-Logitech läuft auch...

Kannste deinen Code mal so schreiben, das er mit dem Profan2Cpp läuft?

Kommen einige Fehlermeldungen.

Ansonsten läuft das Programm.

mfg
 
02.07.2009  ▲
 




Hans
Hermann
...habe jetzt mit einigen Kameras getestet: Es laufen fast alle Kameras mit bis 1.3 M und/oder Kompressionssystem YUY2 bzw. "24Bit". Mit dem Kompressionssystem MJPEG gabs immer Probleme.
 
27.07.2009  ▲
 



Hast Du etwas zum MJPEG herausbekommen können?
 
29.07.2009  ▲
 




p.specht

RESTAURIERT und für XProfan11.2a adaptiert.
Version R0.2ß - Bitte vorsichtig testen:
==============================
KompilierenMarkierenSeparieren
'##################################################
'Video-Capture mit Profan ab Profan-Version 7
'ist aber mit Bereichsvariablen leicht an vorherige
'Versionen anpassbar !
'Alle Funktionen mit Callbacks sind bisher nicht
'verwendbar (habe ich gleich weggelassen ) !
'Das sind vor allem Fehlermeldungen und auch
'die Statusanzeigen.
'##################################################
'Andreas Miethe * Februar 2002
'##################################################
'Definitionen
DEF capCreateCaptureWindow(8) ! "avicap32.dll","capCreateCaptureWindowA"
DEF capGetDriverDescription(5) ! "avicap32.dll","capGetDriverDescriptionA"
DEF GetButtonFaceColor(0) External("User32","GetSysColor",15)
DEF SetWindowLong(3) ! "USER32","SetWindowLongA"
Def GetStockObject(1) !"GDI32","GetStockObject"
Def SetDefaultGUIFont(1) SendMessage(&(1),$30,Val(GetStockObject($11)),1)
Def HiWord(1) &(1)\$10000
Def LoWord(1) &(1) & $FFFF
Def LockWindowUpdate(1) ! "User32","LockWindowUpdate"
'Konstanten
Def &WM_Capstart 1024
Def &WM_CAP_DRIVER_CONNECT 1034
Def &WM_CAP_DRIVER_DISCONNECT 1035
Def &WM_CAP_DRIVER_GET_NAME 1036
Def &WM_CAP_DRIVER_GET_VERSION 1037
Def &WM_CAP_FILE_SET_CAPTURE_FILE 1044
Def &WM_CAP_FILE_GET_CAPTURE_FILE 1045
Def &WM_CAP_FILE_SAVEAS 1047
Def &WM_CAP_FILE_SAVEDIB 1049
Def &WM_CAP_SET_AUDIOFORMAT 1059
Def &WM_CAP_GET_AUDIOFORMAT 1060
Def &WM_CAP_DLG_VIDEOFORMAT 1065
Def &WM_CAP_DLG_VIDEOSOURCE 1066
Def &WM_CAP_DLG_VIDEODISPLAY 1067
Def &WM_CAP_GET_VIDEOFORMAT 1068
Def &WM_CAP_SET_VIDEOFORMAT 1069
Def &WM_CAP_DLG_VIDEOCOMPRESSION 1070
Def &WM_CAP_SET_PREVIEW 1074
Def &WM_CAP_SET_OVERLAY 1075
Def &WM_CAP_SET_PREVIEWRATE 1076
Def &WM_CAP_SET_SCALE 1077
Def &WM_CAP_SET_SCROLL 1079
Def &WM_CAP_GRAB_FRAME 1084
Def &WM_CAP_GRAB_FRAME_NOSTOP 1085
Def &WM_CAP_SEQUENCE 1086
Def &WM_CAP_SEQUENCE_NOFILE 1087
Def &WM_CAP_SET_SEQUENCE_SETUP 1088
Def &WM_CAP_GET_SEQUENCE_SETUP 1089
Def &WM_CAP_SET_MCI_DEVICE 1090
Def &WM_CAP_GET_MCI_DEVICE 1091
Def &WM_CAP_STOP 1092
Def &WM_CAP_ABORT 1093
'Strukturen
Struct WaveFormatEx = wFormatTag%,nChannels%,nSamplesPerSec&,nAvgBytesPerSec&,\
nBlockAlign%,wBitsPerSample%,cbSize%
'globale Variablen
Declare CapDll&,MM&,CapWindow&,CapBMPFilename$,CapAVIFilename$
Declare DriverChoice&,OverlayButton&,CapBMPButton&
Declare VideoFormatText&
Declare SourceDialogButton&,FormatDialogButton&,KompressionDialogButton&
Declare SingleNameEdit&,AVINameEdit&
Declare StartCapButton&,StopCapButton&,EndeButton&
Declare Ende%,IsOverlay%
Declare AudioChoice&,Waveformat#,BM#
Declare T$
'Prozeduren

Proc CapInit

    CapDll& = UseDll("avicap32.dll")

EndProc

Proc CapExit

    FreeDll CapDll&

EndProc

Proc GetCaptureDriverList

    Declare Treiber$,Version$,Zaehler%
    ClearList

    Whilenot zaehler% = 9'reicht fuer 10 Treiber

        Treiber$ = Space$(80)'80 Zeichen werden maximal aufgenommen
        Version$ = Space$(80)'80 Zeichen werden maximal aufgenommen

        If capGetDriverDescription(Zaehler%,ADDR(Treiber$),80,ADDR(Version$),80) > 0

            AddString Trim$(Treiber$)

        Endif

        Inc Zaehler%

    EndWhile

EndProc

Proc CreateCapWindow

    Parameters x%,y%,w%,h%
    CapWindow& = 0
    CapWindow& = capCreateCaptureWindow(0,$50000000,0,0,0,0,%Hwnd,0)

    Whilenot CapWindow& > 0

    wend

    SetWindowLong(CapWindow&,-20,$200)
    SetWindowPos CapWindow& = x%,y% - w%,h%

EndProc

Proc ConnectDriver

    Parameters DriverIndex%
    Return Sendmessage(CapWindow&,1034,DriverIndex%,0)

EndProc

Proc DisconnectDriver

    Return Sendmessage(CapWindow&,&WM_CAP_DRIVER_DISCONNECT,0,0)

EndProc

Proc SetOverlay

    Parameters True%
    Return Sendmessage(CapWindow&,&WM_CAP_SET_OVERLAY,True%,0)

EndProc

Proc SetPreviev

    Parameters True%,Rate%,Scale%
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEW,True%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_PREVIEWRATE,Rate%,0)
    Sendmessage(CapWindow&,&WM_CAP_SET_SCALE,Scale%,0)

EndProc

Proc GetVideoFormat

    Declare Ret$
    Dim BM#,44
    Clear BM#
    Sendmessage(CapWindow&,&WM_CAP_GET_VIDEOFORMAT,44,BM#)
    Ret$ = Str$(word(bm#,4))+","+Str$(word(bm#,8))
    Dispose BM#
    Return Ret$

EndProc

Proc CapSaveas

    Parameters Savename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEAS,0,ADDR(Savename$))

EndProc

Proc SaveAsBMP

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SAVEDIB,0,ADDR(Filename$))

EndProc

Proc GrabFrame

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_GRAB_FRAME_NOSTOP,0,0)
    SaveAsBMP Filename$

EndProc

Proc CapStart

    Parameters Filename$
    Sendmessage(CapWindow&,&WM_CAP_FILE_SET_CAPTURE_FILE,0,addr(filename$))
    Sendmessage(CapWindow&,&WM_CAP_SEQUENCE,0,0)

EndProc

Proc CapStop

    Sendmessage(CapWindow&,&WM_CAP_STOP,0,0)

EndProc

Proc CapAbort

    Sendmessage(CapWindow&,&WM_CAP_ABORT,0,0)

EndProc

Proc VideoSourceDialog

    Sendmessage(CapWindow&,1066,0,0)

EndProc

Proc VideoFormatDialog

    Sendmessage(CapWindow&,1065,0,0)

EndProc

Proc VideoDisplayDialog

    Sendmessage(CapWindow&,1067,0,0)

EndProc

Proc VideoKompressionDialog

    Sendmessage(CapWindow&,1070,0,0)

EndProc

Proc SetWaveFormat

    Parameters Stereo%,Bits%,Samples%
    Declare GetSize&
    Dim WaveFormat#,WaveFormatEx
    GetSize& = Sendmessage(CapWindow&,1060,0,0)
    Sendmessage(CapWindow&,1060,GetSize&,WaveFormat#)

    if WaveFormat#.wFormatTag% = 1

        Case Stereo% = 0 : WaveFormat#.nChannels% = 1
        Case Stereo% = 1 : WaveFormat#.nChannels% = 2
        WaveFormat#.nSamplesPerSec& = Samples%
        Case Bits% = 8 :WaveFormat#.wBitsPerSample% = 8
        Case Bits% = 16 :WaveFormat#.wBitsPerSample% = 16
        WaveFormat#.nBlockAlign% = (WaveFormat#.nChannels% * WaveFormat#.wBitsPerSample%) / 8
        WaveFormat#.nAvgBytesPerSec& = (WaveFormat#.nSamplesPerSec& * WaveFormat#.nBlockAlign%)
        Sendmessage(CapWindow&,1059,GetSize&,WaveFormat#)

    endif

    Dispose WaveFormat#

EndProc

Set("TrueColor", 1)
CLS GetButtonFaceColor(0)
'Voreinstellungen
'#################
CapInit
GetCaptureDriverList
DriverChoice& =  @Control("ComboBox","",$54000043,0,300,320,80,%hwnd,1000,%Hinstance)
SetDefaultGUIFont(DriverChoice&)
MoveListToChoice(DriverChoice&)
AudioChoice& =  @Control("ComboBox","",$54000242,0,330,320,300,%hwnd,1001,%Hinstance)
SetDefaultGUIFont(AudioChoice&)
SendMessage(DriverChoice&,$014E,0,0)'Auf 1. Eintrag setzen
OverlayButton& = @Create("Button",%Hwnd,"Preview",340,0,120,24)
SetDefaultGUIFont(OverlayButton&)
CapBMPButton& = @Create("Button",%Hwnd,"Einzelbild fangen",340,30,120,24)
SetDefaultGUIFont(CapBMPButton&)
SourceDialogButton& = @Create("Button",%Hwnd,"Video-Source",340,60,120,24)
SetDefaultGUIFont(SourceDialogButton&)
FormatDialogButton& = @Create("Button",%Hwnd,"Video-Format",340,90,120,24)
SetDefaultGUIFont(FormatDialogButton&)
KompressionDialogButton& = @Create("Button",%Hwnd,"Video-Kompression",340,120,120,24)
SetDefaultGUIFont(KompressionDialogButton&)
SingleNameEdit& = @Create("Edit",%Hwnd,"Noname.bmp",480,30,120,24)
SetDefaultGUIFont(SingleNameEdit&)
StartCapButton& = @Create("Button",%Hwnd,"Starte-Capture",340,150,120,24)
SetDefaultGUIFont(StartCapButton&)
AVINameEdit& = @Create("Edit",%Hwnd,"Noname.avi",480,150,120,24)
SetDefaultGUIFont(AVINameEdit&)
StopCapButton& = @Create("Button",%Hwnd,"Stop-Capture",340,180,120,24)
SetDefaultGUIFont(StopCapButton&)
EndeButton& = @Create("Button",%Hwnd,"Ende",340,210,120,24)
SetDefaultGUIFont(EndeButton&)
UseCursor 2
CreateCapWindow 0,40,320,240'Capture-Fenster anlegen
ConnectDriver 0'ersten Eintrag wählen
SetOverlay 1'Overlay-Modus einschalten
IsOverlay% = 1
UseCursor 0
VideoFormatText& = \
@Control("Static","",$54001001,0,0,320,20,%hwnd,1000,%Hinstance,0)
SetDefaultGUIFont(VideoFormatText&)
'GetVideoFormatVideo-Format auslesen
SetText VideoFormatText&, "Video-Format : "+\
Substr$(@$(0),1,",")+" x "+Substr$(@$(0),2,",")+"Pixel"
T$ =" Mono - 8Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 8Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Mono - 16Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 8Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 8.000 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 11.025 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 22,050 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
T$ =" Stereo - 16Bit - 44.100 kHz"
SendMessage(AudioChoice&,$0143,0,ADDR(T$))
SendMessage(AudioChoice&,$014E,15,0)'Auf 1. Eintrag setzen
SetWaveFormat 1,16,44100
'#################
Usermessages $03,$0111
SetPreviev 1,25,1
SetText OverlayButton&,"Overlay"
IsOverlay% = 0

Whilenot ende%

    Waitinput

    If %UMessage = $0111'WM_Command

        If &ULParam = DriverChoice&

            If HiWord(&UWParam) = $01'Eintrag in Choicebox gewechselt ??

                UseCursor 2
                LockWindowUpdate(%hwnd)
                DisconnectDriver
                ConnectDriver SendMessage(DriverChoice&,$0147,0,0)
                LockWindowUpdate(0)
                UseCursor 0

            endif

        ElseIf &ULParam = AudioChoice&

            If HiWord(&UWParam) = $01'Eintrag in Choicebox gewechselt ??

                Case Sendmessage(AudioChoice&,$0147,0,0) = 0 :SetWaveFormat 0,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 1 :SetWaveFormat 0,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 2 :SetWaveFormat 0,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 3 :SetWaveFormat 0,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 4 :SetWaveFormat 0,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 5 :SetWaveFormat 0,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 6 :SetWaveFormat 0,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 7 :SetWaveFormat 0,16,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 8 :SetWaveFormat 1,8,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 9 :SetWaveFormat 1,8,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 10 :SetWaveFormat 1,8,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 11 :SetWaveFormat 1,8,44100
                Case Sendmessage(AudioChoice&,$0147,0,0) = 12 :SetWaveFormat 1,16,8
                Case Sendmessage(AudioChoice&,$0147,0,0) = 13 :SetWaveFormat 1,16,11025
                Case Sendmessage(AudioChoice&,$0147,0,0) = 14 :SetWaveFormat 1,16,22050
                Case Sendmessage(AudioChoice&,$0147,0,0) = 15 :SetWaveFormat 1,16,44100

            endif

        Endif

    endif

    If %Umessage = $03'$WM_Move

        SetWindowpos CapWindow& = 0,0 - 0,0
        SetWindowpos CapWindow& = 0,40 - 320,240

    Endif

    If GetFocus(EndeButton&)

        Ende% = 1

    Elseif GetFocus (OverlayButton&)

        If IsOverlay% = 1

            SetPreviev 1,25,1
            SetText OverlayButton&,"Overlay"
            IsOverlay% = 0
            SetFocus(0)

        else

            SetOverlay 1
            SetText OverlayButton&,"Preview"
            IsOverlay% = 1
            SetFocus(0)

        Endif

    Elseif GetFocus (CapBMPButton&)

        if GetText$(SingleNameEdit&) <> ""

            GrabFrame GetText$(SingleNameEdit&)

        Else

            @Messagebox("Keine Bitmapname vergeben","Fehler...",64)

        Endif

    Elseif GetFocus (StartCapButton&)

        if GetText$(AVINameEdit&) <> ""

            Capstart F:\Noname.aviGetText$(AVINameEdit&)

        Else

            @Messagebox("Keine AVI-Name vergeben","Fehler...",64)

        Endif

    Elseif GetFocus (StopCapButton&)

        CapStop

    Elseif GetFocus (SourceDialogButton&)

        VideoSourceDialog
        SetFocus(0)

    Elseif GetFocus (FormatDialogButton&)

        VideoFormatDialog
        GetVideoFormat
        SetText VideoFormatText&,"Video-Format : "+\
        Substr$(@$(0),1,",")+" x "+Substr$(@$(0),2,",")+"Pixel"
        SetFocus(0)

    Elseif GetFocus (KompressionDialogButton&)

        VideoKompressionDialog
        SetFocus(0)

    Endif

EndWhile

DisconnectDriver
CapExit
End
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
09.10.2018  ▲
 




Walter
Bei mir funktioniert mit dem obigen Code die avi-Aufzeichnung, jedoch kann ich keine Einzelbilder aufzeichnen (die werden zwar mit dem Dateinamen angelegt, sind jedoch immer 0 Byte groß).

Jetzt hab ich mittels escapi.dll (https://solhsa.com/escapi/) versucht, eine Einzelbildaufzeichnung zu erstellen.

Die Kamera wird sichtbar ein- und wieder ausgeschaltet, das Bild sollte in einem Bereich erstellt worden sein.
Wie bekomme ich nun das Bild auf den Bildschirm bzw. in eine Datei?
(So, wie ich es versuche (mit Blockwrite), landet es zwar in einer Datei, wird aber nicht als bmp erkannt).
KompilierenMarkierenSeparieren
' Camera
cls
declare dll1&,Anzahl%,capture#,a%,b%,name$,mWidth%,mHeight%,i%
struct Bild=B#(300000),mWidth%,mHeight%
dim capture#,Bild
capture#.mWidth%=320
capture#.mHeight%=280
Def ESCAPIDLLVersion(0) !"escapi","ESCAPIDLLVersion"
Def countCaptureDevices(0) !"escapi","countCaptureDevices"
Def deinitCapture(1) !"escapi","deinitCapture"
Def doCapture(1) !"escapi","doCapture"
Def getCaptureDeviceName(3) !"escapi","getCaptureDeviceName"
Def initCOM(0) !"escapi","initCOM"
Def initCapture(2) !"escapi","initCapture"
Def isCaptureDone(1) !"escapi","isCaptureDone"
dll1&=usedll("Escapi.dll")
initCOM()
Anzahl%=countCaptureDevices()
name$=space$(1024)
messagebox("Anzahl Kameras gefunden: "+str$(anzahl%),"",0)
getCaptureDeviceName(0,addr(name$),1024)
messagebox(name$,"",0)
a%=initCapture(0,addr(capture#))

if a%>0

    b%=doCapture(0)

endif

if b%>0

    whilenot isCaptureDone(0)

        waitinput 10
        inc i%
        case i%=1000: break

    wend

endif

' Bild anzeigen
case i%<1000: blockwrite "test.bmp",capture#
deinitCapture(0)
dispose capture#
freedll dll1&
 
16.01.2023  ▲
 




Walter
Habe nun hier [...] 
eine Lösung mittels Escapi.dll gepostet.
 
26.04.2023  ▲
 



◄
12

Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

26.016 Betrachtungen

Unbenanntvor 0 min.
H.Brill10.10.2024
Heiko Dix30.10.2023
Thomas Zielinski28.06.2023
Paul Glatz22.06.2023
Mehr...

Themeninformationen

Dieses Thema hat 5 Teilnehmer:

iF (8x)
Hans Hermann (6x)
Walter (2x)
p.specht (1x)
unbekannt (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie