Scrolling a STATIC area with the Wheel or Swipe

[rdonnay]

A customer wanted a better interface than STATIC SCROLL using a Scrollbar.
Using the mouse Wheel or Swiping the mouse pad is a better idea.

Code: Select all

#INCLUDE "dcdialog.CH"
#INCLUDE "appevent.CH"

FUNCTION Main()

LOCAL GetList[0], oStatic1, oStatic2, i, GetOptions, nColor

@ 0,0 DCSAY ;
      'This sample will use the Wheel to scroll the below;'  + ;
      'STATIC area when the mouse is placed over the STATIC.' ;
      SAYWORDBREAK ;
      SAYSIZE 50,2 ;
      FONT '12.Lucida Console' SAYSIZE 0 ;
      RESIZE DCGUI_RESIZE_REPOSONLY_Y

@ 3,0 DCSTATIC TYPE XBPSTATIC_TYPE_RAISEDBOX OBJECT oStatic1 ;
      SIZE 50,20 ;
      RESIZE DCGUI_RESIZE_RESIZEONLY_Y

@ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT OBJECT oStatic2 ;
      SIZE 100,100 PARENT oStatic1 ;
      RESIZE DCGUI_RESIZE_RESIZEONLY

nColor := 2
FOR i := 1 TO 99
  @ i,1 DCSAY 'Row ' + Alltrim(Str(i)) SAYSIZE 0 PARENT oStatic2 ;
        FONT '10.Lucida Console' ;
        SAYSIZE 30 ;
        COLOR nColor ;
        RESIZE DCGUI_RESIZE_REPOSONLY_Y
  nColor++
  IF nColor > 15
    nColor := 2
  ENDIF
NEXT

DCGETOPTIONS RESIZE

DCREAD GUI FIT TITLE 'Static Scroll Test' ;
   HANDLER ScrollWindow REFERENCE @oStatic2 OPTIONS GetOptions

RETURN nil

* -----------

PROC appsys ; return

* -----------

STATIC FUNCTION ScrollWindow( nEvent, mp1, mp2, oXbp, oDlg, GetList, oStatic2 )

IF nEvent == xbeM_Wheel .AND. Valtype(mp2) == 'A' .AND. oXbp:isDerivedFrom('DC_XbpStatic')
  IF mp2[2] < 0 .AND. oStatic2:currentPos()[2] >= 0
    RETURN DCGUI_NONE
  ELSEIF mp2[2] > 0 .AND. Abs(oStatic2:currentPos()[2]) >=  ;
      oStatic2:currentSize()[2] - oStatic2:parent:currentSize()[2]
    RETURN DCGUI_NONE
  ENDIF
  oStatic2:setPos({0,oStatic2:currentPos()[2]-(mp2[2]/10)})
ENDIF

RETURN DCGUI_NONE