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