(793)  Login

English
Source / code snippets

record Avicap32 Cam Capture Fernseh video Webcam

 
- Page 1 -


Andreas Miethe, URL=www.paules-pc-forum.de/forum/aide-tools/114963-avicap32-dll-or-mci-webcam.html#mail703893, Zeitpunkt=23.05.2009
Hello BackBONE,

have yet a older code ( of 2002 ) ausgegraben.
hopefully blickst You there through

so can You do not only Wabcams record separate too TV-cards.
CompileMarkSeparation
##################################################
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=s2>(0)

    Endif

EndWhile

DisconnectDriver
CapExit
end
 
05/23/09  ▲
Vollständiges Quote
Absatzweise QuoteZeilenweise Quote
 



« this Posting watts as Solution marked. »

- Page 2 -



p.specht

RESTAURIERT and XProfan11.2a adaptiert.
Version R0.2ß - Please softly-softly testing:
==============================
CompileMarkSeparation
'##################################################
'video-Capture with Profan ex Profan-Version 7
'is with Memory-Variables slight on previous
'versions anpassbar !
'any functions with Callbacks are yet not
'useable (have I same omitted ) !
'the are particularly Fehlermeldungen and
'The Statusanzeigen.
'##################################################
'Andreas Miethe * february 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
'Structures
Struct WaveFormatEx = wFormatTag%,nChannels%,nSamplesPerSec&,nAvgBytesPerSec&,\
nBlockAlign%,wBitsPerSample%,cbSize%
'globale variables
Declare CapDll&,MM&,CapWindow&,CapBMPFilename$,CapAVIFilename$
Declare DriverChoice&,OverlayButton&,CapBMPButton&
Declare VideoFormatText&
Declare SourceDialogButton&,FormatDialogButton&,KompressionDialogButton&
Declare SingleNameEdit&,AVINameEdit&
Declare StartCapButton&,StopCapButton&,EndeButton&
Declare end%,IsOverlay%
Declare AudioChoice&,Waveformat#,BM#
Declare T$
'Procedures

Proc CapInit

    CapDll& = UseDll("avicap32.dll")

ENDPROC

Proc CapExit

    FreeDll CapDll&

ENDPROC

Proc GetCaptureDriverList

    Declare driver$,Version$,Zaehler%
    ClearList

    Whilenot zaehler% = 9'reicht fuer 10 driver

        driver$ = Space$(80)'80 characters go maximum adopted
        Version$ = Space$(80)'80 characters go maximum adopted

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

            AddStrings Trim $(driver$)

        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)'On 1. entry settle
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-Window lay out
ConnectDriver 0'first entry dial
SetOverlay 1'Overlay-mode on
IsOverlay% = 1
UseCursor 0
VideoFormatText& = \
@Control("Static","",$54001001,0,0,320,20,%hwnd,1000,%Hinstance,0)
SetDefaultGUIFont(VideoFormatText&)
'GetVideoFormatVideo-stature read
SetText VideoFormatText&, "Video-stature : "+\
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)'On 1. entry settle
SetWaveFormat 1,16,44100
'#################
User Messages $03,$0111
SetPreviev 1,25,1
SetText OverlayButton&,"Overlay"
IsOverlay% = 0

Whilenot end%

    Waitinput

    If %UMessage = $0111'WM_Command

        If &ULParam = DriverChoice&

            If HiWord(&UWParam) = $01'Sign in Choicebox changed ??

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

            endif

        ElseIf &ULParam = AudioChoice&

            If HiWord(&UWParam) = $01'Sign in Choicebox changed ??

                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&)

        end% = 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","Error...",64)

        Endif

    Elseif GetFocus (StartCapButton&)

        if GetText$(AVINameEdit&) <> ""

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

        Else

            @Messagebox("Keine AVI-name vergeben","Error...",64)

        Endif

    Elseif GetFocus (StopCapButton&)

        CapStop

    Elseif GetFocus (SourceDialogButton&)

        VideoSourceDialog
        SetFocus(0)

    Elseif GetFocus (FormatDialogButton&)

        VideoFormatDialog
        GetVideoFormat
        SetText VideoFormatText&,"Video-stature : "+\
        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'...
10/09/18  ▲
Vollständiges Quote
Absatzweise QuoteZeilenweise Quote
 



 
- Page 1 -



Hans
Hermann
...The USB-Cam becomes under job --> Scanner and cameras as "USB-Videogerät" displayed and shows to Double click The momentanen Images...

name still Please some USB-Fabrikate/models, with them The display functions -- THANK YOU!
 
07/01/09  ▲
 



Microsoft and Herkules, with letzterem The 3,99Euro, The 7,99Euro and the 16,99Euro-mutants functions by me definitiv.
 
07/01/09  ▲
 




Hans
Hermann
> 3,99Euro - 7,99Euro - 16,99Euro
have unfortunately no derartigen prices with Hercules found. Gibts there evtl. too Typenbezeichnungen?
 
07/01/09  ▲
 



I buy such leg Conrad, Classic standing z.B. on it.

Imho funktionierte with obigen code yet "jede" Cam, only even these one of you unfortunately not.

which exactly the?
 
07/01/09  ▲
 




Hans
Hermann
Besagte Webcam is a Megapixel D251 (Shenzen Xinyi Jingye Tec [xinyi2008.com]) and a chinesisches Massenprodukt, which latterly on the europäischen market under many Aliasen too via Ebay verscherbelt becomes.

have The "Classic"-Kamera order and wants try, whom Difference to find...
 
07/02/09  ▲
 



 
- Page 2 -


Jau!
 
07/02/09  ▲
 



USB-Logitech runs too...

Kannste your code time so write, the it with the Profan2Cpp runs?

come some Fehlermeldungen.

otherwise runs the program.

mfg
 
07/02/09  ▲
 




Hans
Hermann
...have now with some cameras tested: it walk almost any cameras with To 1.3 M and/or Kompressionssystem YUY2 or. "24Bit". with the Kompressionssystem MJPEG gabs always Problems.
 
07/27/09  ▲
 



have You something to that MJPEG herausbekommen can?
 
07/29/09  ▲
 




p.specht

RESTAURIERT and XProfan11.2a adaptiert.
Version R0.2ß - Please softly-softly testing:
==============================
CompileMarkSeparation
'##################################################
'video-Capture with Profan ex Profan-Version 7
'is with Memory-Variables slight on previous
'versions anpassbar !
'any functions with Callbacks are yet not
'useable (have I same omitted ) !
'the are particularly Fehlermeldungen and
'The Statusanzeigen.
'##################################################
'Andreas Miethe * february 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
'Structures
Struct WaveFormatEx = wFormatTag%,nChannels%,nSamplesPerSec&,nAvgBytesPerSec&,\
nBlockAlign%,wBitsPerSample%,cbSize%
'globale variables
Declare CapDll&,MM&,CapWindow&,CapBMPFilename$,CapAVIFilename$
Declare DriverChoice&,OverlayButton&,CapBMPButton&
Declare VideoFormatText&
Declare SourceDialogButton&,FormatDialogButton&,KompressionDialogButton&
Declare SingleNameEdit&,AVINameEdit&
Declare StartCapButton&,StopCapButton&,EndeButton&
Declare end%,IsOverlay%
Declare AudioChoice&,Waveformat#,BM#
Declare T$
'Procedures

Proc CapInit

    CapDll& = UseDll("avicap32.dll")

ENDPROC

Proc CapExit

    FreeDll CapDll&

ENDPROC

Proc GetCaptureDriverList

    Declare driver$,Version$,Zaehler%
    ClearList

    Whilenot zaehler% = 9'reicht fuer 10 driver

        driver$ = Space$(80)'80 characters go maximum adopted
        Version$ = Space$(80)'80 characters go maximum adopted

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

            AddStrings Trim $(driver$)

        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)'On 1. entry settle
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-Window lay out
ConnectDriver 0'first entry dial
SetOverlay 1'Overlay-mode on
IsOverlay% = 1
UseCursor 0
VideoFormatText& = \
@Control("Static","",$54001001,0,0,320,20,%hwnd,1000,%Hinstance,0)
SetDefaultGUIFont(VideoFormatText&)
'GetVideoFormatVideo-stature read
SetText VideoFormatText&, "Video-stature : "+\
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)'On 1. entry settle
SetWaveFormat 1,16,44100
'#################
User Messages $03,$0111
SetPreviev 1,25,1
SetText OverlayButton&,"Overlay"
IsOverlay% = 0

Whilenot end%

    Waitinput

    If %UMessage = $0111'WM_Command

        If &ULParam = DriverChoice&

            If HiWord(&UWParam) = $01'Sign in Choicebox changed ??

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

            endif

        ElseIf &ULParam = AudioChoice&

            If HiWord(&UWParam) = $01'Sign in Choicebox changed ??

                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&)

        end% = 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","Error...",64)

        Endif

    Elseif GetFocus (StartCapButton&)

        if GetText$(AVINameEdit&) <> ""

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

        Else

            @Messagebox("Keine AVI-name vergeben","Error...",64)

        Endif

    Elseif GetFocus (StopCapButton&)

        CapStop

    Elseif GetFocus (SourceDialogButton&)

        VideoSourceDialog
        SetFocus(0)

    Elseif GetFocus (FormatDialogButton&)

        VideoFormatDialog
        GetVideoFormat
        SetText VideoFormatText&,"Video-stature : "+\
        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'...
10/09/18  ▲
 




Walter
by me functions with the obigen code The avi-note, however can I no Einzelbilder record (The go of course with the Filenames laid out, are however always 0 byte big).

now Have I through escapi.dll (https://solhsa.com/escapi/) attempts, a Einzelbildaufzeichnung to create.

The Kamera becomes visible one- and again off, the image ought to in a area prepares been his.
How do I get now the image on the screen or. in a File?
(so, How I it try (with Block Write), alights it of course in a File, becomes but not as bmp recognized).
CompileMarkSeparation
' Camera
cls
declare dll1&,amount%,capture#,a%,b%,name$,mWidth%,mHeight%,i%
struct Image=B#(300000),mWidth%,mHeight%
dim capture#,Image
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 cameras found: "+st$(number%),"",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

' Image Show
case i%<1000: blockwrite "test.bmp",capture#
deinitCapture(0)
dispose capture#
freedll dll1&
 
01/16/23  ▲
 




Walter
have now hier [...] 
a Solution through Escapi.dll posted.
 
04/26/23  ▲
 



◄
12

Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

26.863 Views

Untitledvor 0 min.
Georg Teles vor 10 Tagen
H.Brill10/10/24
Heiko Dix10/30/23
Klaus Müller06/28/23
More...

Themeninformationen

this Topic has 5 subscriber:

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


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie