RichTextBox scroll like a TextBox [unsolved]

[Narfy]

If you have noticed, the TextBox scrolls down one line at a time while the RichTextBox scrolls down smoothly.

Since im using a richtextbox, How can I make it so when the user scrolls down via the Vertical scroll bar its scrolls down one line a time like the textbox instead of the smooth scrolling of the richtextbox?

[vbNeo]

If there isn't a property to do it, SendMessage probably can help you... but... Why would you want it to scroll one line at a time? Why not just use a listbox or a normal textbpx ?

[Narfy]

i want it to scroll one line at a time because im making a line numbering control and i cant get the line numbers to match exactly up with the text in a richtextbox because of the smooth scrolling, but i can get them to line up in the textbox because of the one-line-at-a-time scrolling.

[Madboy]

You could subclass as vbNeo suggests, or better still make your own User Control

[Narfy]

is there a example anywere on how to do a subclass?

[Madboy]

Not sure, i believe its the hardest thing to do in VB

Woka, Marty or someone else should be able to help you more.

[vbNeo]

or MerrionComputing, drop them a mail

[Narfy]

Ive been searching like mad to try to find a answer, and i found this in the Developers Pad Source code, they use a richtextbox and it scrolls one line at a time

im using the vbaccelerator subclassing
http://www.vbaccelerator.com/home/VB...Tmr_Binary.asp

Implements ISubclass
 
Private Type POINTAPI
        x As Long
        y As Long
End Type
 
Private Const WM_USER = &H400
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_VSCROLL = &H115
Private Const EM_GETSCROLLPOS = (WM_USER + 221)
Private Const EM_SETSCROLLPOS = (WM_USER + 222)
Private Const WM_LBUTTONDOWN = &H201
 
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetScrollPos Lib "USER32" (ByVal hwnd As Long, ByVal nBar As Long) As Long
 
Private lPixelsPerLine    As Long
Private bResizingTriggered  As Boolean
 
Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
End Property
 
Private Property Get ISubclass_MsgResponse() As EMsgResponse
    Select Case CurrentMessage
    Case WM_VSCROLL, WM_MOUSEWHEEL
        ISubclass_MsgResponse = emrConsume
    Case Else
        ISubclass_MsgResponse = emrPreprocess
    End Select
End Property
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim iScrollPos As Long
Dim bScrolling As Boolean
Dim tp As POINTAPI
    ' scroll events
    Select Case iMsg
    Case WM_MOUSEWHEEL
        'go up or down 3 lines...
        SendMessage hwnd, EM_GETSCROLLPOS, 0, tp
        If wParam > 0 Then
            tp.y = tp.y - (lPixelsPerLine * 5)
        Else
            tp.y = tp.y + (lPixelsPerLine * 5)
        End If
        SendMessage hwnd, EM_SETSCROLLPOS, 0, tp
        DrawLines picLines, txtDocument
    Case WM_VSCROLL
        'are we scrolling, or scrolled?
        bScrolling = (LoWord(wParam) = 4 Or LoWord(wParam) = 5)
        If bScrolling Then
            'get info using wparam
            iScrollPos = HiWord(wParam)
        Else
            'call api
            iScrollPos = GetScrollPos(hwnd, 1)
        End If
        
        'update lines
        If Int(iScrollPos / lPixelsPerLine) <> (iScrollPos / lPixelsPerLine) Then
            'not divisible by 16
            'we are showing half a line...
            If bScrolling Then
                wParam = MakeDWord(LoWord(wParam), Int(iScrollPos / lPixelsPerLine) * lPixelsPerLine)
            Else
                'hmm...
            End If
        End If
        'send message to rtf for processing
        ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
        'update the lines
        DrawLines picLines, txtDocument
        'reset flags
        bResizingTriggered = False
        If wParam = 8 Then '8=SB_END... scroll end
 
        ElseIf wParam > 1 Then 'not up/down button
 
        End If
    Case WM_LBUTTONDOWN
        Debug.Print lParam
    End Select
End Function
 
Private Function LoWord(dwValue As Long) As Integer
    CopyMemory LoWord, dwValue, 2
End Function
Private Function MakeDWord(LoWord As Integer, HiWord As Integer) As Long
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function
Private Function HiWord(dwValue As Long) As Integer
    CopyMemory HiWord, ByVal VarPtr(dwValue) + 2, 2
End Function

it doesn't do anything but it works in developers pad but not in my program, i get a illegal operation then vb6 crashes.
anyone know what the problem is?

[Dasiths]

http://www.elitevb.com/content/01,0099,01/

exactly what you want ........

Can you in return help me ...

Dasith [email protected]
25-Jan-04


Is it possible to add a Black Line to indicate the end of the page (printer.height) .... So the user knows when a page ends and a new page starts ..

Like in ms word you get a line to indicate page margins ...

please email me if you can do it [email protected]

[Narfy]

thanks, but it didn't work, the richtextbox they have in that project, it doesn't scroll one line at a time

[Narfy]

bump

cmon, someone has got to know :P

[Narfy]

bump

[Narfy]

cmon, someone answer, im desperate ive been searching everywhere

[Dasiths]

try my above example ....... it has a line numbered rich text control