CamGadget - Module (windows only)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

CamGadget - Module (windows only)

Beitrag von ts-soft »

Hier mal eine kleine Spielerei, für diejenigen, die eine WebCam haben :wink:

Code: Alles auswählen

DeclareModule CamGadget
  Interface ICamGadget
    Free()
    Resize(x, y, width, height)
    GetcaphWnd()
    DlgSettings()
    SnapImage()
  EndInterface
  
  Declare New(x, y, width, height, rate.l = 30, Text.s = "My Capture Window")
EndDeclareModule

Module CamGadget
  EnableExplicit
  
  Structure Class
    *vTable
    ID.i
    hWndC.i
  EndStructure
   
  Define DLL

  Prototype capCreateCaptureWindow(lpszWindowName.p-Unicode, dwStyle.l, x.l, y.l, nWith.l, nHeigth.l, hWnd.i, nID.l)
  
  Global capCreateCaptureWindow.capCreateCaptureWindow
  
  DLL = OpenLibrary(#PB_Any, "avicap32.dll")
  
  If DLL
    capCreateCaptureWindow =  GetFunction(DLL, "capCreateCaptureWindowW")
  EndIf
  
  Procedure New(x, y, width, height, rate.l = 30, Text.s = "My Capture Window")
    Protected *obj.Class
    
    *obj = AllocateMemory(SizeOf(Class))
    If *obj
      With *obj
        \vTable = ?vTable
        \ID = ContainerGadget(#PB_Any, x, y, width, height)
        CloseGadgetList()
        HideGadget(\ID, #True)
        \hWndC = capCreateCaptureWindow(Text,  #WS_CHILD | #WS_VISIBLE, 0, 0, width, height, GadgetID(\ID), \ID)
        If \hWndC
          SendMessage_(\hWndC, #WM_CAP_DRIVER_CONNECT, 0, 0)
          SendMessage_(\hWndC, #WM_CAP_SET_PREVIEWRATE, rate, 0)
          SendMessage_(\hWndC, #WM_CAP_SET_PREVIEW, #True, 0)
          SendMessage_(\hWndC, #WM_CAP_SET_SCALE, #True, 0)
          HideGadget(\ID, #False)
          
          ProcedureReturn *obj
        Else
          FreeGadget(\ID)
          FreeMemory(*obj)
          
          ProcedureReturn #False
        EndIf
      EndWith
    EndIf
  EndProcedure
    
  Procedure Free(*obj.Class)
      If *obj
        With *obj
          SendMessage_(\hWndC, #WM_CAP_STOP, 0, 0)
          SendMessage_(\hWndC, #WM_CAP_DRIVER_DISCONNECT, 0, 0)
          DestroyWindow_(\hWndC)
          FreeGadget(\ID)
        EndWith
        FreeMemory(*obj)
      EndIf
  EndProcedure

  Procedure Resize(*obj.Class, x, y, width, height)
    If *obj
      With *obj
        ResizeGadget(\ID, x, y, width, height)
        MoveWindow_(\hWndC, 0, 0, width, height, #True)
      EndWith
    EndIf
  EndProcedure
  
  Procedure GetcaphWnd(*obj.Class)
    If *obj
      ProcedureReturn *obj\hWndC
    EndIf
  EndProcedure
  
  Procedure DlgSettings(*obj.Class)
    If *obj
      SendMessage_(*obj\hWndC, #WM_CAP_DLG_VIDEOSOURCE, 0, 0)
    EndIf
  EndProcedure
  
  Procedure SnapImage(*obj.Class)
    If *obj
      SendMessage_(*obj\hWndC, #WM_CAP_EDIT_COPY, 0, 0)
      ProcedureReturn GetClipboardImage(#PB_Any, 32)
    EndIf
  EndProcedure
  
  DataSection
    vTable:
    Data.i @Free()
    Data.i @Resize()
    Data.i @GetcaphWnd()
    Data.i @DlgSettings()
    Data.i @SnapImage()
  EndDataSection 
EndModule

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Enumeration
    #btnSettings
    #btnSnap
    #imgSnap
  EndEnumeration
  
  Define myCam.CamGadget::ICamGadget
  Define img
   
  OpenWindow(0, #PB_Ignore, #PB_Ignore, 800, 410, "Webcam Example", #PB_Window_SizeGadget | #PB_Window_SystemMenu)
  myCam = CamGadget::New(10, 10, 640, 360)
  
  ButtonGadget(#btnSettings, 10, 380, 80, 20, "Settings")
  ButtonGadget(#btnSnap, 100, 380, 80, 20, "Snapshot")
  ImageGadget(#imgSnap, WindowWidth(0) - 105, 10, 100, 100, 0, #PB_Image_Border)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        myCam\Free()
        Break
      
      Case #PB_Event_SizeWindow
        myCam\Resize(#PB_Ignore, #PB_Ignore, WindowWidth(0) - 120, WindowHeight(0) - 50)
        ResizeGadget(#btnSettings, #PB_Ignore, WindowHeight(0) - 30, #PB_Ignore, #PB_Ignore)
        ResizeGadget(#btnSnap, #PB_Ignore, WindowHeight(0) - 30, #PB_Ignore, #PB_Ignore)
        ResizeGadget(#imgSnap, WindowWidth(0) - 105, #PB_Ignore, #PB_Ignore, #PB_Ignore)
        
      Case #PB_Event_Gadget
        
        Select EventGadget()
          Case #btnSettings
            myCam\DlgSettings()
            
          Case #btnSnap
            img = myCam\SnapImage()
            ResizeImage(img, 100, 100)
            SetGadgetState(#imgSnap, ImageID(img))
            
        EndSelect
    EndSelect
  ForEver
CompilerEndIf
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von RSBasic »

Ich werds morgen testen.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
KeyKon
Beiträge: 1412
Registriert: 10.09.2004 20:51
Computerausstattung: Laptop: i5 2,8 Ghz, 16GB DDR3 RAM, GeForce 555GT 2GB VRAM
PC: i7 4,3 Ghz, 32GB DDR3 RAM, GeForce 680 GTX 4GB VRAM
Win10 x64 Home/Prof
PB 5.30 (64bit)
Wohnort: Ansbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von KeyKon »

Komisch hat bei mir beim erstmal mal einwandfrei funktioniert ohne dass irgend eine Auswahl nötig gewesen wäre.
Beim zweiten starten kam jetzt aber ein Fenster wo ich meine Webcam auswählen musste, sie wird jedoch nicht angesteuert.

BTW danke dass du mir die Konstante #PB_Compiler_IsMainFile näher gebracht hast, wusste von deren Existenz bisher nicht :D
Hab bisher immer umständlicher meine Includes getestet^^

LG KeyKon
(\/) (°,,,°) (\/)
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: CamGadget - Module (windows only)

Beitrag von ts-soft »

Für diejenigen, die das ganze noch erweitern wollen, bzw. weitere Messages benötigen:
http://msdn.microsoft.com/en-us/library ... 85%29.aspx
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von RSBasic »

Beim Ausführen erscheint zwar das folgende Fenster:
Bild

Aber nach dem Bestätigen bleibt die Fläche schwarz und ich sehe nichts. Ich versuchs in ein paar Tagen mit einem anderen Laptop mit externer Webcam.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
KeyKon
Beiträge: 1412
Registriert: 10.09.2004 20:51
Computerausstattung: Laptop: i5 2,8 Ghz, 16GB DDR3 RAM, GeForce 555GT 2GB VRAM
PC: i7 4,3 Ghz, 32GB DDR3 RAM, GeForce 680 GTX 4GB VRAM
Win10 x64 Home/Prof
PB 5.30 (64bit)
Wohnort: Ansbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von KeyKon »

RSBasic hat geschrieben:Aber nach dem Bestätigen bleibt die Fläche schwarz und ich sehe nichts.
Genau wie bei mir, aber das ganze ist erst ab dem zweiten mal so gewesen.
Das erste mal Ausführen ging einwandfrei... (Bin auch am Laptop)

LG KeyKon
(\/) (°,,,°) (\/)
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: CamGadget - Module (windows only)

Beitrag von ts-soft »

Ich hab nur eine WebCam unter Windows, kann somit nicht viel mehr testen. Meine läuft über USB
und benötigt keinerlei Treiber (abgesehen von in Windows integrierten).
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von RSBasic »

Mit folgendem Code funktioniert es auch bei mir: http://www.purebasic.fr/english/viewtop ... bb#p370293
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: CamGadget - Module (windows only)

Beitrag von ts-soft »

RSBasic hat geschrieben:Mit folgendem Code funktioniert es auch bei mir: http://www.purebasic.fr/english/viewtop ... bb#p370293
Der einzige Unterschied ist, das die Rate auf 15 ms steht, in meinem Beispiel auf 30.
(vielleicht schaffen das eure CAMs nicht? (integrierter Sondermüll :mrgreen: ))
Einfach mal testen, ansonsten gibt es keinen Unterschied, abgesehen davon, das ich die Unicode-Version
der API aufrufe.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: CamGadget - Module (windows only)

Beitrag von RSBasic »

Als ich deinen Code einfach mal so getestet hab, hat es jetzt auf Anhieb funktioniert, aber beim zweiten Versuch nicht mehr. Auch das Setzen der Rate bringt nichts.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten