Can any one help me to click on a web page using cursor coordinates.
Tip: Button don't have ID & name
Here is an example of moving the mouse and clicking using mouse_event:
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Private Const MOUSEEVENTF_WHEEL = &H800 ' wheel button rolled
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Type POINTAPI
x As Long
y As Long
End Type
Sub Click()
Dim pt As POINTAPI
Dim x As Long
Dim y As Long
'(0,0) = top left
'(65535,65535) = bottom right
x = 65535 / 2
y = 65535 / 2
LeftClick x, y
End Sub
Sub LeftClick(x As Long, y As Long)
'Move mouse
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, x, y, 0, 0
'Press left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
'Release left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Related
I am creating a simple program, using Excel VBA, that will allow me to resize a control at run-time as the mouse moves or on mouse drag. However, it seems that I'm getting a different result
I'm not sure why I am getting a different final width result, but here's how I'm doing it:
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
initialx = X
initialy = Y
xmove = True
End Sub
Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
Dim newx, newy As Single
If xmove = True Then
newx = Math.Abs(X - initialx)
newy = Math.Abs(Y - initialy)
TextBox1.Width = TextBox1.Width + newx
End If
End Sub
And here's how my form looks like:
As you can see in the screenshot, the width of the TextBox should increase by 9 as it is the distance covered by the mouse cursor from the mouse cursor initial click(location) on the control.
And I'm stuck with this. Why isn't it working as expected?
It's needs Global variable initialWidth.
Dim initialX, initialY, xmove, initialWidth
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As _
Integer, ByVal X As Single, ByVal Y As Single)
initialX = X
initialY = Y
initialWidth = TextBox1.Width '<~~setting initialWidth
xmove = True
TextBox2.Value = initialX
TextBox3.Value = initialY
End Sub
Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As _
Integer, ByVal X As Single, ByVal Y As Single)
Dim newx, newy As Single
If xmove = True Then
newx = Math.Abs(X - initialX)
newy = Math.Abs(Y - initialY)
'TextBox1.Width = TextBox1.Width + newx
TextBox1.Width = initialWidth + newx
TextBox5.Value = newx
TextBox6.Value = newy
End If
End Sub
This question may have been asked before but im just starting out with VB.Net and was given this application to fix that uses the webcam of the pc/ tablet but I cant figure out the pinvoke error
here is my code:
Imports System.IO
Public Class frm
CaptureWebCam
Const CAP As Short = &H400S
Const CAP_DRIVER_CONNECT As Integer = CAP + 10
Const CAP_DRIVER_DISCONNECT As Integer = CAP + 11
Const CAP_EDIT_COPY As Integer = CAP + 30
Const CAP_SET_PREVIEW As Integer = CAP + 50
Const CAP_SET_PREVIEWRATE As Integer = CAP + 52
Const CAP_SET_SCALE As Integer = CAP + 53
Const WS_CHILD As Integer = &H40000000
Const WS_VISIBLE As Integer = &H10000000
Const SWP_NOMOVE As Short = &H2S
Const SWP_NOSIZE As Short = 1
Const SWP_NOZORDER As Short = &H4S
Const HWND_BOTTOM As Short = 1
Dim iDevice As Integer = 0 ' Normal device ID
Dim hHwnd As Integer ' Handle value to preview window
Public image_base64String As String
' Declare function from AVI capture DLL.
Declare Auto Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Object) As Integer
Declare Auto Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Declare Auto Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
Declare Auto Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
Private Sub OpenForm()
Dim iHeight As Integer = picCapture.Height
Dim iWidth As Integer = picCapture.Width
' Open Preview window in picturebox .
' Create a child window with capCreateCaptureWindowA so you can display it in a picturebox.
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 600, 480, picCapture.Handle, IntPtr.Zero)
' Connect to device
If SendMessage(hHwnd, CAP_DRIVER_CONNECT, iDevice, IntPtr.Zero) Then
' Set the preview scale
SendMessage(hHwnd, CAP_SET_SCALE, True, IntPtr.Zero)
' Set the preview rate in milliseconds
SendMessage(hHwnd, CAP_SET_PREVIEWRATE, 66, IntPtr.Zero)
' Start previewing the image from the camera
SendMessage(hHwnd, CAP_SET_PREVIEW, True, IntPtr.Zero)
' Resize window to fit in picturebox
SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
Else
' Error connecting to device close window
DestroyWindow(hHwnd)
End If
End Sub
Private Function btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCapture.Click
Dim data As IDataObject
Dim bmap As Image
' Copy image to clipboard
SendMessage(hHwnd, CAP_EDIT_COPY, 0, 0)
' Get image from clipboard and convert it to a bitmap
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
picCapture.Image = bmap
Dim saveFileDialog1 As New SaveFileDialog()
saveFileDialog1.Filter = "Jpeg Image|*.jpg|Bitmap Image|*.bmp|Gif Image|*.gif"
saveFileDialog1.Title = "Save an Image File"
saveFileDialog1.FileName = "Image001"
If saveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
' If the file name is not an empty string open it for saving.
If saveFileDialog1.FileName <> "" Then
' Saves the Image via a FileStream created by the OpenFile method.
Dim fs As System.IO.FileStream = CType(saveFileDialog1.OpenFile(), System.IO.FileStream)
picCapture.Image.Save(fs, System.Drawing.Imaging.ImageFormat.Jpeg)
fs.Close()
End If
End If
End If
End Function
Public Function getImage() As String
Dim bmap As Image
Dim ms As New MemoryStream
bmap.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
Dim bytes() As Byte = ms.ToArray
' Dim image_base64String As String = Convert.ToBase64String(bytes)
image_base64String = Convert.ToBase64String(bytes)
'MsgBox(image_base64String)
Return image_base64String
End Function
Private Sub frmcap_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Leave
' Disconnect from device
SendMessage(hHwnd, CAP_DRIVER_DISCONNECT, iDevice, 0)
' close window
DestroyWindow(hHwnd)
End Sub
Private Sub frmCaptureWebCam_Load(sender As Object, e As EventArgs) Handles MyBase.Load
OpenForm()
End Sub
End Class
you will notice that I'm also trying to return the image via the image_base64 variable
Can someone help me with the code as I get the following error:
PInvokeStackImbalance was detected
Message: A call to PInvoke function
'GCOS3_Mobile_Host_Application!GCOS3_Mobile_Host_Application.frmCaptureWebCam::SendMessage'
has unbalanced the stack. This is likely because the managed PInvoke
signature does not match the unmanaged target signature. Check that
the calling convention and parameters of the PInvoke signature match
the target unmanaged signature.
SendMessage declaration according to pinvoke should be like this
Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Also see the tips for Overloads there.
In your code you have declared lParam, which provides additional message-specific information, as object.
And you are passing IntPtr.Zero, so I think using ByVal lParam As IntPtr will be more specific.
I used the emgu library and got it to return the base 64 string:
Imports Emgu.CV
Imports Emgu.CV.Util
Imports System.IO
Public Class frmEmguCapture
Private imagecapture As Capture
Private imageCaptureReady As Boolean = False
Public b64 As String
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles tmrUpdateImage.Tick
tmrUpdateImage.Enabled = False
If imageCaptureReady Then
pbWebCamStream.Visible = True
lblConnecting.Visible = False
btnCapture.Enabled = True
pbWebCamStream.Image = imagecapture.QueryFrame.Bitmap
tmrUpdateImage.Enabled = True
Else
MessageBox.Show("Error connecting to camera.", "Error conecting to camera.", MessageBoxButtons.OK, MessageBoxIcon.Error)
Me.Close()
End If
End Sub
Public Function btnCapture_Click(sender As Object, e As EventArgs) Handles btnCapture.Click
tmrUpdateImage.Enabled = False
pbWebCamStream.Visible = True
lblConnecting.Visible = False
btnCapture.Enabled = True
pbWebCamStream.Image = imagecapture.QueryFrame.Bitmap
Dim bmap As Image
bmap = imagecapture.QueryFrame.Bitmap
Dim ms As New MemoryStream
bmap.Save(ms, System.Drawing.Imaging.ImageFormat.Jpeg)
Dim bytes() As Byte = ms.ToArray
Dim image_base64String As String = Convert.ToBase64String(bytes)
image_base64String = Convert.ToBase64String(bytes)
b64 = image_base64String
imagecapture.Dispose()
Me.Close()
'MsgBox(image_base64String)
Return image_base64String
End Function
Private Sub frmEmguCapture_Load(sender As Object, e As EventArgs) Handles MyBase.Load
tmrLoad.Enabled = True
End Sub
Private Sub tmrLoad_Tick(sender As Object, e As EventArgs) Handles tmrLoad.Tick
tmrLoad.Enabled = False
Try
imagecapture = New Capture
imageCaptureReady = True
tmrUpdateImage.Enabled = True
Catch ex As Exception
MessageBox.Show("Error connecting to camera.", "Error conecting to camera.", MessageBoxButtons.OK, MessageBoxIcon.Error)
Me.Close()
End Try
End Sub
End Class
I am trying to create labels which have all four corners rounded, the label is being created programatically as seen below:
Dim lbl1 As Label = New Label()
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
How would I switch from the square corners to a more XP styled rounding.
Imports System.Runtime.InteropServices
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
ex.)
Imports System.Runtime.InteropServices
Public Class Form1
<DllImport("Gdi32.dll", EntryPoint:="CreateRoundRectRgn")> _
Private Shared Function CreateRoundRectRgn(ByVal iLeft As Integer, ByVal iTop As Integer, ByVal iRight As Integer, ByVal iBottom As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer) As IntPtr
End Function
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim newid$ = "mylabel"
Dim lbl1 As Label = New Label()
With lbl1
lbl1.AutoSize = False 'allow resizing
lbl1.BackColor = Color.Yellow
lbl1.Text = newid
lbl1.Height = 46
lbl1.Width = 42
lbl1.Padding = New Padding(1, 1, 1, 1)
lbl1.Region = System.Drawing.Region.FromHrgn(CreateRoundRectRgn(2, 2, lbl1.Width - 2, lbl1.Height - 2, 5, 1))
End With
Me.Controls.Add(lbl1)
End Sub
End Class
Hello i have this code which i got from another forum.
Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.Runtime.InteropServices
Public Class mainform
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Private Structure APPBARDATA
Public cbSize As Integer
Public hWnd As IntPtr
Public uCallbackMessage As Integer
Public uEdge As Integer
Public rc As RECT
Public lParam As IntPtr
End Structure
Private Enum ABMsg As Integer
ABM_NEW = 0
ABM_REMOVE = 1
ABM_QUERYPOS = 2
ABM_SETPOS = 3
ABM_GETSTATE = 4
ABM_GETTASKBARPOS = 5
ABM_ACTIVATE = 6
ABM_GETAUTOHIDEBAR = 7
ABM_SETAUTOHIDEBAR = 8
ABM_WINDOWPOSCHANGED = 9
ABM_SETSTATE = 10
End Enum
Private Enum ABNotify As Integer
ABN_STATECHANGE = 0
ABN_POSCHANGED
ABN_FULLSCREENAPP
ABN_WINDOWARRANGE
End Enum
Private Enum ABEdge As Integer
ABE_LEFT = 0
ABE_TOP
ABE_RIGHT
ABE_BOTTOM
End Enum
Private fBarRegistered As Boolean = False
Private Declare Function SHAppBarMessage Lib "shell32.dll" Alias "SHAppBarMessage" _
(ByVal dwMessage As Integer, <MarshalAs(UnmanagedType.Struct)> ByRef pData As _
APPBARDATA) As Integer
Private Declare Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" _
(ByVal nIndex As Integer) As Integer
Private Declare Function MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwnd As
Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As
Integer, _
ByVal bRepaint As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" _
(ByVal lpString As String) As Integer
Private uCallBack As Integer
Private Sub mainform_FormClosing(ByVal sender As Object, ByVal e As
System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
RegisterBar()
End Sub
Private Sub appBar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(600, 960)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
RegisterBar()
Me.Invalidate()
End Sub
Private Sub mainform_Paint(ByVal sender As Object, ByVal e As
System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, Me.Width, 0)
e.Graphics.DrawLine(New Pen(Color.White, 3), 0, 0, 0, Me.Height)
e.Graphics.DrawLine(New Pen(Color.Black, 3), 0, Me.Height - 3, Me.Width, Me.Height
- 3)
e.Graphics.DrawLine(New Pen(Color.Black, 3), Me.Width - 3, 0, Me.Width - 3,
Me.Height)
End Sub
Private Sub RegisterBar()
Dim abd As New APPBARDATA
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
If Not fBarRegistered Then
uCallBack = RegisterWindowMessage("AppBarMessage")
abd.uCallbackMessage = uCallBack
Dim ret As Integer = SHAppBarMessage(CType(ABMsg.ABM_NEW, Integer), abd)
fBarRegistered = True
ABSetPos()
Else
SHAppBarMessage(CType(ABMsg.ABM_REMOVE, Integer), abd)
fBarRegistered = False
End If
End Sub
Private Sub ABSetPos()
Dim abd As New APPBARDATA()
abd.cbSize = Marshal.SizeOf(abd)
abd.hWnd = Me.Handle
abd.uEdge = CInt(ABEdge.ABE_RIGHT)
If abd.uEdge = CInt(ABEdge.ABE_LEFT) OrElse abd.uEdge = CInt(ABEdge.ABE_RIGHT) Then
abd.rc.top = 0
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
If abd.uEdge = CInt(ABEdge.ABE_LEFT) Then
abd.rc.left = 0
abd.rc.right = Size.Width
Else
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
abd.rc.left = abd.rc.right - Size.Width
End If
Else
abd.rc.left = 0
abd.rc.right = SystemInformation.PrimaryMonitorSize.Width
If abd.uEdge = CInt(ABEdge.ABE_TOP) Then
abd.rc.top = 0
abd.rc.bottom = Size.Height
Else
abd.rc.bottom = SystemInformation.PrimaryMonitorSize.Height
abd.rc.top = abd.rc.bottom - Size.Height
End If
End If
' Query the system for an approved size and position.
SHAppBarMessage(CInt(ABMsg.ABM_QUERYPOS), abd)
' Adjust the rectangle, depending on the edge to which the
' appbar is anchored.
Select Case abd.uEdge
Case CInt(ABEdge.ABE_LEFT)
abd.rc.right = abd.rc.left + Size.Width
Exit Select
Case CInt(ABEdge.ABE_RIGHT)
abd.rc.left = abd.rc.right - Size.Width
Exit Select
Case CInt(ABEdge.ABE_TOP)
abd.rc.bottom = abd.rc.top + Size.Height
Exit Select
Case CInt(ABEdge.ABE_BOTTOM)
abd.rc.top = abd.rc.bottom - Size.Height
Exit Select
End Select
' Pass the final bounding rectangle to the system.
SHAppBarMessage(CInt(ABMsg.ABM_SETPOS), abd)
' Move and size the appbar so that it conforms to the
' bounding rectangle passed to the system.
MoveWindow(abd.hWnd, abd.rc.left, abd.rc.top, abd.rc.right - abd.rc.left,
abd.rc.bottom - abd.rc.top, True)
End Sub
Protected Overloads Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = uCallBack Then
Select Case m.WParam.ToInt32()
Case CInt(ABNotify.ABN_POSCHANGED)
ABSetPos()
Exit Select
End Select
End If
MyBase.WndProc(m)
End Sub
Protected Overloads Overrides ReadOnly Property CreateParams() As
System.Windows.Forms.CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.Style = cp.Style And (Not 12582912)
' WS_CAPTION
cp.Style = cp.Style And (Not 8388608)
' WS_BORDER
cp.ExStyle = 128 Or 8
' WS_EX_TOOLWINDOW | WS_EX_TOPMOST
Return cp
End Get
End Property
End Class
and what i want to do is maybe put it in a .dll file or separate class so i don't have to make my form1's code enormous. and example may be
Public Class Docker
'all the appBar code can go here
End Class
Private Sub appBar_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles MyBase.Load
Docker.enabled = true
End Sub
i don't know how to do this at all so if you could please give me a detailed example that would be great thankyou :)
In your solution explorer right click solution>>add new project>>select class library project
Then build the new project (after you've added the class up there)
In the UI project (where your form exists) right click >> add reference >> projects tab >> select the dll project
Now you can see your class in the form, but don't forget to import the dll project
Import YourDLLProject
Create an empty form "MyForm" that use this code, and then inherit all your other forms from MyForm
How do I print the contents of a panel in vb.net, VS-2010 Winform.
I tried the code provided here but for some reason its not working.
I am trying to print the Form inside the panel
Declare Auto Function SendMessage Lib "user32" ( _
ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByVal lParam As Integer) As Integer
Private Enum EDrawingOptions As Integer
PRF_CHECKVISIBLE = &H1
PRF_NONCLIENT = &H2
PRF_CLIENT = &H4
PRF_ERASEBKGND = &H8
PRF_CHILDREN = &H10
PRF_OWNED = &H20
End Enum
Private Function PrintPanel()
Const WM_PRINT As Integer = &H317
Dim myBmp As Bitmap
Dim myGraphics As Graphics
Dim hdc As System.IntPtr
myBmp = New Bitmap( _
Me.FormsDispPanel.DisplayRectangle.Width, _
Me.FormsDispPanel.DisplayRectangle.Height)
myGraphics = Graphics.FromImage(myBmp)
myGraphics.DrawRectangle(Pens.White, New Rectangle(0, 0,
Me.FormsDispPanel.DisplayRectangle.Width, Me.FormsDispPanel.DisplayRectangle.Height))
hdc = myGraphics.GetHdc
'"FormsDispPanel" is your PAnel to print
Call SendMessage(FormsDispPanel.Handle, WM_PRINT, hdc, _
EDrawingOptions.PRF_CHILDREN Or _
EDrawingOptions.PRF_CLIENT Or _
EDrawingOptions.PRF_NONCLIENT Or _
EDrawingOptions.PRF_OWNED)
myGraphics.ReleaseHdc(hdc)
myBmp.Save("d:\out.bmp")
myGraphics.Dispose()
myGraphics = Nothing
myBmp = Nothing
End Function