Printable View
hello:
I am using a Rich text box, works fine. As the box gets filled up a vertical scroll bar suddenly appears, allowing scrolling up and down through the text---works great. However I'd like to know/detect when the scrollbar appears & disappears.
how can you tell if the scrollbar is actually being shown?
You can try this:
Code:Option Explicit
Private Declare Function SendMessage _
Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
Private Const EM_LINESCROLL As Long = &HB6
Public Sub SetTopIndex(rtb As RichTextBox, ByVal nLine As Long)
Dim nIndex As Long
nIndex = nLine - SendMessage(rtb.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
Call SendMessage(rtb.hwnd, EM_LINESCROLL, 0&, ByVal nIndex)
End Sub
Private Sub Form_Load()
rtb.Text = ""
rtb.SelText = "This is a text, this is only a text test, which is long"
SetTopIndex rtb, 0
End Sub
Thanks, but I do not understand your example---I only want to know whether the vertical scroll bar is present (visible/active) or not. something like VSBPRESENT=true/false
Thew scrollbar appears automatically whhen the text box gets full.
That will scroll your rtb back to it's top line, so only the first x lines appear, not the last. Scrollbars are automatic. There's no way to easily detect if there is one, two, or none.
Maybe calculate the max width, compared with the form width, or something...
Ok, I know this comes rather a little late.
I knew there was a rather trivial solution to this problem, but it simply didn't come to my mind. But now here it is. It's really rather simple, fortunately. :rolleyes:
To call the sub you pass the window handle of the RichTextBoxCode:Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long _
) As Long
Private Const GWL_Style = (-16)
Private Const WS_HScroll As Long = &H100000
Private Const WS_VScroll As Long = &H200000
Private Sub ShowScrollBarStyle(hWnd As Long)
Dim ws&, h as boolean, v as boolean
ws = GetWindowLong(hWnd, GWL_Style)
h = ws And WS_HScroll
v = ws And WS_VScroll
'now h is true if a horizontal ScrollBar exists and v is true for the existance of a vertical ScrollBar
'you can do now what you want with this information
End Sub
ShowScrollBarStyle myRTB.hWnd
Or you rewrite this to be a function, returning some value depending on h and v
Notabene: When testing this, I was rather surprised that I couldn't get the RichTextBox to produce a horizontal ScrollBar at all, but the vertical one is properly detected whenever it appears.
Not long enough. Add a few more lines, and it'll appearCode:Notabene: When testing this, I was rather surprised that I couldn't get the RichTextBox to produce a horizontal ScrollBar at all, but the vertical one is properly detected whenever it appears.
No, no. Dont misunderstand. First I added enough lines (more'n there is visible room for them) and then the vertical scrollbar appears immediately tomscroll the text up and down.
Now, I was thinking, if I add lines which are longer than the visible Box, the horizontal scrollbar would appear to allow left to right moving. But instead the Box does wordwrapping and never shows vertical the scrollbar, no matter how many lines I add.
Despite the fact, that I have set the .ScrollBars property to vbBoth.
You could do something like this:
Code:Option Explicit
Private Declare Function SendMessageLong Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lparam As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const DT_CALCRECT = &H400
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Function AutosizeCombo(CB As ComboBox) As Boolean
'Automatically sizes a combo box to hold the longest item within it
'A substantial portion of this code was written by other people. I found the
'basis for this on one of the VB Source Code Web sites. Originally, this
'routine was passed a number and the routine resized the combo box to the width
'of the passed number, not to the size of its 'longest item width. In
'another routine, I found an example of useing the DrawText API 'and thought
'it would be a cool idea to combine the two into a routine which does what
'this 'baby does. The only truly original aspect of this routine is the feature
'that I built in to 'accommodate changes in font size and style (bold, italic,
'underline, name) The rest is an Hack congolmoration of the two pieces of
'code already mentioned.
Dim LongReturn As Long
Dim CurrentCBWidth As Single
Dim TheCBItems As RECT
Dim ParentHdc As Long
Dim MyListCount As Long
Dim MyLongCounter As Long
Dim TempCBWidth As Long
Dim LongWidth As Long
Dim SavedFont As String
Dim SavedSize As Single
Dim SavedBold As Boolean
Dim SavedItalic As Boolean
Dim SavedUnderline As Boolean
Dim IsFontSaved As Boolean
On Error GoTo ErrorHandler
'Grab the combo handle and list count
ParentHdc = CB.Parent.hdc
MyListCount = CB.ListCount
If ParentHdc = 0 Or MyListCount = 0 Then Exit Function
'Save combo box fonts, etc. to the parent object(form),
'for testing lengths with the API
'My personal contribution
With CB.Parent
SavedFont = .FontName
SavedSize = .FontSize
SavedBold = .FontBold
SavedItalic = .FontItalic
SavedUnderline = .FontUnderline
.FontName = CB.FontName
.FontSize = CB.FontSize
.FontBold = CB.FontBold
.FontItalic = CB.FontItalic
.FontUnderline = CB.FontUnderline
End With
IsFontSaved = True
'Get the width of the widest item
For MyLongCounter = 0 To MyListCount
DrawText ParentHdc, CB.List(MyLongCounter), -1, TheCBItems, DT_CALCRECT
'Add twenty to the the number as a margin
TempCBWidth = TheCBItems.Right - TheCBItems.Left + 20
If (TempCBWidth > LongWidth) Then
LongWidth = TempCBWidth
End If
Next
'Get current width of combo
CurrentCBWidth = SendMessageLong(CB.hwnd, CB_GETDROPPEDWIDTH, 0, 0)
'If big enough then that's all A-OK
If CurrentCBWidth > LongWidth Then
AutosizeCombo = True
GoTo ErrorHandler
Exit Function
End If
'... but if not big enough, first calculate the screen width to ensure we don't exceed it!
If LongWidth > Screen.Width \ Screen.TwipsPerPixelX - 20 Then _
LongWidth = Screen.Width \ Screen.TwipsPerPixelX - 20
'Set the width of our combo
LongReturn = SendMessageLong(CB.hwnd, CB_SETDROPPEDWIDTH, LongWidth, 0)
'Set the function to True/False depending on API success
AutosizeCombo = LongReturn > 0
ErrorHandler:
'If anything blows up, reset the combo to its original state
On Error Resume Next
If IsFontSaved Then
With CB.Parent
.FontName = SavedFont
.FontSize = SavedSize
.FontUnderline = SavedUnderline
.FontBold = SavedBold
.FontItalic = SavedItalic
End With
End If
End Function
'In the dropdown even of the combo box, place this code
Private Sub Combo1_DropDown()
Dim x As Variant
x = AutosizeCombo(combo1)
End Sub
Private Sub Form_Load()
combo1.AddItem "this is a short item"
combo1.AddItem "this is a longer item that doesn't fit"
End Sub
This a rather interesting piece of code, which I have added instantly to my tricks collection.
But what has this to do with a RichTextBox not showing the horizontal scrollbar?
It rather seems, the RTB does not do left to right scrolling at all. Instead it is doing wordwrap.
Possibly you could produce a horizontal scrollbar with the SetWindowLong, GWL_Style and WS_HSCROLL, like I did once with a listbox. Should work on other boxes, too.
I was just intrigued why the RTB wouldnt do a horizontal scrollbar, even if you set the ScrollBar property to vbBoth. The standard TextBox will in this case produce the horizontal scrollbar and stop word wrapping.
Wow. Found a KB article about it:
Quote:
After loading the contents of the file into the RichTextBox, read them out into a string variable using the TextRTF property and then read them back into the RichTextBox. The Horizontal Scroll Bar will then appear as expected. The code for this workaround follows:
http://support.microsoft.com/kb/175501Code:Dim x As String
x = RichTextBox2.TextRTF
RichTextBox2.TextRTF = x
Property, RightMargin, I'll bet it presently equals zero (0). Set it to a value greater than the RTB's width and your horizontal scroll bar will appear when you enter a sufficient amount of text. Then once that limit is reached, the automatic word wrapping will take effect BUT if the value of right margin is sufficient enough for words to "hide" then the horizontal scroll bar will remain and eventually your vertical scroll bar will appear.
Simple...
Good Luck
That's it. Got it. Simply didn't know about the RightMargin property being responsible for the word wrap and scrollbar. Well, we live and learn.
@David thanks for researching. :) But the trick does not work as expected in my simple sample. I read the article, though, which is interesting.
To me the solution seems to be: Set the .RightMargin property to .Width and you will get Scrollbars as expected.
Then there is a final version of the scrollbar detector:
The function returns 0, 1, 2 or 3 depending on the appearance of scrollbars.Code:Private Function GetScrollBarStyle(hWnd As Long)
Dim ws&
ws = GetWindowLong(hWnd, GWL_Style)
GetScrollBarStyle = (ws And (WS_HScroll Or WS_VScroll) ) / WS_HScroll
End Function