PDA

View Full Version : Can't have a form



JStack
December 26, 2006, 16:16:07
I want to use the ICImagingControl, and I will handle all buffering/rotating/displaying myself.
(I have verified my functions against the ICImagingControl in a small test project and it works fine with the control on a form)

In the actual project, there will be no form on which to put the Imaging control.
Instead I need to encapsulate the functionality of the camera in a VB6 class to be compatible with the others video sources I am using.

What are my options?

/Johan Stäck

Johannes Vogel
December 29, 2006, 13:07:43
Hello,

here is a code sample that shows how to create an instance of the OCX dynamically without a form:

Option Explicit
Dim IC As Object

Private Sub Form_Load()
Dim ob As OverlayBitmap
Set IC = CreateObject("IC.ICImagingControl")

IC.ShowDeviceSettingsDialog
If IC.DeviceValid Then
Set ob = IC.OverlayBitmap
ob.Enable = True
ob.DropOutColor = RGB(255, 0, 255)
ob.Fill ob.DropOutColor
ob.FontTransparent = True
ob.DrawText RGB(255, 0, 0), 10, 10, "IC Imaging Control 3.0"

IC.LiveStart
End If
End Sub

JStack
December 29, 2006, 22:48:12
Johannes,

I tried it as shown, but Createobject consistently fails with an error 429 "Active/X component can't create object".

Are there any prerequisites that I am not aware of?

/Johan

JStack
December 30, 2006, 18:03:25
I continued experimenting and finally managed to get the control running without placing it on a form.
This is a complete printout of a working albeit crude program that initiates an Imaging control and handles the displaying itself...


Option Explicit
Private WithEvents obj_IC As ICImagingControl
Private hdd As Long
Private Declare Function DrawDibDraw Lib "msvfw32.dll" (ByVal hdd As Long, ByVal hDC As Long, _
ByVal xDst As Long, ByVal yDst As Long, ByVal dxDst As Long, ByVal dyDst As Long, _
lpbi As Any, lpBits As Any, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal dxSrc As Long, ByVal dySrc As Long, _
ByVal wFlags As Long) As Long

Private Declare Function DrawDibOpen Lib "msvfw32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal millisec As Long)

Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private bm As BITMAPINFOHEADER
Private CurrentBuffer As ImageBuffer

Private Sub Cmd_start_Click()
obj_IC.LiveStart
End Sub

Private Sub Cmd_stop_Click()
obj_IC.LiveStop
End Sub

Private Sub Form_Load()
Set obj_IC = New ICImagingControl
obj_IC.Device = "DFx 21AF04"
obj_IC.VideoFormat = "UYVY (640x480)"
obj_IC.DeviceFrameRate = CDbl(30.00003)
obj_IC.LiveDisplay = False
obj_IC.ExposureAuto = True
obj_IC.ImageRingBufferSize = 1
obj_IC.LiveCaptureLastImage = False
obj_IC.LiveCaptureContinuous = True
Debug.Print Time & "Device = " & obj_IC.Device
Debug.Print Time & "Videoformat = " & obj_IC.VideoFormat
Debug.Print Time & "DeviceFrameRate = " & obj_IC.DeviceFrameRate
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set obj_IC = Nothing
End Sub

Private Sub item_exit_Click()
Cmd_stop_Click
Unload Me
End Sub

Private Sub obj_IC_DeviceLost()
Debug.Print Time & "*obj_IC_DeviceLost"
End Sub

Private Sub obj_IC_ImageAvailable(ByVal BufferIndex As Long)
'Debug.Print Time & "*obj_IC_ImageAvailable"
Set CurrentBuffer = obj_IC.ImageBuffers(BufferIndex)
bm.biCompression = 0
bm.biBitCount = 24
bm.biClrImportant = 0
bm.biClrUsed = 0
bm.biHeight = CurrentBuffer.FrameType.Height
bm.biPlanes = 1
bm.biSize = 40
bm.biSizeImage = CurrentBuffer.FrameType.Buffersize
bm.biWidth = CurrentBuffer.FrameType.Width
bm.biXPelsPerMeter = 0
bm.biYPelsPerMeter = 0
If hdd = 0 Then
hdd = DrawDibOpen()
End If
Dim res As Long
res = DrawDibDraw(hdd, Picture1.hDC, 0, 0, 640, 480, bm, ByVal CurrentBuffer.ImageDataPtr, 0, 0, 640, 480, 0)
Debug.Assert (res)
Picture1.Refresh
End Sub