Scrollbars and text selections in DDT label and textbox controls

[S Stamp]

1 - I'd like to use a vertical scroll bar within label/static text (i.e., CONTROL ADD LABEL) in a dialog. I tried using the styles %ES_AUTOVSCROLL or %ws_vscroll, but this doesn't work. A scrollbar appears but it is not functional.

Does powerbasic not have any inherent support for scrolling within text labels? I found a few hacks discussed in this forum, so I presume that native scrolling support is not available in this type of control. But I wanted to check whether perhaps this functionality may have been added in the latest version of power basic for Windows.

2 - to get around the scrolling limitation for the static label text controls, I used a text/edit box instead (i.e., CONTROL ADD TEXTBOX), since this control has a scrolling option.

There's one thing I don't like about the text/edit box. Whenever the control gains focus, any existing text in the control is automatically selected and highlighted (inverted). The user must click somewhere in the control in order to unselect and unhighlight the text. Is there some option that I can set so that the text is not automatically selected/inverted? The %es_nohidesel style option does the exact opposite of what I want; it keeps the text inverted even when the control does not have the focus.

3 - For the text/edit box control, is there anyway to get the vertical scroll bar to appear only when the amount of text requires vertical scrolling,and disappear when the scrollbar is not necessary? When I use the styles %ES_AUTOVSCROLL or %ws_vscroll, the vertical scroll bar is always present, no matter how little text is in the box. when I use %ES_AUTOVSCROLL by itself, I can scroll via the keyboard but there's no scrollbar present even when the amounts of text justifies a scrollbar.

[Chris Boss]

Many window classes can have a scrollbar.

The styles:

%WS_VSCROLL
%WS_HSCROLL

can be used.

The problem is that such scrollbars (which are part of a windows nonclient area) send their notification messages (WM_HSCROLL or WM_VSCROLL) to the window they are associated with (we are talking about window scrollbars, not the control class).

If a control uses the scrollbar styles, it must be subclassed so you can get access to its window procedure, so you can process the WM_HSCROLL/WM_VSCROLL messages. These messages are sent to the control itself and not the controls parent dialog.

[Chris Boss]

If you want to do some low level window message processing for controls, it may be better to create a superclass of that control class, rather than subclass the controls.

Superclassing is where you create a new window class, based on an existing one. You write your own window procedure and simply pass unprocessed messages to the address of the original window procedure for the class. There should be some examples of superclassing on the forums, so do a search to find some code examples.

[Dominic Mitchell]

Controls of the "Static" class do not support scrolling by default.

You can solve your problems with the edit control by using code similar
to that shown below. There is no need to subclass or superclass the control.
Also, do not add the WS_VSCROLL style in the CONTROL ADD TEXTBOX statement.

FUNCTION ToggleVerticalScrollbar _
  ( _
  BYVAL hWnd  AS DWORD _ ' control handle
  ) AS LONG

  LOCAL ttm         AS TEXTMETRIC
  LOCAL trc         AS RECT
  LOCAL dwStyle     AS DWORD
  LOCAL hDC         AS DWORD
  LOCAL hFontOld    AS DWORD
  LOCAL cLines      AS LONG
  LOCAL cyLine      AS LONG
  LOCAL fUpdate     AS LONG

  hDC = GetDC(hWnd)
  hFontOld = SelectObject(hDC, SendMessage(hWnd, %WM_GETFONT, 0, 0))
  GetTextMetrics hDC, ttm
  SelectObject hDC, hFontOld
  ReleaseDC hWnd, hDC
  cyLine = ttm.tmHeight

  SendMessage hWnd, %EM_GETRECT, 0, BYVAL VARPTR(trc)

  cLines = SendMessage(hWnd, %EM_GETLINECOUNT, 0, 0)

  dwStyle = GetWindowLong(hWnd, %GWL_STYLE)
  IF ((cLines * cyLine) > (trc.nBottom - trc.nTop)) THEN
    fUpdate = ((dwStyle AND %WS_VSCROLL) <> %WS_VSCROLL)
    SetWindowLong hWnd, %GWL_STYLE, dwStyle OR %WS_VSCROLL
  ELSE
    fUpdate = (dwStyle AND %WS_VSCROLL)
    SetWindowLong hWnd, %GWL_STYLE, dwStyle AND NOT %WS_VSCROLL
  END IF

  IF fUpdate THEN
    ' Force a WM_NCCALCSIZE message to be sent to the window
    SetWindowPos hWnd, %NULL, 0, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOMOVE OR %SWP_NOSIZE OR %SWP_FRAMECHANGED OR %SWP_DRAWFRAME
  END IF

END FUNCTION

Then in your callback use code similar to that shown below.

    SELECT CASE AS LONG CBMSG
      CASE %WM_INITDIALOG
  
      CASE %WM_NCACTIVATE
  
      CASE %WM_COMMAND  
        
        SELECT CASE AS LONG CBCTL
          CASE %IDC_EDIT1
          
            SELECT CASE CBCTLMSG
              CASE %EN_SETFOCUS  
                ' CBLPARAM is the handle of the edit control 
                ' Remove the selection when the control gains the focus 
                SendMessage CBLPARAM, %EM_SETSEL, -1, 0
                
              CASE %EN_UPDATE 
                ' CBLPARAM is the handle of the edit control
                ToggleVerticalScrollbar CBLPARAM
            END SELECT
          
          CASE %IDC_BUTTON1       
        END SELECT 
        
    END SELECT

[Dave Biggs]

Another option might be to use a Rich edit control as a label?

Richedit controls do have the advantage of only showing the scroll bar when warranted by default. However, like a TextBox / Edit Control it doesn't seem to be scrollable when disabled (eg to prevent the user typing into the label) so it is still neccessary to do something like subclassing the control to make it 'read only'...

#Dim All
#Include "WIN32API.INC"
#Include "RICHEDIT.INC"
'------------------
%LBL_LABEL1  = 100
%RE_LABEL    = 101
%BTN_Test    = 102
'------------------
 
' Subclass Macros (TT Colin Schmidt)
Macro mSC_Set(hDlg, IdCtl, SubProc)                           ' Set new callback proc
    SETWINDOWLONG GETDLGITEM(hDlg, IdCtl), %GWL_USERDATA, _
      SETWINDOWLONG(GETDLGITEM(hDlg, IdCtl), %GWL_WNDPROC, CodePtr(SubProc))
End Macro
 
Macro mSC_OrgProc                                             ' Restore original callback proc
    Function = CALLWINDOWPROC(GETWINDOWLONG(CbHndl, %GWL_USERDATA), CbHndl, CbMsg, CbWParam, CbLParam)
End Macro
'------------------/Macros mSC_Set and mSC_OrgProc
 
CallBack Function DlgProc()
  Select Case As Long CbMsg
    Case %WM_COMMAND
      Select Case As Long CbCtl
        Case %BTN_Test                      ' fill label manuallly - could use %EM_STREAMIN here
          If CbCtlMsg = %BN_CLICKED Then 
            Local RE_Header, sReLabel As String 
            RE_Header = _                                               ' RT header starts with
              "{"+ _                                                    ' <- Opening brace  **
              "\rtf1\ansi\ansicpg1252\deff0\deflang1033"+ _             ' Version and Char set
              "{\fonttbl"+ _                                            ' Font table
              "{\f0\fswiss\fprq2\fcharset0 Microsoft Sans Serif;}"+ _   ' \f0 = default/initial font
              "{\f1\fswiss\fprq2\fcharset0 Arial;}"+ _
              "{\f2\fnil\fprq2\fcharset2 Wingdings;}}"+ _
              "{\colortbl"+ _                                           ' Colour table
              "\red0\green0\blue0;"+ _                                  ' black  \cf0
              "\red255\green0\blue0;}"                                  ' red    \cf1
 
            sReLabel =  _
              "\fs16 "+ _                                         ' fs16 = use 8 point text
              "A richedit control will default to show \line "+ _
              "scroll bars only when required. \line "+ _
              "You need to add annother style \line "+ _
              "(%ES_DISABLENOSCROLL) if \line "+ _
              "you want to see the scroll bar all the\line "+ _"
              "time (with this style the bar will be greyed - \line "+ _"
              "dissabled if the text doesn't extend \line "+ _
              "far enough to warrant scrolling). \line "+ _
              "\fs22 \f1 "+ _                                     ' \f1 change font to Arial
              "Bonus - a richedit label can have different "+ _
              "fonts and \cf1 colours \cf0 too! \line "+ _
              "\fs24 \f2 J"+ _                                    ' \f2 change font to "Wingdings" :)
              "}"                                                 ' <- Closing brace  **
 
            sReLabel = RE_Header + sReLabel                       ' Add RT Header to label text
            Control Set Text CbHndl, %RE_Label, sReLabel
            Dialog Redraw CbHndl                                  ' Paint scroll bar properly
          End If
        Case %RE_Label
          If CbCtlMsg = %EN_SETFOCUS Then 
            Control Send CbHndl, %RE_Label, %EM_SETSEL, -1, 0     ' Prevent highlight on entry
          End If
      End Select
  End Select
End Function
'------------------/DlgProc
 
CallBack Function REditProc                               ' SubClas proc for REdit control
 
  Select Case As Long CbMsg
    Case %WM_CHAR                                         ' 'Eat' characters
      Function = 1 : Exit Function 
    Case %WM_KEYDOWN
      Select Case CbwParam
        Case %VK_DOWN, %VK_UP, %VK_TAB                    ' Allow some keys
          Function = 0 : mSC_OrgProc : EXIT Function 
        Case Else 
          Function = 1 : EXIT Function 
      End Select
  End Select
 
 mSC_OrgProc                                              ' call original DIALOG proc
End Function
'------------------/REditProc
 
Function PBMain()
 Local hDlg As Dword, sLabelText As String 
  sLabelText = "RE control as a label. Notice scroll bar not yet needed / showing. (Press Test..)"
  LoadLibrary "RICHED32.DLL"
 
  Dialog New 0, "Test", 100, 100, 300, 120, %WS_CAPTION Or %WS_SYSMENU, To hDlg
  Control Add Label,  hDlg, %LBL_LABEL1, "RichEdit label below", 10, 20, 100, 10
  Control Add Button, hDlg, %BTN_Test, "Test", 195, 45, 50, 15
  Control Add "RichEdit", hDlg, %RE_LABEL, sLabelText, 10, 40, 150, 45, %WS_CHILD Or %WS_VISIBLE _
    Or %ES_MULTILINE Or %WS_VSCROLL Or %ES_AUTOVSCROLL Or %WS_TABSTOP
  Control Send hDlg, %RE_LABEL, %EM_SETBKGNDCOLOR, 0, GetSysColor(%COLOR_BTNFACE)   ' Adjust appearance
  ' Need To subclass the RE control to prevent editing - %WS_DISABLED prevents scrolling...:
  mSC_Set(hDlg, %RE_Label, REditProc)                                               ' subclass control
 
  Dialog Show Modal hDlg, Call DlgProc
End Function
'------------------/PbMain

[Michael Mattias]

You could always add a separate scrollbar control next to the label control and keep track of which line of text should be shown.

[Chris Boss]

Scrollbars added to a label control

This requires a little trick!

First subclass the label control and process the WM_HSCROLL/WM_VSCROLL messages in the subclass procedure.

The trick is to forward a few non-client messages to the DefWindowProc API function, so the static control doesn't get them and they are processed using defaults.

Here is the code:

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
'   Written by Chris Boss (cwsof.com) 01/07/08
' ***************************************************************
#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding

#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'                  Constants and Declares (#1)
' *************************************************************
%FORM1_LABEL1             = 100
' --------------------------------------------------
DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
DECLARE CALLBACK FUNCTION Form1_DLGPROC
' --------------------------------------------------
' ------------------------------------------------
' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
GLOBAL hForm1&    ' Dialog handle
' *************************************************************
'                    Application Entrance
' *************************************************************
FUNCTION PBMAIN
    LOCAL Count&
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION
' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************
SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&, CT&        '  Variables used for Reading Data in Arrays for Listbox and Combobox
    '   hParent& = 0 if no parent Dialog
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  267,  177, Style&, ExStyle& TO hForm1&
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL1,  "Label  1", 72, 32, 99, 86, _
        %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR %SS_CENTER OR %WS_HSCROLL OR %WS_VSCROLL OR %SS_NOTIFY ' SS_NOTIFY required to respond to mouse clicks !
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
GLOBAL OriginalProc AS DWORD
FUNCTION MySubClassProc(BYVAL hCtrl&, BYVAL Msg&, BYVAL wParam&,BYVAL lParam&) AS LONG
     LOCAL SB AS SCROLLINFO, SFlag&, T$
     SELECT CASE Msg&
          CASE %WM_NCHITTEST, %WM_NCLBUTTONDOWN, %WM_NCLBUTTONUP      ' required to allow mouse to work with Static scrollbars
               FUNCTION=DefWindowProc(hCtrl&, Msg&, wParam&, lParam&)
               EXIT FUNCTION
          CASE %WM_VSCROLL
               SFlag&=%SB_VERT
               GOSUB DoScroll
               FUNCTION=0
               EXIT FUNCTION
          CASE %WM_HSCROLL
               SFlag&=%SB_HORZ
               GOSUB DoScroll
               FUNCTION=0
               EXIT FUNCTION
     END SELECT
     FUNCTION=CallWindowProc(OriginalProc, hCtrl&, Msg&, wParam&, lParam&)
     EXIT FUNCTION
     
     DoScroll:
     SB.cbSize=SIZEOF(SB)
     SB.fMask=%SIF_ALL
     GetScrollInfo hCtrl&, SFlag&, SB
     SELECT CASE LOWRD(wParam&)
          CASE %SB_LINEDOWN       ' sames as %SB_LINERIGHT
               SB.nPos=SB.nPos+1
          CASE %SB_LINEUP         ' sames as %SB_LINELEFT
               SB.nPos=SB.nPos-1
          CASE %SB_PAGEDOWN       ' sames as %SB_PAGERIGHT
               SB.nPos=SB.nPos+SB.nPage
          CASE %SB_PAGEUP         ' sames as %SB_PAGELEFT
               SB.nPos=SB.nPos-SB.nPage
          CASE %SB_THUMBPOSITION
               SB.nPos=SB.nTrackPos    'SP&
          CASE %SB_THUMBTRACK
               SB.nPos=SB.nTrackPos    'SP&
     END SELECT
     SetScrollInfo hCtrl&, SFlag&, SB, %TRUE
     ' see what the values are and put into caption bar
     GetScrollInfo hCtrl&, %SB_HORZ, SB
     T$=STR$(SB.nPos)
     GetScrollInfo hCtrl&, %SB_VERT, SB
     T$=T$+" , "+STR$(SB.nPos)
     DIALOG SET TEXT hForm1&, "Scrollbar values:  "+T$
     RETURN
     
END FUNCTION
' *************************************************************
'                             Dialog Callback Procedure
'                             for Form Form1
'                             uses Global Handle - hForm1&
' *************************************************************
CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
             LOCAL hCtrl&
             CONTROL HANDLE hForm1&, %FORM1_LABEL1 TO hCtrl&
             OriginalProc=SetWindowLong(hCtrl&, %GWL_WNDPROC, CODEPTR(MySubClassProc))
             LOCAL SB AS SCROLLINFO
             SB.cbSize=SIZEOF(SB)
             SB.fMask=%SIF_ALL
             SB.nMin=0
             SB.nMax=500
             SB.nPage=25
             SB.nPos=250
             SB.nTrackPos=0
             SetScrollInfo hCtrl&, %SB_VERT, SB, %TRUE
             SetScrollInfo hCtrl&, %SB_HORZ, SB, %TRUE
        CASE ELSE
    END SELECT
END FUNCTION

[Chris Boss]

I should note that the code I posted above will be useful for the PB Graphic control.

You can add scrollbars to the Graphic control too.

The PB Graphic control is an Ownerdraw Static control (label control is a Static control) so it will work.

Of course the PB Graphic image can't be scrolled directly, but if you keep a Bitmap buffer of a larger image it could be BitBlt'ed into the control using different coordinates based on the scrollbars.

[Chris Boss]

Moral of the Story !

is ...

The beauty of the DefWindowProc API function

Any window class can be subclassed and some messages rerouted to the DefWindowProc function to override unwanted actions of the window class. Of course this requires a little "trial and error" to see what messages need to be rerouted and whether this causes problems for the control (some messages should not be rerouted). But often it works quite well.

Another noce technique is to pass a message to the origina window procedure, but modify the return value. This works great to change some behaviors.

The beauty of all of this is you can use existing window classes and significantly change its behaviors.