MattiaFanti-4051 avatar image
0 Votes"
MattiaFanti-4051 asked MattiaFanti-4051 commented

How to avoid richtextbox text to flicker when updated from timer?

I'm using Windows.Media.Ocr to scan some text on screen and I'm using a timer to make it scan every 100ms and updating a richtextbox. Unfortunately the text on the rtb is flickering quite a lot, is there any way to avoid this behavior?
The code under timer is:

    Dim scaledSoftwareBitmap As Windows.Graphics.Imaging.SoftwareBitmap
         Dim softwareBmp As Windows.Graphics.Imaging.SoftwareBitmap
         Using bmp As Bitmap = New Bitmap(PictureBox1.Width, PictureBox1.Height)
             Using g As Graphics = Graphics.FromImage(bmp)
                 Dim pt As Point = Me.PointToScreen(New Point(PictureBox1.Left, PictureBox1.Top))
                 g.CopyFromScreen(pt.X, pt.Y, 0, 0, bmp.Size, CopyPixelOperation.SourceCopy)
                 Using memStream = New Windows.Storage.Streams.InMemoryRandomAccessStream()
                     bmp.Save(memStream.AsStream(), System.Drawing.Imaging.ImageFormat.Bmp)
                     Dim decoder As Windows.Graphics.Imaging.BitmapDecoder = Await Windows.Graphics.Imaging.BitmapDecoder.CreateAsync(memStream)
                     softwareBmp = Await decoder.GetSoftwareBitmapAsync(decoder.BitmapPixelFormat, BitmapAlphaMode.Ignore)
                     Dim transform = New Windows.Graphics.Imaging.BitmapTransform() With {
                          .ScaledWidth = CUInt(PictureBox1.Width * 2),
                          .ScaledHeight = CUInt(PictureBox1.Height * 2),
                          .InterpolationMode = Windows.Graphics.Imaging.BitmapInterpolationMode.NearestNeighbor
                     Dim pixelData As Windows.Graphics.Imaging.PixelDataProvider = Await decoder.GetPixelDataAsync(Windows.Graphics.Imaging.BitmapPixelFormat.Bgra8, Windows.Graphics.Imaging.BitmapAlphaMode.Premultiplied, transform, Windows.Graphics.Imaging.ExifOrientationMode.RespectExifOrientation, Windows.Graphics.Imaging.ColorManagementMode.ColorManageToSRgb)
                     scaledSoftwareBitmap = New Windows.Graphics.Imaging.SoftwareBitmap(Windows.Graphics.Imaging.BitmapPixelFormat.Bgra8, CInt(transform.ScaledWidth), CInt(transform.ScaledHeight))
                     Dim pixels As Byte() = pixelData.DetachPixelData()
                     Dim buffer As Windows.Storage.Streams.IBuffer = pixels.AsBuffer()
                 End Using
             End Using
         End Using
         Dim ocrEng = OcrEngine.TryCreateFromLanguage(New Windows.Globalization.Language("en-US"))
         Dim languages As IReadOnlyList(Of Windows.Globalization.Language) = ocrEng.AvailableRecognizerLanguages
         For Each language In languages
         Dim r = ocrEng.RecognizerLanguage
         Dim n = ocrEng.MaxImageDimension
         Dim ocrResult = Await ocrEng.RecognizeAsync(scaledSoftwareBitmap)
         Dim wordList As List(Of cText) = New List(Of cText)()
         Dim lines As IReadOnlyList(Of OcrLine) = ocrResult.Lines
         For Each line In lines
             For Each word In line.Words
                 Dim nY As Double = CLng(word.BoundingRect.Bottom / 10) * 10
                 wordList.Add(New cText() With {.Text = word.Text, .LocY = nY, .LocX = word.BoundingRect.Left})
         wordList.Sort(New WordComparer())
         Dim oldLocY As Double = 0
         For Each item As cText In wordList
             If (item.LocY > oldLocY And oldLocY <> 0) Then
                 RichTextBox1.Text += Environment.NewLine
             End If
             RichTextBox1.Text += (item.Text + " ")
             oldLocY = item.LocY


5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

1 Answer

Castorix31 avatar image
1 Vote"
Castorix31 answered MattiaFanti-4051 commented

You can reduce flickering with WM_SETREDRAW

     <DllImport("User32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
     Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
     End Function
     Public Const WM_SETREDRAW As Integer = &HB

Before you add lines (before RichTextBox1.Clear())

         If (RichTextBox1.IsHandleCreated) Then
             SendMessage(RichTextBox1.Handle, WM_SETREDRAW, 0, IntPtr.Zero)
         End If

After lines have been added :

         If (RichTextBox1.IsHandleCreated) Then
             SendMessage(RichTextBox1.Handle, WM_SETREDRAW, 1, IntPtr.Zero)
         End If

· 1
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

you are a freakin genious. Thanks

0 Votes 0 ·