Scroll RichTextBox programatically using SendMessage user32 API cannot exceed Integer value - vb.net

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.

Related

Force scroll to the top of a RichTextBox

I'm using the following code to force the RichTextBox to scroll to the real bottom
Private Const WM_VSCROLL As Integer = 277
Private Const SB_PAGEBOTTOM As Integer = 7
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
Friend Shared Sub ScrollToBottom(ByVal richTextBox As RichTextBox)
SendMessage(richTextBox.Handle, WM_VSCROLL, CType(SB_PAGEBOTTOM, IntPtr), IntPtr.Zero)
richTextBox.SelectionStart = richTextBox.Text.Length
End Sub
' to call it
ScrollToBottom(RichTextBox1)
Is there a way to reverse this code so I can force it to to always scroll up?
I am not looking to append text solutions.
Thanks
This Should do it:
Private Const WM_VSCROLL As Integer = &H115
Private Const SB_TOP As Integer = 6
Private Const SB_BOTTOM As Integer = 7
<DllImport("user32.dll")> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
' scroll RichTextBox
Friend Shared Sub ScrollRichTextBox(ByVal richTextBox As RichTextBox, Direction as integer)
SendMessage(richTextBox.Handle, WM_VSCROLL, Direction, 0)
End Sub
' to call it
ScrollRichTextBox(RichTextBox1, SB_TOP) 'Scrolls to top
ScrollRichTextBox(RichTextBox1, SB_BOTTOM) 'Scrolls to bottom

Using Bitblt to screenshot

I'm looking for the fastest way to take a print-screen, and i found out that using Bitblt was my better choice, however, it only works for device context handle's, which means for me to retrieve a bitmap from that, i'd have to use multiple API's including CreateCompatibleBitmap, which in the end it probably takes the same time as using a managed way, like graphics.CopyFromScreen (which is a bit slow for me and also consumes alot of CPU, between 7-10% on a 2.3ghz quad-core processor...)
However, i still searched for a cleaner way of retrieving a bitmap from it, so i came up with this code:
<DllImport("user32.dll")> _
Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll")> _
Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("gdi32.dll")> _
Public Shared Function BitBlt(ByVal hdcDest As IntPtr, ByVal xDest As Integer, ByVal yDest As Integer, ByVal wDest As Integer, ByVal hDest As Integer, ByVal hdcSource As IntPtr, _
ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal rop As TernaryRasterOperations) As Boolean
End Function
Dim hwNd As IntPtr = Nothing
hwNd = GetDC(GetDesktopWindow)
picHandle = GetDC(Me.PictureBox1.Handle)
BitBlt(picHandle, 0, 0, PictureBox1.Width, PictureBox1.Height, hwNd, 0, 0, TernaryRasterOperations.SRCCOPY)
ReleaseDC(hwNd, picHandle)
I can reach ~30 fps with this... But it has two problems as i said above:
Even if displaying it on a picturebox as i'm doing it above accomplished what i want, it doesn't resize to the picturebox control, even if i change those "0" values to the picturebox x and y coordinates.
I further searched and found there's a StretchBit API for that, and it does stretch, but it also reduces quality, (Even with the necessary call to SetStretchBltMode with parameter "HALFTONE" so it doesn't "corrupt" the pixels), it also reduces performance at least in 10+ fps...
But as i need to get it as bitmap object, with the other necessary API's for that, i ended up with almost half the performance (15~ fps) which is equivalent of graphics.CopyFromScreen.
So, i'm asking, is there another way to get a bitmap from the screen using Bitblt or similar without losing performance?
If there isn't a .Net way, i kindly ask for any language-way of doing that.
If you want raw performance, you will have to get away from managed code. This is easy enough using C++ with Visual Studio. You can make calls directly to the Windows API, bypassing the .NET runtime, managed code for your application, and the overhead of p/invokes in .NET.
If you are familiar with C#, you can take your C# code, convert it to C++ (which should be straightforward, with a lot of work to replace the CLI).
Private Declare Function BitBlt Lib "GDI32" ( _
ByVal hdcDest As Integer, _
ByVal nXDest As Integer, _
ByVal nYDest As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hdcSrc As Integer, _
ByVal nXSrc As Integer, _
ByVal nYSrc As Integer, _
ByVal dwRop As System.Int32) As Boolean
Declare Function QueryPerformanceCounter Lib "Kernel32" (ByRef X As Long) As Short
Declare Function QueryPerformanceFrequency Lib "Kernel32" (ByRef X As Long) As Short
Const SRCCOPY As Integer = &HCC0020
Use a form with only a picturebox and a label in it. Set the anchors of picbox accordingly. In picbox down event:
Private Sub PictureBox1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim Ctr1, Ctr2, Freq As Long
Dim dbl As Double
QueryPerformanceCounter(Ctr1)
Dim desktopDC As IntPtr = Nothing
Dim picboxDC As IntPtr = Nothing
desktopDC = GetDC(New IntPtr(0))
picboxDC = GetDC(PictureBox1.Handle)
BitBlt(picboxDC, 0, 0, PictureBox1.Width, PictureBox1.Height, desktopDC, 0, 0, SRCCOPY)
QueryPerformanceCounter(Ctr2)
QueryPerformanceFrequency(Freq)
dbl = (Ctr2 - Ctr1) / Freq
dbl *= 1000000
Label1.Text = dbl.ToString 'it is in microseconds
ReleaseDC(New IntPtr(0), desktopDC)
ReleaseDC(PictureBox1.Handle, picboxDC)
End Sub
Maximize your form and click in picturebox.

VB.NET BitBlt copy bitmap to screen

Edit: Fixed, I created a compatibleDC for the graphics object, and a handle for the bitmap (using b.gethbitmap), then used the SelectObject function inside GDI to select those two, and used the compatibleDC instead of hDc in the BitBlt function
I've been trying to draw a bitmap to the screen (device 0), however I have encountered a problem copying the graphics using BitBlt.
Initially, I was drawing directly to the desktop using SetPixel (gdi32), but it was slow, so now I am setting the pixels of a bitmap object and then creating graphics from that object, and copying the hdc of the graphics to the screen.
My guess is that I am adding the HDC of the graphics object to an intptr, which essentially gives me the HDC of the container of the graphics object, which is not what I need. However even so, I have not found any information on how I could copy a bitmap to a device other than using BitBlt.
This is my current code (Windows forms app, textbox, button) The textbox is the device to copy to, and the button starts it. For testing purposes, set the textbox text to 0, and press the button. You should see a black box (50x50px) in the top left corner of your screen. The colour should be blue if it is working correctly:
Public Class Form1
Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Int32) As Int32
Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Int32, ByVal hdc As Int32) As Int32
Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal crColor As Integer) As Integer
Declare Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean
Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntPtr
Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As IntPtr
Dim x As Integer
Sub setpx(ByVal location As Point, ByVal color As Color)
b.SetPixel(location.X, location.Y, color)
End Sub
Sub drawrectangle(ByVal device As Integer, ByVal location As Point, ByVal size As Point, ByVal color As Color)
b = New Bitmap(size.X, size.Y)
For i = location.X To size.X - 1
For z = location.Y To size.Y - 1
setpx(New Point(i, z), color)
Next
Next
g = Graphics.FromImage(b)
Dim hDc As IntPtr = g.GetHdc
BitBlt(GetDC(device), location.X, location.Y, size.X, size.Y, hDc, location.X, location.Y, 13369376)
ReleaseDC(device, GetDC(device))
End Sub
Dim b As Bitmap
Dim g As Graphics
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttnon1.Click
Dim r As New Random
Dim timestart As Integer = Now.TimeOfDay.TotalMilliseconds
drawrectangle(TextBox1.Text, New Point(1, 1), New Point(50, 50), Color.Blue)
MsgBox(Now.TimeOfDay.TotalMilliseconds - timestart)
End Sub
End Class
The way it works is it calls the function setpx, given a location and color from within a loop iterating through all of the pixels in a box (50x50 in my code). The setpx function will then call the setpixel function on a bitmap b. This part is working fine.
Next, it will define a graphics object g from the bitmap, and I use BitBlt to copy g's hdc (g.gethdc) to the screen. This is not working correctly, is this the correct way of doing this?
You are passing Textbox1.text as a device descriptor, that won't work...You want textbox1.hwnd

How can I get the RGB color of the pixel at the cursor location using VB.NET?

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.

Kerning in vb.net

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.