Hide Scrollbars At RunTime

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
%IDC_TextBox = 500
Global hDlg,hTextBox As Dword
 
Function PBMain() As Long
   Local style&, temp$, i As Long
   style& = %WS_TabStop Or _
            %WS_Border Or  _
            %WS_VScroll Or _
            %WS_HScroll Or _
            %ES_Left Or    _
            %ES_WantReturn Or _
            %ES_AutoHScroll Or _
            %ES_AutoVScroll Or _
            %ES_MultiLine
   Dialog New Pixels, 0, "TextBox Test",300,300,200,200, %WS_OverlappedWindow, 0 To hDlg
   Control Add TextBox, hDlg, %IDC_TextBox,"", 10,10,180,180, Style&
   Control Handle hDlg, %IDC_TextBox To hTextBox
 
   For i = 1 To 20 : temp$ = temp$ + $CrLf + Repeat$(5,"Line") + Str$(i) : Next i
   Control Set Text hdlg, %IDC_TextBox, Trim$(temp$,$CrLf)
 
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local w,h As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         PostMessage hTextBox, %EM_SETSEL, -1, 0   'remove startup highlighting
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_TextBox
               Select Case Cb.CtlMsg
                  Case %EN_Change : SetVerticalScrollbar
               End Select
         End Select
      Case %WM_Size
         Dialog Get Client hDlg To w,h
         Control Set Size hDlg, %IDC_TextBox, w-20,h-20
         SetVerticalScrollbar
         SetHorizontalScrollbar
   End Select
End Function
 
Sub SetVerticalScrollBar
   Local LineCount, MaxVisibleLines, w,h As Long, style&
   LineCount = SendMessage(hTextBox, %EM_GetLineCount, 0,0)  'lines of text in the control
   Control Get Client hDlg, %IDC_TextBox To w,h
   MaxVisibleLines = h / LineToLine      'get # of lines that will fit
   ShowScrollbar hTextbox, %SB_Vert, IIf(LineCount > MaxVisibleLines, %True, %False)
End Sub
 
Function LineToLine() As Long
   'assumes Graphic Attach has been used, works on currently assigned font
   Local x,y,m,n As Single, hBMP,hFont As Dword
   Graphic Bitmap New 100,100 To hBMP : Graphic Attach hBMP, 0
   Font New "MS Sans Serif", 8, 0 To hFont
   Graphic Set Font hFont
   Graphic Get Pos To x,y
   Graphic Print "ABC"
   Graphic Get Pos To m,n
   Function = n-y
End Function
 
Sub SetHorizontalScrollBar
   Local ActualLineCount, MaxVisibleLines, w,h As Long, style&
   Control Get Client hDlg, %IDC_TextBox To w,h
   ShowScrollbar hTextbox, %SB_Horz, IIf(MaxContentWidth > w, %True, %False)
End Sub
 
Function MaxContentWidth() As Long
   Local i,LineCount,wMax,w,h As Long, temp$,tmp$, hBMP, hFont As Long
   Graphic Bitmap New 100,100 To hBMP : Graphic Attach hBMP, 0
   Font New "MS Sans Serif", 8, 0 To hFont
   Graphic Set Font hFont
   Control Get Text hDlg, %IDC_TextBox To temp$
   LineCount = ParseCount(temp$,$CrLf)
   For i = 1 To LineCount
      tmp$ = Parse$(temp$,$CrLf,i)
      Graphic Text Size tmp$ To w,h                   'width of text
      wMax = Max(wMax,w)                               'keep largest width
   Next i
   Function = wMax
End Function
 
 
'gbs_01234
'Date: 05-11-2013                

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm