Skip to content
Permalink
Browse files

[DisplayRichText] Fix chat not scrolling when at the bottom.

  • Loading branch information...
nmbook committed Oct 31, 2017
1 parent 0ab1beb commit 3a2d38f519e29856422d4db1f0a63db0d53cecee
Showing with 29 additions and 7 deletions.
  1. +8 −5 trunk/modAPI.bas
  2. +21 −2 trunk/modOtherCode.bas
@@ -113,17 +113,20 @@ Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As L
Public Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Public Const CB_LIMITTEXT = &H141
Public Const SB_BOTTOM = 7
Public Const EM_SCROLL = &HB5
Public Const IDC_HAND = 32649&
Public Const CB_LIMITTEXT As Long = &H141
Public Const SB_BOTTOM As Long = 7
Public Const EM_SCROLL As Long = &HB5
Public Const WS_HSCROLL As Long = &H100000
Public Const WS_VSCROLL As Long = &H200000
Public Const GWL_STYLE As Long = (-16)
Public Const IDC_HAND As Long = 32649&

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd _
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd _
As Long, ByVal nIndex As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
@@ -1893,6 +1893,7 @@ Public Sub DisplayRichText(ByRef rtb As RichTextBox, ByRef saElements() As Varia
Dim arr() As Variant
Dim s As String
Dim lngVerticalPos As Long
Dim blnCanVScroll As Boolean
Dim Diff As Long
Dim i As Long
Dim intRange As Long
@@ -1990,7 +1991,8 @@ Public Sub DisplayRichText(ByRef rtb As RichTextBox, ByRef saElements() As Varia

' is the RTB at the bottom?
lngVerticalPos = IsScrolling(rtb)

blnCanVScroll = CanVScroll(rtb)

If (lngVerticalPos) Then
rtb.Visible = False

@@ -2060,6 +2062,7 @@ Public Sub DisplayRichText(ByRef rtb As RichTextBox, ByRef saElements() As Varia
With rtb
SetTextSelection rtb, -1, -1
RTBSetSelectedText rtb, vbCrLf
SetTextSelection rtb, -1, -1
End With

If (LogThis) Then
@@ -2072,7 +2075,15 @@ Public Sub DisplayRichText(ByRef rtb As RichTextBox, ByRef saElements() As Varia

'ColorModify rtb, GetRTBLength(rtb) - NewLength

If (blUnlock) Then
If Not blnCanVScroll And CanVScroll(rtb) Then
' didn't previously have scrollbar but now does
LockWindowUpdate rtb.hWnd
SendMessage rtb.hWnd, EM_SCROLL, SB_BOTTOM, &H0
LockWindowUpdate &H0
If (blUnlock) Then
rtb.Visible = True
End If
ElseIf (blUnlock) Then
SendMessage rtb.hWnd, WM_VSCROLL, _
SB_THUMBPOSITION + &H10000 * lngVerticalPos, 0&

@@ -2190,6 +2201,14 @@ Public Function IsScrolling(ByRef rtb As RichTextBox) As Long

End Function

Public Function CanVScroll(cnt As Control) As Boolean

Dim Style As Long
Style = GetWindowLong(cnt.hWnd, GWL_STYLE)
CanVScroll = CBool((Style And WS_VSCROLL) = WS_VSCROLL)

End Function

Public Sub CloseAllConnections(Optional ShowMessage As Boolean = True)
If (frmChat.sckBNLS.State <> sckClosed) Then: frmChat.sckBNLS.Close
If (frmChat.sckBNet.State <> sckClosed) Then: frmChat.sckBNet.Close

2 comments on commit 3a2d38f

@Davnit

This comment has been minimized.

Copy link
Collaborator

replied Oct 31, 2017

This does not appear to be fixed as of c9d950e

@Davnit

This comment has been minimized.

Copy link
Collaborator

replied Oct 31, 2017

Appears to be fixed in 3972472

Please sign in to comment.
You can’t perform that action at this time.