home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4611 / fw16d.ins / SOURCE / CLASSES / WBROWSE.PRG < prev    next >
Text File  |  1994-06-10  |  27KB  |  1,027 lines
  1. #include "FiveWin.ch"
  2. #include "InKey.ch"
  3. #include "Set.ch"
  4. #include "Constant.ch"
  5.  
  6. #define GW_HWNDFIRST          0
  7. #define GW_HWNDLAST           1
  8. #define GW_HWNDNEXT           2
  9.  
  10. #define HWND_BROADCAST    65535  // 0xFFFF
  11.  
  12. #define CS_DBLCLKS            8
  13. #define COLOR_ACTIVECAPTION   2
  14. #define COLOR_CAPTIONTEXT     9
  15.  
  16. #define WM_SETFONT           48  // 0x30
  17.  
  18. extern DBSKIP
  19.  
  20. static lRegistered := .f.
  21.  
  22. //----------------------------------------------------------------------------//
  23.  
  24. CLASS TWBrowse FROM TControl
  25.  
  26.    DATA   cAlias, cField, uValue1, uValue2
  27.    DATA   bLine, bSkip, bGoTop, bGoBottom, bLogicLen, bChange, bAdd
  28.    DATA   nRowPos, nColPos, nLen, nAt
  29.    DATA   lHitTop, lHitBottom
  30.    DATA   oVScroll, oHScroll
  31.    DATA   aHeaders, aColSizes
  32.    DATA   nClrBackHead, nClrForeHead
  33.    DATA   nClrBackFocus, nClrForeFocus
  34.  
  35.    METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, ;
  36.                aColSizes, oWnd, cField, uVal1, uVal2, bChange,;
  37.                bLDblClick, bRClick, oFont, oCursor, nClrFore,;
  38.                nForeBack, cMsg, lUpdate ) CONSTRUCTOR
  39.  
  40.    METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1,;
  41.                     uVal2, bChange, bLDblClick, bRClick, oFont,;
  42.                     oCursor, nClrFore, nClrBack, cMsg, lUpdate ) CONSTRUCTOR
  43.  
  44.    METHOD SetArray( aArray )
  45.  
  46.    METHOD lCloseArea() INLINE ;
  47.              If( ! Empty( ::cAlias ), ( ::cAlias )->( DbCloseArea() ),),;
  48.              If( ! Empty( ::cAlias ), ::cAlias := "",), .t.
  49.  
  50.    METHOD Default()
  51.  
  52.    METHOD EditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack )
  53.  
  54.    METHOD GetDlgCode() INLINE  nOR( DLGC_WANTARROWS, DLGC_WANTCHARS )
  55.  
  56.    METHOD GoUp()
  57.    METHOD GoDown()
  58.    METHOD GoLeft()
  59.    METHOD GoRight()
  60.    METHOD GoTop()
  61.    METHOD GoBottom()
  62.    METHOD HandleEvent( nMsg, nWParam, nLParam )
  63.    METHOD HScroll( nWParam, nLParam )
  64.  
  65.    METHOD Init( hDlg ) INLINE Super:Init( hDlg ), ::Default()
  66.  
  67.    METHOD PageUp( nLines )
  68.    METHOD PageDown( nLines )
  69.    METHOD KeyDown( nKey )
  70.    METHOD KeyChar( nKey, nFlags )
  71.  
  72.    METHOD LButtonDown( nRow, nCol, nKeyFlags )
  73.  
  74.    METHOD MouseMove( nRow, nCol, nKeyFlags )
  75.  
  76.    METHOD Paint()
  77.  
  78.    METHOD VScroll( nWParam, nLParam )
  79.    METHOD Skip( n )
  80.  
  81.    METHOD DrawLine( nRow ) INLINE ;
  82.                wBrwLine( ::hWnd, ::hDC, If( nRow == nil, ::nRowPos, nRow ), ;
  83.                Eval( ::bLine ), ::GetColSizes(), ::nColPos,;
  84.                ::nClrText, ::nClrPane,;
  85.                If( ::oFont != nil, ::oFont:hFont, 0 ),;
  86.                ValType( ::aColSizes ) == "B" )
  87.  
  88.    METHOD DrawSelect() INLINE ;
  89.                wBrwLine( ::hWnd, ::hDC, ::nRowPos, Eval( ::bLine ),;
  90.                ::GetColSizes(), ::nColPos, ::nClrForeFocus,;
  91.                If( ::lFocused, ::nClrBackFocus, CLR_GRAY ),;
  92.                If( ::oFont != nil, ::oFont:hFont, 0 ),;
  93.                ValType( ::aColSizes ) == "B"  )
  94.  
  95.    METHOD RecAdd() INLINE If( ::bAdd != nil, Eval( ::bAdd ),)
  96.  
  97.    METHOD SetFilter( cField, uVal1, uVal2 )
  98.  
  99.    METHOD GotFocus() INLINE Super:GotFocus(),;
  100.                   If( ::nLen > 0 .and. ! Empty( ::cAlias ), ::DrawSelect(),)
  101.  
  102.    MESSAGE RecCount METHOD _RecCount( uSeekValue )
  103.  
  104.    METHOD UpStable()      // Thanks to Javier Alcazar
  105.                           // Corrects the same page skipping bug!
  106.  
  107.    METHOD nRowCount() INLINE ;
  108.           nWRows( ::hWnd, 0, If( ::oFont != nil, ::oFont:hFont, 0 ) ) - 1
  109.  
  110.    METHOD GetColSizes() INLINE ;
  111.           If( ValType( ::aColSizes ) == "A", ::aColSizes, Eval( ::aColSizes ) )
  112.  
  113.    METHOD LostFocus() INLINE Super:LostFocus(),;
  114.                    If( ::nLen > 0 .and. ! Empty( ::cAlias ), ::DrawSelect(),)
  115.  
  116. ENDCLASS
  117.  
  118. //----------------------------------------------------------------------------//
  119.  
  120. METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, aColSizes, oWnd,;
  121.             cField, uVal1, uVal2, bChange, bLDblClick, bRClick,;
  122.             oFont, oCursor, nClrFore, nClrBack, cMsg, lUpdate ) CLASS TWBrowse
  123.  
  124.    DEFAULT nRow := 0, nCol := 0, nHeigth := 100, nWidth := 100,;
  125.            oWnd := GetWndDefault(), nClrFore := CLR_BLACK,;
  126.            nClrBack := CLR_LIGHTGRAY,;
  127.            lUpdate  := .f.
  128.  
  129.    ::cCaption   = ""
  130.    ::nTop       = nRow * BRSE_CHARPIX_H    // 14
  131.    ::nLeft      = nCol * BRSE_CHARPIX_W        //8
  132.    ::nBottom    = ::nTop + nHeigth - 1
  133.    ::nRight     = ::nLeft + nWidth - 1
  134.    ::oWnd       = oWnd
  135.    ::lHitTop    = .f.
  136.    ::lHitBottom = .f.
  137.    ::lFocused   = .f.
  138.    ::nRowPos    = 1
  139.    ::nColPos    = 1
  140.    ::nStyle     = nOr( WS_CHILD, WS_VSCROLL, WS_HSCROLL,;
  141.                        WS_BORDER, WS_VISIBLE, WS_TABSTOP )
  142.    ::nId        = ::GetNewId()
  143.    ::cAlias     = Alias()
  144.    ::bLine      = bLine
  145.  
  146.    ::SetFilter( cField, uVal1, uVal2 )
  147.  
  148.    ::bAdd       = { || ( ::cAlias )->( DbAppend() ), ::UpStable() }
  149.  
  150.    ::aHeaders   = aHeaders
  151.    ::aColSizes  = aColSizes
  152.    ::nLen       = 0
  153.    ::lDrag      = .f.
  154.    ::lCaptured  = .f.
  155.    ::bChange    = bChange
  156.    ::bLDblClick = bLDblClick
  157.    ::bRClicked  = bRClick
  158.  
  159.    ::oCursor    = oCursor
  160.    ::oFont      = oFont
  161.  
  162.    ::nClrBackHead  = GetSysColor( COLOR_ACTIVECAPTION )
  163.    ::nClrForeHead  = GetSysColor( COLOR_CAPTIONTEXT )
  164.    ::nClrBackFocus = CLR_CYAN
  165.    ::nClrForeFocus = CLR_WHITE
  166.    ::cMsg          = cMsg
  167.    ::lUpdate       = lUpdate
  168.  
  169.    ::SetColor( nClrFore, nClrBack )
  170.  
  171.    if ! lRegistered
  172.       ::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_GLOBALCLASS, CS_DBLCLKS ) )
  173.       lRegistered = .t.
  174.    endif
  175.  
  176.    if oWnd:lVisible
  177.       ::Create()
  178.       ::Default()
  179.       ::lVisible = .t.
  180.    else
  181.       oWnd:DefControl( Self )
  182.       ::lVisible = .f.
  183.    endif
  184.  
  185.    if uVal1 != nil
  186.       Eval( ::bGoTop )
  187.    endif
  188.  
  189. return nil
  190.  
  191. //----------------------------------------------------------------------------//
  192.  
  193. METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1, uVal2,;
  194.                  bChange, bLDblClick, bRClick, oFont, oCursor,;
  195.                  nClrFore, nClrBack, cMsg, lUpdate ) CLASS TWBrowse
  196.  
  197.    DEFAULT oDlg := GetWndDefault(), nClrFore := CLR_BLACK,;
  198.            nClrBack := CLR_LIGHTGRAY, lUpdate := .f.
  199.  
  200.    ::lHitTop    = .f.
  201.    ::lHitBottom = .f.
  202.    ::lFocused   = .f.
  203.    ::nId        = nId
  204.    ::nRowPos    = 1
  205.    ::nColPos    = 1
  206.    ::cAlias     = Alias()
  207.    ::oWnd       = oDlg
  208.    ::aHeaders   = aHeaders
  209.    ::aColSizes  = aColSizes
  210.    ::nClrPane   = CLR_LIGHTGRAY
  211.    ::nClrText   = CLR_WHITE
  212.    ::nLen       = 0
  213.    ::lDrag      = .f.
  214.    ::lCaptured  = .f.
  215.    ::lVisible   = .f.
  216.  
  217.    ::bLine      = bLine
  218.    ::bChange    = bChange
  219.    ::bLDblClick = bLDblClick
  220.    ::bRClicked  = bRClick
  221.  
  222.    ::oCursor    = oCursor
  223.    ::oFont      = oFont
  224.  
  225.    ::nClrBackHead  = GetSysColor( COLOR_ACTIVECAPTION )
  226.    ::nClrForeHead  = GetSysColor( COLOR_CAPTIONTEXT )
  227.    ::nClrBackFocus = CLR_CYAN
  228.    ::nClrForeFocus = CLR_WHITE
  229.    ::cMsg          = cMsg
  230.    ::lUpdate       = lUpdate
  231.  
  232.    ::SetColor( nClrFore, nClrBack )
  233.  
  234.    ::SetFilter( cField, uVal1, uVal2 )
  235.    ::bAdd       = { || ( ::cAlias )->( DbAppend() ), ::UpStable() }
  236.  
  237.    if ! lRegistered
  238.       ::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_GLOBALCLASS, CS_DBLCLKS ) )
  239.       lRegistered = .t.
  240.    endif
  241.  
  242.    oDlg:DefControl( Self )
  243.  
  244.    if uVal1 != nil
  245.       Eval( ::bGoTop )
  246.    endif
  247.  
  248. return nil
  249.  
  250. //----------------------------------------------------------------------------//
  251.  
  252. METHOD SetArray( aArray ) CLASS TWBrowse
  253.  
  254.    ::nAt       = 1
  255.    ::cAlias    = "ARRAY"
  256.    ::bLogicLen = { || Len( aArray ) }
  257.    ::bGoTop    = { || ::nAt := 1 }
  258.    ::bGoBottom = { || ::nAt := Eval( ::bLogicLen ) }
  259.    ::bSkip     = { | nSkip, nOld | nOld := ::nAt, ::nAt += nSkip,;
  260.                   ::nAt := Min( Max( ::nAt, 1 ), Eval( ::bLogicLen ) ),;
  261.                   ::nAt - nOld }
  262. return nil
  263.  
  264. //----------------------------------------------------------------------------//
  265.  
  266. METHOD Paint() CLASS TWBrowse
  267.  
  268.  
  269.    wBrwLine( ::hWnd, ::hDC, 0, ::aHeaders, ::GetColSizes(),;
  270.                ::nColPos, ::nClrForeHead, ::nClrBackHead,;
  271.                If( ::oFont != nil, ::oFont:hFont, 0 ) )
  272.  
  273.    if ::nLen > 0
  274.  
  275.       ::Skip( 1 - ::nRowPos )
  276.  
  277.                   // WBrwPane() returns the Nº of visible rows
  278.  
  279.                   // WBrwPane recieves at aColSizes the Array or a Block
  280.                   // to get dinamically the Sizes !!!
  281.  
  282.       ::Skip( ::nRowPos - WBrwPane( ::hWnd, ::hDC, Self, ::bLine,;
  283.               ::aColSizes, ::nColPos, ::nClrText, ::nClrPane,;
  284.               If( ::oFont != nil, ::oFont:hFont, 0 ) ) )
  285.  
  286.       ::DrawSelect()
  287.    endif
  288.  
  289.    ::lHitTop    = .f.
  290.    ::lHitBottom = .f.
  291.  
  292. return 0
  293.  
  294. //----------------------------------------------------------------------------//
  295.  
  296. METHOD EditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack ) CLASS TWBrowse
  297.  
  298.    local oDlg
  299.    local aDim := aBrwPosRect( ::hWnd, ::nRowPos, ::aColSizes, ::nColPos, nCol,;
  300.                              If( ::oFont != nil, ::oFont:hFont, 0 ) )
  301.  
  302.    DEFINE DIALOG oDlg FROM aDim[ 1 ], aDim[ 2 ] TO aDim[ 3 ], aDim[ 4 ] ;
  303.           STYLE nOR( WS_VISIBLE, WS_POPUP, WS_BORDER )  PIXEL
  304.  
  305.    ACTIVATE DIALOG oDlg
  306.  
  307. return nil
  308.  
  309. //----------------------------------------------------------------------------//
  310.  
  311. METHOD GoUp() CLASS TWBrowse
  312.  
  313.    local nSkipped
  314.    local nLines := ::nRowCount()
  315.  
  316.    if ::nLen < 1
  317.       return nil
  318.    endif
  319.  
  320.    if ! ::lHitTop
  321.       ::DrawLine()
  322.       if ::Skip( -1 ) == -1
  323.          ::lHitBottom = .f.
  324.          if ::nRowPos > 1
  325.             ::nRowPos--
  326.          else
  327.             WBrwScroll( ::hWnd, -1, If( ::oFont != nil, ::oFont:hFont, 0 ) )
  328.          endif
  329.       else
  330.          ::lHitTop = .t.
  331.       endif
  332.       ::DrawSelect()
  333.       ::oVScroll:GoUp()
  334.       if ::bChange != nil
  335.          Eval( ::bChange )
  336.       endif
  337.    endif
  338.  
  339. return nil
  340.  
  341. //----------------------------------------------------------------------------//
  342.  
  343. METHOD GoDown() CLASS TWBrowse
  344.  
  345.    local nSkipped
  346.    local nLines := ::nRowCount()
  347.  
  348.    if ::nLen < 1
  349.       return nil
  350.    endif
  351.  
  352.    if ! ::lHitBottom
  353.       ::DrawLine()
  354.       if ::Skip( 1 ) == 1
  355.          ::lHitTop = .f.
  356.          if ::nRowPos < nLines
  357.             ::nRowPos++
  358.          else
  359.             WBrwScroll( ::hWnd, 1, If( ::oFont != nil, ::oFont:hFont, 0 ) )
  360.          endif
  361.       else
  362.          ::lHitBottom = .t.
  363.       endif
  364.       ::DrawSelect()
  365.       ::oVScroll:GoDown()
  366.       if ::bChange != nil
  367.          Eval( ::bChange )
  368.       endif
  369.    endif
  370.  
  371. return nil
  372.  
  373. //---------------------------------------------------------------------------//
  374.  
  375. METHOD GoLeft()  CLASS TWBrowse
  376.  
  377.  if ::nColPos > 1
  378.     ::nColPos--
  379.     ::Refresh( .f. )
  380.     ::oHScroll:GoUp()
  381.  endif
  382.  
  383. return nil
  384.  
  385. //---------------------------------------------------------------------------//
  386.  
  387. METHOD GoRight() CLASS TWBrowse
  388.  
  389.  if ::nColPos < Len( ::GetColSizes() )
  390.  
  391.     ::nColPos++
  392.     ::Refresh( .f. )
  393.     ::oHScroll:GoDown()
  394.  endif
  395.  
  396. return nil
  397.  
  398. //----------------------------------------------------------------------------//
  399.  
  400. METHOD GoTop() CLASS TWBrowse
  401.  
  402.    if ::nLen < 1
  403.       return nil
  404.    endif
  405.  
  406.    if ! ::lHitTop
  407.       Eval( ::bGoTop )
  408.       ::lHitTop = .t.
  409.       ::lHitBottom = .f.
  410.       ::nRowPos = 1
  411.       ::Refresh( .f. )
  412.       ::oVScroll:GoTop()
  413.       if ::bChange != nil
  414.          Eval( ::bChange )
  415.       endif
  416.    endif
  417.  
  418. return nil
  419.  
  420. //----------------------------------------------------------------------------//
  421.  
  422. METHOD GoBottom() CLASS TWBrowse
  423.  
  424.    local nSkipped
  425.    local nLines := ::nRowCount()
  426.    local n
  427.  
  428.    if ::nLen < 1
  429.       return nil
  430.    endif
  431.  
  432.    if ! ::lHitBottom
  433.       ::lHitBottom = .t.
  434.       ::lHitTop    = .f.
  435.  
  436.       Eval( ::bGoBottom )
  437.  
  438.       nSkipped = ::Skip( -( nLines - 1 ) )
  439.       ::nRowPos = 1 - nSkipped
  440.  
  441.       ::GetDC()
  442.       for n = 1 to -nSkipped
  443.           ::DrawLine( n )
  444.           ::Skip( 1 )
  445.       next
  446.       ::DrawSelect()
  447.       ::ReleaseDC()
  448.       ::oVScroll:GoBottom()
  449.       if ::bChange != nil
  450.          Eval( ::bChange )
  451.       endif
  452.    endif
  453.  
  454. return nil
  455.  
  456. //----------------------------------------------------------------------------//
  457.  
  458. METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TWBrowse
  459.  
  460.    local nClickRow, nSkipped
  461.  
  462.    if ::nLen < 1
  463.       return nil
  464.    endif
  465.  
  466.    ::SetFocus()
  467.  
  468.    nClickRow = nWRow( ::hWnd, ::hDC, nRow,;
  469.                       If( ::oFont != nil, ::oFont:hFont, 0 ) )
  470.  
  471.    if nClickRow > 0 .and. nClickRow != ::nRowPos .and. ;
  472.                           nClickRow < ::nRowCount() + 1
  473.       ::DrawLine()
  474.       nSkipped  = ::Skip( nClickRow - ::nRowPos )
  475.       ::nRowPos += nSkipped
  476.       ::oVScroll:SetPos( ::oVScroll:GetPos() + nSkipped )
  477.       ::DrawSelect()
  478.       ::lHitTop = .f.
  479.       ::lHitBottom = .f.
  480.       if ::bChange != nil
  481.          Eval( ::bChange )
  482.       endif
  483.    endif
  484.  
  485. return 0
  486.  
  487. //----------------------------------------------------------------------------//
  488.  
  489. METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TWBrowse
  490.  
  491.    do case
  492.       case nMsg == WM_KEYDOWN
  493.            return ::KeyDown( nWParam )
  494.  
  495.       case nMsg == WM_LBUTTONDOWN
  496.            return ::LButtonDown( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
  497.  
  498.       case nMsg == WM_PAINT
  499.            ::BeginPaint()
  500.             if ::oVScroll != nil   // They generate WM_PAINT msgs when range 0
  501.                ::oVScroll:SetRange( 1, ::nLen := Eval( ::bLogicLen ) )
  502.             endif                  // so here we avoid 'flicking'
  503.             if ::oHScroll != nil
  504.                ::oHScroll:SetRange( 1, Len( ::GetColSizes() ) )
  505.             endif
  506.            ::Paint()
  507.            ::EndPaint()
  508.            return 0
  509.  
  510.       case nMsg == WM_VSCROLL
  511.            return ::VScroll( nWParam, nLParam )
  512.  
  513.       case nMsg == WM_HSCROLL
  514.            return ::HScroll( nWParam, nLParam )
  515.  
  516.       case nMsg == FW_CLOSEAREA
  517.            if ! Empty( ::cAlias )
  518.               ( ::cAlias )->( DbCloseArea() )
  519.               ::cAlias = ""
  520.               return 0
  521.            endif
  522.    endcase
  523.  
  524. return Super:HandleEvent( nMsg, nWParam, nLParam )
  525.  
  526. //----------------------------------------------------------------------------//
  527.  
  528. METHOD Default() CLASS TWBrowse
  529.  
  530.    local n, aFields
  531.    local cAlias := Alias()
  532.    local nElements
  533.  
  534.    DEFAULT ::aHeaders := {}, ::aColSizes := {}
  535.  
  536.    if ::bLine == nil
  537.       ::bLine = { || _aFields( cAlias ) }
  538.    endif
  539.  
  540.    nElements = Len( Eval( ::bLine ) )
  541.  
  542.    if Len( ::aHeaders ) < nElements              //  == nil
  543.       ::aHeaders = Array( nElements )
  544.       for n = 1 to nElements
  545.           ::aHeaders[ n ] = ( cAlias )->( Field( n ) )
  546.       next
  547.    endif
  548.  
  549.    if Len( ::GetColSizes() ) < nElements
  550.       aFields = Eval( ::bLine )
  551.       ::aColSizes = Array( nElements )
  552.       for n = 1 to nElements
  553.           ::aColSizes[ n ] := GetTextWidth( 0, Replicate( "B", ;
  554.                                    Max( Len( ::aHeaders[ n ] ), ;
  555.                                         Len( aFields[ n ] ) ) + 1 ) )
  556.       next
  557.    endif
  558.  
  559.    DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self ;
  560.       RANGE 1, Eval( ::bLogicLen )
  561.  
  562.    DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self ;
  563.       RANGE 1, Len( ::GetColSizes() )
  564.  
  565.    if ::oFont == nil
  566.       ::oFont = ::oWnd:oFont
  567.    endif
  568.  
  569. return nil
  570.  
  571. //----------------------------------------------------------------------------//
  572.  
  573. function _aFields( cAlias )
  574.  
  575.    local aFld := Array( ( cAlias )->( FCount() ) )
  576.    local n, uVal
  577.  
  578.    for n = 1 to Len( aFld )
  579.        uVal = ( cAlias )->( FieldGet( n ) )
  580.        if ValType( uVal ) == "N"
  581.           uVal = Str( uVal )
  582.           aFld[ n ] = xPadL( uVal,;
  583.                       GetTextWidth( 0, Replicate( "B", Len( uVal ) ) ) )
  584.        else
  585.           aFld[ n ] = cValToChar( uVal )
  586.        endif
  587.    next
  588.  
  589. return aFld
  590.  
  591. //---------------------------------------------------------------------------//
  592.  
  593. METHOD KeyDown( nKey ) CLASS TWBrowse
  594.  
  595.    do case
  596.       case nKey == VK_UP
  597.            ::GoUp()
  598.  
  599.       case nKey == VK_DOWN
  600.            ::GoDown()
  601.  
  602.       case nKey == VK_LEFT
  603.            ::GoLeft()
  604.  
  605.       case nKey == VK_RIGHT
  606.            ::GoRight()
  607.  
  608.       case nKey == VK_HOME
  609.            ::GoTop()
  610.  
  611.       case nKey == VK_END
  612.            ::GoBottom()
  613.  
  614.       case nKey == VK_PRIOR
  615.            ::PageUp()
  616.  
  617.       case nKey == VK_NEXT
  618.            ::PageDown()
  619.  
  620.       otherwise
  621.            Super:KeyDown( nKey )
  622.    endcase
  623.  
  624. return 0
  625.  
  626. //----------------------------------------------------------------------------//
  627.  
  628. METHOD KeyChar( nKey, nFlags ) CLASS TWBrowse
  629.  
  630.    do case
  631.       case nKey == K_PGUP
  632.            ::PageUp()
  633.  
  634.       case nKey == K_PGDN
  635.            ::PageDown()
  636.  
  637.       otherwise
  638.            return nil
  639.    endcase
  640.  
  641. return 0
  642.  
  643. //----------------------------------------------------------------------------//
  644.  
  645. METHOD PageUp( nLines ) CLASS TListBox
  646.  
  647.    local nSkipped
  648.  
  649.    DEFAULT nLines := ::nRowCount()
  650.  
  651.    nSkipped = ::Skip( -nLines )
  652.  
  653.    if ::nLen < 1
  654.       return nil
  655.    endif
  656.  
  657.    if ! ::lHitTop
  658.       if nSkipped == 0
  659.          ::lHitTop = .t.
  660.       else
  661.          ::lHitBottom = .f.
  662.          if -nSkipped < nLines
  663.             ::nRowPos = 1
  664.             ::oVScroll:SetPos( 1 )
  665.          else
  666.  
  667.             nSkipped = ::Skip( -nLines )
  668.             ::Skip( -nSkipped )
  669.  
  670.             ::oVScroll:SetPos( ::oVScroll:GetPos() + nSkipped )
  671.  
  672.          endif
  673.          ::Refresh( .f. )
  674.          if ::bChange != nil
  675.             Eval( ::bChange )
  676.          endif
  677.          
  678.       endif
  679.       
  680.       // ::oVScroll:PageUp()
  681.  
  682.    else
  683.       ::oVScroll:GoTop()
  684.    endif
  685.  
  686. return nil
  687.  
  688. //----------------------------------------------------------------------------//
  689.  
  690. METHOD PageDown( nLines ) CLASS TListBox
  691.  
  692.    local nSkipped, n
  693.  
  694.    DEFAULT nLines := ::nRowCount()
  695.  
  696.    if ::nLen < 1
  697.       return nil
  698.    endif
  699.  
  700.    if ! ::lHitBottom
  701.       ::DrawLine()
  702.       nSkipped = ::Skip( ( nLines * 2 ) - ::nRowPos )
  703.  
  704.       if nSkipped != 0
  705.          ::lHitTop = .f.
  706.       endif
  707.  
  708.       do case
  709.          case nSkipped == 0 .or. nSkipped < nLines
  710.               if nLines - ::nRowPos < nSkipped
  711.                  ::GetDC()
  712.                  ::Skip( -( nLines ) )
  713.                  for n = 1 to ( nLines - 1 )
  714.                      ::Skip( 1 )
  715.                      ::DrawLine( n )
  716.                  next
  717.                  ::ReleaseDC()
  718.                  ::Skip( 1 )
  719.               endif
  720.               ::nRowPos = Min( ::nRowPos + nSkipped, nLines )
  721.               ::lHitBottom = .t.
  722.               ::oVScroll:GoBottom()
  723.  
  724.          otherwise
  725.               ::GetDC()
  726.               for n = nLines to 1 step -1
  727.                   ::DrawLine( n )
  728.                   ::Skip( -1 )
  729.               next
  730.               ::ReleaseDC()
  731.               ::Skip( ::nRowPos )
  732.       endcase
  733.       ::DrawSelect()
  734.       if ::bChange != nil
  735.          Eval( ::bChange )
  736.       endif
  737.  
  738.       if ! ::lHitBottom
  739.          ::oVScroll:SetPos( ::oVScroll:GetPos() + nSkipped - ( nLines - ::nRowPos ) )
  740.       else
  741.          ::oVScroll:GoBottom()
  742.       endif
  743.    endif
  744.  
  745. return nil
  746.  
  747. //----------------------------------------------------------------------------//
  748.  
  749. METHOD VScroll( nWParam, nLParam ) CLASS TWBrowse
  750.  
  751.    local nLines := ::nRowCount()
  752.    local nLen
  753.  
  754.    do case
  755.       case nWParam == SB_LINEUP
  756.            ::GoUp()
  757.  
  758.       case nWParam == SB_LINEDOWN
  759.            ::GoDown()
  760.  
  761.       case nWParam == SB_PAGEUP
  762.            ::PageUp()
  763.  
  764.       case nWParam == SB_PAGEDOWN
  765.            ::PageDown()
  766.  
  767.       case nWParam == SB_TOP
  768.            ::GoTop()
  769.  
  770.       case nWParam == SB_BOTTOM
  771.            ::GoBottom()
  772.  
  773.       case nWParam == SB_THUMBPOSITION
  774.            if ::nLen < 1
  775.               return 0
  776.            endif
  777.  
  778.            ::Skip( nLParam - ::oVScroll:GetPos() )
  779.            ::oVScroll:SetPos( nLParam )
  780.            nLen = Eval( ::bLogicLen )
  781.            if nLParam - ::oVScroll:nMin < nLines
  782.               ::nRowPos = 1
  783.            endif
  784.            if ::oVScroll:nMax - nLParam < Min( nLines, nLen )
  785.               ::nRowPos = Min( nLines, nLen ) - ( ::oVScroll:nMax - nLParam )
  786.            endif
  787.            ::Refresh( .f. )
  788.            if ::bChange != nil
  789.               Eval( ::bChange )
  790.            endif
  791.  
  792.       otherwise
  793.            return nil
  794.    endcase
  795.  
  796. return 0
  797.  
  798. //----------------------------------------------------------------------------//
  799.  
  800. METHOD HScroll( nWParam, nLParam ) CLASS TWBrowse
  801.  
  802.    do case
  803.       case nWParam == SB_LINEUP
  804.            ::GoLeft()
  805.  
  806.       case nWParam == SB_LINEDOWN
  807.            ::GoRight()
  808.  
  809.       case nWParam == SB_PAGEUP
  810.            ::GoLeft()
  811.  
  812.       case nWParam == SB_PAGEDOWN
  813.            ::GoRight()
  814.  
  815.       case nWParam == SB_TOP
  816.            ::nColPos = 1
  817.            ::oHScroll:SetPos( 1 )
  818.            ::Refresh( .f. )
  819.  
  820.       case nWParam == SB_BOTTOM
  821.            ::nColPos = Len( ::GetColSizes() )
  822.            ::oHScroll:SetPos( ::nColPos )
  823.            ::Refresh( .f. )
  824.  
  825.       case nWParam == SB_THUMBPOSITION
  826.            ::nColPos = nLParam
  827.            ::oHScroll:SetPos( nLParam )
  828.            ::Refresh( .f. )
  829.  
  830.       otherwise
  831.            return nil
  832.    endcase
  833.  
  834. return 0
  835.  
  836. //----------------------------------------------------------------------------//
  837.  
  838. METHOD Skip( n ) CLASS TWBrowse
  839.  
  840.    if ::bSkip != nil
  841.       return Eval( ::bSkip, n )
  842.    endif
  843.  
  844. return _DBSkipper( n )
  845.  
  846. //----------------------------------------------------------------------------//
  847.  
  848. static function BrwGoBottom( uExpr )
  849.  
  850.    local lSoftSeek := Set( _SET_SOFTSEEK, .t. )
  851.  
  852.    if ValType( uExpr ) == "C"
  853.       DbSeek( SubStr( uExpr, 1, Len( uExpr ) - 1 ) + ;
  854.               Chr( Asc( SubStr( uExpr, Len( uExpr ) ) ) + 1 ) )
  855.    else
  856.       DbSeek( uExpr + 1 )
  857.    endif
  858.    DbSkip( -1 )
  859.  
  860.    Set( _SET_SOFTSEEK, lSoftSeek )
  861.  
  862. return nil
  863.  
  864. //----------------------------------------------------------------------------//
  865.  
  866. // To simulate Filters using INDEXES         -they go extremely fast!-
  867.  
  868. static function BuildSkip( cAlias, cField, uValue1, uValue2 )
  869.  
  870.    local bSkipBlock
  871.    local cType := ValType( uValue1 )
  872.  
  873.    do case
  874.       case cType == "C"
  875.            bSkipBlock = { | n | ( cAlias )->( BrwGoTo( n, ;
  876.            &( "{||" + cField + ">= '" + uValue1 + "' .and." + ;
  877.            cField + "<= '" + uValue2 + "' }" ) ) ) }
  878.  
  879.       case cType == "D"
  880.            bSkipBlock = { | n | ( cAlias )->( BrwGoTo( n, ;
  881.            &( "{||" + cField + ">= CToD( '" + DToC( uValue1 ) + "') .and." + ;
  882.             cField + "<= CToD( '" + DToC( uValue2 ) + "') }" ) ) ) }
  883.  
  884.       case cType == "N"
  885.            bSkipBlock = { | n | ( cAlias )->( BrwGoTo( n, ;
  886.            &( "{||" + cField + ">= " + cValToChar( uValue1 ) + " .and." + ;
  887.            cField + "<= " + cValToChar( uValue2 ) + " }" ) ) ) }
  888.  
  889.       case cType == "L"
  890.            bSkipBlock = { | n | ( cAlias )->( BrwGoTo( n, ;
  891.            &( "{||" + cField + ">= " + cValToChar( uValue1 ) + " .and." + ;
  892.            cField + "<= " + cValToChar( uValue2 ) + " }" ) ) ) }
  893.    endcase
  894.  
  895. return bSkipBlock
  896.  
  897. //----------------------------------------------------------------------------//
  898.  
  899. static function BrwGoTo( n, bWhile )
  900.  
  901.    local nSkipped := 0, nDirection := If( n > 0, 1, -1 )
  902.  
  903.    while nSkipped != n .and. Eval( bWhile ) .and. ! EoF() .and. ! BoF()
  904.       DbSkip( nDirection )
  905.       nSkipped += nDirection
  906.    enddo
  907.  
  908.    do case
  909.       case EoF()
  910.          DbSkip( -1 )
  911.          nSkipped += -nDirection
  912.  
  913.       case BoF()
  914.          DbGoTo( RecNo() )
  915.          nSkipped++
  916.  
  917.       case ! Eval( bWhile )
  918.          DbSkip( -nDirection )
  919.          nSkipped += -nDirection
  920.    endcase
  921.  
  922. return nSkipped
  923.  
  924. //----------------------------------------------------------------------------//
  925.  
  926. METHOD _RecCount( uSeekValue ) CLASS TWBrowse
  927.  
  928.    local nRecNo := RecNo()
  929.    local nRecs  := 1
  930.  
  931.    if DbSeek( uSeekValue )
  932.       while ::Skip( 1 ) == 1
  933.          nRecs++
  934.       end
  935.    endif
  936.  
  937.    GOTO nRecNo
  938.  
  939. return nRecs
  940.  
  941. //----------------------------------------------------------------------------//
  942.  
  943. METHOD UpStable() CLASS TWBrowse
  944.  
  945.    local nRow   := ::nRowPos
  946.    local nRows  := ::nRowCount()
  947.    local nRecNo := ( ::cAlias )->( RecNo() )
  948.    local n      := 1
  949.    local lSkip  := .t.
  950.  
  951.    ::nRowPos    = 1
  952.    ::lHitTop    = .f.
  953.    ::lHitBottom = .f.
  954.    ::GoTop()
  955.  
  956.    while ! ( ::cAlias )->( EoF() )
  957.       if n > nRows
  958.          ( ::cAlias )->( DbGoTo( nRecNo ) )
  959.          ::nRowPos = nRow
  960.          lSkip     = .f.
  961.          exit
  962.       endif
  963.       if nRecNo == ( ::cAlias )->( RecNo() )
  964.          ::nRowPos = n
  965.          exit
  966.       else
  967.          ( ::cAlias )->( DbSkip() )
  968.       endif
  969.       n++
  970.    end
  971.  
  972.    if lSkip
  973.       ( ::cAlias )->( DbSkip( -::nRowPos ) )
  974.    endif
  975.  
  976. return nil
  977.  
  978. //----------------------------------------------------------------------------//
  979.  
  980. METHOD SetFilter( cField, uVal1, uVal2 ) CLASS TWBrowse
  981.  
  982.    DEFAULT uVal2 := uVal1
  983.  
  984.    ::cField     = cField
  985.    ::uValue1    = uVal1
  986.    ::uValue2    = uVal2
  987.  
  988.    // Posibility of using FILTERs based on INDEXES!!!
  989.  
  990.    ::bGoTop     = If( uVal1 != nil, { || ( ::cAlias )->( DbSeek( uVal1 ) ) },;
  991.                                     { || ( ::cAlias )->( DbGoTop() ) } )
  992.  
  993.    ::bGoBottom  = If( uVal2 != nil, { || ( ::cAlias )->( BrwGoBottom( uVal2 ) ) },;
  994.                                     { || ( ::cAlias )->( DbGoBottom() ) } )
  995.  
  996.    ::bSkip      = If( uVal1 != nil, BuildSkip( ::cAlias, cField, uVal1, uVal2 ),;
  997.                       { | n | ( ::cAlias )->( _DbSkipper( n ) ) } )
  998.  
  999.    ::bLogicLen  = If( uVal1 != nil,;
  1000.                       { || ( ::cAlias )->( Self:RecCount( uVal1 ) ) },;
  1001.                       { || ( ::cAlias )->( RecCount() ) } )
  1002.  
  1003. return nil
  1004.  
  1005. //----------------------------------------------------------------------------//
  1006.  
  1007. METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TWBrowse
  1008.  
  1009.    local nColPos := 0
  1010.  
  1011.    if ::lDrag
  1012.       return Super:MouseMove( nRow, nCol, nKeyFlags )
  1013.    else
  1014.       if AScan( ::GetColSizes(),;
  1015.                 { | nColumn | nColPos += nColumn,;
  1016.                               nCol >= nColPos - 1 .and. ;
  1017.                               nCol <= nColPos + 1 } ) != 0
  1018.          CursorWE()
  1019.       else
  1020.          Super:MouseMove( nRow, nCol, nKeyFlags )
  1021.       endif
  1022.    endif
  1023.  
  1024. return 0
  1025.  
  1026. //----------------------------------------------------------------------------//
  1027.