Click here to Skip to main content
15,868,016 members
Home / Discussions / Visual Basic
   

Visual Basic

 
QuestionText box auto takes serial no when items select form combo box Pin
GOBIND KUMAR SHARMA31-Aug-21 23:48
GOBIND KUMAR SHARMA31-Aug-21 23:48 
Rant[REPOST] Text box auto takes serial no when items select form combo box Pin
Richard Deeming1-Sep-21 0:06
mveRichard Deeming1-Sep-21 0:06 
QuestionWhat is the problem here? Pin
Member 1495490331-Aug-21 9:59
Member 1495490331-Aug-21 9:59 
AnswerRe: What is the problem here? Pin
Richard MacCutchan31-Aug-21 21:57
mveRichard MacCutchan31-Aug-21 21:57 
GeneralRe: What is the problem here? Pin
Richard Deeming31-Aug-21 22:50
mveRichard Deeming31-Aug-21 22:50 
QuestionHow to faster process export to excel row by row with excel formating Pin
Anton Setiawan 202124-Aug-21 18:33
Anton Setiawan 202124-Aug-21 18:33 
AnswerRe: How to faster process export to excel row by row with excel formating Pin
Richard Deeming24-Aug-21 21:37
mveRichard Deeming24-Aug-21 21:37 
QuestionBlank/Black webcam on newer model laptop running webcam program in VB.net Pin
nethelp1116-Aug-21 16:47
professionalnethelp1116-Aug-21 16:47 
I'm using "avicap32.dll" for my program which found on this website. However the webcam preview only works on older laptop built in webcam but display black/blank on newer model laptop.

Anyone has the solution to this? Been cracking my head for few months trying to solve it.

Attach below with my code:
VB.NET
  1  Imports System.IO
  2  Imports System.Threading
  3  Imports System.Diagnostics
  4  Imports System.Runtime.InteropServices
  5  
  6  Public Class frmTest
  7    Private Structure BITMAPINFOHEADER
  8      Dim biSize As Integer
  9      Dim biWidth As Integer
 10      Dim biHeight As Integer
 11      Dim biPlanes As Short
 12      Dim biBitCount As Short
 13      Dim biCompression As Integer
 14      Dim biSizeImage As Integer
 15      Dim biXPelsPerMeter As Integer
 16      Dim biYPelsPerMeter As Integer
 17      Dim biClrUsed As Integer
 18      Dim biClrImportant As Integer
 19    End Structure
 20  
 21    Private Structure BITMAPINFO
 22      Dim bmiHeader As BITMAPINFOHEADER
 23      Dim bmiColors() As Integer
 24    End Structure
 25  
 26    Const WM_CAP As Short = &H400S
 27    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
 28    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
 29    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
 30    Const WM_CAP_SET_VIDEOFORMAT = WM_CAP + 45
 31    Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
 32    Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
 33    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
 34  
 35    Const WS_CHILD As Integer = &H40000000
 36    Const WS_VISIBLE As Integer = &H10000000
 37    Const SWP_NOMOVE As Short = &H2S
 38    Const SWP_NOZORDER As Short = &H4S
 39    Const HWND_BOTTOM As Short = 1
 40  
 41    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, _
 42    ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
 43    ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
 44  
 45    Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
 46    (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
 47    ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
 48    ByVal nHeight As Short, ByVal hWndParent As Integer, _
 49    ByVal nID As Integer) As Integer
 50  
 51    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
 52        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
 53        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer
 54  
 55    Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
 56  
 57    Private iDevice As Integer = 0 ' Current device ID
 58    Private hHwnd As Integer '
 59  
 60    Private intSecurity As ENSECURITY
 61    Private m_strImage As String
 62    Private m_strFinger As String
 63    Private m_imageRawData() As Byte = Nothing
 64    Private m_strReader As String
 65  
 66   
 67  
 68  
 69    Public WriteOnly Property SetSecurity() As Integer
 70      Set(ByVal value As Integer)
 71        intSecurity = value
 72        If intSecurity = ENSECURITY.EN_READ Then
 73  
 74        End If
 75      End Set
 76    End Property
 77  
 78    
 79  
 80    Private Sub OpenPreviewWindow()
 81      Dim iHeight As Integer = pbPhoto.Height
 82      Dim iWidth As Integer = pbPhoto.Width
 83  
 84      '
 85      ' Open Preview window in picturebox
 86      '
 87      hHwnd = capCreateCaptureWindowA(iDevice.ToString, WS_VISIBLE Or WS_CHILD, 0, 0, 1280, _
 88          1024, pbPhoto.Handle.ToInt32, 0)
 89  
 90      '
 91      ' Connect to device
 92      '
 93      If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
 94        '
 95        'Set the preview scale
 96        '
 97        SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
 98  
 99        '
100        'Set the preview rate in milliseconds
101        '
102        SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
103  
104        '
105        'Start previewing the image from the camera
106        '
107        SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
108  
109        '
110        ' Resize window to fit in picturebox
111        '
112        SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, pbPhoto.Width, pbPhoto.Height, _
113                SWP_NOMOVE Or SWP_NOZORDER)
114  
115  
116  
117      Else
118        '
119        ' Error connecting to device close window
120        ' 
121        DestroyWindow(hHwnd)
122  
123      End If
124    End Sub
125  
126    Private Sub fncStart()
127      Try
128        File.Delete(Application.StartupPath & "\" & "Web.jpg")
129        If hHwnd = 0 Then
130          hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, pbPhoto.Width, pbPhoto.Height, pbPhoto.Handle.ToInt32, 0)
131        End If
132  
133        ' Connect to device
134        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
135          ' set the video size
136          Dim myBitMapInfo As BITMAPINFO
137          With myBitMapInfo.bmiHeader
138            .biSize = Len(myBitMapInfo.bmiHeader)
139            .biWidth = 1024
140            .biHeight = 768
141            .biPlanes = 1
142            .biBitCount = 24
143          End With
144  
145          SendMessage(hHwnd, WM_CAP_SET_VIDEOFORMAT, Len(myBitMapInfo), myBitMapInfo)
146          'Set the preview scale
147          SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
148          'Set the preview rate in milliseconds
149          SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
150          'Start previewing the image from the camera
151          SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
152          ' Resize window to fit in picturebox
153          SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, pbPhoto.Width, pbPhoto.Height, SWP_NOMOVE Or SWP_NOZORDER)
154  
155        Else
156          ' Error connecting to device close window
157          DestroyWindow(hHwnd)
158        End If
159      Catch ex As Exception
160  
161      End Try
162  
163    End Sub
164  
165    Private Sub ClosePreviewWindow()
166      '
167      ' Disconnect from device
168      '
169      SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
170  
171      '
172      ' close window
173      '
174  
175      DestroyWindow(hHwnd)
176    End Sub
177  
178    Private Sub fncCapture()
179      Dim data As IDataObject
180      Dim bmap As Bitmap
181      Dim strImageFileName As String
182      Dim fsImage As FileStream = Nothing
183      '
184      ' Copy image to clipboard
185      '
186      SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
187  
188      '
189      ' Get image from clipboard and convert it to a bitmap
190      '
191      data = Clipboard.GetDataObject()
192      If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
193        strImageFileName = Application.StartupPath & "\" & "Web.jpg"
194        bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Bitmap)
195        pbPhoto.Image = bmap
196  
197        ClosePreviewWindow()
198  
199        Trace.Assert(Not (bmap Is Nothing))
200  
201        bmap.Save(strImageFileName, Imaging.ImageFormat.Jpeg)
202  
203        pbPhoto.ImageLocation = strImageFileName
204        fsImage = New FileStream(strImageFileName, FileMode.Open, FileAccess.Read)
205        m_imageRawData = New Byte(fsImage.Length) {}
206        fsImage.Read(m_imageRawData, 0, fsImage.Length)
207        fsImage.Close()
208  
209      End If
210      hHwnd = Nothing
211    End Sub
212  
213    
214  
215    Private Sub frmTest_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
216      Dim retval As Int32
217      Dim readers(-1)() As Char
218      Try
219  
220   
221  
222        retval = GetReaders(readers)
223        'If retval = SCARD_E_NO_SERVICE Then
224        '    MessageBox.Show("Smart Card service not started")
225        '    Exit Sub
226        'ElseIf retval = SCARD_E_NO_READERS_AVAILABLE Then
227        '    MessageBox.Show("No readers available")
228        '    Exit Sub
229        'ElseIf retval <> 0 Then
230        '    MessageBox.Show("Error listing reader")
231        '    Exit Sub
232        'End If
233        m_strReader = CStr(readers(0))
234        If txtName.CanFocus Then txtName.Focus()
235  
236  
237      Catch ex As Exception
238        cmdMyKad.Visible = False
239        'MessageBox.Show(ex.Message)
240      End Try
241    End Sub
242  
243   
244  
245  
246    Private Sub pbPhoto_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbPhoto.Resize
247      fncStart()
248    End Sub


modified 17-Aug-21 3:45am.

AnswerRe: Blank/Black webcam on newer model laptop running webcam program in VB.net Pin
Richard MacCutchan16-Aug-21 21:46
mveRichard MacCutchan16-Aug-21 21:46 
AnswerRe: Blank/Black webcam on newer model laptop running webcam program in VB.net Pin
Eddy Vluggen17-Aug-21 1:38
professionalEddy Vluggen17-Aug-21 1:38 
QuestionOdd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher6-Aug-21 4:02
Peter R. Fletcher6-Aug-21 4:02 
AnswerRe: Odd Transparency behavior in VB.Net Panel Pin
Dave Kreskowiak6-Aug-21 5:02
mveDave Kreskowiak6-Aug-21 5:02 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher6-Aug-21 5:49
Peter R. Fletcher6-Aug-21 5:49 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Dave Kreskowiak6-Aug-21 6:16
mveDave Kreskowiak6-Aug-21 6:16 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher6-Aug-21 6:31
Peter R. Fletcher6-Aug-21 6:31 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher6-Aug-21 8:27
Peter R. Fletcher6-Aug-21 8:27 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Dave Kreskowiak6-Aug-21 13:25
mveDave Kreskowiak6-Aug-21 13:25 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher7-Aug-21 3:45
Peter R. Fletcher7-Aug-21 3:45 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Dave Kreskowiak7-Aug-21 5:14
mveDave Kreskowiak7-Aug-21 5:14 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher7-Aug-21 9:10
Peter R. Fletcher7-Aug-21 9:10 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Dave Kreskowiak7-Aug-21 9:40
mveDave Kreskowiak7-Aug-21 9:40 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher7-Aug-21 9:59
Peter R. Fletcher7-Aug-21 9:59 
AnswerRe: Odd Transparency behavior in VB.Net Panel Pin
Gerry Schmitz6-Aug-21 6:52
mveGerry Schmitz6-Aug-21 6:52 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Peter R. Fletcher6-Aug-21 8:14
Peter R. Fletcher6-Aug-21 8:14 
GeneralRe: Odd Transparency behavior in VB.Net Panel Pin
Gerry Schmitz6-Aug-21 8:46
mveGerry Schmitz6-Aug-21 8:46 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.