Does anyone know how to change the kerning (space between characters) in vb.net? For example, i would like to change "STRING" to "S T R I N G". If possible i would like to be able to create my own font where i can specify the kerning as i wish! Thanks in advance!
The only way I found is to P/Invoke. Assumming a generic form with a generic button this code will work.
Imports System.Runtime.InteropServices
Public Class Form1
Declare Function SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtra" (ByVal hDC As Integer, ByVal nCharExtra As Integer) As Integer
<DllImport("gdi32")> _
Private Shared Function TextOut(ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal textstring As String, ByVal charCount As Integer) As Boolean
End Function
<DllImport("gdi32")> _
Private Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hgdiobj As IntPtr) As IntPtr
End Function
<DllImport("gdi32")> _
Private Shared Function DeleteObject(ByVal objectHandle As IntPtr) As Boolean
End Function
<DllImport("gdi32")> _
Private Shared Function SetBkColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
End Function
<DllImport("gdi32")> _
Private Shared Function SetTextColor(ByVal hdc As IntPtr, ByVal crColor As Integer) As UInt32
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Using G = Graphics.FromHwnd(Me.Handle)
Using myFont As New System.Drawing.Font("Arial", 20, FontStyle.Regular, GraphicsUnit.Pixel)
'Regular Way
Dim LeftEdge = 20
G.DrawString("Hello", myFont, Brushes.Red, LeftEdge, 40)
'If you want kerning
Dim Kerning As Integer = 6 'I think this is twips
Dim Hdc As IntPtr
Dim FontPtr As IntPtr
Try
'Grab the Graphic object's handle
Hdc = G.GetHdc()
'Set the current GDI font
FontPtr = SelectObject(Hdc, myFont.ToHfont())
'Set the drawing surface background color
SetBkColor(Hdc, ColorTranslator.ToWin32(Me.BackColor))
'Set the text color
SetTextColor(Hdc, ColorTranslator.ToWin32(Color.Red))
'Set the kerning
SetTextCharacterExtra(Hdc, Kerning)
Dim Text = "Hello"
'Draw the text at (20,60), Kerning will be applied so reset the left edge to half of kerning
TextOut(Hdc, LeftEdge + (Kerning \ 2), 60, Text, Text.Length)
Catch ex As Exception
Finally
'Release the font
DeleteObject(FontPtr)
'Release the handle on the graphics object
G.ReleaseHdc()
End Try
End Using
End Using
End Sub
End Class
You can use CSS.
I usually set the letter-spacing style attribute in my aspx page.
Related
I'm making a text editor application using vb2010 WinForm. Instead of scrolling with scrollbar, users can scroll directly on the richtextbox with the mouse, similar to adobe acrobat reader. To scroll richtextbox programatically I'm using SendMessage user32 API.
I have two problems:
If the text in richtextbox is big and I scrolled near the end of integer value then scrollbar will scroll back to its initial position.
The scrollbar value that has been set using SendMessage is not the same when we read it later with GetScrollPos. As a result, when I dragged the text using mouse, the richtextbox does not scroll smoothly at the beginning, it's jump.
Here's what I've done:
Public Class Form1
Dim StartMouseDownPos As New Point
Dim StartScrollBarPos As New Point
Const WM_USER = &H400
Const EM_GETSCROLLPOS = WM_USER + 221
Const EM_SETSCROLLPOS = WM_USER + 222
Public Declare Auto Function RtfScroll Lib "user32.dll" Alias "SendMessage" ( _
ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByRef lParam As System.Drawing.Point) As Integer
Private Sub RichTextBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseDown
'Capture the initial mouse position
StartMouseDownPos.X = e.X
StartMouseDownPos.Y = e.Y
'Capture the initial scrollbar position
RtfScroll(RichTextBox1.Handle, EM_GETSCROLLPOS, 0, StartScrollBarPos)
End Sub
Private Sub RichTextBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseMove
'Verify left button is pressed while the mouse is moving
If e.Button = Windows.Forms.MouseButtons.Left Then
'Prevent the text in RichTextBox1 to be unintentionally selected when user dragged the text while the cursor shape at that moment is a hand.
ActiveControl = Nothing
NewScrollBarPos.X = StartScrollBarPos.X + (StartMouseDownPos.X - e.X)
NewScrollBarPos.Y = StartScrollBarPos.Y + (StartMouseDownPos.Y - e.Y)
RtfScroll(RichTextBox1.Handle, EM_SETSCROLLPOS, 0, NewScrollBarPos)
End If
End Sub
I tried to change the problematic statement above: RtfScroll(RichTextBox1.Handle, EM_SETSCROLLPOS, 0, NewScrollBarPos) with the following:
Public Declare Function GetScrollPos Lib "user32.dll" ( _
ByVal hWnd As IntPtr, _
ByVal nBar As Integer) As Integer
Public Declare Function SetScrollPos Lib "user32.dll" ( _
ByVal hWnd As IntPtr, _
ByVal nBar As Integer, _
ByVal nPos As Integer, _
ByVal bRedraw As Boolean) As Integer
Public Declare Function PostMessageA Lib "user32.dll" ( _
ByVal hwnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Boolean
'Scroll the horizontal scrollbar according to the drag of the mouse
SetScrollPos(RichTextBox1.Handle, SBS_HORZ, NewScrollBarPos.X, True)
SetScrollPos(RichTextBox1.Handle, SBS_VERT, NewScrollBarPos.Y, True)
'Scroll the text according to the drag of the mouse
PostMessageA(RichTextBox1.Handle, WM_HSCROLL, SB_THUMBPOSITION + &H10000 * GetScrollPos(RichTextBox1.Handle, SBS_HORZ), Nothing)
PostMessageA(RichTextBox1.Handle, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * GetScrollPos(RichTextBox1.Handle, SBS_VERT), Nothing)
The result is even worse: an overflow exception raised at multiplication of &H10000 * GetScrollPos(RichTextBox1.Handle, SBS_HORZ), Nothing), that happen when I tried to scroll beyond integer value.
So, my question is how to solve these two problems?
I've made a small program to find out what the cause of my problem, and it turns out that the problem is this: RtfScroll function alias "SendMessage" which uses Point as input doesn't get or set the correct value. This doesn't happen to GetScrollPos, SetScrollPos, and PostMessageA.
So, don't use a combination of RtfScroll(RichTextBox1.Handle, EM_SETSCROLLPOS, 0, New Point(countX, countY)) & RtfScroll(RichTextBox1.Handle, EM_GETSCROLLPOS, 0, point).
Just use a combination of GetScrollPos, SetScrollPos, and PostMessageA.
I'm trying to use a PrivateFontCollection for my application, so it can print a document with a specific font. note that i can not "install" the font as the Windows directory is admin protected.
The code I have works, in the sense that provided I close my application, and restart it, when i restart it, it will recognise that the font is there and can be used. But if I click the command button to install the font as a privatefontcollection, and then refresh my PrintDocument, it does not show it using the newly installed font. I have to close the app and open it, and then it does.
Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
End Function
<DllImport("user32.dll")>
Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True)>
Public Shared Function SendMessageTimeout(ByVal hWnd As IntPtr,
ByVal msg As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr,
ByVal flags As SendMessageTimeoutFlags,
ByVal timeout As Integer,
ByRef result As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Public Shared Function SendNotifyMessage(
ByVal hWnd As IntPtr,
ByVal msg As UInteger,
ByVal wParam As UIntPtr,
ByVal lParam As IntPtr
) As Boolean
End Function
<Flags()>
Public Enum SendMessageTimeoutFlags
SMTO_NORMAL = 0
SMTO_BLOCK = 1
SMTO_ABORTIFHUNG = 2
SMTO_NOTIMEOUTIFNOTHUNG = 8
End Enum
Private Sub RibbonButton1_Click(sender As Object, e As EventArgs) Handles RibbonButton1.Click
Try
If IsFontInstalled("Open Sans ExtraBold") = False Then
Dim Fonts_Source As String = Path.Combine(Application.StartupPath, "Resources\OpenSans-ExtraBold.ttf")
Dim Fonts_Install As String = My.Computer.FileSystem.CombinePath(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "OpenSans-ExtraBold.ttf")
Dim Ret As Integer
Dim Res As Integer
Dim FontPath As String
Const WM_FONTCHANGE As Integer = &H1D
Const HWND_BROADCAST As Integer = &HFFFF
FontPath = Fonts_Install.ToString
Ret = AddFontResource(Fonts_Source.ToString)
Res = SendMessageTimeout(HWND_BROADCAST, WM_FONTCHANGE, IntPtr.Zero, IntPtr.Zero,
SendMessageTimeoutFlags.SMTO_ABORTIFHUNG Or
SendMessageTimeoutFlags.SMTO_NOTIMEOUTIFNOTHUNG,
5000, IntPtr.Zero)
Ret = WriteProfileString("Fonts", Path.GetFileName(FontPath) & " (TrueType)", FontPath.ToString)
End If
Catch ex As Exception
MsgBox("Error: " & ex.Message)
End Try
End Sub
This next subroutine is the one that draws the document. I have a function to check if the font is installed, and if its not then the an alternative font is used.
Dim TitleFont As New Font("Segoe UI Black", Font48Pt, FontStyle.Bold)
If IsFontInstalled("Open Sans ExtraBold") = True Then TitleFont = New Font("Open Sans ExtraBold", Font48Pt)
If Title <> "Everyday" Then
'TITLE TEXT DRAWN
Dim TitleRect As RectangleF = New RectangleF()
TitleRect.Location = New Point(20, 25)
TitleRect.Size = New Size(DrawWidth, CInt(e.Graphics.MeasureString(Title, TitleFont, DrawWidth, CenterAlignment).Height))
e.Graphics.DrawString(Title, TitleFont, ForeColourBrush, TitleRect, CenterAlignment)
End If
the function that checks if the font is installed.
Public Function IsFontInstalled(ByVal FontName As String) As Boolean
Using TestFont As Font = New Font(FontName, 10)
Return CBool(String.Compare(FontName, TestFont.Name, StringComparison.InvariantCultureIgnoreCase) = 0)
End Using
End Function
this function above could be the problem as it returns false. mind you if I close the app and restart it, then this same function will then detect the privatefontcollection and return true, and I can successfully print my document with my font.
I did try adding the install font subroutine, to the very start of my app. then raising a flag if a font was installed and then tried to call the Application.Restart() method, so that while the splash screen was up it could install the font, then immediately restart the app, which of course would then latch onto the installed font, but this method just left the app in a loop of opening and closing.
I have a WinForm application developed in Framework 2.0 with VB.Net which was using the event MouseMove on all the ListView objects to display ToolTip text on the first row of the ListViews - as it's not possible to have ToolTips on ColumnHeader, as far as I know, without third part tools.
The problem is that since I converted the application to Framework 4.0 this "trick" is not working and the ToolTips are not displayed anymore.
Does anyone know a solution or, even better, a way to display ToolTips on ListView ColumnHeaders?
Here's my code snippet:
Private Sub ShowTooltip(ByVal sender As Object, ByVal e As MouseEventArgs)
Handles myListView.MouseMove
Dim iColumn As System.Int32 = FindListViewColumnHeader(e.X, e.Y)
If Me.myListView.Columns.Count > 0 AndAlso iColumn >= 0 AndAlso
iColumn <= Me.myListView.Columns.Count - 1 Then
Me.myToolTip.Active = True
Me.myToolTip.UseAnimation = True
Me.myToolTip.UseFading = True
Me.myToolTip.AutomaticDelay = 10000
Me.myToolTip.AutoPopDelay = 10000
Me.myToolTip.InitialDelay = 0
Me.myToolTip.ReshowDelay = 2000
Dim sTooltipText As System.String = SomeText(...)
If sTooltipText <> DirectCast(Me.myToolTip.Tag, System.String) Then
Me.myToolTip.Tag = sTooltipText
Me.myToolTip.SetToolTip(Me.myListView, sTooltipText)
End If
Else
Me.myToolTip.Active = False
End If
End Sub
Protected Overridable Function FindListViewColumnHeader(ByVal X As System.Int32,
ByVal Y As System.Int32) As System.Int32
If Y > 20 And Y < 40 Then
Dim iCount As System.Int32
Dim iLeft As System.Int32
For iCount = 0 To myListView.Columns.Count - 1
iLeft = iLeft + myListView.Columns(iCount).Width
If X <= iLeft Then
Return iCount
Exit For
End If
Next
Return iCount
Else
Return -1
End If
End Function
Note: myToolTip is
Friend WithEvents myToolTip As System.Windows.Forms.ToolTip
and myListView is
Protected WithEvents myListView As System.Windows.Forms.ListView
Please notice that, as suggested in the question:
How to set tooltip for a ListviewItem, ShowItemToolTips is already set to True.
You can get the handle of the header column and subclass it:
<DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function SetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer, ByVal newProc As Win32WndProc) As IntPtr
End Function
<DllImport("user32.dll")> _
Private Shared Function CallWindowProc(lpPrevWndFunc As IntPtr, hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Private Delegate Function Win32WndProc(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Const GWL_WNDPROC As Integer = -4
Private Const WM_LBUTTONDOWN As Integer = &H201
Private Const WM_MOUSEMOVE As Integer = &H200
Private oldWndProc As IntPtr = IntPtr.Zero
Private newWndProc As Win32WndProc = Nothing
Private Sub SubclassHWnd(ByVal hWnd As IntPtr)
'hWnd is the window you want to subclass...,
'create a new delegate for the new wndproc
newWndProc = New Win32WndProc(AddressOf MyWndProc)
'subclass
oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, newWndProc)
End Sub
Private Function MyWndProc(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case Msg
Case WM_LBUTTONDOWN
'The lower 2 bytes of lParam are the x coordinate
'and the higher 2 bytes the y.
ToolTip1.Show("My tooltip", ListView1, lParam And &HFFFF, (lParam >> 16) And &HFF, 2000)
Exit Select
Case Else
Exit Select
End Select
Return CallWindowProc(oldWndProc, hWnd, Msg, wParam, lParam)
End Function
To subclass the header use:
'LVM_GETHEADER = &H101F
Dim hwndHeader As IntPtr = SendMessage(ListView1.Handle, &H101F, 0, 0)
SubclassHWnd(hwndHeader)
I used the WM_LBUTTONDOWN event for convenience. You can use the WM_MOUSEMOVE event and check which column the mouse is etc... and show the tooltip
The code for subclassing: Subclass an Unmanged Window in C#
I can get text from external application text box but now I want to get text from my desired text box from external application.
My English is not so good that's why see Image Below.
The Below Code Return The First Text Box Value Only.
Imports System.Runtime.InteropServices
Public Class Form1
Private Const WM_GETTEXT As Integer = &HD
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
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function FindWindowEx(ByVal parentHandle As IntPtr, _
ByVal childAfter As IntPtr, _
ByVal lclassName As String, _
ByVal windowTitle As String) As IntPtr
End Function
Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'Find the running notepad window
Dim Hwnd As IntPtr = FindWindow(Nothing, TextBox1.Text)
'Alloc memory for the buffer that recieves the text
Dim Handle As IntPtr = Marshal.AllocHGlobal(100)
'send WM_GWTTEXT message to the notepad window
Dim NumText As Integer = SendMessage(Hwnd, WM_GETTEXT, 50, Handle)
'copy the characters from the unmanaged memory to a managed string
Dim Text As String = Marshal.PtrToStringUni(Handle)
'Display the string using a label
Label1.Text = Text
'Find the Edit control of the Running Notepad
Dim ChildHandle As IntPtr = FindWindowEx(Hwnd, IntPtr.Zero, "Edit", Nothing)
'Alloc memory for the buffer that recieves the text
Dim Hndl As IntPtr = Marshal.AllocHGlobal(200)
'Send The WM_GETTEXT Message
NumText = SendMessage(ChildHandle, WM_GETTEXT, 200, Hndl)
'copy the characters from the unmanaged memory to a managed string
Text = Marshal.PtrToStringUni(Hndl)
'Display the string using a label
Label2.Text = Text
End Sub
End Class
You'll have to loop through children of the main window (External Application) and get their properties.
You'll use the following:
<DllImport("User32.dll")> _
Public Function EnumChildWindows _
(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, _
ByVal lParam As IntPtr) As Boolean
End Function
Public Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
Public Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr()
Dim ChildrenList As New List(Of IntPtr)
Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)
Try
EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle))
Finally
If ListHandle.IsAllocated Then ListHandle.Free()
End Try
Return ChildrenList.ToArray
End Function
For for details, check this How can I get properties of controls contained in a popup message box using VB.Net
' try this on excel vbe
External_application_handle=findwindow(vbNullString,"External_application")
textbox_1_handle=findwindowex(External_application_handle,0&,"Edit",vbNullString)
next_handle=textbox_1_handle
textbox_2_handle=findwindowex(External_application_handle,next_handle,"Edit",vbNullString")
Length = SendMessage(textbox_2_handle, WM_GETTEXTLENGTH, 0,0)
buffer$=space(Length)
call sendmessage(textbox_2_handle,Length+1,buffer$)
msgbox buffer
How can I get the color of a pixel at the location of the cursor? I know how to get the mouses position using MousePosition but I can not figure out how to get the pixel color at that location.
A C# version: How do I get the colour of a pixel at X,Y using c# ?
Should be easy to rewrite in VB.NET.
Quick simple very slow but it works.
The idea is to copy the screen to a bitmap which can be done using the GDI+ build into the drawing.graphics object. Then simply read the bitmap that it generates. Get pixel is very slow. The best way it to read the image byte array directly.
Function MakeScreenShot() As Drawing.Bitmap
Dim out As Drawing.Bitmap
'Get the screen Size
Dim bounds As Rectangle = Screen.GetBounds(Point.Empty)
'create the bitmap
out = New Drawing.Bitmap(bounds.Width, bounds.Height)
'create a graphic object to recive the pic
Using gr As Drawing.Graphics = Graphics.FromImage(out)
'Copy the screen using built in API
gr.CopyFromScreen(Point.Empty, Point.Empty, bounds.Size)
End Using
Return out
End Function
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
Dim BM As Drawing.Bitmap = MakeScreenShot()
Dim mouseloc As Point = Cursor.Position
Dim c As Color = BM.GetPixel(mouseloc.X, mouseloc.Y) ' The Slowest way possable to read a color
Debug.Print(c.R & "," & c.G & "," & c.B)
End Sub
Enjoy.
Try this code:
#Region "#include"
Imports System
Imports System.Drawing
Imports System.Runtime.InteropServices
#End Region
Public Class Test
#Region "From Windows API"
<DllImport("user32.dll", SetLastError:=True)> _
Public Shared Function GetWindowDC(ByVal hwnd As IntPtr) As IntPtr
'Do not try to name this method "GetDC" it will say that user32 doesnt have GetDC !!!
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Public Shared Function ReleaseDC(ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Int32
End Function
<DllImport("gdi32.dll", SetLastError:=True)> _
Public Shared Function GetPixel(ByVal hdc As IntPtr, ByVal nXPos As Integer, ByVal nYPos As Integer) As UInteger
End Function
#End Region
REM --Test--
#Region "Some Functions"
Public Function GetPixelColor(ByVal x As Integer, ByVal y As Integer) As Color
Dim hdc As IntPtr = GetWindowDC(IntPtr.Zero)
Dim pixel As UInteger = GetPixel(hdc, x, y)
Dim color As Color
ReleaseDC(IntPtr.Zero, hdc)
MsgBox(pixel)
color = color.FromArgb(Int(pixel And &HFF), _
Int(pixel And &HFF00) >> 8, _
Int(pixel And &HFF0000) >> 16)
Return color
End Function
#End Region
REM --Test--
#Region "OnClick"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim mouseloc As Point = Cursor.Position
Me.Label1.BackColor = GetPixelColor(mouseloc.X, mouseloc.Y)
Me.Refresh()
End Sub
#End Region
End Class
You need button (name==Button1) and label (name==Label1). To get color from screen you will need to use Timer.
If you need to rewrite code from C# to VB.NET use this link: http://www.harding.edu/fmccown/vbnet_csharp_comparison.html
Keep it simple, not very optimized but do the job:
Public Class Form1
Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Declare Function GetDC Lib "user32" (ByVal hWnd As IntPtr) As IntPtr
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As IntPtr
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As IntPtr, ByVal X As Int32, ByVal Y As Int32) As Int32
Private Function CheckScreen()
Dim CursorLoc As Point = Cursor.Position
Dim hDC As IntPtr = GetDC(0) '0 = Get the color to any window on screen, not only your app
Try
Dim CursorColor As Integer = GetPixel(hDC, CursorLoc.X, CursorLoc.Y)
Me.Panel1.BackColor = ColorTranslator.FromWin32(CursorColor) 'a simple panel to show the color
Me.Refresh()
Return True
Catch ex As Exception
Return False
Finally
ReleaseDC(0, hDC)
End Try
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Timer1.Start() 'Timer with a short delay
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
CheckScreen()
End Sub
End Class
This is actually harder than you would guess. I would look for some example code that already does it, and copy their technique.
In the end, the algorithm is going to have to perform these operations:
Get a bitmap of the desktop/window close to the cursor position
Index into that bitmap with the cursor position and extract the pixel color
It sounds simple, but is not easy.