Weil Jimmer's BlogWeil Jimmer's Blog


RichTextbox Scroll Smooth 平滑滾動 VB.NET
No Comments

Published:2015-05-13 19:22:04

簡言之,RichTextBox 若裡面包含圖片的話(比如用剪貼簿的方法貼上RTF格式圖片),滾動就會顯得很有問題,不管是用右邊的滾動條上鍵、下鍵移動,或是用滑鼠滾輪滾動,都會「快速跳躍圖片」,意指:把圖片當成「一行文字」看待,尤其是當圖片很長(Height大於RichTextBox的高)的時候,而且又多張圖片,快速滾動就有可能發生,但問題是,我去網路上查很多資料都沒查到有什麼方法可以修正,當然是希望能用一行Code,就解決這個問題,不然滾動圖片「咻」一下就不見了,已經滾到最下面了,根本爛透了。

本方法以Vb.net Code為例,原代碼從網路上查到是 C#.Net,但是原代碼是按下按鈕自動平滑滾到最下面,而我這個是依照滑鼠滾輪而去做上下正常平滑滾動,意思是指修正滑鼠的快速滾動問題,稍微修改了原代碼,原本想貼上引用的地址,不過都關掉網頁,懶得查記錄了,好吧,也算是原創,因為有些還是我自己再添加的。

要先創建一個 Timer,代碼中 ID 為「Scroll_timer」。其餘不解釋,看代碼就明白。

    Private min, max As Integer
    Private pos As Integer = 0
    Private endPos As Integer = 0
    Private Const SB_HORZ As Integer = &H0
    Private Const SB_VERT As Integer = &H1
    Private Const WM_HSCROLL As Integer = &H114
    Private Const WM_VSCROLL As Integer = &H115
    Private Const SB_THUMBPOSITION As Integer = 4
    Private Const WM_SETREDRAW As Int32 = &HB
    Private scroll_speed As Integer = 20

    Private Declare Function SetScrollPos Lib "user32" (hwnd As IntPtr, nBar As Integer, nPos As Integer, bRedraw As Boolean) As Integer
    Private Declare Function GetScrollPos Lib "user32" (hwnd As IntPtr, nBar As Integer) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hwnd As IntPtr, nBar As Integer, wParam As Integer, lParam As Integer) As Integer
    Private Declare Function GetScrollRange Lib "user32" (hwnd As IntPtr, nBar As Integer, ByRef lpMinPos As Integer, ByRef lpMaxPos As Integer) As Boolean
    Private Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr


    Private Sub Scroll_timer_Tick(sender As Object, e As EventArgs) Handles Scroll_timer.Tick

        GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
        max = max - RichTextBox1.ClientSize.Height
        pos = GetScrollPos(RichTextBox1.Handle, SB_VERT)
        Debug.WriteLine("Max=" & max & "--Min=" & min & "--Current=" & pos)
        If Scroll_timer.Tag = "down" Then
            If (pos >= endPos) Then
                Me.Scroll_timer.Enabled = False
                Exit Sub
            End If
            If endPos >= max Then
                endPos = max
            End If
            pos = pos + scroll_speed
            SetScrollPos(RichTextBox1.Handle, SB_VERT, pos, True)
            PostMessage(RichTextBox1.Handle, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * pos, 0)
        Else
            If endPos <= 1 Then
                endPos = 1
            End If
            If (pos <= endPos) Then
                Me.Scroll_timer.Enabled = False
                Exit Sub
            End If
            If (pos - scroll_speed) < 1 Then
                pos = 0
            Else
                pos = pos - scroll_speed
            End If
            SetScrollPos(RichTextBox1.Handle, SB_VERT, pos, True)
            PostMessage(RichTextBox1.Handle, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * pos, 0)
        End If
    End Sub

    Private Sub RichTextBox1_MouseWheel_Click(sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles RichTextBox1.MouseWheel
        Dim temp As HandledMouseEventArgs = e
        temp.Handled = True
        Dim temp_pos = GetScrollPos(RichTextBox1.Handle, SB_VERT)
        If Scroll_timer.Enabled = True Then
            temp_pos = endPos
        Else
        End If
        If e.Delta > 0 Then
            Debug.WriteLine("Scrolled up!" & e.Delta)
            GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
            endPos = temp_pos - e.Delta
            If endPos <= 1 Then
                endPos = 1
            End If
            Debug.WriteLine(endPos)
            Scroll_timer.Tag = "up"
            Me.Scroll_timer.Enabled = True
        Else
            Debug.WriteLine("Scrolled down!" & e.Delta & "--Current: " & temp_pos)
            GetScrollRange(RichTextBox1.Handle, SB_VERT, min, max)
            max = max - RichTextBox1.ClientSize.Height
            If temp_pos + Math.Abs(e.Delta) >= max Then
                endPos = max - 1
            Else
                endPos = temp_pos + Math.Abs(e.Delta) - 1
            End If
            Debug.WriteLine(endPos)
            Scroll_timer.Tag = "down"
            Me.Scroll_timer.Enabled = True
        End If
    End Sub

 


This entry was posted in Functions, VB.NET By Weil Jimmer.

About Weil Jimmer

avatar

Hi! Everyone! My name is Weil Jimmer. This is my personal blog. I'm a webmaster of this site. I hope the site will be popular. Now, Let's go! Enjoy gaining more knowledge.
More Details About Me : https://weils.net/profile.php

Leave a Reply

Name*:

Email*:

Website:

Privacy:   

Comment*:

Visitor Count

pop
nonenonenone

Note

WPA2 已被 KRACK 攻擊破解!請更新 WiFi 軟體。

歡迎前來本站。

Search

Republic Of China
Privacy is your right and ability to be yourself and express yourself without the fear that someone is looking over your shoulder and that you might be punished for being yourself, whatever that may be.

It is quality rather than quantity that matters.

I WANT Internet Freedom.

Reality made most of people lost their childishness.

Justice,Freedom,Knowledge.

Support/Donate

This site also need a little money to maintain operations, not entirely without any cost in the Internet. Your donations will be the best support and power of the site.
MethodBitcoin Address
bitcoin1NRMVGGpm2T1pmeejisLSEhCXfCefEW9V4
paypal

The Lie We Live

youtube

The Questions We Never Ask

youtube

Support The Zeitgeist Movement

The Zeitgeist Movement

Man

youtube

In The Fall

youtube

Facebook is EATING the Internet

Facebook

Recent Comments

sickcatail on STEAM免費序號

包包 on STEAM免費序號

問問題 on 最棒的手機通訊軟體 Telegram

unocme on STEAM免費序號

窩仔 on STEAM免費序號

Categories

Announcement (4)

Bash (2)

C (1)

C# (4)

C++ (1)

Experience (38)

Flash (2)

Free (10)

Functions (35)

Games (13)

General (44)

HTML (7)

Java (12)

JS (7)

Mood (23)

Note (24)

Office (1)

PHP (9)

Privacy (3)

Product (9)

Python (4)

Software (8)

The Internet (15)

Tools (12)

VB.NET (8)

WebHosting (7)

Wi-Fi (5)

XML (4)