vb.net RichTextBox - How to append text to RichTextBox without scrolling and losing selection

[Miroslav Draxal]

Dobrý den,
Dovolil jsem si malinko upravit předmět, aby se k tomuhle dostali i jiní, protože ve VB.net jsem to nenašel.
Díky za typ, chvíli mi trvalo, než jsem to z C# přechroupal do vb, ale chodí to výborně.
Takže stačí v průzkumníkovi přidat třídu a do ní nakopírovat viz dole. 
Potom v sadě nástrojů si na form přidat RichTextBoxEx a provést přidání textu do rtb bez ztráty pozice a výběru. Rtb v průběhu přidávání textu nebliká.
Přeji dobrou noc Míra

----------------------------------------
rtbXYZ.SuspendPainting()
rtbXYZ.AppendText("něco")
rtbXYZ.ResumePainting()
----------------------------------------

Imports System.Runtime.InteropServices
Public Class RichTextBoxEx
    Inherits RichTextBox
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Ansi)>
    Private Shared Function SendMessage(hWnd As IntPtr, wMsg As Int32, wParam As Int32, ByRef lParam As Point) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Ansi)>
    Private Shared Function SendMessage(hWnd As IntPtr, wMsg As Int32, wParam As Int32, lParam As IntPtr) As IntPtr
    End Function

    Const WM_USER As Integer = &H400
    Const WM_SETREDRAW As Integer = &HB
    Const EM_GETEVENTMASK As Integer = WM_USER + 59
    Const EM_SETEVENTMASK As Integer = WM_USER + 69
    Const EM_GETSCROLLPOS As Integer = WM_USER + 221
    Const EM_SETSCROLLPOS As Integer = WM_USER + 222

    Private _ScrollPoint As Point
    Private _Painting As Boolean = True
    Private _EventMask As IntPtr
    Private _SuspendIndex As Integer = 0
    Private _SuspendLength As Integer = 0

    Public Sub SuspendPainting()
        If _Painting Then
            _SuspendIndex = Me.SelectionStart
            _SuspendLength = Me.SelectionLength
            SendMessage(Me.Handle, EM_GETSCROLLPOS, 0, _ScrollPoint)
            SendMessage(Me.Handle, WM_SETREDRAW, 0, IntPtr.Zero)
            _EventMask = SendMessage(Me.Handle, EM_GETEVENTMASK, 0, IntPtr.Zero)
            _Painting = False
        End If
    End Sub

    Public Sub ResumePainting()
        If Not _Painting Then
            Me.Select(_SuspendIndex, _SuspendLength)
            SendMessage(Me.Handle, EM_SETSCROLLPOS, 0, _ScrollPoint)
            SendMessage(Me.Handle, EM_SETEVENTMASK, 0, _EventMask)
            SendMessage(Me.Handle, WM_SETREDRAW, 1, IntPtr.Zero)
            _Painting = True
            Me.Invalidate()
        End If
    End Sub
End Class

-----Original Message-----
From: Hw-list [mailto:hw-list-bounces na list.hw.cz] On Behalf Of Ladislav Vaiz
Sent: Monday, August 14, 2017 12:02 PM
To: HW-news
Subject: Re: vb.net RichTextBox

Já se zeptal ".net richtextbox do not scroll after appendtext"
a dozvěděl jsem se:
https://stackoverflow.com/questions/6547193/how-to-append-text-to-richtextbox-without-scrolling-and-losing-selection
https://stackoverflow.com/questions/626988/prevent-autoscrolling-in-richtextbox

L.

Dne 14.8.2017 v 11:12 Miroslav Draxal napsal(a):
>
> Přeji hezký den ve spolek.
>
> Nevím jak se zeptat googlu, tak to zkusím tady.
>
> Mějme RichTextBox (rtb) do kterého metodou rtb.AppendText(„xyz“) 
> přidávám text.
>
> Pokud není rtb ve focusu a textu je v rtb více než se může zobrazit, 
> tak se nově vypisovaný text schová pod spodní okraj rtb.
>
> Metodou rtb.ScrollToCaret() se posune text na posledně vložení řádek.
>
> Čili, pokud chci neposouvat text, vynechám metodu ScrollToCaret()
>
> A teď. Pokud je rtb ve focusu, tak se text posouvá automaticky na 
> posledně přidaný text. Nevíte, jak tomu zabránit?
>
> Míra
>


_______________________________________________
HW-list mailing list  -  sponsored by www.HW.cz Hw-list na list.hw.cz http://list.hw.cz/mailman/listinfo/hw-list