Better way to do this?

[Barabajagal]

I just finished one of the most useful features ever in a chat client, which is preventing the chat textbox from scrolling down when the user has scrolled up, either to read or copy text. Everyone knows what I'm talking about, I'd guess. I just want to know if this is the best way to go about this, though.

First, I found out how to detect if the scrollbar is at the bottom of the textbox (using the GetScrollInfo API). That code looks a bit like:

Code Select Expand

Public Function DetectScrollLoc(ByVal rtb As Long) As Boolean
Dim sInfo As SCROLLINFO
    sInfo.cbSize = Len(sInfo)
    sInfo.fMask = &H1 Or &H2 Or &H4
    GetScrollInfo rtb, 1, sInfo
    If sInfo.nPos >= sInfo.nMax - sInfo.nPage Then
        DetectScrollLoc = True
    Else
        DetectScrollLoc = False
    End If
End Function

Then, I of course, needed to apply this function. At first, I tried locking the chat RTB, but that made it look like crap, and removed the useful feature of the scrollbar on the right getting smaller when new text appears. So, I set out to find a way to add formatted text to the bottom of a rich text box without selecting it. However, selecting appears to be the only way to set colors in RTBs.

So what'd I do? I created a second rich text box, which I used as a "buffer" box. First, I set the TextRTF of the buffer box to the TextRTF of the normal box. Then, I add the new text to the buffer RTF like I would have normally for the regular one. Then, I set the TextRTF of the normal box to the TextRTF of the buffer box, thereby adding formatted text to the end without selecting anything in the normal text box. This worked fine for the first few minutes of chat. However, running times of the function soon reached 400 milliseconds. So, to fix this problem, I set up the function to apply all text formatting to a variable declared as a rich text box, which was set as the normal or buffer box, depending on if the function displayed above returned true or false. Now, the function runs at 16 ms on average (which is what it originally ran at) when the scrollbar is normal, and it runs a bit laggy when scrolled up a bit. However, that lag is unnoticeable since you're scrolled up

Anyway, is there a better way to do this in VB6? Maybe an API call that can be used to set the color of text from one location to another without selecting it or something along those lines?

[MyndFyre]

The way that I've done this in the past is to detect scroll and selection events, and delay the addition of new text until no text is selected and the scroll position is reset to the bottom.

This seems similar to what you're doing, but I noticed that you said something about 400ms.  I'm not really sure what that's about (I just kind of skimmed your post).

Might be something of interest to you.

[Camel]

I came up with some really long-winded solution that worked well. If I can find the CD with the source code to my old bot on it, I'll look it up.

By the way,

Code Select Expand


    If sInfo.nPos >= sInfo.nMax - sInfo.nPage Then
        DetectScrollLoc = True
    Else
        DetectScrollLoc = False
    End If


can be condensed to:

Code Select Expand


    DetectScrollLoc = (sInfo.nPos >= sInfo.nMax - sInfo.nPage)


While I doubt it will actually make any difference in the generated assembly, it will streamline your code a bit. There are schools of thought that say that's bad design though, so it's all just a matter of opinion/preference.

[Barabajagal]

I think I'll choose readability. Thanks for the suggestion, though.

MF:

At first, I tried locking the chat RTB, but that made it look like crap, and removed the useful feature of the scrollbar on the right getting smaller when new text appears.

[FrOzeN]

I wrote this at the start of August last year for StealthBot, and Stealth made a small correction to my code. You can find it here. The AddChat procedure only pulls you to the bottom of the RichTextBox when the scrollbar is at the bottom, if your haven't got the scrollbar at the bottom then it continues to add text correctly, but doesn't draw you to it. Enjoy.

EDIT - Added code to post.

Code:

Code Select Expand

Option Explicit

'Code written by FrOzeN on 2/8/06
'Small correction by Stealth on 5/8/06

'Note: If your form (in this case, frmMain) is using Twips instead of pixels then line 5 should look like:
'   If (lngVerticalPos + (frmMain.rtbChat.Height / Screen.TwipsPerPixelY)) <= intRange Then

Private Const EM_GETTHUMB = &HBE
Private Const SB_THUMBPOSITION = &H4
Private Const WM_VSCROLL = &H115
Private Const SB_VERT As Long = 1

Private Declare Function GetScrollRange Lib "User32" (ByVal hWnd As Long, ByVal nBar As Integer, ByRef lpMinPos As Integer, ByRef lpMaxPos As Integer) As Boolean
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 Function LockWindowUpdate Lib "User32" (ByVal hwndLock As Long) As Long

Public Sub AddChat(ParamArray saElements() As Variant)
    Dim blUnlock As Boolean, lngVerticalPos As Long, intRange As Integer
   
    GetScrollRange frmMain.rtbChat.hWnd, SB_VERT, 0, intRange
    lngVerticalPos = SendMessage(frmMain.rtbChat.hWnd, EM_GETTHUMB, 0&, 0&)
   
    If (lngVerticalPos + frmMain.rtbChat.Height) <= intRange Then   'Line 5
        LockWindowUpdate frmMain.rtbChat.hWnd
        blUnlock = True
    End If
   
    '// Your code here -------------------------------------------------
    Dim i As Integer
    For i = LBound(saElements) To UBound(saElements) Step 2
        With frmMain.rtbChat
            .SelStart = Len(.Text)
            .SelLength = 0
            .SelColor = saElements(i)
            .SelText = saElements(i + 1) & Left$(vbCrLf, -2 * CLng((i + 1) = UBound(saElements)))
            .SelStart = Len(.Text)
        End With
    Next i
    '-----------------------------------------------------------------//
   
    If blUnlock = True Then
        SendMessage frmMain.rtbChat.hWnd, WM_VSCROLL, SB_THUMBPOSITION + &H10000 * lngVerticalPos, Nothing
        LockWindowUpdate 0&
    End If
End Sub

[Barabajagal]

That screws up horribly when you try to select text...

[brew]

not to mention that it doesn't work one bit ...
And the code where it actually appends the text to the RTB should look something more like this.

Code Select Expand


    Dim i As Long
    For i = LBound(saElements) To UBound(saElements) Step 2
        With rtbChat
            .SelStart = Len(.Text)
            .SelColor = saElements(i)
            .SelText = saElements(i + 1)
        End With
    Next i
    rtbChat.SelText = vbCrLf


[Barabajagal]

Brew, it works fine. Download the example program. The only problem is selection.

[Banana fanna fo fanna]

I think I'll choose readability. Thanks for the suggestion, though.

RONG.

[Barabajagal]

I think I'll choose readability. Thanks for the suggestion, though.

RONG.

Care to mention what's wrong, besides your spelling?

[FrOzeN]

Eh, when I originally wrote it for StealthBot it was designed on the basis that when you try to view previous conversations the scrollbar keeps jumping to the bottom which got annoying. When schools over (just over 6 weeks from now) I'm going to write a whole set of classes, one of which will be a huge focus on the RichEdit control, in that I'll look into appending text to a RichEdit box without affecting the user's current selection. I'll bring this topic up again if I solve it, and you haven't posted a solution by then.

[Barabajagal]

My current system is a solution. It just may or may not be the best one.

[Banana fanna fo fanna]

I think I'll choose readability. Thanks for the suggestion, though.

RONG.

Care to mention what's wrong, besides your spelling?

if x then
y = true/false
else
y = false/true

is universally recognized as bad code that should be written as y = x or y = not x. much more poetic that way, too

[Barabajagal]

I suppose. But I think it's easier to read, which is important in undocumented code

[Camel]

I suppose. But I think it's easier to read, which is important in undocumented code

If that's your issue, you could wrap the condition with CBool(...) so it's clear what it's doing.