diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ef2f9a9766..66003fee43 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,35 @@ past entries belonging to author(s): Viktor Szakats. */ +2009-08-07 12:35 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) + * contrib/hbxbp/appevent.ch + * contrib/hbxbp/xbpbrowse.prg + ! A thorough rewrite of XbpBrowse() class. The vertical navigation is + based on TBrowse() class and hence XbpBrowse() via Qt will probably be the + fastest GUI browser in the market in the sense that it has almost negligible + memory overhead. + + * contrib/hbxbp/tests/demoxbp.prg + ! Fine-tuned XbpBrowse() code confirming to latest changes. + + /* + Finally I could achieve vertical navigation as per TBrowse without any + memory overhead. Horizontal navigation stll needs a lot of work but in its + simplest form it is working. Please play with vertical navigation and report + on this list any differences you might found. + + XbpBrowse() truely follows Xbase++ event loop protocol. So it is possible + that you can try real-life XbpBrowse code with Harbour-Qt. I am looking forward + your support in this direction. Because it is taking my lot of time to + understand the Qt's internal behavior of model/view programming, I am + finding it hard to test all possible scenarios. + + Please make experiments with array bowsers, indexed browsers, etc. and provide + feedback as much as possible. + + Enjoy + */ + 2009-08-07 12:30 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) * contrib/hbqt/qth/QAbstractItemView.qth ! Fixed one artifact causing limited sources. diff --git a/harbour/contrib/hbxbp/appevent.ch b/harbour/contrib/hbxbp/appevent.ch index 22326e5887..5a75703c67 100644 --- a/harbour/contrib/hbxbp/appevent.ch +++ b/harbour/contrib/hbxbp/appevent.ch @@ -363,6 +363,14 @@ #define xbeHTML_FrameBeforeNavigate ( 759 + xbeB_Event ) #define xbeHTML_FrameNavigateComplete ( 760 + xbeB_Event ) +#define xbeBRW_ItemMarked ( 400 + xbeB_Event ) +#define xbeBRW_ItemSelected ( 401 + xbeB_Event ) +#define xbeBRW_ItemRbDown ( 402 + xbeB_Event ) +#define xbeBRW_HeaderRbDown ( 403 + xbeB_Event ) +#define xbeBRW_FooterRbDown ( 404 + xbeB_Event ) +#define xbeBRW_Navigate ( 405 + xbeB_Event ) +#define xbeBRW_Pan ( 406 + xbeB_Event ) +#define xbeBRW_ForceStable ( 408 + xbeB_Event ) #define _APPEVENT_CH #endif diff --git a/harbour/contrib/hbxbp/tests/demoxbp.prg b/harbour/contrib/hbxbp/tests/demoxbp.prg index 65b67b3798..10492292cf 100644 --- a/harbour/contrib/hbxbp/tests/demoxbp.prg +++ b/harbour/contrib/hbxbp/tests/demoxbp.prg @@ -55,6 +55,7 @@ #include "appevent.ch" #include "inkey.ch" #include "gra.ch" +#include "set.ch" #ifdef __XPP__ #pragma library("XppUi2") @@ -1324,7 +1325,7 @@ FUNCTION Build_Rtf( oWnd ) oRTF:setColorBG( GraMakeRGBColor( {255,255,200} ) ) oRTF:setFontCompoundName( "12.Times" ) - oRTF:change := {|| hb_outDebug( "change" ) } + //oRTF:change := {|| /*hb_outDebug( "change"*/ NIL ) } // Assign text to the RTF object's text buffer oRTF:text := "Text with varying " + Chr(10) +; @@ -1442,132 +1443,200 @@ STATIC FUNCTION RtfApplyFont( oRTF ) FUNCTION Build_Browse( oWnd ) LOCAL aPresParam, oXbpBrowse, oXbpColumn - #include "set.ch" - Set( _SET_DATEFORMAT, "MM/DD/YYYY" ) USE "test.dbf" NEW SHARED VIA 'DBFCDX' + DbGotop() - oXbpBrowse := XbpBrowse():new( oWnd ):create( , , { 10,10 }, { oWnd:currentSize()[1]-25,oWnd:currentSize()[2]-45 } ) + oXbpBrowse := XbpBrowse():new():create( oWnd, , { 10,10 }, { oWnd:currentSize()[1]-25,oWnd:currentSize()[2]-45 } ) + oXbpBrowse:setFontCompoundName( "10.Courier" ) - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "Last" }, ; - { XBP_PP_COL_HA_FGCLR , XBPSYSCLR_WINDOWSTATICTEXT }, ; - { XBP_PP_COL_HA_BGCLR , XBPSYSCLR_DIALOGBACKGROUND }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; - { XBP_PP_COL_DA_BGCLR , RGB( 248,210,194 ) }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } + oXbpBrowse:skipBlock := {|n| DbSkipBlock( n ) } + oXbpBrowse:goTopBlock := {| | DbGoTop() } + oXbpBrowse:goBottomBlock := {| | DbGoBottom() } - oXbpColumn := XbpColumn():new( , , , , aPresParam ) - oXbpColumn:dataLink := {|| test->Last } - oXbpColumn:create() + oXbpBrowse:firstPosBlock := {| | 1 } + oXbpBrowse:lastPosBlock := {| | LastRec() } + oXbpBrowse:posBlock := {| | RecNo() } + oXbpBrowse:goPosBlock := {|n| DbGoto( n ) } + oXbpBrowse:phyPosBlock := {| | RecNo() } + + oXbpBrowse:headerRbDown := {|mp1, mp2, o| mp1 := mp1, xbp_debug( o:getColumn( mp2 ):heading ) } + + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "Last" } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , XBPSYSCLR_WINDOWSTATICTEXT } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 30 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , RGB( 248,210,194 ) } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 20 } ) + + oXbpColumn := XbpColumn():new() + oXbpColumn:dataLink := {|| test->Last } oXbpColumn:colorBlock := {|x| IF( left( x,1 ) $ "L,H", { GRA_CLR_BLUE, GRA_CLR_YELLOW }, { NIL, NIL } ) } + oXbpColumn:create( , , , , aPresParam ) // oXbpBrowse:addColumn( oXbpColumn ) - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "First" }, ; - { XBP_PP_COL_HA_ALIGNMENT , XBPALIGN_LEFT }, ; - { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 200, 100, 255 } ) }, ; - { XBP_PP_COL_HA_BGCLR , GRA_CLR_RED }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_BGCLR , RGB( 120,130,230 ) }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } - // - oXbpColumn := XbpColumn():new( , , , , aPresParam ) - oXbpColumn:dataLink := {|| test->First } - oXbpColumn:create() - // - oXbpBrowse:addColumn( oXbpColumn ) + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "Salary" } ) + aadd( aPresParam, { XBP_PP_COL_HA_ALIGNMENT , XBPALIGN_RIGHT } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , RGB( 140,170,240 ) } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 20 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , GRA_CLR_DARKGREEN } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 25 } ) + //aadd( aPresParam, { XBP_PP_COL_DA_ROWWIDTH , 60 } ) - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "Hired On" }, ; - { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 255, 0, 255 } ) }, ; - { XBP_PP_COL_HA_BGCLR , GRA_CLR_YELLOW }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; - { XBP_PP_COL_DA_BGCLR , GRA_CLR_GREEN }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } // - oXbpColumn := XbpColumn():new( , , , , aPresParam ) - oXbpColumn:dataLink := {|| test->HireDate } - oXbpColumn:create() - // - oXbpBrowse:addColumn( oXbpColumn ) - - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "Age" }, ; - { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 200, 100, 255 } ) }, ; - { XBP_PP_COL_HA_BGCLR , GRA_CLR_BLUE }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; - { XBP_PP_COL_DA_BGCLR , GRA_CLR_YELLOW }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } - // - oXbpColumn := XbpColumn():new( , , , , aPresParam ) - oXbpColumn:dataLink := {|| test->Age } - oXbpColumn:create() - // - oXbpBrowse:addColumn( oXbpColumn ) - - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "City" }, ; - { XBP_PP_COL_HA_FGCLR , GRA_CLR_CYAN }, ; - { XBP_PP_COL_HA_BGCLR , GRA_CLR_BLUE }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; - { XBP_PP_COL_DA_BGCLR , RGB( 205,240,210 ) }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } - // - oXbpColumn := XbpColumn():new( , , , , aPresParam ) - oXbpColumn:dataLink := {|| test->City } - oXbpColumn:create() - // - oXbpBrowse:addColumn( oXbpColumn ) - - aPresParam := { ; - { XBP_PP_COL_HA_CAPTION , "Salary" }, ; - { XBP_PP_COL_HA_ALIGNMENT , XBPALIGN_RIGHT }, ; - { XBP_PP_COL_HA_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_HA_BGCLR , RGB( 140,170,240 ) }, ; - { XBP_PP_COL_HA_HEIGHT , 20 }, ; - { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK }, ; - { XBP_PP_COL_DA_BGCLR , GRA_CLR_DARKGREEN }, ; - { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE }, ; - { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY }, ; - { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED }, ; - { XBP_PP_COL_DA_ROWHEIGHT , 20 } } - // - oXbpColumn := XbpColumn():new( , , , , aPresParam ) + oXbpColumn := XbpColumn():new() oXbpColumn:dataLink := {|| test->Salary } - oXbpColumn:create() + oXbpColumn:create( , , , , aPresParam ) oXbpColumn:colorBlock := {|x| IF( x < 40000, { NIL, RGB( 255,0,0 ) }, {NIL,NIL} ) } // oXbpBrowse:addColumn( oXbpColumn ) + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "First" } ) + aadd( aPresParam, { XBP_PP_COL_HA_ALIGNMENT , XBPALIGN_LEFT } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 200, 100, 255 } ) } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , GRA_CLR_RED } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 20 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , RGB( 120,130,230 ) } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 20 } ) + // + oXbpColumn := XbpColumn():new() + oXbpColumn:dataLink := {|| test->First } + oXbpColumn:create( , , , , aPresParam ) + // + oXbpBrowse:addColumn( oXbpColumn ) + + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "Hired On" } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 255, 0, 255 } ) } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , GRA_CLR_YELLOW } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 20 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , GRA_CLR_GREEN } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 20 } ) + // + oXbpColumn := XbpColumn():new() + oXbpColumn:dataLink := {|| test->HireDate } + oXbpColumn:create( , , , , aPresParam ) + // + oXbpBrowse:addColumn( oXbpColumn ) + + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "Age" } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , GraMakeRGBColor( { 200, 100, 255 } ) } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , GRA_CLR_BLUE } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 20 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , GRA_CLR_YELLOW } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 20 } ) + // + oXbpColumn := XbpColumn():new() + oXbpColumn:dataLink := {|| test->Age } + oXbpColumn:create( , , , , aPresParam ) + // + oXbpBrowse:addColumn( oXbpColumn ) + + aPresParam := {} + aadd( aPresParam, { XBP_PP_COL_HA_CAPTION , "City" } ) + aadd( aPresParam, { XBP_PP_COL_HA_FGCLR , GRA_CLR_CYAN } ) + aadd( aPresParam, { XBP_PP_COL_HA_BGCLR , GRA_CLR_BLUE } ) + aadd( aPresParam, { XBP_PP_COL_HA_HEIGHT , 20 } ) + aadd( aPresParam, { XBP_PP_COL_DA_FGCLR , GRA_CLR_BLACK } ) + aadd( aPresParam, { XBP_PP_COL_DA_BGCLR , RGB( 205,240,210 ) } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_FGCLR , GRA_CLR_WHITE } ) + aadd( aPresParam, { XBP_PP_COL_DA_HILITE_BGCLR , GRA_CLR_DARKGRAY } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_COLSEPARATOR , XBPCOL_SEP_DOTTED } ) + aadd( aPresParam, { XBP_PP_COL_DA_ROWHEIGHT , 20 } ) + // + oXbpColumn := XbpColumn():new() + oXbpColumn:dataLink := {|| test->City } + oXbpColumn:create( , , , , aPresParam ) + // + oXbpBrowse:addColumn( oXbpColumn ) + RETURN nil /*----------------------------------------------------------------------*/ + +STATIC FUNCTION DbSkipBlock( n ) + LOCAL nSkipped := 0 + + if n == 0 + DBSkip( 0 ) + + elseif n > 0 + do while nSkipped != n .and. TBNext() + nSkipped++ + enddo + else + do while nSkipped != n .and. TBPrev() + nSkipped-- + enddo + endif + + RETURN nSkipped + +/*----------------------------------------------------------------------*/ + +STATIC FUNCTION TBNext() + LOCAL nSaveRecNum := recno() + LOCAL lMoved := .T. + + if Eof() + lMoved := .F. + else + DBSkip( 1 ) + if Eof() + lMoved := .F. + DBGoTo( nSaveRecNum ) + endif + endif + + RETURN lMoved + +/*----------------------------------------------------------------------*/ + +STATIC FUNCTION TBPrev() + LOCAL nSaveRecNum := Recno() + LOCAL lMoved := .T. + + DBSkip( -1 ) + + if Bof() + DBGoTo( nSaveRecNum ) + lMoved := .F. + endif + + RETURN lMoved + +/*----------------------------------------------------------------------*/ + diff --git a/harbour/contrib/hbxbp/xbpbrowse.prg b/harbour/contrib/hbxbp/xbpbrowse.prg index cf1e7b59a5..2851730c7a 100644 --- a/harbour/contrib/hbxbp/xbpbrowse.prg +++ b/harbour/contrib/hbxbp/xbpbrowse.prg @@ -9,6 +9,9 @@ * Copyright 2009 Pritpal Bedi * http://www.harbour-project.org * + * Navigation Based on TBrowse.prg + * Copyright 2008 Przemyslaw Czerpak + * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) @@ -76,169 +79,6 @@ /*----------------------------------------------------------------------*/ -CLASS XbpBrowse INHERIT XbpWindow - - METHOD new() - METHOD create() - METHOD configure() - METHOD destroy() - METHOD exeBlock() - METHOD supplyInfo() - - DATA cursorMode INIT XBPBRW_CURSOR_CELL - DATA hScroll INIT .T. - DATA sizeCols INIT .T. - DATA softTrack INIT .T. - DATA vScroll INIT .T. - - ACCESS colCount INLINE Len( ::columns ) - DATA colPos INIT 1 - DATA rowCount - DATA rowPos - - DATA b_firstPosBlock PROTECTED - DATA b_goBottomBlock PROTECTED - DATA b_goPosBlock PROTECTED - DATA b_goTopBlock PROTECTED - DATA b_hitBottomBlock PROTECTED - DATA b_hitTopBlock PROTECTED - DATA b_lastPosBlock PROTECTED - DATA b_phyPosBlock PROTECTED - DATA b_posBlock PROTECTED - DATA b_skipBlock PROTECTED - DATA b_stableBlock PROTECTED - - METHOD firstPosBlock SETGET - METHOD goBottomBlock SETGET - METHOD goPosBlock SETGET - METHOD goTopBlock SETGET - METHOD hitBottomBlock SETGET - METHOD hitTopBlock SETGET - METHOD lastPosBlock SETGET - METHOD phyPosBlock SETGET - METHOD posBlock SETGET - METHOD skipBlock SETGET - METHOD stableBlock SETGET - - METHOD addColumn( oXbpColumn ) - METHOD delColumn( nColPos ) - METHOD getColumn( nColPos ) - METHOD insColumn( nColPos, oXbpColumn ) - METHOD setColumn( nColPos, oNewXbpColumn ) - METHOD setLeftFrozen( aColumnIndex ) - METHOD setRightFrozen( aColumnIndex ) - - /* Navigation */ - METHOD down() - METHOD firstCol() - METHOD goBottom() - METHOD goTop() - METHOD lastCol() - METHOD left() - METHOD pageDown() - METHOD pageUp() - METHOD pageEnd() - METHOD panHome() - METHOD panLeft() - METHOD panRight() - METHOD right() - METHOD up() - - METHOD deHilite() -// METHOD forceStable() - METHOD hiLite() - METHOD refreshAll() - METHOD refreshCurrent() - - METHOD getData() - - METHOD footerRbDown() SETGET - METHOD headerRbDown() SETGET - METHOD itemMarked() SETGET - METHOD itemRbDown() SETGET - METHOD itemSelected() SETGET - - METHOD forceStable() SETGET - METHOD navigate() SETGET - METHOD pan() SETGET - - DATA sl_xbeBRW_FooterRbDown - DATA sl_xbeBRW_HeaderRbDown - DATA sl_xbeBRW_ItemMarked - DATA sl_xbeBRW_ItemRbDown - DATA sl_xbeBRW_ItemSelected - DATA sl_xbeBRW_ForceStable - DATA sl_xbeBRW_Navigate - DATA sl_xbeBRW_Pan - - DATA oDbfModel - DATA oModelIndex INIT QModelIndex() - DATA oVertHeaderView - DATA oHorzHeaderView - DATA pCurIndex - - DATA columns INIT {} - - ENDCLASS - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) - - ::xbpWindow:init( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) - - ::xbpWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) - - /* Subclass of QTableView */ - ::oWidget := HbTableView():new( ::pParent ) - - /* Do we need to fix the font size ? May be needed for TBrowse Behabvior */ - ::setFontCompoundName( "10.Courier" ) - - ::connect( ::pWidget, "keyPressEvent()", {|o,p| ::exeBlock( 1, p, o ) } ) - - /* .DBF Manipulation Model */ - ::oDbfModel := HbDbfModel():new( {|p1,p2,p3,p4| ::supplyInfo( p1, p2, p3, p4 ) } ) - - /* Hide veritical Header because of Performance boost */ - ::oVertHeaderView := QHeaderView() - ::oVertHeaderView:configure( ::oWidget:verticalHeader() ) - ::oVertHeaderView:hide() - - ::oWidget:setModel( QT_PTROF( ::oDbfModel ) ) - ::oWidget:setCurrentIndex( QModelIndex():new():sibling( 0,0 ) ) - ::pCurIndex := ::oWidget:currentIndex() - - //::oWidget:setColumnWidth( 2, 150 ) // PP - //::oWidget:setColumnWidth( 4, 30 ) // PP - //::oWidget:setRowHeight( 0,70 ) // PP - - ::oWidget:setAlternatingRowColors( .t. ) - - ::oWidget:setTabKeyNavigation( .t. ) - ::oWidget:setShowGrid( .t. ) - ::oWidget:setGridStyle( Qt_DotLine ) // to be based on column definition - ::oWidget:setSelectionMode( QAbstractItemView_ExtendedSelection ) - - ::oWidget:selectRow( 0 ) - // ::oWidget:resizeRowsToContents() /* Very expansive */ - - ::setPosAndSize() - IF ::visible - ::show() - ENDIF - ::oParent:AddChild( SELF ) - - RETURN Self - -/*----------------------------------------------------------------------*/ - #define HBQT_BRW_CELLVALUE 1001 #define HBQT_BRW_COLCOUNT 1002 #define HBQT_BRW_ROWCOUNT 1003 @@ -253,44 +93,676 @@ METHOD XbpBrowse:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) #define HBQT_BRW_DATHEIGHT 1012 #define HBQT_BRW_DATALIGN 1013 -METHOD XbpBrowse:supplyInfo( nInfo, p2, p3, p4 ) +/*----------------------------------------------------------------------*/ +/*----------------------------------------------------------------------*/ +/*----------------------------------------------------------------------*/ +// +// XbpBrowse +// +/*----------------------------------------------------------------------*/ +/*----------------------------------------------------------------------*/ +/*----------------------------------------------------------------------*/ + +#define HB_CLS_NOTOBJECT + +#include "hbclass.ch" + +#include "button.ch" +#include "color.ch" +#include "common.ch" +#include "error.ch" +#include "inkey.ch" +#include "setcurs.ch" +#include "tbrowse.ch" + +#define _TBCI_COLOBJECT 1 // column object +#define _TBCI_COLWIDTH 2 // width of the column +#define _TBCI_COLPOS 3 // column position on screen +#define _TBCI_CELLWIDTH 4 // width of the cell +#define _TBCI_CELLPOS 5 // cell position in column +#define _TBCI_COLSEP 6 // column separator +#define _TBCI_SEPWIDTH 7 // width of the separator +#define _TBCI_HEADING 8 // column heading +#define _TBCI_FOOTING 9 // column footing +#define _TBCI_HEADSEP 10 // heading separator +#define _TBCI_FOOTSEP 11 // footing separator +#define _TBCI_DEFCOLOR 12 // default color +#define _TBCI_FROZENSPACE 13 // space after frozen columns +#define _TBCI_LASTSPACE 14 // space after last visible column +#define _TBCI_SIZE 14 // size of array with TBrowse column data + +#define _TBC_SETKEY_KEY 1 +#define _TBC_SETKEY_BLOCK 2 + +#define _TBC_CLR_STANDARD 1 +#define _TBC_CLR_SELECTED 2 +#define _TBC_CLR_HEADING 3 +#define _TBC_CLR_FOOTING 4 +#define _TBC_CLR_MAX 4 + +#define _TBR_CONF_COLORS 1 +#define _TBR_CONF_COLUMNS 2 +#define _TBR_CONF_ALL 3 + +/* Footing/heading line separator. */ +#define _TBR_CHR_LINEDELIMITER ";" + +#define _TBR_COORD( n ) Int( n ) + +/*----------------------------------------------------------------------*/ + +CREATE CLASS XbpBrowse INHERIT XbpWindow + + VAR cargo AS USUAL EXPORTED // 01. User-definable variable + +PROTECTED: + VAR n_Top AS NUMERIC INIT 0 // 02. Top row number for the TBrowse display + VAR n_Left AS NUMERIC INIT 0 // 03. Leftmost column for the TBrowse display + VAR n_Bottom AS NUMERIC INIT 0 // 04. Bottom row number for the TBrowse display + VAR n_Right AS NUMERIC INIT 0 // 05. Rightmost column for the TBrowse display + + VAR columns AS ARRAY INIT {} // 06. Array of TBrowse columns + + VAR cHeadSep AS CHARACTER INIT "" // 07. Heading separator characters + VAR cColSep AS CHARACTER INIT " " // 08. Column separator characters + VAR cFootSep AS CHARACTER INIT "" // 09. Footing separator characters + + VAR cColorSpec AS CHARACTER // 10. Color table for the TBrowse display + + VAR bSkipBlock AS BLOCK INIT {|| NIL } // 11. Code block used to reposition data source + VAR bGoTopBlock AS BLOCK INIT {|| NIL } // 12. Code block executed by TBrowse:goTop() + VAR bGoBottomBlock AS BLOCK INIT {|| NIL } // 13. Code block executed by TBrowse:goBottom() + VAR bFirstPosBlock AS BLOCK INIT {|| NIL } + VAR bLastPosBlock AS BLOCK INIT {|| NIL } + VAR bPhyPosBlock AS BLOCK INIT {|| NIL } + VAR bPosBlock AS BLOCK INIT {|| NIL } + VAR bGoPosBlock AS BLOCK INIT {|| NIL } + VAR bHitBottomBlock AS BLOCK INIT {|| NIL } + VAR bHitTopBlock AS BLOCK INIT {|| NIL } + VAR bStableBlock AS BLOCK INIT {|| NIL } + + VAR dummy INIT "" // 14. ??? In Clipper it's character variable with internal C level structure containing browse data + VAR cBorder AS CHARACTER // 15. character value defining characters drawn around object + VAR cMessage // 16. character string displayed on status bar + VAR keys AS ARRAY // 17. array with SetKey() method values + VAR styles AS ARRAY // 18. array with SetStyle() method values + +EXPORTED: + +#if 0 + VAR mRowPos AS INTEGER INIT 0 // numeric value indicating the data row of the mouse position + VAR mColPos AS INTEGER INIT 0 // numeric value indicating the data column of the mouse position +#else + METHOD mRowPos SETGET // numeric value indicating the data row of the mouse position + METHOD mColPos SETGET // numeric value indicating the data column of the mouse position +#endif + + METHOD setStyle( nStyle, lNewValue ) // maintains a dictionary within an object + METHOD setKey( nKey, bBlock ) // get/set a code block associated with an INKEY() value + METHOD applyKey( nKey ) // evaluate the code block associated with given INKEY() value + METHOD hitTest( mRow, mCol ) // indicate position of mouse cursor relative to TBrowse + METHOD nRow SETGET // screen row number for the actual cell + METHOD nCol SETGET // screen column number for the actual cell + METHOD border( cBorder ) SETGET // get/set character value used for TBrowse are border + METHOD message( cMessage ) SETGET // get/set character string displayed on status bar + + METHOD nTop( nTop ) SETGET // get/set top row number for the TBrowse display + METHOD nLeft( nLeft ) SETGET // get/set leftmost column for the TBrowse display + METHOD nBottom( nBottom ) SETGET // get/set bottom row number for the TBrowse display + METHOD nRight( nRight ) SETGET // get/set rightmost column for the TBrowse display + + METHOD headSep( cHeadSep ) SETGET // get/set heading separator characters + METHOD colSep( cColSep ) SETGET // get/set column separator characters + METHOD footSep( cFootSep ) SETGET // get/set footing separator characters + + METHOD skipBlock( bSkipBlock ) SETGET // get/set code block used to reposition data source + METHOD goTopBlock( bBlock ) SETGET // get/set code block executed by TBrowse:goTop() + METHOD goBottomBlock( bBlock ) SETGET // get/set code block executed by TBrowse:goBottom() + /* Xbase++ */ + METHOD firstPosBlock( bBlock ) SETGET + METHOD lastPosBlock( bBlock ) SETGET + METHOD phyPosBlock( bBlock ) SETGET + METHOD posBlock( bBlock ) SETGET + METHOD goPosBlock( bBlock ) SETGET + METHOD hitBottomBlock( bBlock ) SETGET + METHOD hitTopBlock( bBlock ) SETGET + METHOD stableBlock( bBlock ) SETGET + + + METHOD colorSpec( cColorSpec ) SETGET // get/set string value with color table for the TBrowse display + + ACCESS rowPos METHOD getRowPos // get current cursor row position + ASSIGN rowPos METHOD setRowPos // set current cursor row position + + ACCESS colPos METHOD getColPos // get current cursor column position + ASSIGN colPos METHOD setColPos // set current cursor column position + + ACCESS freeze METHOD getFrozen // get number of frozen columns + ASSIGN freeze METHOD freeze // set number of columns to freeze + + ACCESS hitTop METHOD getTopFlag // get the beginning of available data flag + ASSIGN hitTop METHOD setTopFlag // set the beginning of available data flag + + ACCESS hitBottom METHOD getBottomFlag // get the end of available data flag + ASSIGN hitBottom METHOD setBottomFlag // set the end of available data flag + + ACCESS autoLite METHOD getAutoLite // get automatic highlighting state + ASSIGN autoLite METHOD setAutoLite // set automatic highlighting + + ACCESS stable METHOD getStableFlag // get flag indicating if the TBrowse object is stable + ASSIGN stable METHOD setStableFlag // set flag indicating if the TBrowse object is stable + + METHOD addColumn( oCol ) // adds a TBColumn object to the TBrowse object + METHOD delColumn( nColumn ) // delete a column object from a browse + METHOD insColumn( nColumn, oCol ) // insert a column object in a browse + METHOD setColumn( nColumn, oCol ) // replaces one TBColumn object with another + METHOD getColumn( nColumn ) // gets a specific TBColumn object + + METHOD rowCount() // number of visible data rows in the TBrowse display + METHOD colCount() // number of browse columns + + METHOD colWidth( nColumn ) // returns the display width of a particular column + + METHOD leftVisible() // indicates position of leftmost unfrozen column in display + METHOD rightVisible() // indicates position of rightmost unfrozen column in display + + METHOD hilite() // highlights the current cell + METHOD deHilite() // dehighlights the current cell + METHOD refreshAll() // causes all data to be recalculated during the next stabilize + METHOD refreshCurrent() // causes the current row to be refilled and repainted on next stabilize + METHOD forceStable() // performs a full stabilization + METHOD invalidate() // forces entire redraw during next stabilization + + METHOD up() // moves the cursor up one row + METHOD down() // moves the cursor down one row + METHOD pageUp() // repositions the data source upward + METHOD pageDown() // repositions the data source downward + METHOD goTop() // repositions the data source to the top of file + METHOD goBottom() // repositions the data source to the bottom of file + + METHOD left() // moves the cursor left one column + METHOD right() // moves the cursor right one column + METHOD home() // moves the cursor to the leftmost visible data column + METHOD end() // moves the cursor to the rightmost visible data column + METHOD panHome() // moves the cursor to the leftmost visible data column + METHOD panEnd() // moves the cursor to the rightmost data column + METHOD lastCol() + METHOD firstCol() + METHOD panLeft() // pans left without changing the cursor position + METHOD panRight() // pans right without changing the cursor position + + METHOD stabilize() // performs incremental stabilization + METHOD colorRect( aRect, aColors ) // alters the color of a rectangular group of cells + + METHOD viewArea() // Xbase++ compatible method + METHOD firstScrCol() // Xbase++ compatible method + + MESSAGE _left() METHOD Left() + MESSAGE _right() METHOD Right() + MESSAGE _end() METHOD End() + + METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats] + METHOD create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) // constructor, NOTE: This method is a Harbour extension [vszakats] + METHOD exeBlock( nMode ) // executes view events + METHOD supplyInfo( nMode ) // supplies cell parameters to Qt engine + METHOD configure( nMode ) // mark that the internal settings of the TBrowse object should be reconfigured + METHOD handleEvent( nEvent, mp1, mp2 ) + +PROTECTED: + VAR nRowPos AS INTEGER INIT 1 // current cursor row position + VAR nColPos AS INTEGER INIT 1 // current cursor column position + VAR nLeftVisible AS INTEGER INIT 0 // indicates position of leftmost unfrozen column in display + VAR nRightVisible AS INTEGER INIT 0 // indicates position of rightmost unfrozen column in display + VAR n_Row AS INTEGER INIT 0 // current cursor screen row position + VAR n_Col AS INTEGER INIT 0 // current cursor screen column position + VAR nHeadHeight AS INTEGER INIT 0 // heading vertical size + VAR nFootHeight AS INTEGER INIT 0 // footing vertical size + VAR nFrozen AS INTEGER INIT 0 // number of frozen columns + VAR nBufferPos AS INTEGER INIT 1 // position in row buffer + VAR nMoveOffset AS INTEGER INIT 0 // requested repositioning + VAR nLastRow AS INTEGER INIT 0 // last row in the buffer + VAR nLastScroll AS INTEGER INIT 0 // last srcoll value + VAR nConfigure AS INTEGER INIT _TBR_CONF_ALL // configuration status + VAR nLastPos AS INTEGER INIT 0 // last calculated column position + VAR lHitTop AS LOGICAL INIT .F. // indicates the beginning of available data + VAR lHitBottom AS LOGICAL INIT .F. // indicates the end of available data + VAR lHiLited AS LOGICAL INIT .F. // indicates if current cell is highlighted + VAR lAutoLite AS LOGICAL INIT .T. // logical value to control highlighting + VAR lStable AS LOGICAL INIT .F. // indicates if the TBrowse object is stable + VAR lInvalid AS LOGICAL INIT .T. // indicates that TBrowse object data should be fully redrawn + VAR lRefresh AS LOGICAL INIT .F. // indicates that record buffer should be discarded in next stabilization + VAR lFrames AS LOGICAL INIT .F. // indicates that headings and footings should be redrawn + VAR lHeadSep AS LOGICAL INIT .F. // indicates if heading separator exists + VAR lFootSep AS LOGICAL INIT .F. // indicates if footing separator exists + VAR aColData AS ARRAY INIT {} // column information, see _TBCI_* + VAR aColors AS ARRAY INIT {} // array with TBrowse colors, see _TBC_CLR_* + VAR aDispStatus AS ARRAY INIT {} // record buffer status + VAR aCellStatus AS ARRAY INIT {} // record buffer status + VAR aCellValues AS ARRAY INIT {} // cell values buffers for each record - transformed + VAR aCellValuesA AS ARRAY INIT {} // cell values buffers for each record - actual + VAR aCellColors AS ARRAY INIT {} // cell colors buffers for each record + + METHOD doConfigure() // reconfigures the internal settings of the TBrowse object + METHOD setUnstable() // set TBrows in unstable mode resetting flags + METHOD setPosition( nPos ) // synchronize record position with the buffer + METHOD readRecord() // read current record into the buffer + + METHOD setVisible() // set visible columns + METHOD setCursorPos() // set screen cursor position at current cell + METHOD scrollBuffer( nRows ) // scroll internal buffer for given row numbers + METHOD colorValue( nColorIndex ) // get color value for given index + METHOD cellValue( nRow, nCol ) // get cell value formatted + METHOD cellValueA( nRow, nCol ) // get cell value actual + METHOD cellColor( nRow, nCol ) // get cell formatted value + METHOD dispFrames() // display TBrowse border, columns' headings, footings and separators + METHOD dispRow( nRow ) // display TBrowse data + + FRIEND FUNCTION _mBrwPos // helper function for mRow() and mCol() methods + + DATA oDbfModel + DATA oModelIndex INIT QModelIndex() + DATA oVertHeaderView + DATA oHorzHeaderView INIT QHeaderView() + DATA oVertScrollBar INIT QScrollBar() + DATA oHorzScrollBar INIT QScrollBar() + DATA oWidgetViewport INIT QWidget() + DATA oFont INIT QFont() + DATA pCurIndex + + DATA lFirst INIT .t. + DATA nRowsInView INIT 1 + + METHOD setCurrentIndex() + METHOD setHorzOffset() + METHOD setVertScrollBarRange() + METHOD setHorzScrollBarRange() + METHOD updateVertScrollBar() + METHOD updatePosition() + +EXPORTED: + METHOD footerRbDown() SETGET + METHOD headerRbDown() SETGET + METHOD itemMarked() SETGET + METHOD itemRbDown() SETGET + METHOD itemSelected() SETGET + + //METHOD forceStable() SETGET + METHOD navigate() SETGET + METHOD pan() SETGET + + DATA sl_xbeBRW_FooterRbDown + DATA sl_xbeBRW_HeaderRbDown + DATA sl_xbeBRW_ItemMarked + DATA sl_xbeBRW_ItemRbDown + DATA sl_xbeBRW_ItemSelected + DATA sl_xbeBRW_ForceStable + DATA sl_xbeBRW_Navigate + DATA sl_xbeBRW_Pan + + DATA cursorMode INIT XBPBRW_CURSOR_CELL + DATA hScroll INIT .T. + DATA sizeCols INIT .T. + DATA softTrack INIT .T. + DATA vScroll INIT .T. + + ENDCLASS + +/*----------------------------------------------------------------------*/ +/* Just to retain TBrowse functionality: in the future */ +METHOD new( nTop, nLeft, nBottom, nRight ) CLASS XbpBrowse + + DEFAULT nTop TO 0 + DEFAULT nLeft TO 0 + DEFAULT nBottom TO MaxRow() + DEFAULT nRight TO MaxCol() + + ::nTop := nTop + ::nLeft := nLeft + ::nBottom := nBottom + ::nRight := nRight + + ::colorSpec := SetColor() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD XbpBrowse:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) + + ::xbpWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) + + /* Subclass of QTableView */ + ::oWidget := HbTableView():new( ::pParent ) + + /* Important here as other parts will be based on it*/ + ::setPosAndSize() + + /* Some parameters */ + ::oWidget:setTabKeyNavigation( .t. ) + ::oWidget:setShowGrid( .f. ) + ::oWidget:setGridStyle( Qt_DotLine ) /* to be based on column definition */ + ::oWidget:setSelectionMode( QAbstractItemView_SingleSelection ) + ::oWidget:selectRow( 0 ) + + /* Connect Keyboard Events */ + ::connect( ::pWidget, "keyPressEvent()" , {|o,p| ::exeBlock( 1, p, o ) } ) + ::connect( ::pWidget, "mousePressEvent()" , {|o,p| ::exeBlock( 2, p, o ) } ) + ::connect( ::pWidget, "scrollContentsBy(int,int)", {|o,p,p1| ::exeBlock( 3, p, p1, o ) } ) + + /* Finetune Horizontal Scrollbar */ + ::oWidget:setHorizontalScrollBarPolicy( Qt_ScrollBarAlwaysOn ) + ::oHorzScrollBar:configure( ::oWidget:horizontalScrollBar() ) + ::connect( QT_PTROF( ::oHorzScrollBar ), "actionTriggered(int)", {|o,i| ::exeBlock( 103, i, o ) } ) + ::connect( QT_PTROF( ::oHorzScrollBar ), "sliderReleased()" , {|o,i| ::exeBlock( 104, i, o ) } ) + + /* Replace Vertical Scrollbar with our own */ + ::oWidget:setVerticalScrollBarPolicy( Qt_ScrollBarAlwaysOn ) + // + ::oVertScrollBar := QScrollBar():new() //:configure( ::oWidget:verticalScrollBar() ) + ::oVertScrollBar:setOrientation( Qt_Vertical ) + ::connect( QT_PTROF( ::oVertScrollBar ), "actionTriggered(int)", {|o,i| ::exeBlock( 101, i, o ) } ) + ::connect( QT_PTROF( ::oVertScrollBar ), "sliderReleased()" , {|o,i| ::exeBlock( 102, i, o ) } ) + // + ::oWidget:setVerticalScrollBar( QT_PTROF( ::oVertScrollBar ) ) + + /* Veritical Header because of Performance boost */ + ::oVertHeaderView := QHeaderView() + ::oVertHeaderView:configure( ::oWidget:verticalHeader() ) + ::oVertHeaderView:hide() + + /* Horizontal Header Fine Tuning */ + ::oHorzHeaderView := QHeaderView() + ::oHorzHeaderView:configure( ::oWidget:horizontalHeader() ) + ::oHorzHeaderView:setHighlightSections( .f. ) + ::connect( QT_PTROF( ::oHorzHeaderView ), "sectionPressed(int)", {|o,i| ::exeBlock( 111, i, o ) } ) + + /* .DBF Manipulation Model */ + ::oDbfModel := HbDbfModel():new( {|p1,p2,p3,p4| ::supplyInfo( p1, p2, p3, p4 ) } ) + + ::oWidget:setModel( QT_PTROF( ::oDbfModel ) ) + ::oWidget:setCurrentIndex( QModelIndex():new():sibling( 0,0 ) ) + ::pCurIndex := ::oWidget:currentIndex() + + IF ::visible + ::show() + ENDIF + ::oParent:AddChild( SELF ) + + /* Viewport */ + ::oWidgetViewport:configure( ::oWidget:viewport() ) + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD XbpBrowse:exeBlock( nEvent, p1 ) + LOCAL oMouseEvent, i, nRow, nRowPos, nCol, nColPos + + DO CASE + CASE nEvent == 1 /* Keypress Event */ + SetAppEvent( xbeP_Keyboard, XbpQKeyEventToAppEvent( p1 ), NIL, self ) + + CASE nEvent == 2 /* Mousepress : TOBE: button */ + oMouseEvent := QMouseEvent():configure( p1 ) + IF oMouseEvent:button() == Qt_LeftButton + + IF hb_isPointer( QT_PTROF( ::oModelIndex ) ) + ::oModelIndex:destroy() + ENDIF + ::oModelIndex:configure( ::oWidget:indexAt( QT_PTROF( QPoint():new( oMouseEvent:x(), oMouseEvent:y() ) ) ) ) + IF ::oModelIndex:isValid() + nRow := ::oModelIndex:row() + 1 + nRowPos := ::rowPos + // + IF nRow < ::rowPos + FOR i := 1 TO nRowPos - nRow + ::up() + NEXT + ELSEIF nRow > ::rowPos + FOR i := 1 TO nRow - nRowPos + ::down() + NEXT + ENDIF + + nCol := ::oModelIndex:column() + 1 + nColPos := ::colPos + // + IF nCol < nColPos + FOR i := 1 TO nColPos - nCol + ::left() + NEXT + ELSEIF nCol > nColPos + FOR i := 1 TO nCol - nColPos + ::right() + NEXT + ENDIF + ENDIF + ENDIF + oMouseEvent:destroy() + + CASE nEvent == 3 /* Horizontal Scroll Position : sent by Qt */ + IF p1 <> 0 + ::setHorzOffset() + ENDIF + + CASE nEvent == 101 /* Vertical Scrollbar Movements by the User */ + SWITCH p1 + CASE QAbstractSlider_SliderNoAction + RETURN NIL + CASE QAbstractSlider_SliderSingleStepAdd + ::down() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderSingleStepSub + ::up() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderPageStepAdd + ::pageDown() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderPageStepSub + ::pageUp() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderToMinimum + ::goTop() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderToMaximum + ::goBottom() + ::updateVertScrollBar() + EXIT + CASE QAbstractSlider_SliderMove + ::updatePosition() + EXIT + ENDSWITCH + + CASE nEvent == 102 /* Vertical Scrollbar: Slider Released */ + ::updatePosition() + + CASE nEvent == 103 /* Horizontal Scrollbar: Slider moved */ +xbp_Debug( 103, ::oHorzScrollBar:value() ) + ::colPos := ::oHorzScrollBar:value()+1 + ::setCurrentIndex() + ::setHorzOffset() + + CASE nEvent == 104 /* Horizontal Scrollbar: Slider Released */ +xbp_Debug( 104, ::oHorzScrollBar:value() ) + ::colPos := ::oHorzScrollBar:value()+1 + ::setCurrentIndex() + ::setHorzOffset() + + CASE nEvent == 111 /* Column Header Pressed */ + SetAppEvent( xbeBRW_HeaderRbDown, { 0,0 }, p1+1, Self ) + + ENDCASE + +#if 0 +xbp_debug( ::oHorzHeaderView:visualIndexAt( 1 )+1, ; + ::oHorzHeaderView:visualIndexAt( ::oWidget:width() - 1 )+1,; + ::oHorzHeaderView:sectionViewportPosition(0),; + ::oHorzHeaderView:sectionViewportPosition(::colCount-1) ) +#endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD handleEvent( nEvent, mp1, mp2 ) CLASS XbpBrowse + + HB_SYMBOL_UNUSED( mp1 ) + HB_SYMBOL_UNUSED( mp2 ) + + DO CASE + CASE nEvent == xbeP_Keyboard + SWITCH mp1 + + CASE xbeK_UP /* Vertical Navigation */ + ::up() + ::updateVertScrollBar() + EXIT + CASE xbeK_DOWN + ::down() + ::updateVertScrollBar() + EXIT + CASE xbeK_PGUP + ::pageUp() + ::updateVertScrollBar() + EXIT + CASE xbeK_PGDN + ::pageDown() + ::updateVertScrollBar() + EXIT + CASE xbeK_CTRL_PGUP + ::goTop() + ::updateVertScrollBar() + EXIT + CASE xbeK_CTRL_PGDN + ::goBottom() + ::updateVertScrollBar() + EXIT + CASE xbeK_RIGHT /* Horizontal Navigation */ + ::right() + IF ::rowPos == ::rowCount + ::updateVertScrollBar() + ENDIF + //::oHorzScrollBar:setValue( ::colPos - 1 ) + EXIT + CASE xbeK_LEFT + ::left() + //::oHorzScrollBar:setValue( ::colPos - 1 ) + IF ::rowPos == ::rowCount + ::updateVertScrollBar() + ENDIF + EXIT + CASE xbeK_HOME + ::firstCol() + //::oHorzScrollBar:setValue( ::colPos - 1 ) + ::setHorzOffset() + IF ::rowPos == ::rowCount + ::updateVertScrollBar() + ENDIF + EXIT + CASE xbeK_END + ::lastCol() + //::oHorzScrollBar:setValue( ::colPos - 1 ) + ::setHorzOffset() + IF ::rowPos == ::rowCount + ::updateVertScrollBar() + ENDIF + EXIT + #if 0 /* Xbase++ does not recognizes it */ + CASE xbeK_CTRL_HOME + ::panHome() + ::setHorzOffset() + EXIT + CASE xbeK_CTRL_END + ::panEnd() + ::setHorzOffset() + EXIT + #endif + ENDSWITCH + + CASE nEvent == xbeBRW_ForceStable + ::forceStable() + + CASE nEvent == xbeBRW_Pan + DO CASE + CASE mp1 == XBPBRW_Pan_Left + CASE mp1 == XBPBRW_Pan_Right + CASE mp1 == XBPBRW_Pan_FirstCol + CASE mp1 == XBPBRW_Pan_LastCol + CASE mp1 == XBPBRW_Pan_Track + ENDCASE + + CASE nEvent == xbeBRW_Navigate + DO CASE + CASE mp1 == XBPBRW_Navigate_NextLine + CASE mp1 == XBPBRW_Navigate_PrevLine + CASE mp1 == XBPBRW_Navigate_NextPage + CASE mp1 == XBPBRW_Navigate_PrevPage + CASE mp1 == XBPBRW_Navigate_GoTop + CASE mp1 == XBPBRW_Navigate_GoBottom + CASE mp1 == XBPBRW_Navigate_Skip + CASE mp1 == XBPBRW_Navigate_NextCol + CASE mp1 == XBPBRW_Navigate_PrevCol + CASE mp1 == XBPBRW_Navigate_FirstCol + CASE mp1 == XBPBRW_Navigate_LastCol + CASE mp1 == XBPBRW_Navigate_GoPos + CASE mp1 == XBPBRW_Navigate_SkipCols + CASE mp1 == XBPBRW_Navigate_GotoItem + CASE mp1 == XBPBRW_Navigate_GotoRecord + ENDCASE + + CASE nEvent == xbeBRW_HeaderRbDown + ::headerRBDown( mp1, mp2 ) + + ENDCASE + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD XbpBrowse:supplyInfo( nInfo, p2, p3 ) LOCAL aColor - HB_SYMBOL_UNUSED( p4 ) +//xbp_debug( "XbpBrowse:supplyInfo( nInfo, p2, p3 )", nInfo, p2, p3 ) SWITCH ( nInfo ) CASE HBQT_BRW_COLCOUNT - RETURN ::colCount + ::setHorzScrollBarRange( .f. ) + RETURN ::colCount() CASE HBQT_BRW_ROWCOUNT - RETURN lastrec() + ::setVertScrollBarRange( .f. ) + RETURN ::rowCount() /* Header Area */ CASE HBQT_BRW_COLHEIGHT - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:height , 12 ) + RETURN IF( p3 > 0 .and. p3 <= ::colCount(), ::columns[ p3 ]:height , 12 ) CASE HBQT_BRW_COLHEADER - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:caption , "" ) + RETURN IF( p3 > 0 .and. p3 <= ::colCount(), ::columns[ p3 ]:heading , "" ) CASE HBQT_BRW_COLALIGN - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:halignment, Qt_AlignHCenter ) + RETURN IF( p3 > 0 .and. p3 <= ::colCount(), ::columns[ p3 ]:halignment, Qt_AlignHCenter ) CASE HBQT_BRW_COLFGCOLOR - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:hFgColor , Qt_black ) + RETURN IF( p3 > 0 .and. p3 <= ::colCount(), ::columns[ p3 ]:hFgColor , Qt_black ) CASE HBQT_BRW_COLBGCOLOR - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:hBgColor , Qt_darkGray ) + RETURN IF( p3 > 0 .and. p3 <= ::colCount(), ::columns[ p3 ]:hBgColor , Qt_darkGray ) /* Data Area */ CASE HBQT_BRW_DATFGCOLOR - IF ( p3 > 0 .and. p3 <= ::colCount ) - DbGoto( p2 ) - + ::forceStable() + IF ( p3 > 0 .and. p3 <= ::colCount() ) IF hb_isBlock( ::columns[ p3 ]:colorBlock ) - aColor := eval( ::columns[ p3 ]:colorBlock, ::columns[ p3 ]:setData() ) + //aColor := eval( ::columns[ p3 ]:colorBlock, ::columns[ p3 ]:setData() ) + aColor := eval( ::columns[ p3 ]:colorBlock, ::cellValueA( p2, p3 ) ) IF hb_isArray( aColor ) .and. hb_isNumeric( aColor[ 1 ] ) RETURN ConvertAFact( "Color", XBTOQT_FROM_XB, aColor[ 1 ] ) ELSE @@ -304,11 +776,13 @@ METHOD XbpBrowse:supplyInfo( nInfo, p2, p3, p4 ) ENDIF CASE HBQT_BRW_DATBGCOLOR + ::forceStable() IF ( p3 > 0 .and. p3 <= ::colCount ) - DbGoto( p2 ) - IF hb_isBlock( ::columns[ p3 ]:colorBlock ) - aColor := eval( ::columns[ p3 ]:colorBlock, ::columns[ p3 ]:setData() ) + //aColor := eval( ::columns[ p3 ]:colorBlock, ::columns[ p3 ]:setData() ) + + aColor := eval( ::columns[ p3 ]:colorBlock, ::cellValueA( p2, p3 ) ) + IF hb_isArray( aColor ) .and. hb_isNumeric( aColor[ 2 ] ) RETURN ConvertAFact( "Color", XBTOQT_FROM_XB, aColor[ 2 ] ) ELSE @@ -323,15 +797,21 @@ METHOD XbpBrowse:supplyInfo( nInfo, p2, p3, p4 ) CASE HBQT_BRW_DATALIGN + ::forceStable() RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:alignment , Qt_AlignLeft ) CASE HBQT_BRW_DATHEIGHT + ::forceStable() RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:dheight , 12 ) CASE HBQT_BRW_CELLVALUE - /* Evaluate ROW Buffer */ - DbGoto( p2 ) - RETURN IF( p3 > 0 .and. p3 <= ::colCount, ::columns[ p3 ]:cellValue , "" ) + IF ::lFirst + ::lFirst := .f. + ::forceStable() + ::setVertScrollBarRange( .t. ) + ::setHorzScrollBarRange( .f. ) + ENDIF + RETURN ::cellValue( p2, p3 ) ENDSWITCH @@ -339,457 +819,2635 @@ METHOD XbpBrowse:supplyInfo( nInfo, p2, p3, p4 ) /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:exeBlock( nEvent, p1 ) - LOCAL nXbpkey, pCurIndex +METHOD footerRbDown( p1, p2 ) CLASS XbpBrowse + IF hb_isBlock( p1 ) + ::sl_xbeBRW_FooterRbDown := p1 + ENDIF + IF hb_isArray( p1 ) .and. hb_isBlock( ::sl_xbeBRW_FooterRbDown ) + eval( ::sl_xbeBRW_FooterRbDown, p1, p2, self ) + ENDIF + RETURN Self - DO CASE - CASE nEvent == 1 - ::oModelIndex:configure( ::oWidget:currentIndex() ) +/*----------------------------------------------------------------------*/ - nXbpkey := XbpQKeyEventToAppEvent( p1 ) +METHOD headerRbDown( p1, p2 ) CLASS XbpBrowse + IF hb_isBlock( p1 ) + ::sl_xbeBRW_HeaderRbDown := p1 + ENDIF + IF hb_isArray( p1 ) .and. hb_isBlock( ::sl_xbeBRW_HeaderRbDown ) + eval( ::sl_xbeBRW_HeaderRbDown, p1, p2, self ) + ENDIF + RETURN Self - DO CASE +/*----------------------------------------------------------------------*/ - CASE nXbpKey == xbeK_RIGHT - ::right() +METHOD itemMarked( p1 ) CLASS XbpBrowse + IF hb_isBlock( p1 ) + ::sl_xbeBRW_ItemMarked := p1 + ENDIF + IF hb_isArray( p1 ) .and. hb_isBlock( ::sl_xbeBRW_ItemMarked ) + eval( ::sl_xbeBRW_ItemMarked, p1, NIL, self ) + ENDIF + RETURN Self - CASE nXbpKey == xbeK_LEFT - ::left() +/*----------------------------------------------------------------------*/ - CASE nXbpKey == xbeK_CTRL_PGUP - ::oWidget:setCurrentIndex( ::oModelIndex:sibling( 0,::oModelIndex:column() ) ) - ::oWidget:scrollToTop() +METHOD itemRbDown( p1, p2 ) CLASS XbpBrowse + IF hb_isBlock( p1 ) + ::sl_xbeBRW_ItemRbDown := p1 + ENDIF + IF hb_isArray( p1 ) .and. hb_isBlock( ::sl_xbeBRW_ItemRbDown ) + eval( ::sl_xbeBRW_ItemRbDown, p1, p2, self ) + ENDIF + RETURN Self - CASE nXbpKey == xbeK_CTRL_PGDN - ::oWidget:setCurrentIndex( ::oModelIndex:sibling( lastRec()-1,::oModelIndex:column() ) ) - ::oWidget:scrollToBottom() +/*----------------------------------------------------------------------*/ - OTHERWISE - pCurIndex := ::oWidget:navigate( ConvertAFact( "BRWNAVIGATE", XBTOQT_FROM_XB, nXbpkey ) ) - ::oWidget:setCurrentIndex( pCurIndex ) - ::oWidget:scrollTo( ::oWidget:currentIndex() ) +METHOD itemSelected( p1 ) CLASS XbpBrowse + IF hb_isBlock( p1 ) + ::sl_xbeBRW_ItemSelected := p1 + RETURN Self + ENDIF + IF hb_isBlock( ::sl_xbeBRW_ItemSelected ) + eval( ::sl_xbeBRW_ItemSelected, NIL, NIL, self ) + ENDIF + RETURN Self - ENDCASE +/*----------------------------------------------------------------------*/ - ENDCASE +METHOD pan( p1 ) CLASS XbpBrowse + LOCAL xRet + IF hb_isBlock( p1 ) + ::sl_xbeBRW_Pan := p1 + ENDIF + IF hb_isNumeric( p1 ) .and. hb_isBlock( ::sl_xbeBRW_Pan ) + xRet := eval( ::sl_xbeBRW_Pan, p1, NIL, self ) + IF xRet != NIL + ::handleEvent( xbeBRW_Pan, p1, NIL ) + ENDIF + ELSEIF hb_isNumeric( p1 ) + ::handleEvent( xbeBRW_Pan, p1, NIL ) + ENDIF + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD navigate( p1, p2 ) CLASS XbpBrowse + LOCAL xRet + IF hb_isBlock( p1 ) + ::sl_xbeBRW_Navigate := p1 + ENDIF + IF hb_isNumeric( p1 ) .and. hb_isBlock( ::sl_xbeBRW_Navigate ) + xRet := eval( ::sl_xbeBRW_Navigate, p1, p2, self ) + IF xRet != NIL + ::handleEvent( xbeBRW_Navigate, p1, p2 ) + ENDIF + ELSEIF hb_isNumeric( p1 ) + ::handleEvent( xbeBRW_Navigate, p1, p2 ) + ENDIF + RETURN Self + +/*----------------------------------------------------------------------*/ + +STATIC FUNCTION _SKIP_RESULT( xResult ) + RETURN iif( ISNUMBER( xResult ), Int( xResult ), 0 ) + +/*----------------------------------------------------------------------*/ + +METHOD configure( nMode ) CLASS XbpBrowse + + IF !ISNUMBER( nMode ) .OR. nMode == 0 .OR. nMode > _TBR_CONF_ALL + nMode := _TBR_CONF_ALL + ENDIF + ::nConfigure := HB_BITOR( ::nConfigure, nMode ) RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:configure() +METHOD setVertScrollBarRange( lPageStep ) CLASS XbpBrowse + LOCAL nMin, nMax + DEFAULT lPageStep TO .f. - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:destroy() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:firstPosBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_firstPosBlock := bBlock - ENDIF - RETURN ::b_firstPosBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:goBottomBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_goBottomBlock := bBlock - ENDIF - RETURN ::b_goBottomBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:goPosBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_goPosBlock := bBlock - ENDIF - RETURN ::b_goPosBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:goTopBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_goTopBlock := bBlock - ENDIF - RETURN ::b_goTopBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:hitBottomBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_hitBottomBlock := bBlock - ENDIF - RETURN ::b_hitBottomBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:hitTopBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_hitTopBlock := bBlock - ENDIF - RETURN ::b_hitTopBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:lastPosBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_lastPosBlock := bBlock - ENDIF - RETURN ::b_lastPosBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:phyPosBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_phyPosBlock := bBlock - ENDIF - RETURN ::b_phyPosBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:posBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_posBlock := bBlock - ENDIF - RETURN ::b_posBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:skipBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_skipBlock := bBlock - ENDIF - RETURN ::b_skipBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:stableBlock( bBlock ) - IF hb_isBlock( bBlock ) - ::b_stableBlock := bBlock - ENDIF - RETURN ::b_stableBlock - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:addColumn( oColumn ) - - IF hb_isObject( oColumn ) - aadd( ::columns, oColumn ) -xbp_Debug( "added column" ) - //::oDbfModel:insertColumn( ::oDbfModel:columnCount() ) - ::oDbfModel:reset() - ::configure() + IF hb_isNumeric( nMin := eval( ::bFirstPosBlock ) ) .and. hb_isNumeric( nMax := eval( ::bLastPosBlock ) ) + ::oVertScrollBar:setMinimum( nMin - 1 ) + ::oVertScrollBar:setMaximum( nMax - 1 ) + ::oVertScrollBar:setSingleStep( 1 ) + // + IF lPageStep + ::oVertScrollBar:setPageStep( ::rowCount() ) + ENDIF ENDIF RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:delColumn( nColPos ) +METHOD setHorzScrollBarRange( lPageStep ) CLASS XbpBrowse - HB_SYMBOL_UNUSED( nColPos ) + DEFAULT lPageStep TO .f. + + ::oHorzScrollBar:setMinimum( 0 ) + ::oHorzScrollBar:setMaximum( ::colCount - 1 ) + ::oHorzScrollBar:setSingleStep( 1 ) RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:getColumn( nColPos ) +METHOD updatePosition() CLASS XbpBrowse - HB_SYMBOL_UNUSED( nColPos ) + IF hb_isBlock( ::goPosBlock ) + eval( ::goPosBlock, ::oVertScrollBar:value() + 1 ) + ::refreshAll() + ::forceStable() + ::setCurrentIndex() + ENDIF RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:insColumn( nColPos, oXbpColumn ) +METHOD updateVertScrollBar() CLASS XbpBrowse - HB_SYMBOL_UNUSED( nColPos ) - HB_SYMBOL_UNUSED( oXbpColumn ) + ::oVertScrollBar:setValue( eval( ::posBlock ) - 1 ) RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:setColumn( nColPos, oNewXbpColumn ) +METHOD setHorzOffset() CLASS XbpBrowse - HB_SYMBOL_UNUSED( nColPos ) - HB_SYMBOL_UNUSED( oNewXbpColumn ) + IF ::colPos == ::colCount + ::oHorzHeaderView:setOffsetToLastSection() + ELSE + ::oHorzHeaderView:setOffsetToSectionPosition( ::colPos - 1 ) + ENDIF RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:setLeftFrozen( aColumnIndex ) +METHOD setCurrentIndex() CLASS XbpBrowse - HB_SYMBOL_UNUSED( aColumnIndex ) + /* Important */ + ::oDbfModel:reset() + + Qt_QModelIndex_destroy( ::pCurIndex ) + ::pCurIndex := ::oDbfModel:index( ::rowPos - 1, ::colPos - 1 ) + ::oWidget:setCurrentIndex( ::pCurIndex ) RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:setRightFrozen( aColumnIndex ) +METHOD doConfigure() CLASS XbpBrowse + LOCAL oCol + LOCAL aCol, aVal, aValA + LOCAL nWidth, nHeight, nColCount, nRowCount + LOCAL xValue + LOCAL cType + LOCAL cColSep + LOCAL cHeadSep, cHeading + LOCAL nHeadHeight + LOCAL cFootSep, cFooting + LOCAL nFootHeight + LOCAL lHeadSep, lFootSep + LOCAL nMaxCellH := 0 + LOCAL nViewH, i, xVal, oFontMetrics - HB_SYMBOL_UNUSED( aColumnIndex ) + ::nConfigure := 0 + + nColCount := Len( ::columns ) + + /* update color table */ + ::aColors := _DECODECOLORS( ::cColorSpec ) + + /* update column data */ + nHeadHeight := nFootHeight := 0 + lHeadSep := lFootSep := .F. + ASize( ::aColData, nColCount ) + + FOR EACH oCol, aCol IN ::columns, ::aColData + xValue := Eval( oCol:block ) + cType := ValType( xValue ) + nWidth := IIF( cType $ "CMNDTL", Len( Transform( xValue, oCol:picture ) ), 0 ) + cColSep := oCol:colSep + IF cColSep == NIL + cColSep := ::cColSep + ENDIF + cHeadSep := oCol:headSep + IF !ISCHARACTER( cHeadSep ) .OR. cHeadSep == "" + cHeadSep := ::cHeadSep + IF !ISCHARACTER( cHeadSep ) + cHeadSep := "" + ENDIF + ENDIF + + cFootSep := oCol:footSep + IF !ISCHARACTER( cFootSep ) .OR. cFootSep == "" + cFootSep := ::cFootSep + IF !ISCHARACTER( cFootSep ) + cFootSep := "" + ENDIF + ENDIF + aCol := Array( _TBCI_SIZE ) + aCol[ _TBCI_COLOBJECT ] := oCol + aCol[ _TBCI_COLWIDTH ] := nWidth + aCol[ _TBCI_COLPOS ] := NIL + aCol[ _TBCI_CELLWIDTH ] := nWidth + aCol[ _TBCI_CELLPOS ] := 0 + aCol[ _TBCI_COLSEP ] := cColSep + aCol[ _TBCI_SEPWIDTH ] := Len( cColSep ) + aCol[ _TBCI_HEADSEP ] := cHeadSep + aCol[ _TBCI_FOOTSEP ] := cFootSep + aCol[ _TBCI_DEFCOLOR ] := _COLDEFCOLORS( oCol:defColor, Len( ::aColors ) ) + aCol[ _TBCI_FROZENSPACE ] := 0 + aCol[ _TBCI_LASTSPACE ] := 0 + IF Len( cHeadSep ) > 0 + lHeadSep := .T. + ENDIF + IF Len( cFootSep ) > 0 + lFootSep := .T. + ENDIF + cHeading := oCol:heading + IF _DECODE_FH( @cHeading, @nHeight, @nWidth ) + aCol[ _TBCI_COLWIDTH ] := Max( aCol[ _TBCI_COLWIDTH ], nWidth ) + IF nHeight > nHeadHeight + nHeadHeight := nHeight + ENDIF + ENDIF + + aCol[ _TBCI_HEADING ] := cHeading + cFooting := oCol:footing + IF _DECODE_FH( @cFooting, @nHeight, @nWidth ) + aCol[ _TBCI_COLWIDTH ] := Max( aCol[ _TBCI_COLWIDTH ], nWidth ) + IF nHeight > nFootHeight + nFootHeight := nHeight + ENDIF + ENDIF + aCol[ _TBCI_FOOTING ] := cFooting + nWidth := oCol:width + IF nWidth != NIL + IF nWidth > 0 + aCol[ _TBCI_COLWIDTH ] := nWidth + IF nWidth < aCol[ _TBCI_CELLWIDTH ] .OR. cType == "C" + aCol[ _TBCI_CELLWIDTH ] := nWidth + ENDIF + ELSE + aCol[ _TBCI_CELLWIDTH ] := 0 + ENDIF + ENDIF + IF aCol[ _TBCI_CELLWIDTH ] > 0 + IF aCol[ _TBCI_COLWIDTH ] > aCol[ _TBCI_CELLWIDTH ] + IF cType == "N" + aCol[ _TBCI_CELLPOS ] := aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLWIDTH ] + ELSEIF cType == "L" + aCol[ _TBCI_CELLPOS ] := Int( ( aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLWIDTH ] ) / 2 ) + ENDIF + ENDIF + ENDIF + NEXT + + nHeight := Max( _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ), 0 ) + IF lHeadSep .AND. nHeight > 0 + --nHeight + ELSE + lHeadSep := .F. + ENDIF + IF lFootSep .AND. nHeight > 0 + --nHeight + ELSE + lFootSep := .F. + ENDIF + IF nHeadHeight >= nHeight + nHeadHeight := nHeight + nHeight := 0 + ELSE + nHeight -= nHeadHeight + ENDIF + IF nFootHeight >= nHeight + nFootHeight := nHeight + nHeight := 0 + ENDIF + ::lHeadSep := lHeadSep + ::nHeadHeight := nHeadHeight + ::nFootHeight := nFootHeight + ::lFootSep := lFootSep + + /* update headings to maximum size and missing head/foot separators */ + FOR EACH aCol IN ::aColData + aCol[ _TBCI_HEADING ] := Replicate( _TBR_CHR_LINEDELIMITER, nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], _TBR_CHR_LINEDELIMITER ) ) + ; + aCol[ _TBCI_HEADING ] + IF lHeadSep .AND. aCol[ _TBCI_HEADSEP ] == "" + aCol[ _TBCI_HEADSEP ] := " " + ENDIF + IF lFootSep .AND. aCol[ _TBCI_FOOTSEP ] == "" + aCol[ _TBCI_FOOTSEP ] := " " + ENDIF + NEXT + + ::lHeadSep := .f. // lHeadSep + ::nHeadHeight := 0 // nHeadHeight + ::nFootHeight := 0 // nFootHeight + ::lFootSep := .f. // lFootSep + + nRowCount := ::rowCount + IF nRowCount == 0 + _GENLIMITRTE() + ENDIF + + /* create new record buffer */ + ASize( ::aCellStatus, nRowCount ) + ASize( ::aDispStatus, nRowCount ) + ASize( ::aCellValues, nRowCount ) + ASize( ::aCellValuesA, nRowCount ) + ASize( ::aCellColors, nRowCount ) + AFill( ::aCellStatus, .F. ) + AFill( ::aDispStatus, .T. ) + FOR EACH aVal, aValA, aCol IN ::aCellValues, ::aCellValuesA, ::aCellColors + IF aVal == NIL + aVal := Array( nColCount ) + ELSE + ASize( aVal, nColCount ) + ENDIF + IF aValA == NIL + aValA := Array( nColCount ) + ELSE + ASize( aValA, nColCount ) + ENDIF + IF aCol == NIL + aCol := Array( nColCount ) + ELSE + ASize( aCol, nColCount ) + ENDIF + NEXT + + ::lStable := .F. + ::lFrames := .T. + + /* Clipper does not set refreshAll flag in Configure */ + /* ::lRefresh := .T. */ + + ::nLastRow := nRowCount + ::nLastScroll := 0 + + /* CA-Cl*pper update visible columns here but without + * colPos repositioning. [druzus] + */ + _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; + @::nFrozen, @::nLeftVisible, @::nRightVisible ) + + ::nLastPos := 0 + + IF ::nRowPos > nRowCount + ::nRowPos := nRowCount + ELSEIF ::nRowPos < 1 + ::nRowPos := 1 + ENDIF + + /* Calculate how many rows fit in the view */ + IF len( ::columns ) > 0 + //::oWidgetViewport:configure( ::oWidget:viewport() ) + // + aeval( ::columns, {|o| nMaxCellH := max( nMaxCellH, o:dheight ) } ) + // + nViewH := ::oWidgetViewport:height() + ::nRowsInView := Int( nViewH / nMaxCellH ) + IF ( nViewH % nMaxCellH ) > ( nMaxCellH / 3 ) + ::nRowsInView++ + ENDIF + + /* Probably this is the appropriate time to update row heights */ + FOR i := 1 TO ::nRowsInView + ::oWidget:setRowHeight( i-1, nMaxCellH ) + NEXT + + /* Set column widths */ + oFontMetrics := QFontMetrics():new( "QFont", ::oWidget:font() ) + // + FOR i := 1 TO len( ::columns ) + IF ::columns[ i ]:nColWidth != NIL + ::oWidget:setColumnWidth( i-1, ::columns[ i ]:nColWidth ) + ELSE + xVal := transform( eval( ::columns[ i ]:block ), ::columns[ i ]:picture ) + ::oWidget:setColumnWidth( i-1, oFontMetrics:width( xVal, -1 ) + 8 ) + ENDIF + NEXT + ENDIF + + /* Tell Qt to Reload Everything */ + ::oDbfModel:reset() RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:down() +METHOD scrollBuffer( nRows ) CLASS XbpBrowse + LOCAL nRowCount := ::rowCount + LOCAL aValues, aValuesA, aColors + + /* Store last scroll value to chose refresh order. [druzus] */ + ::nLastScroll := nRows + + IF nRows >= nRowCount .OR. nRows <= -nRowCount + AFill( ::aCellStatus, .F. ) + ELSE + #if 0 /* Physical scroll - in GUI not required */ + hb_scroll( ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ), ::n_Left, ; + ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ), ::n_Right, ; + nRows,, ::colorValue( _TBC_CLR_STANDARD ) ) + #endif + + IF nRows > 0 + DO WHILE --nRows >= 0 + aValues := ::aCellValues[ 1 ] + aValuesA := ::aCellValuesA[ 1 ] + aColors := ::aCellColors[ 1 ] + ADel( ::aCellValues, 1 ) + ADel( ::aCellValuesA, 1 ) + ADel( ::aCellColors, 1 ) + ADel( ::aCellStatus, 1 ) + ADel( ::aDispStatus, 1 ) + ::aCellValues[ nRowCount ] := aValues + ::aCellValuesA[ nRowCount ] := aValuesA + ::aCellColors[ nRowCount ] := aColors + ::aCellStatus[ nRowCount ] := .F. + ::aDispStatus[ nRowCount ] := .T. + ENDDO + ELSEIF nRows < 0 + DO WHILE ++nRows <= 0 + HB_AIns( ::aCellValues, 1, ATail( ::aCellValues ), .F. ) + HB_AIns( ::aCellValuesA, 1, ATail( ::aCellValuesA ), .F. ) + HB_AIns( ::aCellColors, 1, ATail( ::aCellColors ), .F. ) + HB_AIns( ::aCellStatus, 1, .F., .F. ) + HB_AIns( ::aDispStatus, 1, .T., .F. ) + ENDDO + ENDIF + ENDIF RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:firstCol() +METHOD readRecord( nRow ) CLASS XbpBrowse + LOCAL aCol + LOCAL oCol + LOCAL cValue, cValueA + LOCAL aColor + LOCAL nColors, nToMove, nMoved + LOCAL nRowCount := ::rowCount + LOCAL lRead := .F. + + IF nRow >= 1 .AND. nRow <= nRowCount .AND. !::aCellStatus[ nRow ] + IF nRow <= ::nLastRow + nToMove := nRow - ::nBufferPos + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nToMove ) ) + IF nToMove > 0 + IF nMoved < 0 + nMoved := 0 + ENDIF + ELSEIF nToMove < 0 + nMoved := nToMove + ELSE + nMoved := 0 + ENDIF + ::nBufferPos += nMoved + IF nToMove > 0 .AND. nMoved < nToMove + ::nLastRow := ::nBufferPos + ELSE + lRead := .T. + ENDIF + ENDIF + nColors := Len( ::aColors ) + IF nRow <= ::nLastRow + FOR EACH aCol, cValue, cValueA, aColor IN ::aColData, ::aCellValues[ nRow ], ::aCellValuesA[ nRow ], ::aCellColors[ nRow ] + oCol := aCol[ _TBCI_COLOBJECT ] + cValueA := cValue := Eval( oCol:block ) + aColor := _CELLCOLORS( aCol, cValue, nColors ) + IF ValType( cValue ) $ "CMNDTL" + cValue := PadR( Transform( cValue, oCol:picture ), aCol[ _TBCI_CELLWIDTH ] ) + ELSE + cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) + ENDIF + NEXT + ELSE + FOR EACH aCol, cValue, cValueA, aColor IN ::aColData, ::aCellValues[ nRow ], ::aCellValuesA[ nRow ], ::aCellColors[ nRow ] + aColor := { aCol[ _TBCI_DEFCOLOR ][ 1 ], aCol[ _TBCI_DEFCOLOR ][ 2 ] } + cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) + cValueA := aCol[ _TBCI_COLOBJECT ]:blankVariable + NEXT + ENDIF + + ::aCellStatus[ nRow ] := .T. + ::aDispStatus[ nRow ] := .T. + ENDIF + + RETURN lRead + +/*----------------------------------------------------------------------*/ + +METHOD setPosition() CLASS XbpBrowse + LOCAL nMoved + LOCAL nRowCount := ::rowCount + LOCAL nMoveOffset := ::nMoveOffset + ( ::nRowPos - ::nBufferPos ) + LOCAL nNewPos := ::nBufferPos + nMoveOffset + LOCAL lSetPos := .T. + + IF nNewPos < 1 + IF ::nMoveOffset < -1 + nMoveOffset -= ::nRowPos - 1 + ENDIF + ELSEIF nNewPos > ::nLastRow + IF ::nMoveOffset > 1 + nMoveOffset += ::nLastRow - ::nRowPos + ENDIF + ELSEIF lSetPos + ::nRowPos := nNewPos + ENDIF + + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nMoveOffset ) ) + IF nMoved > 0 + ::nBufferPos += nMoved + IF ::nBufferPos > ::nLastRow + AFill( ::aCellStatus, .F., ::nLastRow + 1, ::nBufferPos - ::nLastRow ) + ENDIF + IF ::nBufferPos > nRowCount + ::scrollBuffer( ::nBufferPos - nRowCount ) + ::nBufferPos := nRowCount + lSetPos := .F. + ENDIF + IF ::nBufferPos > ::nLastRow + ::nLastRow := ::nBufferPos + IF nMoved != nMoveOffset + lSetPos := .F. + ENDIF + ENDIF + ELSEIF nMoved < 0 + ::nBufferPos += nMoved + IF ::nBufferPos < 1 + ::nLastRow := Min( nRowCount, ::nLastRow - ::nBufferPos + 1 ) + ::scrollBuffer( ::nBufferPos - 1 ) + ::nBufferPos := 1 + lSetPos := .F. + ENDIF + ELSE /* nMoved == 0 */ + IF nMoveOffset > 0 + IF nMoveOffset != 0 .AND. ::nBufferPos == ::nRowPos + ::lHitBottom := .T. + ENDIF + ::nLastRow := ::nBufferPos + AFill( ::aCellStatus, .F., ::nLastRow + 1 ) + ELSEIF nMoveOffset < 0 + IF nMoveOffset != 0 .AND. ::nBufferPos == ::nRowPos + ::lHitTop := .T. + ENDIF + IF ::nBufferPos > 1 + ::scrollBuffer( ::nBufferPos - 1 ) + ::nBufferPos := 1 + ENDIF + ENDIF + ENDIF + + IF lSetPos + ::nRowPos := ::nBufferPos + ENDIF + + ::nMoveOffset := 0 RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:goBottom() +METHOD stabilize() CLASS XbpBrowse + LOCAL nRowCount, nToMove, nMoved + LOCAL lDisp, lRead, lStat + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !::lStable .OR. ::lInvalid .OR. ::lFrames .OR. ::lRefresh .OR. ; + ::nMoveOffset != 0 .OR. ::nBufferPos != ::nRowPos + + nRowCount := ::rowCount + + IF ::lRefresh + AFill( ::aCellStatus, .F. ) + ::nLastRow := nRowCount + ::nLastScroll := 0 + ::lRefresh := .F. + ENDIF + + ::setVisible() + + IF ::lFrames + ::dispFrames() + AFill( ::aDispStatus, .T. ) + ENDIF + + lRead := .F. + IF ::nMoveOffset != 0 + ::setPosition() + lRead := .T. + ENDIF + + IF ::nLastScroll > 0 + FOR EACH lStat, lDisp IN ::aCellStatus, ::aDispStatus DESCEND + IF !lStat + IF lRead + RETURN .F. + ENDIF + lRead := ::readRecord( lStat:__enumIndex() ) + ENDIF + IF lDisp + ::dispRow( lDisp:__enumIndex() ) + ENDIF + NEXT + ELSE + FOR EACH lStat, lDisp IN ::aCellStatus, ::aDispStatus + IF !lStat + IF lRead + RETURN .F. + ENDIF + lRead := ::readRecord( lStat:__enumIndex() ) + ENDIF + IF lDisp + ::dispRow( lDisp:__enumIndex() ) + ENDIF + NEXT + ENDIF + + /* We reach here when browse is stable : synchronize the record pointer with ::rowPos */ + IF ::nRowPos > ::nLastRow + ::nRowPos := ::nLastRow + ENDIF + IF ::nBufferPos != ::nRowPos + nToMove := ::nRowPos - ::nBufferPos + + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nToMove ) ) + + IF nToMove > 0 + IF nMoved < 0 + nMoved := 0 + ENDIF + ELSEIF nToMove < 0 + nMoved := nToMove + ELSE + nMoved := 0 + ENDIF + ::nBufferPos += nMoved + ::nRowPos := ::nBufferPos + ENDIF + + ::lStable := .T. + ::lInvalid := .F. + ENDIF + + IF ::autoLite + ::hilite() + ELSE + ::setCursorPos() + ENDIF + + RETURN .T. + +/*----------------------------------------------------------------------*/ + +METHOD forceStable() CLASS XbpBrowse + + DO WHILE !::stabilize() + ENDDO RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:goTop() +METHOD cellValue( nRow, nCol ) CLASS XbpBrowse + + IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; + nCol >= 1 .AND. nCol <= ::colCount .AND. ; + ::aCellStatus[ nRow ] + + RETURN ::aCellValues[ nRow, nCol ] + ENDIF + + RETURN NIL + +/*----------------------------------------------------------------------*/ + +METHOD cellValueA( nRow, nCol ) CLASS XbpBrowse + + IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; + nCol >= 1 .AND. nCol <= ::colCount .AND. ; + ::aCellStatus[ nRow ] + + RETURN ::aCellValuesA[ nRow, nCol ] + ENDIF + + RETURN NIL + +/*----------------------------------------------------------------------*/ + +METHOD setUnstable() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF ::lHiLited + ::deHilite() + ENDIF + + ::lHitTop := .F. + ::lHitBottom := .F. + ::lStable := .F. RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:lastCol() +METHOD invalidate() CLASS XbpBrowse + + ::setUnstable() + ::lInvalid := .T. + ::lFrames := .T. RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:left() +METHOD refreshAll() CLASS XbpBrowse + + ::setUnstable() + + Eval( ::bSkipBlock, 1 - ::nBufferPos ) + ::nBufferPos := 1 + ::lFrames := .T. + ::lRefresh := .T. + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD refreshCurrent() CLASS XbpBrowse + + ::setUnstable() + + IF ::nRowPos >= 1 .AND. ::nRowPos <= ::rowCount + ::aCellStatus[ ::nRowPos ] := .F. + ENDIF + + RETURN Self + +/*----------------------------------------------------------------------*/ +/* Vertical Navigation */ +/*----------------------------------------------------------------------*/ + +METHOD up() CLASS XbpBrowse + + ::setUnstable() + ::nMoveOffset-- + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD down() CLASS XbpBrowse + + ::setUnstable() + ::nMoveOffset++ + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD pageUp() CLASS XbpBrowse + + ::setUnstable() + ::nMoveOffset -= ::rowCount + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD pageDown() CLASS XbpBrowse + + ::setUnstable() + ::nMoveOffset += ::rowCount + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD goTop() CLASS XbpBrowse + + ::setUnstable() + + Eval( ::bGoTopBlock ) + ::lRefresh := .T. + ::nRowPos := 1 + ::nBufferPos := 1 + ::nMoveOffset := 0 + Eval( ::bSkipBlock, 0 ) + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD goBottom() CLASS XbpBrowse + LOCAL nMoved + + ::setUnstable() + + Eval( ::bGoBottomBlock ) + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, -( ::rowCount - 1 ) ) ) + ::lRefresh := .T. + ::nRowPos := 1 + ::nBufferPos := 1 + ::nMoveOffset := -nMoved + Eval( ::bSkipBlock, 0 ) + + ::forceStable() + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ +/* Horizontal Navigation */ +/*----------------------------------------------------------------------*/ + +METHOD left() CLASS XbpBrowse IF ::colPos > 1 ::colPos-- - ::pCurIndex := ::oWidget:navigate( QAbstractItemView_MoveLeft ) - ::oWidget:setCurrentIndex( ::pCurIndex ) - ::oWidget:scrollTo( ::oWidget:currentIndex() ) + ::setCurrentIndex() ENDIF + #if 0 /* NECESSARY ? */ + ::setUnstable() + DO WHILE .T. + ::nColPos-- + IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ; + ::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0 + EXIT + ENDIF + ENDDO + #endif RETURN Self /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:pageDown() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:pageUp() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:pageEnd() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:panHome() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:panLeft() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:panRight() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:right() +METHOD right() CLASS XbpBrowse IF ::colPos < ::colCount ::colPos++ - ::pCurIndex := ::oWidget:navigate( QAbstractItemView_MoveRight ) - ::oWidget:setCurrentIndex( ::pCurIndex ) - ::oWidget:scrollTo( ::oWidget:currentIndex() ) + ::setCurrentIndex() + ENDIF + + #if 0 /* NECESSARY ? */ + ::setUnstable() + DO WHILE .T. + ::nColPos++ + IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ; + ::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0 + EXIT + ENDIF + ENDDO + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD home() CLASS XbpBrowse + + ::colPos := max( 1, ::oHorzHeaderView:visualIndexAt( 1 )+1 ) + ::setCurrentIndex() + + #if 0 /* NECESSARY ? */ + ::setUnstable() + ::nColPos := iif( ::nLeftVisible < ::nRightVisible, ::nLeftVisible, ::nRightVisible ) + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD end() CLASS XbpBrowse + + ::nRightVisible := ::oHorzHeaderView:visualIndexAt( ::oWidgetViewport:width()-2 )+1 + IF ::nRightVisible == 0 + ::nRightVisible := ::colCount + ENDIF + ::colPos := ::nRightVisible + ::setCurrentIndex() + + #if 0 + ::setUnstable() + ::nColPos := ::nRightVisible + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD panHome() CLASS XbpBrowse + + ::colPos := 1 + ::setCurrentIndex() + + #if 0 + ::setUnstable() + ::nColPos := _NEXTCOLUMN( ::aColData, 1 ) + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD firstCol() CLASS XbpBrowse + + ::setUnstable() + ::colPos := 1 + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD lastCol() CLASS XbpBrowse + + ::setUnstable() + ::colPos := ::colCount + ::setCurrentIndex() + + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD panEnd() CLASS XbpBrowse + + ::setUnstable() + // + ::colPos := ::colCount + ::setCurrentIndex() + + #if 0 + ::nColPos := _PREVCOLUMN( ::aColData, ::colCount ) + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD panLeft() CLASS XbpBrowse + LOCAL nLeftVisible := ::oHorzHeaderView:visualIndexAt( 1 )+1 + + IF nLeftVisible > 1 + ::oHorzHeaderView:setOffSet( ::oHorzHeaderView:sectionPosition( nLeftVisible - 2 ) ) + ENDIF + + #if 0 + LOCAL nNewPos + + ::setUnstable() + nNewPos := _PREVCOLUMN( ::aColData, Min( ::colCount, ::nLeftVisible - 1 ) ) + + IF nNewPos != 0 .AND. nNewPos != ::nLeftVisible + ::nRightVisible := 0 + ::nLeftVisible := nNewPos + ENDIF + #endif + RETURN Self + +/*----------------------------------------------------------------------*/ + +METHOD panRight() CLASS XbpBrowse + LOCAL nNewPos + + ::setUnstable() + nNewPos := _NEXTCOLUMN( ::aColData, Max( 1, ::nRightVisible + 1 ) ) + + IF nNewPos != 0 .AND. nNewPos != ::nRightVisible + ::nLeftVisible := 0 + ::nRightVisible := nNewPos ENDIF RETURN Self /*----------------------------------------------------------------------*/ - -METHOD XbpBrowse:up() - - RETURN Self - +/* */ /*----------------------------------------------------------------------*/ -METHOD XbpBrowse:deHilite() +STATIC PROCEDURE _GENLIMITRTE() + LOCAL oError := ErrorNew() - RETURN Self + oError:severity := ES_ERROR + oError:genCode := EG_LIMIT + oError:subSystem := "TBROWSE" + oError:subCode := 0 + oError:description := hb_LangErrMsg( EG_LIMIT ) + oError:canRetry := .F. + oError:canDefault := .F. + oError:fileName := "" + oError:osCode := 0 + + Eval( ErrorBlock(), oError ) + __errInHandler() + + RETURN /*----------------------------------------------------------------------*/ +/* helper function to take headings and footing data */ +STATIC FUNCTION _DECODE_FH( cName, nHeight, nWidth ) + LOCAL i -METHOD XbpBrowse:forceStable() + nHeight := nWidth := 0 + IF ISCHARACTER( cName ) + + IF Len( cName ) > 0 + /* When last character of heading/footing is ';' then CA-Cl*pper + * does not calculate it as separator + */ + IF Right( cName, 1 ) == _TBR_CHR_LINEDELIMITER + cName := Left( cName, Len( cName ) - 1 ) + ENDIF + nHeight := hb_TokenCount( cName, _TBR_CHR_LINEDELIMITER ) + FOR i := 1 TO nHeight + nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, _TBR_CHR_LINEDELIMITER ) ) ) + NEXT + ENDIF + + ELSE + /* CA-Cl*per bug, it accepts non character values though cannot + * display them properly + */ + /* nHeight := 1 */ + cName := "" + ENDIF + + RETURN nHeight != 0 + + +STATIC FUNCTION _MAXFREEZE( nColumns, aColData, nWidth ) + LOCAL aCol + LOCAL lFirst + LOCAL nCol, nColWidth, nTot + + IF nColumns > Len( aColData ) .OR. nColumns < 1 + RETURN 0 + ENDIF + + nTot := nWidth + lFirst := .T. + FOR nCol := 1 TO nColumns + aCol := aColData[ nCol ] + IF aCol[ _TBCI_CELLWIDTH ] > 0 + nColWidth := aCol[ _TBCI_COLWIDTH ] + IF lFirst + lFirst := .F. + ELSE + nColWidth += aCol[ _TBCI_SEPWIDTH ] + ENDIF + IF ( nWidth -= nColWidth ) < 0 + EXIT + ENDIF + ENDIF + NEXT + + /* CA-Cl*pper allows to freeze all columns only when they + * are fully visible, otherwise it reserves at least one + * character for 1-st unfrozen column [druzus] + */ + IF nWidth > 0 .OR. ; + nWidth == 0 .AND. _NEXTCOLUMN( aColData, nColumns + 1 ) == 0 + + RETURN nColumns + ENDIF + + nWidth := nTot + + RETURN 0 + + +STATIC FUNCTION _NEXTCOLUMN( aColData, nCol ) + LOCAL aCol + + DO WHILE nCol <= Len( aColData ) + aCol := aColData[ nCol ] + IF aCol[ _TBCI_CELLWIDTH ] > 0 + RETURN nCol + ENDIF + ++nCol + ENDDO + + RETURN 0 + + +//STATIC PROCEDURE _DISP_FHSEP( nRow, nType, cColor, aColData ) +STATIC PROCEDURE _DISP_FHSEP() + /* GUI does not implements it */ + RETURN + +//STATIC PROCEDURE _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aColors, aColData ) +STATIC PROCEDURE _DISP_FHNAME() + /* GUI does not implements it */ + RETURN + +METHOD dispFrames() CLASS XbpBrowse + /* GUI do not implements it */ + ::lFrames := .F. + RETURN Self + +METHOD dispRow( nRow ) CLASS XbpBrowse + /* GUI do not implements it */ + HB_SYMBOL_UNUSED( nRow ) + RETURN Self + +METHOD colorRect( aRect, aColors ) CLASS XbpBrowse + /* GUI does not implements it */ + HB_SYMBOL_UNUSED( aRect ) + HB_SYMBOL_UNUSED( aColors ) + RETURN Self + +STATIC FUNCTION _PREVCOLUMN( aColData, nCol ) + LOCAL aCol + + DO WHILE nCol >= 1 + aCol := aColData[ nCol ] + IF aCol[ _TBCI_CELLWIDTH ] > 0 + RETURN nCol + ENDIF + --nCol + ENDDO + + RETURN 0 + + +STATIC FUNCTION _SETCOLUMNS( nFrom, nTo, nStep, aColData, nFirst, nWidth, lFirst ) + LOCAL aCol + LOCAL nCol, nColWidth + LOCAL nLast := 0 + + IF nWidth > 0 + FOR nCol := nFrom TO nTo STEP nStep + aCol := aColData[ nCol ] + IF aCol[ _TBCI_CELLWIDTH ] > 0 + IF nFirst == 0 .OR. nCol == nFirst + nColWidth := aCol[ _TBCI_COLWIDTH ] + ELSEIF nCol < nFirst + nColWidth := aCol[ _TBCI_COLWIDTH ] + aColData[ nFirst ][ _TBCI_SEPWIDTH ] + ELSE + nColWidth := aCol[ _TBCI_COLWIDTH ] + aCol[ _TBCI_SEPWIDTH ] + ENDIF + IF nWidth >= nColWidth + nLast := nCol + nWidth -= nColWidth + lFirst := .F. + IF nFirst == 0 .OR. nCol < nFirst + nFirst := nCol + ENDIF + ELSE + IF lFirst + nLast := nCol + nWidth := 0 + lFirst := .F. + ENDIF + EXIT + ENDIF + ENDIF + NEXT + ENDIF + + RETURN iif( nLast == 0, nFrom - nStep, nLast ) + + +STATIC PROCEDURE _SETVISIBLE( aColData, nWidth, nFrozen, nLeft, nRight ) + + LOCAL nPos, nFirst + LOCAL lLeft, lRight, lFirst + LOCAL nColCount := Len( aColData ) + + /* Check if frozen columns are still valid, if not reset it to 0 + * It also calculates the size left for unfrozen columns [druzus] + */ + nFrozen := _MAXFREEZE( nFrozen, aColData, @nWidth ) + + /* CA-Cl*pper checks here only for columns number and does not check + * if at least one column is visible (oCol:width > 0) and if not then + * wrongly calculates visible columns and some internal indexes. + * Using linkers like EXOSPACE with memory protection it causes + * application crash with GPF. [druzus] + */ + IF nColCount == 0 .OR. _NEXTCOLUMN( aColData, 1 ) == 0 + nLeft := nRight := 0 + ELSE + /* This algorithms keeps CA-Cl*pper precedence in visible column + * updating. It's also important for proper working panLeft and + * panRight methods which use leftVisible and rightVisible values + * for horizontal scrolling just like in CA-Cl*pper. [druzus] + */ + IF nWidth >= 1 + lRight := nRight > nFrozen .AND. nRight <= nColCount .AND. ; + aColData[ nRight ][ _TBCI_CELLWIDTH ] > 0 + lLeft := nLeft > nFrozen .AND. nLeft <= nColCount .AND. ; + aColData[ nLeft ][ _TBCI_CELLWIDTH ] > 0 + IF !lLeft + IF lRight + IF ( nLeft := _PREVCOLUMN( aColData, nRight ) ) < nFrozen + nLeft := nRight + ENDIF + ELSE + nPos := _NEXTCOLUMN( aColData, Max( nLeft + 1, nFrozen + 1 ) ) + IF nPos == 0 + nPos := _PREVCOLUMN( aColData, Min( nColCount, nLeft - 1 ) ) + ENDIF + IF nPos > nFrozen + nLeft := nPos + lLeft := .T. + ENDIF + ENDIF + ENDIF + lFirst := .T. + nFirst := _PREVCOLUMN( aColData, nFrozen ) + ELSE + lLeft := lRight := .F. + ENDIF + IF lLeft + nRight := _SETCOLUMNS( nLeft, nColCount, 1, aColData, @nFirst, @nWidth, @lFirst ) + nLeft := _SETCOLUMNS( nLeft - 1, nFrozen + 1, -1, aColData, @nFirst, @nWidth, @lFirst ) + ELSEIF lRight + nLeft := _SETCOLUMNS( nRight, nFrozen + 1, -1, aColData, @nFirst, @nWidth, @lFirst ) + nRight := _SETCOLUMNS( nRight + 1, nColCount, 1, aColData, @nFirst, @nWidth, @lFirst ) + ELSE + nLeft := nFrozen + 1 + nRight := nFrozen + ENDIF + ENDIF + + RETURN + + +METHOD colorValue( nColorIndex ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF ISNUMBER( nColorIndex ) + IF nColorIndex >= 1 .AND. nColorIndex <= Len( ::aColors ) + RETURN ::aColors[ nColorIndex ] + ELSEIF nColorIndex == 0 + RETURN "N/N" + ENDIF + ENDIF + + RETURN ::aColors[ _TBC_CLR_STANDARD ] + + +METHOD cellColor( nRow, nCol ) CLASS XbpBrowse + + IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; + nCol >= 1 .AND. nCol <= ::colCount .AND. ; + ::aCellStatus[ nRow ] + + RETURN ::aCellColors[ nRow, nCol ] + ENDIF + + RETURN NIL + + +STATIC FUNCTION _DECODECOLORS( cColorSpec ) + LOCAL aColors := {} + LOCAL nColors := hb_TokenCount( cColorSpec, "," ) + LOCAL cColor + LOCAL nPos + + FOR nPos := 1 TO nColors + cColor := hb_tokenGet( cColorSpec, nPos, "," ) + IF nPos <= 2 .AND. hb_colorToN( cColor ) == -1 + cColor := iif( nPos == 1, "W/N", "N/W" ) + ENDIF + AAdd( aColors, cColor ) + NEXT + IF Empty( aColors ) + AAdd( aColors, "W/N" ) + ENDIF + IF Len( aColors ) < 2 + AAdd( aColors, "N/W" ) + ENDIF + DO WHILE Len( aColors ) < _TBC_CLR_MAX + AAdd( aColors, aColors[ _TBC_CLR_STANDARD ] ) + ENDDO + + RETURN aColors + + +STATIC FUNCTION _COLDEFCOLORS( aDefColorsIdx, nMaxColorIndex ) + LOCAL aColorsIdx := { _TBC_CLR_STANDARD, _TBC_CLR_SELECTED, ; + _TBC_CLR_STANDARD, _TBC_CLR_STANDARD } + LOCAL nColorIndex + LOCAL nPos + + IF ISARRAY( aDefColorsIdx ) + FOR nPos := 1 TO _TBC_CLR_MAX + IF nPos <= Len( aDefColorsIdx ) .AND. ; + ISNUMBER( nColorIndex := aDefColorsIdx[ nPos ] ) .AND. ; + ( nColorIndex := Int( nColorIndex ) ) >= 0 .AND. ; + nColorIndex <= nMaxColorIndex + + aColorsIdx[ nPos ] := nColorIndex + ELSEIF nPos > 2 + aColorsIdx[ nPos ] := aColorsIdx[ 1 ] + ENDIF + NEXT + ENDIF + + RETURN aColorsIdx + + +STATIC FUNCTION _CELLCOLORS( aCol, xValue, nMaxColorIndex ) + LOCAL aColors := { aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_STANDARD ], ; + aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_SELECTED ] } + LOCAL xColor := Eval( aCol[ _TBCI_COLOBJECT ]:colorBlock, xValue ) + LOCAL nColorIndex + LOCAL nPos, nMax + + IF ISARRAY( xColor ) + nMax := Min( Len( xColor ), 2 ) + FOR nPos := 1 TO nMax + nColorIndex := xColor[ nPos ] + IF ISNUMBER( nColorIndex ) + nColorIndex := Int( nColorIndex ) + IF nColorIndex >= 0 .AND. nColorIndex <= nMaxColorIndex + aColors[ nPos ] := nColorIndex + ENDIF + ENDIF + NEXT + ENDIF + + RETURN aColors + + +METHOD setCursorPos() CLASS XbpBrowse + + LOCAL aCol + LOCAL nRow, nCol + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + nRow := ::nRowPos + nCol := ::nColPos + + IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; + nCol >= 1 .AND. nCol <= ::colCount .AND. ; + ( aCol := ::aColData[ nCol ] )[ _TBCI_COLPOS ] != NIL + + ::n_Row := ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 0, -1 ) + nRow + ::n_Col := ::aColData[ nCol ][ _TBCI_COLPOS ] + ; + ::aColData[ nCol ][ _TBCI_CELLPOS ] + IF aCol[ _TBCI_SEPWIDTH ] > 0 + DO WHILE --nCol >= 1 + IF ::aColData[ nCol ][ _TBCI_COLPOS ] != NIL + ::n_Col += aCol[ _TBCI_SEPWIDTH ] + EXIT + ENDIF + ENDDO + ENDIF + SetPos( ::n_Row, ::n_Col ) + RETURN .T. + ENDIF + + RETURN .F. + +/* set visible columns */ +METHOD setVisible() CLASS XbpBrowse + LOCAL nCol, nLeft, nFrozen, nLast, nColumns, nWidth, nColPos + LOCAL lFirst, lFrames + LOCAL aCol + + nColPos := ::nColPos + IF nColPos < 1 .OR. nColPos > ::colCount .OR. ::nLastPos != nColPos .OR. ; + ::lFrames .OR. ::nLeftVisible == 0 .OR. ::nRightVisible == 0 .OR. ; + ::aColData[ nColPos ][ _TBCI_COLPOS ] == NIL + + lFrames := .F. + nWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 + nColumns := Len( ::aColData ) + + IF nColPos > nColumns + ::nColPos := nColumns + ::nLeftVisible := nColumns + ::nRightVisible := nColumns + ELSEIF ::nColPos < 1 + ::nColPos := 1 + ::nLeftVisible := 1 + ::nRightVisible := 1 + ELSEIF nColPos != ::nLastPos + IF nColPos > ::nRightVisible + ::nRightVisible := ::nColPos + ::nLeftVisible := 0 + ELSEIF nColPos < ::nLeftVisible + ::nLeftVisible := ::nColPos + ::nRightVisible := 0 + ENDIF + ELSEIF ::nColPos <= ::nFrozen .AND. ::nLeftVisible == 0 + nCol := _NEXTCOLUMN( ::aColData, ::nFrozen + 1 ) + ::nColPos := iif( nCol == 0, nColumns, nCol ) + ENDIF + + _SETVISIBLE( ::aColData, @nWidth, ; + @::nFrozen, @::nLeftVisible, @::nRightVisible ) + + IF ::nColPos > ::nRightVisible + ::nColPos := ::nRightVisible + ELSEIF ::nColPos > ::nFrozen .AND. ::nColPos < ::nLeftVisible + ::nColPos := ::nLeftVisible + ENDIF + + /* update column size and positions on the screen */ + nLeft := _TBR_COORD( ::n_Left ) + lFirst := .T. + FOR nCol := 1 TO ::nRightVisible + aCol := ::aColData[ nCol ] + IF aCol[ _TBCI_CELLWIDTH ] > 0 .AND. ; + ( nCol <= ::nFrozen .OR. nCol >= ::nLeftVisible ) + + nFrozen := iif( nCol == ::nLeftVisible, Int( nWidth / 2 ), 0 ) + nColPos := nLeft += nFrozen + nLeft += aCol[ _TBCI_COLWIDTH ] + IF lFirst + lFirst := .F. + ELSE + nLeft += aCol[ _TBCI_SEPWIDTH ] + ENDIF + nLast := iif( nCol == ::nRightVisible, ; + _TBR_COORD( ::n_Right ) - nLeft + 1, 0 ) + + IF aCol[ _TBCI_COLPOS ] != nColPos .OR. ; + aCol[ _TBCI_FROZENSPACE ] != nFrozen .OR. ; + aCol[ _TBCI_LASTSPACE ] != nLast + + lFrames := .T. + aCol[ _TBCI_COLPOS ] := nColPos + aCol[ _TBCI_FROZENSPACE ] := nFrozen + aCol[ _TBCI_LASTSPACE ] := nLast + ENDIF + ELSE + IF aCol[ _TBCI_COLPOS ] != NIL + lFrames := .T. + ENDIF + aCol[ _TBCI_COLPOS ] := NIL + ENDIF + NEXT + FOR nCol := ::nRightVisible + 1 TO nColumns + aCol := ::aColData[ nCol ] + IF aCol[ _TBCI_COLPOS ] != NIL + lFrames := .T. + ENDIF + aCol[ _TBCI_COLPOS ] := NIL + NEXT + + ::nLastPos := ::nColPos + + IF lFrames + ::lFrames := .T. + ENDIF + + ENDIF RETURN Self -/*----------------------------------------------------------------------*/ -METHOD XbpBrowse:hiLite() +METHOD hiLite() CLASS XbpBrowse + + LOCAL cValue, cColor + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + DispBegin() + + IF ::setCursorPos() + IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL + cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_SELECTED ] ) + IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) + cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) + ENDIF + hb_dispOutAt( ::n_Row, ::n_Col, cValue, cColor ) + SetPos( ::n_Row, ::n_Col ) + ::lHiLited := .T. + ENDIF + ENDIF + + DispEnd() RETURN Self -/*----------------------------------------------------------------------*/ -METHOD XbpBrowse:refreshAll() +METHOD deHilite() CLASS XbpBrowse + + LOCAL cValue, cColor + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + DispBegin() + + IF ::setCursorPos() + IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL + cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_STANDARD ] ) + IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) + cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) + ENDIF + hb_dispOutAt( ::n_Row, ::n_Col, cValue, cColor ) + SetPos( ::n_Row, ::n_Col ) + ENDIF + ENDIF + ::lHiLited := .F. + + DispEnd() RETURN Self -/*----------------------------------------------------------------------*/ -METHOD XbpBrowse:refreshCurrent() +/* Returns the display width of a particular column */ +METHOD colWidth( nColumn ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF ISNUMBER( nColumn ) .AND. nColumn >= 1 .AND. nColumn <= ::colCount + RETURN ::aColData[ nColumn ][ _TBCI_COLWIDTH ] + ENDIF + + RETURN 0 + + +/* get number of frozen columns */ +METHOD getFrozen() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::nFrozen + + +/* set number of columns to freeze */ +METHOD freeze( nColumns ) CLASS XbpBrowse + + LOCAL nCols + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF ISNUMBER( nColumns ) + + nCols := Int( nColumns ) + IF _MAXFREEZE( nCols, ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 ) == nCols + + ::nFrozen := nCols + ::lFrames := .T. + ::nLastPos := 0 + _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; + @::nFrozen, @::nLeftVisible, @::nRightVisible ) + ENDIF + + RETURN nCols + ENDIF + + RETURN ::nFrozen + + +METHOD colorSpec( cColorSpec ) CLASS XbpBrowse + + IF cColorSpec != NIL + ::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001 ) + ::configure( _TBR_CONF_COLORS ) + ENDIF + + RETURN ::cColorSpec + + +METHOD colCount() CLASS XbpBrowse + + RETURN Len( ::columns ) + + +METHOD rowCount() CLASS XbpBrowse +// LOCAL nRows := 6 + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + #if 0 + nRows := _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ) + 1 - ; + ::nHeadHeight - iif( ::lHeadSep, 1, 0 ) - ; + ::nFootHeight - iif( ::lFootSep, 1, 0 ) + + RETURN iif( nRows > 0, nRows, 0 ) + #endif + + RETURN ::nRowsInView + +METHOD setRowPos( nRowPos ) CLASS XbpBrowse + LOCAL nRow + LOCAL nRowCount := ::rowCount + + IF ISNUMBER( nRowPos ) + nRow := Int( nRowPos ) + ::nRowPos := iif( nRow > nRowCount, nRowCount, ; + iif( nRow < 1, 1, nRow ) ) + RETURN nRow + ELSE + ::nRowPos := Min( nRowCount, 1 ) + RETURN 0 + ENDIF + + RETURN ::nRowPos + + +METHOD getRowPos() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::nRowPos + + +METHOD setColPos( nColPos ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF ISNUMBER( nColPos ) + ::nColPos := nColPos + ELSE + ::nColPos := 0 + ENDIF + + RETURN ::nColPos + + +METHOD getColPos() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::nColPos + + +METHOD getTopFlag() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::lHitTop + + +METHOD setTopFlag( lTop ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !ISLOGICAL( lTop ) + RETURN .T. + ENDIF + + ::lHitTop := lTop + + RETURN lTop + + +METHOD getBottomFlag() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::lHitBottom + + +METHOD setBottomFlag( lBottom ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !ISLOGICAL( lBottom ) + RETURN .T. + ENDIF + + ::lHitBottom := lBottom + + RETURN lBottom + + +METHOD getAutoLite() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::lAutoLite + + +METHOD setAutoLite( lAutoLite ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !ISLOGICAL( lAutoLite ) + RETURN .T. + ENDIF + + ::lAutoLite := lAutoLite + + RETURN lAutoLite + + +METHOD getStableFlag() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::lStable + + +METHOD setStableFlag( lStable ) CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !ISLOGICAL( lStable ) + RETURN .T. + ENDIF + + ::lStable := lStable + + RETURN lStable + + +METHOD leftVisible() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::nLeftVisible + + +METHOD rightVisible() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::nRightVisible + + +/* Adds a TBColumn object to the TBrowse object */ +METHOD addColumn( oCol ) CLASS XbpBrowse + + AAdd( ::columns, oCol ) + ::configure( _TBR_CONF_COLUMNS ) + + ::doConfigure() /* QT */ RETURN Self -/*----------------------------------------------------------------------*/ -METHOD XbpBrowse:getData() +/* Delete a column object from a browse */ +METHOD delColumn( nColumn ) CLASS XbpBrowse + LOCAL oCol - RETURN Self + oCol := ::columns[ nColumn ] + ADel( ::columns, nColumn ) + ASize( ::columns, Len( ::columns ) - 1 ) + ::configure( _TBR_CONF_COLUMNS ) -/*----------------------------------------------------------------------*/ + RETURN oCol -METHOD XbpBrowse:footerRbDown() - RETURN Self +/* Insert a column object in a browse */ +METHOD insColumn( nColumn, oCol ) CLASS XbpBrowse -/*----------------------------------------------------------------------*/ + HB_AIns( ::columns, nColumn, oCol, .T. ) + ::configure( _TBR_CONF_COLUMNS ) -METHOD XbpBrowse:headerRbDown() + RETURN oCol - RETURN Self -/*----------------------------------------------------------------------*/ +/* Replaces one TBColumn object with another */ +METHOD setColumn( nColumn, oCol ) CLASS XbpBrowse + LOCAL oPrevCol -METHOD XbpBrowse:itemMarked() + IF nColumn != NIL .AND. oCol != NIL + nColumn := __eInstVar53( Self, "COLUMN", nColumn, "N", 1001 ) + oCol := __eInstVar53( Self, "COLUMN", oCol, "O", 1001 ) - RETURN Self + oPrevCol := ::columns[ nColumn ] + ::columns[ nColumn ] := oCol + ::configure( _TBR_CONF_COLUMNS ) + ENDIF -/*----------------------------------------------------------------------*/ + RETURN oPrevCol -METHOD XbpBrowse:itemRbDown() - RETURN Self +/* Gets a specific TBColumn object */ +METHOD getColumn( nColumn ) CLASS XbpBrowse -/*----------------------------------------------------------------------*/ + RETURN iif( nColumn >= 1 .AND. nColumn <= ::colCount, ::columns[ nColumn ], NIL ) -METHOD XbpBrowse:itemSelected() - RETURN Self +METHOD footSep( cFootSep ) CLASS XbpBrowse -/*----------------------------------------------------------------------*/ -#if 0 -METHOD XbpBrowse:forceStable() + IF cFootSep != NIL + ::cFootSep := __eInstVar53( Self, "FOOTSEP", cFootSep, "C", 1001 ) + ENDIF - RETURN Self -#endif -/*----------------------------------------------------------------------*/ + RETURN ::cFootSep -METHOD XbpBrowse:navigate() - RETURN Self +METHOD colSep( cColSep ) CLASS XbpBrowse -/*----------------------------------------------------------------------*/ + IF cColSep != NIL + ::cColSep := __eInstVar53( Self, "COLSEP", cColSep, "C", 1001 ) + ENDIF -METHOD XbpBrowse:pan() + RETURN ::cColSep - RETURN Self + +METHOD headSep( cHeadSep ) CLASS XbpBrowse + + IF cHeadSep != NIL + ::cHeadSep := __eInstVar53( Self, "HEADSEP", cHeadSep, "C", 1001 ) + ENDIF + + RETURN ::cHeadSep + + +METHOD skipBlock( bSkipBlock ) CLASS XbpBrowse + + IF bSkipBlock != NIL + ::bSkipBlock := __eInstVar53( Self, "SKIPBLOCK", bSkipBlock, "B", 1001 ) + ENDIF + + RETURN ::bSkipBlock + + +METHOD goTopBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bGoTopBlock := __eInstVar53( Self, "GOTOPBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bGoTopBlock + + +METHOD goBottomBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bGoBottomBlock := __eInstVar53( Self, "GOBOTTOMBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bGoBottomBlock + + +METHOD firstPosBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bFirstPosBlock := __eInstVar53( Self, "FIRSTPOSBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bFirstPosBlock + + +METHOD lastPosBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bLastPosBlock := __eInstVar53( Self, "LASTPOSBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bLastPosBlock + + +METHOD phyPosBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bPhyPosBlock := __eInstVar53( Self, "PHYPOSBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bPhyPosBlock + + +METHOD posBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bPosBlock := __eInstVar53( Self, "POSBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bPosBlock + + +METHOD goPosBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bGoPosBlock := __eInstVar53( Self, "GOPOSBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bGoPosBlock + + +METHOD hitBottomBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bHitBottomBlock := __eInstVar53( Self, "HITBOTTOMBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bHitBottomBlock + + +METHOD hitTopBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bHitTopBlock := __eInstVar53( Self, "HITTOPBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bHitTopBlock + + +METHOD stableBlock( bBlock ) CLASS XbpBrowse + + IF bBlock != NIL + ::bStableBlock := __eInstVar53( Self, "STABLEBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bStableBlock + + +METHOD nTop( nTop ) CLASS XbpBrowse + + IF nTop != NIL + ::n_Top := __eInstVar53( Self, "NTOP", nTop, "N", 1001 ) + IF !Empty( ::cBorder ) + ::n_Top++ + ENDIF + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + IF !Empty( ::cBorder ) + RETURN ::n_Top - 1 + ENDIF + + RETURN ::n_Top + + +METHOD nLeft( nLeft ) CLASS XbpBrowse + + IF nLeft != NIL + ::n_Left := __eInstVar53( Self, "NLEFT", nLeft, "N", 1001 ) + IF !Empty( ::cBorder ) + ::n_Left++ + ENDIF + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + IF !Empty( ::cBorder ) + RETURN ::n_Left - 1 + ENDIF + + RETURN ::n_Left + + +METHOD nBottom( nBottom ) CLASS XbpBrowse + + IF nBottom != NIL + ::n_Bottom := __eInstVar53( Self, "NBOTTOM", nBottom, "N", 1001, {| o, x | x >= o:nTop } ) + IF !Empty( ::cBorder ) + ::n_Bottom-- + ENDIF + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + IF !Empty( ::cBorder ) + RETURN ::n_Bottom + 1 + ENDIF + + RETURN ::n_Bottom + + +METHOD nRight( nRight ) CLASS XbpBrowse + + IF nRight != NIL + ::n_Right := __eInstVar53( Self, "NRIGHT", nRight, "N", 1001, {| o, x | x >= o:nLeft } ) + IF !Empty( ::cBorder ) + ::n_Right-- + ENDIF + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + IF !Empty( ::cBorder ) + RETURN ::n_Right + 1 + ENDIF + + RETURN ::n_Right + + +METHOD viewArea() CLASS XbpBrowse + LOCAL nWidth, nFrozenWidth + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + nWidth := nFrozenWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 + _MAXFREEZE( ::nFrozen, ::aColData, @nWidth ) + nFrozenWidth -= nWidth + + RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),; + ::n_Left,; + ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),; + ::n_Right,; + nFrozenWidth } + + +METHOD firstScrCol() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] ) + + +METHOD nRow() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::n_Row + + +METHOD nCol() CLASS XbpBrowse + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + RETURN ::n_Col + + +METHOD hitTest( mRow, mCol ) CLASS XbpBrowse + + LOCAL nTop, nLeft, nBottom, nRight, nRet, nCol + LOCAL lFirst + LOCAL aCol + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + ::mRowPos := ::mColPos := 0 + + IF !ISNUMBER( mRow ) .OR. !ISNUMBER( mCol ) .OR. ; + mRow < ( nTop := _TBR_COORD( ::n_Top ) ) .OR. ; + mRow > ( nBottom := _TBR_COORD( ::n_Bottom ) ) .OR. ; + mCol < ( nLeft := _TBR_COORD( ::n_Left ) ) .OR. ; + mCol > ( nRight := _TBR_COORD( ::n_Right ) ) + RETURN HTNOWHERE + ENDIF + + nRet := HTNOWHERE + + IF !Empty( ::cBorder ) + IF mRow == nTop - 1 + IF mCol == nLeft - 1 + nRet := HTTOPLEFT + ELSEIF mCol == nRight + 1 + nRet := HTTOPRIGHT + ELSE + nRet := HTTOP + ENDIF + ELSEIF mRow == nBottom + 1 + IF mCol == nLeft - 1 + nRet := HTBOTTOMLEFT + ELSEIF mCol == nRight + 1 + nRet := HTBOTTOMRIGHT + ELSE + nRet := HTBOTTOM + ENDIF + ELSEIF mCol == nLeft - 1 + nRet := HTLEFT + ELSEIF mCol == nRight + 1 + nRet := HTRIGHT + ENDIF + ENDIF + + IF nRet == HTNOWHERE + IF mRow < nTop + ::nHeadHeight + nRet := HTHEADING + ELSEIF ::lHeadSep .AND. mRow == nTop + ::nHeadHeight + nRet := HTHEADSEP + ELSEIF ::lFootSep .AND. mRow == nBottom - ::nFootHeight + nRet := HTFOOTSEP + ELSEIF mRow > nBottom - ::nFootHeight + nRet := HTFOOTING + ELSE + nRet := HTCELL + ::mRowPos := mRow - nTop - ::nHeadHeight - iif( ::lHeadSep, 1, 0 ) + + lFirst := .T. + nCol := 1 + DO WHILE nCol <= ::nRightVisible + aCol := ::aColData[ nCol ] + IF aCol[ _TBCI_COLPOS ] != NIL + IF lFirst + lFirst := .F. + ELSE + /* NOTE: CA-Cl*pper has bug here, it takes the size of + * next column separator instead of the current one + */ + IF ( nLeft += aCol[ _TBCI_SEPWIDTH ] ) > mCol + nRet := HTCOLSEP + EXIT + ENDIF + ENDIF + + ::mColPos := nCol + + IF ( nLeft += aCol[ _TBCI_COLWIDTH ] + ; + aCol[ _TBCI_FROZENSPACE ] + ; + aCol[ _TBCI_LASTSPACE ] ) > mCol + EXIT + ENDIF + ENDIF + IF nCol == ::nFrozen .AND. nCol < ::nLeftVisible + nCol := ::nLeftVisible + ELSE + nCol++ + ENDIF + ENDDO + ENDIF + ENDIF + + RETURN nRet + + +STATIC PROCEDURE _mBrwPos( oBrw, mRow, mCol ) + + LOCAL nTop, nLeft, nBottom, nPos, nCol, aCol + + mRow := MRow() + mCol := MCol() + + IF mRow >= ( nTop := _TBR_COORD( oBrw:n_Top ) ) .AND. ; + mRow <= ( nBottom := _TBR_COORD( oBrw:n_Bottom ) ) .AND. ; + mCol >= ( nLeft := _TBR_COORD( oBrw:n_Left ) ) .AND. ; + mCol <= ( _TBR_COORD( oBrw:n_Right ) ) + + IF mRow < nTop + oBrw:nHeadHeight + iif( oBrw:lHeadSep, 1, 0 ) .OR. ; + mRow > nBottom - oBrw:nFootHeight - iif( oBrw:lFootSep, 1, 0 ) + mRow := 0 + ELSE + mRow -= nTop + oBrw:nHeadHeight - iif( oBrw:lHeadSep, 0, 1 ) + ENDIF + + nPos := 0 + nCol := 1 + DO WHILE nCol <= oBrw:nRightVisible + aCol := oBrw:aColData[ nCol ] + IF aCol[ _TBCI_COLPOS ] != NIL + IF nPos != 0 + IF ( nLeft += aCol[ _TBCI_SEPWIDTH ] ) > mCol + EXIT + ENDIF + ENDIF + nPos := nCol + IF ( nLeft += aCol[ _TBCI_COLWIDTH ] + ; + aCol[ _TBCI_FROZENSPACE ] + ; + aCol[ _TBCI_LASTSPACE ] ) > mCol + EXIT + ENDIF + ENDIF + IF nCol == oBrw:nFrozen .AND. nCol < oBrw:nLeftVisible + nCol := oBrw:nLeftVisible + ELSE + nCol++ + ENDIF + ENDDO + mCol := nPos + IF nPos == 0 + mRow := 0 + ENDIF + ELSE + mRow := mCol := 0 + ENDIF + + RETURN + + +METHOD mRowPos() CLASS XbpBrowse + + LOCAL mRow, mCol + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + _mBrwPos( self, @mRow, @mCol ) + + RETURN mRow + + +METHOD mColPos() CLASS XbpBrowse + LOCAL mRow, mCol + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + _mBrwPos( self, @mRow, @mCol ) + + RETURN mCol + + +METHOD border( cBorder ) CLASS XbpBrowse + + IF cBorder != NIL + + cBorder := __eInstVar53( Self, "BORDER", cBorder, "C", 1001 ) + + IF Len( cBorder ) == 0 .OR. Len( cBorder ) == 8 + + IF Empty( ::cBorder ) .AND. !Empty( cBorder ) + ::n_Top++ + ::n_Left++ + ::n_Bottom-- + ::n_Right-- + ::configure( _TBR_CONF_COLUMNS ) + ELSEIF !Empty( ::cBorder ) .AND. Empty( cBorder ) + ::n_Top-- + ::n_Left-- + ::n_Bottom++ + ::n_Right++ + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + ::cBorder := cBorder + ENDIF + ENDIF + + RETURN ::cBorder + + +METHOD message( cMessage ) CLASS XbpBrowse + + IF cMessage != NIL + ::cMessage := __eInstVar53( Self, "MESSAGE", cMessage, "C", 1001 ) + ENDIF + + RETURN ::cMessage + + +METHOD applyKey( nKey ) CLASS XbpBrowse + + LOCAL bBlock := ::SetKey( nKey ) + + IF bBlock == NIL + bBlock := ::SetKey( 0 ) + + IF bBlock == NIL + RETURN TBR_EXCEPTION + ENDIF + ENDIF + + RETURN Eval( bBlock, Self, nKey ) + + +METHOD setKey( nKey, bBlock ) CLASS XbpBrowse + + LOCAL bReturn + LOCAL nPos + + /* NOTE: Assigned codeblock receives two parameters: + {| oTBrowse, nKey | } */ + + IF ::keys == NIL + ::keys := { { K_DOWN , {| o | o:Down() , TBR_CONTINUE } },; + { K_END , {| o | o:End() , TBR_CONTINUE } },; + { K_CTRL_PGDN , {| o | o:GoBottom(), TBR_CONTINUE } },; + { K_CTRL_PGUP , {| o | o:GoTop() , TBR_CONTINUE } },; + { K_HOME , {| o | o:Home() , TBR_CONTINUE } },; + { K_LEFT , {| o | o:Left() , TBR_CONTINUE } },; + { K_PGDN , {| o | o:PageDown(), TBR_CONTINUE } },; + { K_PGUP , {| o | o:PageUp() , TBR_CONTINUE } },; + { K_CTRL_END , {| o | o:PanEnd() , TBR_CONTINUE } },; + { K_CTRL_HOME , {| o | o:PanHome() , TBR_CONTINUE } },; + { K_CTRL_LEFT , {| o | o:PanLeft() , TBR_CONTINUE } },; + { K_CTRL_RIGHT , {| o | o:PanRight(), TBR_CONTINUE } },; + { K_RIGHT , {| o | o:Right() , TBR_CONTINUE } },; + { K_UP , {| o | o:Up() , TBR_CONTINUE } },; + { K_ESC , {| | TBR_EXIT } },; + { K_LBUTTONDOWN, {| o | TBMouse( o, MRow(), MCol() ) } } } + + AAdd( ::keys, { K_MWFORWARD , {| o | o:Up() , TBR_CONTINUE } } ) + AAdd( ::keys, { K_MWBACKWARD , {| o | o:Down() , TBR_CONTINUE } } ) + ENDIF + + IF ( nPos := AScan( ::keys, {| x | x[ _TBC_SETKEY_KEY ] == nKey } ) ) == 0 + IF ISBLOCK( bBlock ) + AAdd( ::keys, { nKey, bBlock } ) + ENDIF + bReturn := bBlock + ELSEIF ISBLOCK( bBlock ) + ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] := bBlock + bReturn := bBlock + ELSEIF PCount() == 1 + bReturn := ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] + ELSE + bReturn := ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] + IF PCount() == 2 .AND. bBlock == NIL .AND. nKey != 0 + ADel( ::keys, nPos ) + ASize( ::keys, Len( ::keys ) - 1 ) + ENDIF + ENDIF + + RETURN bReturn + + +METHOD setStyle( nStyle, lNewValue ) CLASS XbpBrowse + + /* NOTE: CA-Cl*pper 5.3 will initialize this var on the first + :setStyle() method call. [vszakats] */ + + DEFAULT ::styles TO { .F., .F., .F., .F., .F., NIL } + + /* NOTE: CA-Cl*pper 5.3 does no checks on the value of nStyle, so in case + it is zero or non-numeric, a regular RTE will happen. [vszakats] */ + + IF nStyle > Len( ::styles ) .AND. ; + nStyle <= 4096 /* some reasonable limit for maximum number of styles */ + ASize( ::styles, nStyle ) + ENDIF + + IF ISLOGICAL( lNewValue ) + ::styles[ nStyle ] := lNewValue + ENDIF + + RETURN ::styles[ nStyle ] + + +FUNCTION TBMouse( oBrw, nMRow, nMCol ) + + LOCAL n + + IF oBrw:hitTest( nMRow, nMCol ) == HTCELL + + IF ( n := oBrw:mRowPos - oBrw:rowPos ) < 0 + DO WHILE ++n <= 0 + oBrw:up() + ENDDO + ELSEIF n > 0 + DO WHILE --n >= 0 + oBrw:down() + ENDDO + ENDIF + + IF ( n := oBrw:mColPos - oBrw:colPos ) < 0 + DO WHILE ++n <= 0 + oBrw:left() + ENDDO + ELSEIF n > 0 + DO WHILE --n >= 0 + oBrw:right() + ENDDO + ENDIF + + RETURN TBR_CONTINUE + ENDIF + + RETURN TBR_EXCEPTION /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ // -// XbpColumn +// XbpColumn // /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ -CLASS XbpColumn INHERIT XbpWindow, XbpDataRef +CREATE CLASS XbpColumn INHERIT XbpWindow, XbpDataRef - METHOD new() - METHOD create() - METHOD configure() - METHOD destroy() - METHOD cellValue() + EXPORTED: - DATA colorBlock - DATA type INIT XBPCOL_TYPE_TEXT + VAR cargo /* 01. User-definable variable */ + VAR nWidth PROTECTED /* 02. */ + VAR bBlock PROTECTED /* 03. */ + VAR aDefColor PROTECTED INIT { 1, 2 } /* 04. NOTE: Default value for both CA-Cl*pper 5.2 and 5.3. */ + VAR bColorBlock PROTECTED INIT {|| NIL } /* 05. */ + VAR cHeading PROTECTED INIT "" /* 06. */ + VAR cHeadSep PROTECTED /* 07. */ + VAR cColSep PROTECTED /* 08. */ + VAR cFootSep PROTECTED /* 09. */ + VAR cFooting PROTECTED INIT "" /* 10. */ + VAR picture /* 11. Column picture string */ - DATA dataArea - DATA footing - DATA heading - DATA picture INIT "" - DATA valType + VAR bPreBlock PROTECTED /* 12. */ + VAR bPostBlock PROTECTED /* 13. */ + VAR aSetStyle PROTECTED INIT { .F., .F., .F. } /* 14. TBC_READWRITE, TBC_MOVE, TBC_SIZE */ - METHOD dataRow( nRowPos, lRepaint ) - METHOD getRow( nRowPos ) - METHOD hiliteRow() - METHOD refreshRows( nFirstRow, nLastRow ) - METHOD rowCount() - METHOD scrollDown() - METHOD scrollUp() + METHOD block( bBlock ) SETGET /* Code block to retrieve data for the column */ + METHOD colorBlock( bColorBlock ) SETGET /* Code block that determines color of data items */ + METHOD defColor( aDefColor ) SETGET /* Array of numeric indexes into the color table */ + METHOD colSep( cColSep ) SETGET /* Column separator character */ + METHOD heading( cHeading ) SETGET /* Column heading */ + METHOD footing( cFooting ) SETGET /* Column footing */ + METHOD headSep( cHeadSep ) SETGET /* Heading separator character */ + METHOD footSep( cFootSep ) SETGET /* Footing separator character */ + METHOD width( nWidth ) SETGET /* Column display width */ - DATA caption INIT "" - DATA alignment INIT Qt_AlignLeft - DATA halignment INIT Qt_AlignHCenter + Qt_AlignVCenter - DATA height INIT 12 - DATA dheight INIT 12 - DATA hFgColor INIT Qt_black - DATA hBgColor INIT Qt_darkGray - DATA dFgColor INIT Qt_black - DATA dBgColor INIT Qt_white + METHOD preBlock( bPreBlock ) SETGET /* Code block determining editing */ + METHOD postBlock( bPostBlock ) SETGET /* Code block validating values */ + METHOD setStyle( nStyle, lSetting ) + + METHOD new( cHeading, bBlock ) + METHOD create( p1, p2, p3, p4, aPresParams ) + + METHOD datalink( bBlock ) SETGET + + DATA alignment INIT Qt_AlignLeft + DATA halignment INIT Qt_AlignHCenter + Qt_AlignVCenter + DATA height INIT 16 + DATA dheight INIT 16 + DATA hFgColor INIT Qt_black + DATA hBgColor INIT Qt_darkGray + DATA dFgColor INIT Qt_black + DATA dBgColor INIT Qt_white + DATA nColWidth + + DATA valtype + DATA blankVariable ENDCLASS -/*----------------------------------------------------------------------*/ +METHOD datalink( bBlock ) CLASS XbpColumn -METHOD XbpColumn:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) + IF bBlock != NIL + ::bBlock := __eInstVar53( Self, "BLOCK", bBlock, "B", 1001 ) + ENDIF - ::xbpWindow:INIT( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) + RETURN ::bBlock + +METHOD block( bBlock ) CLASS XbpColumn + + IF bBlock != NIL + ::bBlock := __eInstVar53( Self, "BLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bBlock + +METHOD colorBlock( bColorBlock ) CLASS XbpColumn + + IF bColorBlock != NIL + ::bColorBlock := __eInstVar53( Self, "COLORBLOCK", bColorBlock, "B", 1001 ) + ENDIF + + RETURN ::bColorBlock + +METHOD defColor( aDefColor ) CLASS XbpColumn + + IF aDefColor != NIL + ::aDefColor := __eInstVar53( Self, "DEFCOLOR", aDefColor, "A", 1001 ) + ENDIF + + RETURN ::aDefColor + +METHOD colSep( cColSep ) CLASS XbpColumn + + IF cColSep != NIL + ::cColSep := __eInstVar53( Self, "COLSEP", cColSep, "C", 1001 ) + ENDIF + + RETURN ::cColSep + +METHOD heading( cHeading ) CLASS XbpColumn + + IF cHeading != NIL + ::cHeading := __eInstVar53( Self, "HEADING", cHeading, "C", 1001 ) + ENDIF + + RETURN ::cHeading + +METHOD footing( cFooting ) CLASS XbpColumn + + IF cFooting != NIL + ::cFooting := __eInstVar53( Self, "FOOTING", cFooting, "C", 1001 ) + ENDIF + + RETURN ::cFooting + +METHOD headSep( cHeadSep ) CLASS XbpColumn + + IF cHeadSep != NIL + ::cHeadSep := __eInstVar53( Self, "HEADSEP", cHeadSep, "C", 1001 ) + ENDIF + + RETURN ::cHeadSep + +METHOD footSep( cFootSep ) CLASS XbpColumn + + IF cFootSep != NIL + ::cFootSep := __eInstVar53( Self, "FOOTSEP", cFootSep, "C", 1001 ) + ENDIF + + RETURN ::cFootSep + +METHOD width( nWidth ) CLASS XbpColumn + + IF nWidth != NIL + ::nWidth := __eInstVar53( Self, "WIDTH", nWidth, "N", 1001 ) + ENDIF + + RETURN ::nWidth + +METHOD preBlock( bPreBlock ) CLASS XbpColumn + + IF bPreBlock != NIL + ::bPreBlock := __eInstVar53( Self, "PREBLOCK", bPreBlock, "B", 1001 ) + ENDIF + + RETURN ::bPreBlock + +METHOD postBlock( bPostBlock ) CLASS XbpColumn + + IF bPostBlock != NIL + ::bPostBlock := __eInstVar53( Self, "POSTBLOCK", bPostBlock, "B", 1001 ) + ENDIF + + RETURN ::bPostBlock + +METHOD setStyle( nStyle, lNewValue ) CLASS XbpColumn + IF nStyle > Len( ::aSetStyle ) .AND. nStyle <= 4096 + ASize( ::aSetStyle, nStyle ) + ENDIF + + IF ISLOGICAL( lNewValue ) + ::aSetStyle[ nStyle ] := lNewValue + ENDIF + + RETURN ::aSetStyle[ nStyle ] + +METHOD new( cHeading, bBlock ) CLASS XbpColumn + + ::cHeading := cHeading + ::bBlock := bBlock RETURN Self -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) - LOCAL n, xVar, cVar, p, l +METHOD create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) CLASS XbpColumn + LOCAL n, xVar //, cVar, p, l ::xbpWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) IF ( n := ascan( ::aPresParams, {|e_| e_[ 1 ] == XBP_PP_COL_HA_CAPTION } ) ) > 0 - ::caption := ::aPresParams[ n,2 ] + ::cHeading := ::aPresParams[ n,2 ] ENDIF xVar := ::setData() ::valtype := valtype( xVar ) + ::blankVariable := IF( ::valtype == "N", 0, IF( ::valtype == "D", ctod( "" ), IF( ::valtype == "L", .f., "" ) ) ) ::alignment := IF( ::valtype == "N", Qt_AlignRight, IF( ::valtype $ "DL", Qt_AlignHCenter, Qt_AlignLeft ) ) ::alignment += Qt_AlignVCenter @@ -818,7 +3476,11 @@ METHOD XbpColumn:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) IF ( n := ascan( ::aPresParams, {|e_| e_[ 1 ] == XBP_PP_COL_DA_ROWHEIGHT } ) ) > 0 ::dheight := ::aPresParams[ n,2 ] ENDIF + IF ( n := ascan( ::aPresParams, {|e_| e_[ 1 ] == XBP_PP_COL_DA_ROWWIDTH } ) ) > 0 + ::nColWidth := ::aPresParams[ n,2 ] + ENDIF + #if 0 IF empty( ::picture ) DO CASE CASE ::valtype == "N" @@ -839,74 +3501,11 @@ METHOD XbpColumn:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible ) ::picture := "@" ENDCASE ENDIF + #endif RETURN Self /*----------------------------------------------------------------------*/ - -METHOD XbpColumn:cellValue() - RETURN transform( ::setData(), ::picture ) - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:configure() - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:destroy() - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:dataRow( nRowPos, lRepaint ) - - HB_SYMBOL_UNUSED( nRowPos ) - HB_SYMBOL_UNUSED( lRepaint ) - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:getRow( nRowPos ) - - HB_SYMBOL_UNUSED( nRowPos ) - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:hiliteRow() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:refreshRows( nFirstRow, nLastRow ) - - HB_SYMBOL_UNUSED( nFirstRow ) - HB_SYMBOL_UNUSED( nLastRow ) - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:rowCount() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:scrollDown() - - RETURN Self - -/*----------------------------------------------------------------------*/ - -METHOD XbpColumn:scrollUp() - - RETURN Self - /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ /*----------------------------------------------------------------------*/ @@ -1054,2769 +3653,6 @@ METHOD XbpCellGroup:itemSelected() RETURN Self /*----------------------------------------------------------------------*/ -/*----------------------------------------------------------------------*/ -/*----------------------------------------------------------------------*/ - #if 0 -/*----------------------------------------------------------------------*/ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * TBrowse Class - * - * Copyright 2008 Przemyslaw Czerpak - * This implementation contains code and notes by: - * Copyright 2008 Viktor Szakats (harbour.01 syenar.hu) - * www - http://www.harbour-project.org - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries with other - * files to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#define HB_CLS_NOTOBJECT - -#include "hbclass.ch" - -#include "button.ch" -#include "color.ch" -#include "common.ch" -#include "error.ch" -#include "inkey.ch" -#include "setcurs.ch" -#include "tbrowse.ch" - -/* HB_BRW_STATICMOUSE controls if mouse position is static - * and set by call to hitTest() method or dynamic calculated - * by calls to MPOS() / MCOL(). CL53 uses dynamic mouse but - * I guess that some Harbour GUI libraries inherit from TBROWSE - * and because they do not support MCOL()/MROW() (when someone - * will create GUI library integrated with GT system?) then they - * need static mouse with positions passed by GUI code. [druzus] - */ -/* #define HB_BRW_STATICMOUSE */ - - -#define _TBCI_COLOBJECT 1 // column object -#define _TBCI_COLWIDTH 2 // width of the column -#define _TBCI_COLPOS 3 // column position on screen -#define _TBCI_CELLWIDTH 4 // width of the cell -#define _TBCI_CELLPOS 5 // cell position in column -#define _TBCI_COLSEP 6 // column separator -#define _TBCI_SEPWIDTH 7 // width of the separator -#define _TBCI_HEADING 8 // column heading -#define _TBCI_FOOTING 9 // column footing -#define _TBCI_HEADSEP 10 // heading separator -#define _TBCI_FOOTSEP 11 // footing separator -#define _TBCI_DEFCOLOR 12 // default color -#define _TBCI_FROZENSPACE 13 // space after frozen columns -#define _TBCI_LASTSPACE 14 // space after last visible column -#define _TBCI_SIZE 14 // size of array with TBrowse column data - -#define _TBC_SETKEY_KEY 1 -#define _TBC_SETKEY_BLOCK 2 - -#define _TBC_CLR_STANDARD 1 -#define _TBC_CLR_SELECTED 2 -#define _TBC_CLR_HEADING 3 -#define _TBC_CLR_FOOTING 4 -#define _TBC_CLR_MAX 4 - -#define _TBR_CONF_COLORS 1 -#define _TBR_CONF_COLUMNS 2 -#define _TBR_CONF_ALL 3 - -/* Footing/heading line separator. */ -#define _TBR_CHR_LINEDELIMITER ";" - -#define _TBR_COORD( n ) Int( n ) - -CREATE CLASS TBROWSE - -/* The first 18 instance variables are exactly the same as in Clipper - * so also some code which access them directly by array indexes should work - */ - /* === Start of CA-Cl*pper compatible TBrowse instance area === */ - VAR cargo AS USUAL EXPORTED // 01. User-definable variable - -PROTECTED: - VAR n_Top AS NUMERIC INIT 0 // 02. Top row number for the TBrowse display - VAR n_Left AS NUMERIC INIT 0 // 03. Leftmost column for the TBrowse display - VAR n_Bottom AS NUMERIC INIT 0 // 04. Bottom row number for the TBrowse display - VAR n_Right AS NUMERIC INIT 0 // 05. Rightmost column for the TBrowse display - - VAR columns AS ARRAY INIT {} // 06. Array of TBrowse columns - - VAR cHeadSep AS CHARACTER INIT "" // 07. Heading separator characters - VAR cColSep AS CHARACTER INIT " " // 08. Column separator characters - VAR cFootSep AS CHARACTER INIT "" // 09. Footing separator characters - - VAR cColorSpec AS CHARACTER // 10. Color table for the TBrowse display - - VAR bSkipBlock AS BLOCK INIT {|| NIL } // 11. Code block used to reposition data source - VAR bGoTopBlock AS BLOCK INIT {|| NIL } // 12. Code block executed by TBrowse:goTop() - VAR bGoBottomBlock AS BLOCK INIT {|| NIL } // 13. Code block executed by TBrowse:goBottom() - -#ifdef HB_COMPAT_C53 - VAR dummy INIT "" // 14. ??? In Clipper it's character variable with internal C level structure containing browse data - VAR cBorder AS CHARACTER // 15. character value defining characters drawn around object - VAR cMessage // 16. character string displayed on status bar - VAR keys AS ARRAY // 17. array with SetKey() method values - VAR styles AS ARRAY // 18. array with SetStyle() method values -#endif - /* === End of CA-Cl*pper compatible TBrowse instance area === */ - -EXPORTED: - -#ifdef HB_COMPAT_C53 -#ifdef HB_BRW_STATICMOUSE - VAR mRowPos AS INTEGER INIT 0 // numeric value indicating the data row of the mouse position - VAR mColPos AS INTEGER INIT 0 // numeric value indicating the data column of the mouse position -#else - METHOD mRowPos SETGET // numeric value indicating the data row of the mouse position - METHOD mColPos SETGET // numeric value indicating the data column of the mouse position -#endif - - METHOD setStyle( nStyle, lNewValue ) // maintains a dictionary within an object - METHOD setKey( nKey, bBlock ) // get/set a code block associated with an INKEY() value - METHOD applyKey( nKey ) // evaluate the code block associated with given INKEY() value - METHOD hitTest( mRow, mCol ) // indicate position of mouse cursor relative to TBrowse - METHOD nRow SETGET // screen row number for the actual cell - METHOD nCol SETGET // screen column number for the actual cell - METHOD border( cBorder ) SETGET // get/set character value used for TBrowse are border - METHOD message( cMessage ) SETGET // get/set character string displayed on status bar -#endif - - METHOD nTop( nTop ) SETGET // get/set top row number for the TBrowse display - METHOD nLeft( nLeft ) SETGET // get/set leftmost column for the TBrowse display - METHOD nBottom( nBottom ) SETGET // get/set bottom row number for the TBrowse display - METHOD nRight( nRight ) SETGET // get/set rightmost column for the TBrowse display - - METHOD headSep( cHeadSep ) SETGET // get/set heading separator characters - METHOD colSep( cColSep ) SETGET // get/set column separator characters - METHOD footSep( cFootSep ) SETGET // get/set footing separator characters - METHOD skipBlock( bSkipBlock ) SETGET // get/set code block used to reposition data source - METHOD goTopBlock( bBlock ) SETGET // get/set code block executed by TBrowse:goTop() - METHOD goBottomBlock( bBlock ) SETGET // get/set code block executed by TBrowse:goBottom() - - METHOD colorSpec( cColorSpec ) SETGET // get/set string value with color table for the TBrowse display - - ACCESS rowPos METHOD getRowPos // get current cursor row position - ASSIGN rowPos METHOD setRowPos // set current cursor row position - - ACCESS colPos METHOD getColPos // get current cursor column position - ASSIGN colPos METHOD setColPos // set current cursor column position - - ACCESS freeze METHOD getFrozen // get number of frozen columns - ASSIGN freeze METHOD freeze // set number of columns to freeze - - ACCESS hitTop METHOD getTopFlag // get the beginning of available data flag - ASSIGN hitTop METHOD setTopFlag // set the beginning of available data flag - - ACCESS hitBottom METHOD getBottomFlag // get the end of available data flag - ASSIGN hitBottom METHOD setBottomFlag // set the end of available data flag - - ACCESS autoLite METHOD getAutoLite // get automatic highlighting state - ASSIGN autoLite METHOD setAutoLite // set automatic highlighting - - ACCESS stable METHOD getStableFlag // get flag indicating if the TBrowse object is stable - ASSIGN stable METHOD setStableFlag // set flag indicating if the TBrowse object is stable - - METHOD addColumn( oCol ) // adds a TBColumn object to the TBrowse object - METHOD delColumn( nColumn ) // delete a column object from a browse - METHOD insColumn( nColumn, oCol ) // insert a column object in a browse - METHOD setColumn( nColumn, oCol ) // replaces one TBColumn object with another - METHOD getColumn( nColumn ) // gets a specific TBColumn object - - METHOD rowCount() // number of visible data rows in the TBrowse display - METHOD colCount() // number of browse columns - - METHOD colWidth( nColumn ) // returns the display width of a particular column - - METHOD leftVisible() // indicates position of leftmost unfrozen column in display - METHOD rightVisible() // indicates position of rightmost unfrozen column in display - - METHOD hilite() // highlights the current cell - METHOD deHilite() // dehighlights the current cell - METHOD refreshAll() // causes all data to be recalculated during the next stabilize - METHOD refreshCurrent() // causes the current row to be refilled and repainted on next stabilize - METHOD forceStable() // performs a full stabilization - METHOD invalidate() // forces entire redraw during next stabilization - - METHOD up() // moves the cursor up one row - METHOD down() // moves the cursor down one row - METHOD left() // moves the cursor left one column - METHOD right() // moves the cursor right one column - METHOD pageUp() // repositions the data source upward - METHOD pageDown() // repositions the data source downward - METHOD home() // moves the cursor to the leftmost visible data column - METHOD end() // moves the cursor to the rightmost visible data column - - METHOD goTop() // repositions the data source to the top of file - METHOD goBottom() // repositions the data source to the bottom of file - - METHOD panLeft() // pans left without changing the cursor position - METHOD panRight() // pans right without changing the cursor position - METHOD panHome() // moves the cursor to the leftmost visible data column - METHOD panEnd() // moves the cursor to the rightmost data column - - METHOD stabilize() // performs incremental stabilization - METHOD colorRect( aRect, aColors ) // alters the color of a rectangular group of cells - - /* NOTE: nMode is an undocumented parameter in CA-Cl*pper */ - METHOD configure( nMode ) // mark that the internal settings of the TBrowse object should be reconfigured - -#ifdef HB_COMPAT_XPP - METHOD viewArea() // Xbase++ compatible method - METHOD firstScrCol() // Xbase++ compatible method - - MESSAGE _left() METHOD Left() - MESSAGE _right() METHOD Right() - MESSAGE _end() METHOD End() -#endif - - METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats] - -PROTECTED: - VAR nRowPos AS INTEGER INIT 1 // current cursor row position - VAR nColPos AS INTEGER INIT 1 // current cursor column position - VAR nLeftVisible AS INTEGER INIT 0 // indicates position of leftmost unfrozen column in display - VAR nRightVisible AS INTEGER INIT 0 // indicates position of rightmost unfrozen column in display - VAR n_Row AS INTEGER INIT 0 // current cursor screen row position - VAR n_Col AS INTEGER INIT 0 // current cursor screen column position - VAR nHeadHeight AS INTEGER INIT 0 // heading vertical size - VAR nFootHeight AS INTEGER INIT 0 // footing vertical size - VAR nFrozen AS INTEGER INIT 0 // number of frozen columns - VAR nBufferPos AS INTEGER INIT 1 // position in row buffer - VAR nMoveOffset AS INTEGER INIT 0 // requested repositioning - VAR nLastRow AS INTEGER INIT 0 // last row in the buffer - VAR nLastScroll AS INTEGER INIT 0 // last srcoll value - VAR nConfigure AS INTEGER INIT _TBR_CONF_ALL // configuration status - VAR nLastPos AS INTEGER INIT 0 // last calculated column position - VAR lHitTop AS LOGICAL INIT .F. // indicates the beginning of available data - VAR lHitBottom AS LOGICAL INIT .F. // indicates the end of available data - VAR lHiLited AS LOGICAL INIT .F. // indicates if current cell is highlighted - VAR lAutoLite AS LOGICAL INIT .T. // logical value to control highlighting - VAR lStable AS LOGICAL INIT .F. // indicates if the TBrowse object is stable - VAR lInvalid AS LOGICAL INIT .T. // indicates that TBrowse object data should be fully redrawn - VAR lRefresh AS LOGICAL INIT .F. // indicates that record buffer should be discarded in next stabilization - VAR lFrames AS LOGICAL INIT .F. // indicates that headings and footings should be redrawn - VAR lHeadSep AS LOGICAL INIT .F. // indicates if heading separator exists - VAR lFootSep AS LOGICAL INIT .F. // indicates if footing separator exists - VAR aColData AS ARRAY INIT {} // column information, see _TBCI_* - VAR aColors AS ARRAY INIT {} // array with TBrowse colors, see _TBC_CLR_* - VAR aDispStatus AS ARRAY INIT {} // record buffer status - VAR aCellStatus AS ARRAY INIT {} // record buffer status - VAR aCellValues AS ARRAY INIT {} // cell values buffers for each record - VAR aCellColors AS ARRAY INIT {} // cell colors buffers for each record - - METHOD doConfigure() // reconfigures the internal settings of the TBrowse object - METHOD setUnstable() // set TBrows in unstable mode resetting flags - METHOD setPosition( nPos ) // synchronize record position with the buffer - METHOD readRecord() // read current record into the buffer - - METHOD setVisible() // set visible columns - METHOD setCursorPos() // set screen cursor position at current cell - METHOD scrollBuffer( nRows ) // scroll internal buffer for given row numbers - METHOD colorValue( nColorIndex ) // get color value for given index - METHOD cellValue( nRow, nCol ) // get cell color indexes - METHOD cellColor( nRow, nCol ) // get cell formatted value - METHOD dispFrames() // display TBrowse border, columns' headings, footings and separators - METHOD dispRow( nRow ) // display TBrowse data - - FRIEND FUNCTION _mBrwPos // helper function for mRow() and mCol() methods - -ENDCLASS - - - -FUNCTION TBrowseNew( nTop, nLeft, nBottom, nRight ) - - RETURN TBrowse():new( nTop, nLeft, nBottom, nRight ) - - -METHOD new( nTop, nLeft, nBottom, nRight ) CLASS TBROWSE - - DEFAULT nTop TO 0 - DEFAULT nLeft TO 0 - DEFAULT nBottom TO MaxRow() - DEFAULT nRight TO MaxCol() - - ::nTop := nTop - ::nLeft := nLeft - ::nBottom := nBottom - ::nRight := nRight - - ::colorSpec := SetColor() - - RETURN Self - -STATIC FUNCTION _SKIP_RESULT( xResult ) - - RETURN iif( ISNUMBER( xResult ), Int( xResult ), 0 ) - - -STATIC PROCEDURE _DISP_FHSEP( nRow, nType, cColor, aColData ) - LOCAL aCol - LOCAL cSep - LOCAL nLen - LOCAL nWidth - LOCAL lFirst := .T. - LOCAL lFirstVisible := .T. - - FOR EACH aCol IN aColData - IF aCol[ _TBCI_COLPOS ] != NIL - cSep := aCol[ nType ] - nWidth := aCol[ _TBCI_COLWIDTH ] - - /* This is in my opinion bug which should be fixed - * and the First column should be shown with the - * same conditions as first visible column. - * Now I replicated exact CA-Cl*pper behavior but - * probably in the future it will be changed. [druzus] - */ - IF lFirst - lFirst := lFirstVisible := .F. - cSep := Replicate( Right( cSep, 1 ), nWidth + ; - aCol[ _TBCI_FROZENSPACE ] ) - ELSEIF lFirstVisible - lFirstVisible := .F. - nLen := Len( cSep ) - IF nLen <= aCol[ _TBCI_SEPWIDTH ] - cSep := Replicate( Right( cSep, 1 ), nWidth + ; - aCol[ _TBCI_FROZENSPACE ] ) - ELSE - cSep := Substr( cSep, aCol[ _TBCI_SEPWIDTH ] + 1, nWidth ) - IF ( nLen -= aCol[ _TBCI_SEPWIDTH ] + nWidth ) < 0 - cSep += Replicate( Right( cSep, 1 ), -nLen ) - ENDIF - IF aCol[ _TBCI_FROZENSPACE ] > 0 - cSep := Replicate( Left( cSep, 1 ), aCol[ _TBCI_FROZENSPACE ] ) + ; - cSep - ENDIF - ENDIF - ELSE - nLen := Len( cSep ) - aCol[ _TBCI_SEPWIDTH ] - nWidth - IF nLen > 0 - cSep := Left( cSep, aCol[ _TBCI_SEPWIDTH ] + nWidth ) - ELSEIF nLen < 0 - cSep += Replicate( Right( cSep, 1 ), -nLen ) - ENDIF - IF aCol[ _TBCI_FROZENSPACE ] > 0 - cSep := Stuff( cSep, aCol[ _TBCI_SEPWIDTH ] + 1, 0, ; - Replicate( Substr( cSep, aCol[ _TBCI_SEPWIDTH ] + 1, 1 ), ; - aCol[ _TBCI_FROZENSPACE ] ), cSep ) - ENDIF - ENDIF - IF aCol[ _TBCI_LASTSPACE ] > 0 - cSep += Replicate( Right( cSep, 1 ), aCol[ _TBCI_LASTSPACE ] ) - ELSEIF aCol[ _TBCI_LASTSPACE ] < 0 - cSep := Left( cSep, Len( cSep ) + aCol[ _TBCI_LASTSPACE ] ) - ENDIF - hb_dispOutAtBox( nRow, aCol[ _TBCI_COLPOS ] - aCol[ _TBCI_FROZENSPACE ], ; - cSep, cColor ) - ELSEIF aCol[ _TBCI_CELLWIDTH ] > 0 - lFirst := .F. - ENDIF - NEXT - - RETURN - - -STATIC PROCEDURE _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aColors, aColData ) - - LOCAL aCol - LOCAL cName - LOCAL nPos - LOCAL nCol - LOCAL nWidth - LOCAL lFirst := .T. - - hb_dispBox( nRow, nLeft, nRow + nHeight - 1, nRight, ; - Space( 9 ), aColors[ _TBC_CLR_STANDARD ] ) - - FOR EACH aCol IN aColData - IF aCol[ _TBCI_COLPOS ] != NIL - cName := aCol[ nType ] - nCol := aCol[ _TBCI_COLPOS ] - IF lFirst - lFirst := .F. - ELSE - nCol += aCol[ _TBCI_SEPWIDTH ] - ENDIF - nWidth := aCol[ _TBCI_COLWIDTH ] - IF aCol[ _TBCI_LASTSPACE ] < 0 - nWidth += aCol[ _TBCI_LASTSPACE ] - ENDIF - FOR nPos := 1 TO nHeight - hb_dispOutAt( nRow + nPos - 1, nCol, ; - PadR( hb_tokenGet( cName, nPos, _TBR_CHR_LINEDELIMITER ), nWidth ), ; - iif( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ; - aColors[ aCol[ _TBCI_DEFCOLOR ][ nColor ] ] ) ) - NEXT - ENDIF - NEXT - - RETURN - - -METHOD dispFrames() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - DispBegin() - - IF ::lInvalid .AND. !Empty( ::cBorder ) - hb_dispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, ::cBorder, ::colorValue( _TBC_CLR_STANDARD ) ) - ENDIF - - IF ::nHeadHeight > 0 - _DISP_FHNAME( ::n_Top, ::nHeadHeight, ::n_Left, ::n_Right, _TBCI_HEADING, ; - iif( ::lHeadSep, _TBC_CLR_HEADING, _TBC_CLR_STANDARD ), ; - ::aColors, ::aColData ) - ENDIF - IF ::lHeadSep - _DISP_FHSEP( ::n_Top + ::nHeadHeight, _TBCI_HEADSEP, ; - ::colorValue( _TBC_CLR_STANDARD ), ::aColData ) - ENDIF - IF ::lFootSep - _DISP_FHSEP( ::n_Bottom - ::nFootHeight, _TBCI_FOOTSEP, ; - ::colorValue( _TBC_CLR_STANDARD ), ::aColData ) - ENDIF - IF ::nFootHeight > 0 - _DISP_FHNAME( ::n_Bottom - ::nFootHeight + 1, ::nFootHeight, ::n_Left, ::n_Right, _TBCI_FOOTING, ; - iif( ::lFootSep, _TBC_CLR_FOOTING, _TBC_CLR_STANDARD ), ; - ::aColors, ::aColData ) - ENDIF - - DispEnd() - - ::lFrames := .F. - - RETURN Self - - -METHOD dispRow( nRow ) CLASS TBROWSE - - LOCAL nRowPos, nColPos - LOCAL aCol - LOCAL lFirst - LOCAL cValue, cColor, cStdColor - LOCAL aColors - - IF nRow >= 1 .AND. nRow <= ::rowCount - - DispBegin() - - nRowPos := ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ) + nRow - 1 - cStdColor := ::colorValue( _TBC_CLR_STANDARD ) - - hb_dispBox( nRowPos, ::n_Left, nRowPos, ::n_Right, Space( 9 ), cStdColor ) - - lFirst := .T. - FOR EACH aCol, cValue, aColors IN ::aColData, ::aCellValues[ nRow ], ::aCellColors[ nRow ] - IF aCol[ _TBCI_COLPOS ] != NIL - nColPos := aCol[ _TBCI_COLPOS ] - IF lFirst - lFirst := .F. - ELSEIF aCol[ _TBCI_SEPWIDTH ] > 0 - hb_dispOutAtBox( nRowPos, aCol[ _TBCI_COLPOS ] - aCol[ _TBCI_FROZENSPACE ], ; - aCol[ _TBCI_COLSEP ], cStdColor ) - nColPos += aCol[ _TBCI_SEPWIDTH ] - ENDIF - nColPos += aCol[ _TBCI_CELLPOS ] - cColor := ::colorValue( aColors[ _TBC_CLR_STANDARD ] ) - IF aCol[ _TBCI_LASTSPACE ] < 0 - hb_dispOutAt( nRowPos, nColPos, ; - Left( cValue, ::n_Right - nColPos + 1 ), cColor ) - ELSE -#ifdef HB_C52_STRICT - hb_dispOutAt( nRowPos, nColPos, ; - Left( cValue, aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLPOS ] ), cColor ) -#else - hb_dispOutAt( nRowPos, nColPos, cValue, cColor ) -#endif - ENDIF - ENDIF - NEXT - - ::aDispStatus[ nRow ] := .F. - - DispEnd() - ENDIF - - RETURN Self - - -METHOD colorRect( aRect, aColors ) CLASS TBROWSE - - LOCAL nRow := ::rowCount - LOCAL nCol := ::colCount - - /* CA-Cl*pper checks all this conditions */ - IF ISARRAY( aRect ) .AND. Len( aRect ) >= 4 .AND. ; - ISNUMBER( aRect[ 1 ] ) .AND. ISNUMBER( aRect[ 2 ] ) .AND. ; - ISNUMBER( aRect[ 3 ] ) .AND. ISNUMBER( aRect[ 4 ] ) .AND. ; - aRect[ 1 ] >= 1 .AND. aRect[ 1 ] <= nRow .AND. ; - aRect[ 2 ] >= 1 .AND. aRect[ 2 ] <= nCol .AND. ; - aRect[ 3 ] >= aRect[ 1 ] .AND. aRect[ 3 ] <= nRow .AND. ; - aRect[ 4 ] >= aRect[ 2 ] .AND. aRect[ 4 ] <= nCol .AND. ; - ; - ISARRAY( aColors ) .AND. Len( aColors ) >= 2 .AND. ; - ISNUMBER( aColors[ 1 ] ) .AND. ISNUMBER( aColors[ 2 ] ) .AND. ; - ; /* in colorRect() index 0 is not supported */ - aColors[ 1 ] >= 1 .AND. aColors[ 1 ] <= Len( ::aColors ) .AND. ; - aColors[ 2 ] >= 1 .AND. aColors[ 2 ] <= Len( ::aColors ) - - ::setVisible() - - FOR nRow := aRect[ 1 ] TO aRect[ 3 ] - ::readRecord( nRow ) - FOR nCol := aRect[ 2 ] TO aRect[ 4 ] - ::aCellColors[ nRow, nCol, 1 ] := aColors[ 1 ] - ::aCellColors[ nRow, nCol, 2 ] := aColors[ 2 ] - NEXT - ::dispRow( nRow ) - NEXT - ENDIF - - RETURN Self - - -METHOD scrollBuffer( nRows ) CLASS TBROWSE - - LOCAL nRowCount := ::rowCount - LOCAL aValues, aColors - - /* Store last scroll value to chose refresh order. [druzus] */ - ::nLastScroll := nRows - - IF nRows >= nRowCount .OR. nRows <= -nRowCount - AFill( ::aCellStatus, .F. ) - ELSE - hb_scroll( ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ), ::n_Left, ; - ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ), ::n_Right, ; - nRows,, ::colorValue( _TBC_CLR_STANDARD ) ) - IF nRows > 0 - DO WHILE --nRows >= 0 - aValues := ::aCellValues[ 1 ] - aColors := ::aCellColors[ 1 ] - ADel( ::aCellValues, 1 ) - ADel( ::aCellColors, 1 ) - ADel( ::aCellStatus, 1 ) - ADel( ::aDispStatus, 1 ) - ::aCellValues[ nRowCount ] := aValues - ::aCellColors[ nRowCount ] := aColors - ::aCellStatus[ nRowCount ] := .F. - ::aDispStatus[ nRowCount ] := .T. - ENDDO - ELSEIF nRows < 0 - DO WHILE ++nRows <= 0 - HB_AIns( ::aCellValues, 1, ATail( ::aCellValues ), .F. ) - HB_AIns( ::aCellColors, 1, ATail( ::aCellColors ), .F. ) - HB_AIns( ::aCellStatus, 1, .F., .F. ) - HB_AIns( ::aDispStatus, 1, .T., .F. ) - ENDDO - ENDIF - ENDIF - - RETURN Self - - -METHOD readRecord( nRow ) CLASS TBROWSE - - LOCAL aCol - LOCAL oCol - LOCAL cValue - LOCAL aColor - LOCAL nColors, nToMove, nMoved - LOCAL nRowCount := ::rowCount - LOCAL lRead := .F. - - IF nRow >= 1 .AND. nRow <= nRowCount .AND. !::aCellStatus[ nRow ] - - IF nRow <= ::nLastRow - nToMove := nRow - ::nBufferPos - nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nToMove ) ) - /* TOFIX: add protection against unexpected results - * CA-Cl*pper does not fully respect here the returned - * value and current code below replicates what Clipper - * seems to do but it means that in network environment - * with concurent modifications wrong records can be - * shown. [druzus] - */ - IF nToMove > 0 - IF nMoved < 0 - nMoved := 0 - ENDIF - ELSEIF nToMove < 0 - nMoved := nToMove - ELSE - nMoved := 0 - ENDIF - ::nBufferPos += nMoved - IF nToMove > 0 .AND. nMoved < nToMove - ::nLastRow := ::nBufferPos - ELSE - lRead := .T. - ENDIF - ENDIF - - nColors := Len( ::aColors ) - IF nRow <= ::nLastRow - FOR EACH aCol, cValue, aColor IN ::aColData, ::aCellValues[ nRow ], ::aCellColors[ nRow ] - oCol := aCol[ _TBCI_COLOBJECT ] - cValue := Eval( oCol:block ) - aColor := _CELLCOLORS( aCol, cValue, nColors ) - IF ValType( cValue ) $ "CMNDTL" - cValue := PadR( Transform( cValue, oCol:picture ), aCol[ _TBCI_CELLWIDTH ] ) - ELSE - cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) - ENDIF - NEXT - ELSE - FOR EACH aCol, cValue, aColor IN ::aColData, ::aCellValues[ nRow ], ::aCellColors[ nRow ] - aColor := { aCol[ _TBCI_DEFCOLOR ][ 1 ], aCol[ _TBCI_DEFCOLOR ][ 2 ] } - cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) - NEXT - ENDIF - - ::aCellStatus[ nRow ] := .T. - ::aDispStatus[ nRow ] := .T. - - ENDIF - - RETURN lRead - - -METHOD setPosition() CLASS TBROWSE - - LOCAL nMoved - LOCAL nRowCount := ::rowCount - LOCAL nMoveOffset := ::nMoveOffset + ( ::nRowPos - ::nBufferPos ) - LOCAL nNewPos := ::nBufferPos + nMoveOffset - LOCAL lSetPos := .T. - - IF nNewPos < 1 - IF ::nMoveOffset < -1 - nMoveOffset -= ::nRowPos - 1 - ENDIF - ELSEIF nNewPos > ::nLastRow - IF ::nMoveOffset > 1 - nMoveOffset += ::nLastRow - ::nRowPos - ENDIF - ELSEIF lSetPos - ::nRowPos := nNewPos - ENDIF - - nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nMoveOffset ) ) - - IF nMoved > 0 - ::nBufferPos += nMoved - IF ::nBufferPos > ::nLastRow - AFill( ::aCellStatus, .F., ::nLastRow + 1, ::nBufferPos - ::nLastRow ) - ENDIF - IF ::nBufferPos > nRowCount - ::scrollBuffer( ::nBufferPos - nRowCount ) - ::nBufferPos := nRowCount - lSetPos := .F. - ENDIF - IF ::nBufferPos > ::nLastRow - ::nLastRow := ::nBufferPos - IF nMoved != nMoveOffset - lSetPos := .F. - ENDIF - ENDIF - ELSEIF nMoved < 0 - ::nBufferPos += nMoved - IF ::nBufferPos < 1 - ::nLastRow := Min( nRowCount, ::nLastRow - ::nBufferPos + 1 ) - ::scrollBuffer( ::nBufferPos - 1 ) - ::nBufferPos := 1 - lSetPos := .F. - ENDIF - ELSE /* nMoved == 0 */ - IF nMoveOffset > 0 - IF nMoveOffset != 0 .AND. ::nBufferPos == ::nRowPos - ::lHitBottom := .T. - ENDIF - ::nLastRow := ::nBufferPos - /* CA-Cl*pper does not do that */ - AFill( ::aCellStatus, .F., ::nLastRow + 1 ) - ELSEIF nMoveOffset < 0 - IF nMoveOffset != 0 .AND. ::nBufferPos == ::nRowPos - ::lHitTop := .T. - ENDIF - /* CA-Cl*pper does not do that */ - IF ::nBufferPos > 1 - ::scrollBuffer( ::nBufferPos - 1 ) - ::nBufferPos := 1 - ENDIF - ENDIF - ENDIF - - IF lSetPos - ::nRowPos := ::nBufferPos - ENDIF - - ::nMoveOffset := 0 - - RETURN Self - - -METHOD stabilize() CLASS TBROWSE - - LOCAL nRowCount, nToMove, nMoved - LOCAL lDisp, lRead, lStat - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF !::lStable .OR. ::lInvalid .OR. ::lFrames .OR. ::lRefresh .OR. ; - ::nMoveOffset != 0 .OR. ::nBufferPos != ::nRowPos - - nRowCount := ::rowCount - - IF ::lRefresh - AFill( ::aCellStatus, .F. ) - ::nLastRow := nRowCount - ::nLastScroll := 0 - ::lRefresh := .F. - ENDIF - - ::setVisible() - - IF ::lFrames - ::dispFrames() - AFill( ::aDispStatus, .T. ) - ENDIF - - lRead := .F. - IF ::nMoveOffset != 0 - ::setPosition() - lRead := .T. - ENDIF - - IF ::nLastScroll > 0 - FOR EACH lStat, lDisp IN ::aCellStatus, ::aDispStatus DESCEND - IF !lStat - IF lRead - RETURN .F. - ENDIF - lRead := ::readRecord( lStat:__enumIndex() ) - ENDIF - IF lDisp - ::dispRow( lDisp:__enumIndex() ) - ENDIF - NEXT - ELSE - FOR EACH lStat, lDisp IN ::aCellStatus, ::aDispStatus - IF !lStat - IF lRead - RETURN .F. - ENDIF - lRead := ::readRecord( lStat:__enumIndex() ) - ENDIF - IF lDisp - ::dispRow( lDisp:__enumIndex() ) - ENDIF - NEXT - ENDIF - - IF ::nRowPos > ::nLastRow - ::nRowPos := ::nLastRow - ENDIF - IF ::nBufferPos != ::nRowPos - /* TOFIX: add protection against unexpected results - * CA-Cl*pper does not fully respect here the returned - * value and current code below replicates what Clipper - * seems to do but it means that in network environment - * with concurent modifications wrong records can be - * shown. [druzus] - */ - nToMove := ::nRowPos - ::nBufferPos - nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nToMove ) ) - IF nToMove > 0 - IF nMoved < 0 - nMoved := 0 - ENDIF - ELSEIF nToMove < 0 - nMoved := nToMove - ELSE - nMoved := 0 - ENDIF - ::nBufferPos += nMoved - ::nRowPos := ::nBufferPos - ENDIF - ::lStable := .T. - ::lInvalid := .F. - ENDIF - - IF ::autoLite - ::hilite() - ELSE - ::setCursorPos() - ENDIF - - RETURN .T. - - -METHOD forceStable() CLASS TBROWSE - - /* TODO: CA-Cl*pper does not call ::stabilize() if TBrowse object - * is stable and does not need screen update. It may be important - * for applications which do not expect that cursor position may - * be changed. I'll change it in the future but first I will have - * to revert my stupid modifications in Harbour core code. Looking - * at old TBrowse implementation I replaced some: - * DO WHILE !oBrw:stabilize(); END - * with: - * oBrw:forceStable() - * In Clipper it's not the same because oBrw:forceStable() - * may not set cursor position and only ::stabilize() does it. - * [druzus] - */ - DO WHILE !::stabilize() - ENDDO - - RETURN Self - - -METHOD colorValue( nColorIndex ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF ISNUMBER( nColorIndex ) - IF nColorIndex >= 1 .AND. nColorIndex <= Len( ::aColors ) - RETURN ::aColors[ nColorIndex ] - /* In CA-Cl*pper index 0 has special meaning - it's always N/N color */ - ELSEIF nColorIndex == 0 - RETURN "N/N" - ENDIF - ENDIF - - RETURN ::aColors[ _TBC_CLR_STANDARD ] - - -METHOD cellValue( nRow, nCol ) CLASS TBROWSE - - IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; - nCol >= 1 .AND. nCol <= ::colCount .AND. ; - ::aCellStatus[ nRow ] - - RETURN ::aCellValues[ nRow, nCol ] - ENDIF - - RETURN NIL - - -METHOD cellColor( nRow, nCol ) CLASS TBROWSE - - IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; - nCol >= 1 .AND. nCol <= ::colCount .AND. ; - ::aCellStatus[ nRow ] - - RETURN ::aCellColors[ nRow, nCol ] - ENDIF - - RETURN NIL - - -STATIC FUNCTION _DECODECOLORS( cColorSpec ) - LOCAL aColors := {} - LOCAL nColors := hb_TokenCount( cColorSpec, "," ) - LOCAL cColor - LOCAL nPos - - FOR nPos := 1 TO nColors - cColor := hb_tokenGet( cColorSpec, nPos, "," ) - /* For 1-st two colors CA-Cl*pper checks if given color - * definition has at least one of the following characters: - * "*+/bBgGrRwWnNiIxXuU0123456789" - * If not then it takes default color value. - * In Harbour this validation is redirected to GT system which - * decides if passed string is valid color definition. The default - * GT implementation accepts exactly the same color definitions - * as CA-Cl*pper but some new GTs may accept extended color - * definitions and use a little bit different rules. [druzus] - */ - IF nPos <= 2 .AND. hb_colorToN( cColor ) == -1 - cColor := iif( nPos == 1, "W/N", "N/W" ) - ENDIF - AAdd( aColors, cColor ) - NEXT - IF Empty( aColors ) - AAdd( aColors, "W/N" ) - ENDIF - IF Len( aColors ) < 2 - AAdd( aColors, "N/W" ) - ENDIF - DO WHILE Len( aColors ) < _TBC_CLR_MAX - AAdd( aColors, aColors[ _TBC_CLR_STANDARD ] ) - ENDDO - - RETURN aColors - - -/* Color indexes returned by oCol:defColor are adopted to existing - * TBrowse colors and buffered during configuration. - * When index is greater then size of colorspec the default index is used - * Index 0 has special meaning - it's color "N/N" - * In CL5.3 headings and footings can have separated indexes (3 and 4) - * but only when browser shows head/foot separator(s). [druzus] - */ -STATIC FUNCTION _COLDEFCOLORS( aDefColorsIdx, nMaxColorIndex ) - LOCAL aColorsIdx := { _TBC_CLR_STANDARD, _TBC_CLR_SELECTED, ; - _TBC_CLR_STANDARD, _TBC_CLR_STANDARD } - LOCAL nColorIndex - LOCAL nPos - - IF ISARRAY( aDefColorsIdx ) - FOR nPos := 1 TO _TBC_CLR_MAX - IF nPos <= Len( aDefColorsIdx ) .AND. ; - ISNUMBER( nColorIndex := aDefColorsIdx[ nPos ] ) .AND. ; - ( nColorIndex := Int( nColorIndex ) ) >= 0 .AND. ; - nColorIndex <= nMaxColorIndex - - aColorsIdx[ nPos ] := nColorIndex - ELSEIF nPos > 2 - aColorsIdx[ nPos ] := aColorsIdx[ 1 ] - ENDIF - NEXT - ENDIF - - RETURN aColorsIdx - - -/* If oCol:colorBlock does not return array length enough then colors - * are taken from preprocessed during configuration oCol:defColor array. - * oCol:colorBlock is used only for cells so only 1-st two color indexes - * are significant. [druzus] - */ -STATIC FUNCTION _CELLCOLORS( aCol, xValue, nMaxColorIndex ) - LOCAL aColors := { aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_STANDARD ], ; - aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_SELECTED ] } - LOCAL xColor := Eval( aCol[ _TBCI_COLOBJECT ]:colorBlock, xValue ) - LOCAL nColorIndex - LOCAL nPos, nMax - - IF ISARRAY( xColor ) - nMax := Min( Len( xColor ), 2 ) - FOR nPos := 1 TO nMax - nColorIndex := xColor[ nPos ] - IF ISNUMBER( nColorIndex ) - nColorIndex := Int( nColorIndex ) - IF nColorIndex >= 0 .AND. nColorIndex <= nMaxColorIndex - aColors[ nPos ] := nColorIndex - ENDIF - ENDIF - NEXT - ENDIF - - RETURN aColors - - -METHOD setCursorPos() CLASS TBROWSE - - LOCAL aCol - LOCAL nRow, nCol - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - nRow := ::nRowPos - nCol := ::nColPos - - IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; - nCol >= 1 .AND. nCol <= ::colCount .AND. ; - ( aCol := ::aColData[ nCol ] )[ _TBCI_COLPOS ] != NIL - - ::n_Row := ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 0, -1 ) + nRow - ::n_Col := ::aColData[ nCol ][ _TBCI_COLPOS ] + ; - ::aColData[ nCol ][ _TBCI_CELLPOS ] - IF aCol[ _TBCI_SEPWIDTH ] > 0 - DO WHILE --nCol >= 1 - IF ::aColData[ nCol ][ _TBCI_COLPOS ] != NIL - ::n_Col += aCol[ _TBCI_SEPWIDTH ] - EXIT - ENDIF - ENDDO - ENDIF - SetPos( ::n_Row, ::n_Col ) - RETURN .T. - ENDIF - - RETURN .F. - - -METHOD setUnstable() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - /* CA-Cl*pper dehighlights the current cell */ - IF ::lHiLited - ::deHilite() - ENDIF - - ::lHitTop := .F. - ::lHitBottom := .F. - ::lStable := .F. - - RETURN Self - - -METHOD invalidate() CLASS TBROWSE - - ::setUnstable() - ::lInvalid := .T. - ::lFrames := .T. - - RETURN Self - - -METHOD refreshAll() CLASS TBROWSE - - ::setUnstable() - - Eval( ::bSkipBlock, 1 - ::nBufferPos ) - ::nBufferPos := 1 - ::lFrames := .T. - /* In CA-Cl*pper refreshAll() method does not discards - * record buffer here but only set's flag that the record - * buffer should be reloaded in stabilize method. [druzus] - */ - ::lRefresh := .T. - - RETURN Self - - -METHOD refreshCurrent() CLASS TBROWSE - - ::setUnstable() - - IF ::nRowPos >= 1 .AND. ::nRowPos <= ::rowCount - ::aCellStatus[ ::nRowPos ] := .F. - ENDIF - - RETURN Self - - -METHOD up() CLASS TBROWSE - - ::setUnstable() - ::nMoveOffset-- - - RETURN Self - - -METHOD down() CLASS TBROWSE - - ::setUnstable() - ::nMoveOffset++ - - RETURN Self - - -METHOD pageUp() CLASS TBROWSE - - ::setUnstable() - ::nMoveOffset -= ::rowCount - - RETURN Self - - -METHOD pageDown() CLASS TBROWSE - - ::setUnstable() - ::nMoveOffset += ::rowCount - - RETURN Self - - -METHOD left() CLASS TBROWSE - - ::setUnstable() - DO WHILE .T. - ::nColPos-- - IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ; - ::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0 - EXIT - ENDIF - ENDDO - - RETURN Self - - -METHOD right() CLASS TBROWSE - - ::setUnstable() - DO WHILE .T. - ::nColPos++ - IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ; - ::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0 - EXIT - ENDIF - ENDDO - - RETURN Self - - -METHOD home() CLASS TBROWSE - - ::setUnstable() - ::nColPos := iif( ::nLeftVisible < ::nRightVisible, ; - ::nLeftVisible, ::nRightVisible ) - RETURN Self - - -METHOD end() CLASS TBROWSE - - ::setUnstable() - ::nColPos := ::nRightVisible - - RETURN Self - - -METHOD panLeft() CLASS TBROWSE - - LOCAL nNewPos - - ::setUnstable() - nNewPos := _PREVCOLUMN( ::aColData, Min( ::colCount, ::nLeftVisible - 1 ) ) - - IF nNewPos != 0 .AND. nNewPos != ::nLeftVisible - /* It's replicated CA-Cl*pper behavior */ - ::nRightVisible := 0 - ::nLeftVisible := nNewPos - ENDIF - - RETURN Self - - -METHOD panRight() CLASS TBROWSE - - LOCAL nNewPos - - ::setUnstable() - nNewPos := _NEXTCOLUMN( ::aColData, Max( 1, ::nRightVisible + 1 ) ) - - IF nNewPos != 0 .AND. nNewPos != ::nRightVisible - /* It's replicated CA-Cl*pper behavior */ - ::nLeftVisible := 0 - ::nRightVisible := nNewPos - ENDIF - - RETURN Self - - -METHOD panHome() CLASS TBROWSE - - ::setUnstable() - ::nColPos := _NEXTCOLUMN( ::aColData, 1 ) - - RETURN Self - - -METHOD panEnd() CLASS TBROWSE - - ::setUnstable() - ::nColPos := _PREVCOLUMN( ::aColData, ::colCount ) - - RETURN Self - - -METHOD goTop() CLASS TBROWSE - - ::setUnstable() - - Eval( ::bGoTopBlock ) - /* In CA-Cl*pper goTop() method does not discards - * record buffer here but only set's flag that the record - * buffer should be reloaded in stabilize method. [druzus] - */ - ::lRefresh := .T. - ::nRowPos := 1 - ::nBufferPos := 1 - ::nMoveOffset := 0 - Eval( ::bSkipBlock, 0 ) - - RETURN Self - - -METHOD goBottom() CLASS TBROWSE - - LOCAL nMoved - - ::setUnstable() - - Eval( ::bGoBottomBlock ) - nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, -( ::rowCount - 1 ) ) ) - /* In CA-Cl*pper goBottom() method does not discards - * record buffer here but only set's flag that the record - * buffer should be reloaded in stabilize method. [druzus] - */ - ::lRefresh := .T. - ::nRowPos := 1 - ::nBufferPos := 1 - ::nMoveOffset := -nMoved - Eval( ::bSkipBlock, 0 ) - - RETURN Self - - -METHOD configure( nMode ) CLASS TBROWSE - - /* method configure() does not touch the screen contents or - * cursor position. In CA-Cl*pper it only sets flag indicating - * that some internal data should be recalculated before - * accessing [druzus] - */ - - IF !ISNUMBER( nMode ) .OR. nMode == 0 .OR. nMode > _TBR_CONF_ALL - nMode := _TBR_CONF_ALL - ENDIF - ::nConfigure := HB_BITOR( ::nConfigure, nMode ) - - RETURN Self - - -METHOD doConfigure() CLASS TBROWSE - - LOCAL oCol - LOCAL aCol, aVal - LOCAL nWidth, nHeight, nColCount, nRowCount - LOCAL xValue - LOCAL cType - LOCAL cColSep - LOCAL cHeadSep, cHeading - LOCAL nHeadHeight - LOCAL cFootSep, cFooting - LOCAL nFootHeight - LOCAL lHeadSep, lFootSep - - /* TODO: I do not know yet the exact flags behavior (::nConfigure) - * and internal conditions so I'll reconfigure all elements. - * [druzus] - */ - - ::nConfigure := 0 - - /* update color table */ - ::aColors := _DECODECOLORS( ::cColorSpec ) - - /* update column data */ - nHeadHeight := nFootHeight := 0 - lHeadSep := lFootSep := .F. - nColCount := Len( ::columns ) - ASize( ::aColData, nColCount ) - FOR EACH oCol, aCol IN ::columns, ::aColData - /* CA-Cl*pper always evaluates column block even if column is - * hidden by setting :width to 0. [druzus] - */ - xValue := Eval( oCol:block ) - cType := ValType( xValue ) - nWidth := IIF( cType $ "CMNDTL", ; - Len( Transform( xValue, oCol:picture ) ), 0 ) - cColSep := oCol:colSep - IF cColSep == NIL - cColSep := ::cColSep - ENDIF - cHeadSep := oCol:headSep - IF !ISCHARACTER( cHeadSep ) .OR. cHeadSep == "" - cHeadSep := ::cHeadSep - IF !ISCHARACTER( cHeadSep ) - cHeadSep := "" - ENDIF - ENDIF - cFootSep := oCol:footSep - IF !ISCHARACTER( cFootSep ) .OR. cFootSep == "" - cFootSep := ::cFootSep - IF !ISCHARACTER( cFootSep ) - cFootSep := "" - ENDIF - ENDIF - aCol := Array( _TBCI_SIZE ) - aCol[ _TBCI_COLOBJECT ] := oCol - aCol[ _TBCI_COLWIDTH ] := nWidth - aCol[ _TBCI_COLPOS ] := NIL - aCol[ _TBCI_CELLWIDTH ] := nWidth - aCol[ _TBCI_CELLPOS ] := 0 - aCol[ _TBCI_COLSEP ] := cColSep - aCol[ _TBCI_SEPWIDTH ] := Len( cColSep ) - aCol[ _TBCI_HEADSEP ] := cHeadSep - aCol[ _TBCI_FOOTSEP ] := cFootSep - aCol[ _TBCI_DEFCOLOR ] := _COLDEFCOLORS( oCol:defColor, Len( ::aColors ) ) - aCol[ _TBCI_FROZENSPACE ] := 0 - aCol[ _TBCI_LASTSPACE ] := 0 - IF Len( cHeadSep ) > 0 - lHeadSep := .T. - ENDIF - IF Len( cFootSep ) > 0 - lFootSep := .T. - ENDIF - cHeading := oCol:heading - IF _DECODE_FH( @cHeading, @nHeight, @nWidth ) - aCol[ _TBCI_COLWIDTH ] := Max( aCol[ _TBCI_COLWIDTH ], nWidth ) - IF nHeight > nHeadHeight - nHeadHeight := nHeight - ENDIF - ENDIF - aCol[ _TBCI_HEADING ] := cHeading - cFooting := oCol:footing - IF _DECODE_FH( @cFooting, @nHeight, @nWidth ) - aCol[ _TBCI_COLWIDTH ] := Max( aCol[ _TBCI_COLWIDTH ], nWidth ) - IF nHeight > nFootHeight - nFootHeight := nHeight - ENDIF - ENDIF - aCol[ _TBCI_FOOTING ] := cFooting - nWidth := oCol:width - IF nWidth != NIL - IF nWidth > 0 - aCol[ _TBCI_COLWIDTH ] := nWidth - IF nWidth < aCol[ _TBCI_CELLWIDTH ] .OR. cType == "C" - aCol[ _TBCI_CELLWIDTH ] := nWidth - ENDIF - ELSE - aCol[ _TBCI_CELLWIDTH ] := 0 - ENDIF - ENDIF - IF aCol[ _TBCI_CELLWIDTH ] > 0 - IF aCol[ _TBCI_COLWIDTH ] > aCol[ _TBCI_CELLWIDTH ] - IF cType == "N" - aCol[ _TBCI_CELLPOS ] := aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLWIDTH ] - ELSEIF cType == "L" - aCol[ _TBCI_CELLPOS ] := Int( ( aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLWIDTH ] ) / 2 ) - ENDIF - ENDIF -#ifdef HB_C52_STRICT - /* This is bug in CA-Cl*pper TBrowse. It causes that column - * is not well centered when picture increase the field size - * it also has other bad side effects in Clipper. :hiLite() - * method does not check for the cell size and shows the whole - * formatted string starting from the middle of column. When - * string is long enough it causes buffer overflow and other - * TBrowse data becomes corrupted. I do not want to replicate - * it. [druzus] - */ - IF cType == "L" - aCol[ _TBCI_CELLPOS ] := Int( aCol[ _TBCI_COLWIDTH ] / 2 ) - ENDIF -#endif - ENDIF - NEXT - - nHeight := Max( _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ), 0 ) - IF lHeadSep .AND. nHeight > 0 - --nHeight - ELSE - lHeadSep := .F. - ENDIF - IF lFootSep .AND. nHeight > 0 - --nHeight - ELSE - lFootSep := .F. - ENDIF - IF nHeadHeight >= nHeight - nHeadHeight := nHeight - nHeight := 0 - ELSE - nHeight -= nHeadHeight - ENDIF - IF nFootHeight >= nHeight - nFootHeight := nHeight - nHeight := 0 - ENDIF - ::lHeadSep := lHeadSep - ::nHeadHeight := nHeadHeight - ::nFootHeight := nFootHeight - ::lFootSep := lFootSep - - /* update headings to maximum size and missing head/foot separators */ - FOR EACH aCol IN ::aColData - aCol[ _TBCI_HEADING ] := Replicate( _TBR_CHR_LINEDELIMITER, nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], _TBR_CHR_LINEDELIMITER ) ) + ; - aCol[ _TBCI_HEADING ] - IF lHeadSep .AND. aCol[ _TBCI_HEADSEP ] == "" - aCol[ _TBCI_HEADSEP ] := " " - ENDIF - IF lFootSep .AND. aCol[ _TBCI_FOOTSEP ] == "" - aCol[ _TBCI_FOOTSEP ] := " " - ENDIF - NEXT - - nRowCount := ::rowCount - IF nRowCount == 0 - _GENLIMITRTE() - ENDIF - - /* create new record buffer */ - ASize( ::aCellStatus, nRowCount ) - ASize( ::aDispStatus, nRowCount ) - ASize( ::aCellValues, nRowCount ) - ASize( ::aCellColors, nRowCount ) - AFill( ::aCellStatus, .F. ) - AFill( ::aDispStatus, .T. ) - FOR EACH aVal, aCol IN ::aCellValues, ::aCellColors - IF aVal == NIL - aVal := Array( nColCount ) - ELSE - ASize( aVal, nColCount ) - ENDIF - IF aCol == NIL - aCol := Array( nColCount ) - ELSE - ASize( aCol, nColCount ) - ENDIF - NEXT - - ::lStable := .F. - ::lFrames := .T. - - /* Clipper does not set refreshAll flag in Configure */ - /* ::lRefresh := .T. */ - - ::nLastRow := nRowCount - ::nLastScroll := 0 - - /* CA-Cl*pper update visible columns here but without - * colPos repositioning. [druzus] - */ - _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; - @::nFrozen, @::nLeftVisible, @::nRightVisible ) - - ::nLastPos := 0 - - IF ::nRowPos > nRowCount - ::nRowPos := nRowCount - ELSEIF ::nRowPos < 1 - ::nRowPos := 1 - ENDIF - - RETURN Self - - -STATIC PROCEDURE _GENLIMITRTE() - - LOCAL oError := ErrorNew() - - oError:severity := ES_ERROR - oError:genCode := EG_LIMIT - oError:subSystem := "TBROWSE" - oError:subCode := 0 - oError:description := hb_LangErrMsg( EG_LIMIT ) - oError:canRetry := .F. - oError:canDefault := .F. - oError:fileName := "" - oError:osCode := 0 - - Eval( ErrorBlock(), oError ) - __errInHandler() - - RETURN - - -/* helper function to take headings and footing data */ -STATIC FUNCTION _DECODE_FH( cName, nHeight, nWidth ) - - LOCAL i - - nHeight := nWidth := 0 - IF ISCHARACTER( cName ) - - IF Len( cName ) > 0 - /* When last character of heading/footing is ';' then CA-Cl*pper - * does not calculate it as separator - */ - IF Right( cName, 1 ) == _TBR_CHR_LINEDELIMITER - cName := Left( cName, Len( cName ) - 1 ) - ENDIF - nHeight := hb_TokenCount( cName, _TBR_CHR_LINEDELIMITER ) - FOR i := 1 TO nHeight - nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, _TBR_CHR_LINEDELIMITER ) ) ) - NEXT - ENDIF - - ELSE - /* CA-Cl*per bug, it accepts non character values though cannot - * display them properly - */ - /* nHeight := 1 */ - cName := "" - ENDIF - - RETURN nHeight != 0 - - -STATIC FUNCTION _MAXFREEZE( nColumns, aColData, nWidth ) - LOCAL aCol - LOCAL lFirst - LOCAL nCol, nColWidth, nTot - - IF nColumns > Len( aColData ) .OR. nColumns < 1 - RETURN 0 - ENDIF - - nTot := nWidth - lFirst := .T. - FOR nCol := 1 TO nColumns - aCol := aColData[ nCol ] - IF aCol[ _TBCI_CELLWIDTH ] > 0 - nColWidth := aCol[ _TBCI_COLWIDTH ] - IF lFirst - lFirst := .F. - ELSE - nColWidth += aCol[ _TBCI_SEPWIDTH ] - ENDIF - IF ( nWidth -= nColWidth ) < 0 - EXIT - ENDIF - ENDIF - NEXT - - /* CA-Cl*pper allows to freeze all columns only when they - * are fully visible, otherwise it reserves at least one - * character for 1-st unfrozen column [druzus] - */ - IF nWidth > 0 .OR. ; - nWidth == 0 .AND. _NEXTCOLUMN( aColData, nColumns + 1 ) == 0 - - RETURN nColumns - ENDIF - - nWidth := nTot - - RETURN 0 - - -STATIC FUNCTION _NEXTCOLUMN( aColData, nCol ) - LOCAL aCol - - DO WHILE nCol <= Len( aColData ) - aCol := aColData[ nCol ] - IF aCol[ _TBCI_CELLWIDTH ] > 0 - RETURN nCol - ENDIF - ++nCol - ENDDO - - RETURN 0 - - -STATIC FUNCTION _PREVCOLUMN( aColData, nCol ) - LOCAL aCol - - DO WHILE nCol >= 1 - aCol := aColData[ nCol ] - IF aCol[ _TBCI_CELLWIDTH ] > 0 - RETURN nCol - ENDIF - --nCol - ENDDO - - RETURN 0 - - -STATIC FUNCTION _SETCOLUMNS( nFrom, nTo, nStep, aColData, nFirst, nWidth, lFirst ) - LOCAL aCol - LOCAL nCol, nColWidth - LOCAL nLast := 0 - - IF nWidth > 0 - FOR nCol := nFrom TO nTo STEP nStep - aCol := aColData[ nCol ] - IF aCol[ _TBCI_CELLWIDTH ] > 0 - IF nFirst == 0 .OR. nCol == nFirst - nColWidth := aCol[ _TBCI_COLWIDTH ] - ELSEIF nCol < nFirst - nColWidth := aCol[ _TBCI_COLWIDTH ] + aColData[ nFirst ][ _TBCI_SEPWIDTH ] - ELSE - nColWidth := aCol[ _TBCI_COLWIDTH ] + aCol[ _TBCI_SEPWIDTH ] - ENDIF - IF nWidth >= nColWidth - nLast := nCol - nWidth -= nColWidth - lFirst := .F. - IF nFirst == 0 .OR. nCol < nFirst - nFirst := nCol - ENDIF - ELSE - IF lFirst - nLast := nCol - nWidth := 0 - lFirst := .F. - ENDIF - EXIT - ENDIF - ENDIF - NEXT - ENDIF - - RETURN iif( nLast == 0, nFrom - nStep, nLast ) - - -STATIC PROCEDURE _SETVISIBLE( aColData, nWidth, nFrozen, nLeft, nRight ) - - LOCAL nPos, nFirst - LOCAL lLeft, lRight, lFirst - LOCAL nColCount := Len( aColData ) - - /* Check if frozen columns are still valid, if not reset it to 0 - * It also calculates the size left for unfrozen columns [druzus] - */ - nFrozen := _MAXFREEZE( nFrozen, aColData, @nWidth ) - - /* CA-Cl*pper checks here only for columns number and does not check - * if at least one column is visible (oCol:width > 0) and if not then - * wrongly calculates visible columns and some internal indexes. - * Using linkers like EXOSPACE with memory protection it causes - * application crash with GPF. [druzus] - */ - IF nColCount == 0 .OR. _NEXTCOLUMN( aColData, 1 ) == 0 - nLeft := nRight := 0 - ELSE - /* This algorithms keeps CA-Cl*pper precedence in visible column - * updating. It's also important for proper working panLeft and - * panRight methods which use leftVisible and rightVisible values - * for horizontal scrolling just like in CA-Cl*pper. [druzus] - */ - IF nWidth >= 1 - lRight := nRight > nFrozen .AND. nRight <= nColCount .AND. ; - aColData[ nRight ][ _TBCI_CELLWIDTH ] > 0 - lLeft := nLeft > nFrozen .AND. nLeft <= nColCount .AND. ; - aColData[ nLeft ][ _TBCI_CELLWIDTH ] > 0 - IF !lLeft - IF lRight - IF ( nLeft := _PREVCOLUMN( aColData, nRight ) ) < nFrozen - nLeft := nRight - ENDIF - ELSE - nPos := _NEXTCOLUMN( aColData, Max( nLeft + 1, nFrozen + 1 ) ) - IF nPos == 0 - nPos := _PREVCOLUMN( aColData, Min( nColCount, nLeft - 1 ) ) - ENDIF - IF nPos > nFrozen - nLeft := nPos - lLeft := .T. - ENDIF - ENDIF - ENDIF - lFirst := .T. - nFirst := _PREVCOLUMN( aColData, nFrozen ) - ELSE - lLeft := lRight := .F. - ENDIF - IF lLeft - nRight := _SETCOLUMNS( nLeft, nColCount, 1, aColData, @nFirst, @nWidth, @lFirst ) - nLeft := _SETCOLUMNS( nLeft - 1, nFrozen + 1, -1, aColData, @nFirst, @nWidth, @lFirst ) - ELSEIF lRight - nLeft := _SETCOLUMNS( nRight, nFrozen + 1, -1, aColData, @nFirst, @nWidth, @lFirst ) - nRight := _SETCOLUMNS( nRight + 1, nColCount, 1, aColData, @nFirst, @nWidth, @lFirst ) - ELSE - nLeft := nFrozen + 1 - nRight := nFrozen - ENDIF - ENDIF - - RETURN - - -/* set visible columns */ -METHOD setVisible() CLASS TBROWSE - LOCAL nCol, nLeft, nFrozen, nLast, nColumns, nWidth, nColPos - LOCAL lFirst, lFrames - LOCAL aCol - - nColPos := ::nColPos - IF nColPos < 1 .OR. nColPos > ::colCount .OR. ::nLastPos != nColPos .OR. ; - ::lFrames .OR. ::nLeftVisible == 0 .OR. ::nRightVisible == 0 .OR. ; - ::aColData[ nColPos ][ _TBCI_COLPOS ] == NIL - - lFrames := .F. - nWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 - nColumns := Len( ::aColData ) - - IF nColPos > nColumns - ::nColPos := nColumns - ::nLeftVisible := nColumns - ::nRightVisible := nColumns - ELSEIF ::nColPos < 1 - ::nColPos := 1 - ::nLeftVisible := 1 - ::nRightVisible := 1 - ELSEIF nColPos != ::nLastPos - IF nColPos > ::nRightVisible - ::nRightVisible := ::nColPos - ::nLeftVisible := 0 - ELSEIF nColPos < ::nLeftVisible - ::nLeftVisible := ::nColPos - ::nRightVisible := 0 - ENDIF - ELSEIF ::nColPos <= ::nFrozen .AND. ::nLeftVisible == 0 - nCol := _NEXTCOLUMN( ::aColData, ::nFrozen + 1 ) - ::nColPos := iif( nCol == 0, nColumns, nCol ) - ENDIF - - _SETVISIBLE( ::aColData, @nWidth, ; - @::nFrozen, @::nLeftVisible, @::nRightVisible ) - - IF ::nColPos > ::nRightVisible - ::nColPos := ::nRightVisible - ELSEIF ::nColPos > ::nFrozen .AND. ::nColPos < ::nLeftVisible - ::nColPos := ::nLeftVisible - ENDIF - -#if 0 - /* Always try to locate visible column. - * CA-Cl*pper does not have such condition. [druzus] - */ - IF ::nColPos >= 1 .AND. ::aColData[ ::nColPos ][ _TBCI_CELLWIDTH ] <= 0 - nCol := _PREVCOLUMN( ::aColData, ::nColPos - 1 ) - ::nColPos := iif( nCol == 0, ; - _NEXTCOLUMN( ::aColData, ::nColPos + 1 ), nCol ) - ENDIF -#endif - - /* update column size and positions on the screen */ - nLeft := _TBR_COORD( ::n_Left ) - lFirst := .T. - FOR nCol := 1 TO ::nRightVisible - aCol := ::aColData[ nCol ] - IF aCol[ _TBCI_CELLWIDTH ] > 0 .AND. ; - ( nCol <= ::nFrozen .OR. nCol >= ::nLeftVisible ) - - nFrozen := iif( nCol == ::nLeftVisible, Int( nWidth / 2 ), 0 ) - nColPos := nLeft += nFrozen - nLeft += aCol[ _TBCI_COLWIDTH ] - IF lFirst - lFirst := .F. - ELSE - nLeft += aCol[ _TBCI_SEPWIDTH ] - ENDIF - nLast := iif( nCol == ::nRightVisible, ; - _TBR_COORD( ::n_Right ) - nLeft + 1, 0 ) - - IF aCol[ _TBCI_COLPOS ] != nColPos .OR. ; - aCol[ _TBCI_FROZENSPACE ] != nFrozen .OR. ; - aCol[ _TBCI_LASTSPACE ] != nLast - - lFrames := .T. - aCol[ _TBCI_COLPOS ] := nColPos - aCol[ _TBCI_FROZENSPACE ] := nFrozen - aCol[ _TBCI_LASTSPACE ] := nLast - ENDIF - ELSE - IF aCol[ _TBCI_COLPOS ] != NIL - lFrames := .T. - ENDIF - aCol[ _TBCI_COLPOS ] := NIL - ENDIF - NEXT - FOR nCol := ::nRightVisible + 1 TO nColumns - aCol := ::aColData[ nCol ] - IF aCol[ _TBCI_COLPOS ] != NIL - lFrames := .T. - ENDIF - aCol[ _TBCI_COLPOS ] := NIL - NEXT - - ::nLastPos := ::nColPos - - IF lFrames - ::lFrames := .T. - ENDIF - - ENDIF - - RETURN Self - - -METHOD hiLite() CLASS TBROWSE - - LOCAL cValue, cColor - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - DispBegin() - - IF ::setCursorPos() - IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL - cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_SELECTED ] ) - IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) - cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) - ENDIF - hb_dispOutAt( ::n_Row, ::n_Col, cValue, cColor ) - SetPos( ::n_Row, ::n_Col ) - ::lHiLited := .T. - ENDIF - ENDIF - - DispEnd() - - RETURN Self - - -METHOD deHilite() CLASS TBROWSE - - LOCAL cValue, cColor - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - DispBegin() - - IF ::setCursorPos() - IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL - cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_STANDARD ] ) - IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right ) - cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 ) - ENDIF - hb_dispOutAt( ::n_Row, ::n_Col, cValue, cColor ) - SetPos( ::n_Row, ::n_Col ) - ENDIF - ENDIF - ::lHiLited := .F. - - DispEnd() - - RETURN Self - - -/* Returns the display width of a particular column */ -METHOD colWidth( nColumn ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF ISNUMBER( nColumn ) .AND. nColumn >= 1 .AND. nColumn <= ::colCount - RETURN ::aColData[ nColumn ][ _TBCI_COLWIDTH ] - ENDIF - - RETURN 0 - - -/* get number of frozen columns */ -METHOD getFrozen() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::nFrozen - - -/* set number of columns to freeze */ -METHOD freeze( nColumns ) CLASS TBROWSE - - LOCAL nCols - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF ISNUMBER( nColumns ) - - nCols := Int( nColumns ) - IF _MAXFREEZE( nCols, ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 ) == nCols - - ::nFrozen := nCols - ::lFrames := .T. - ::nLastPos := 0 - _SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ; - @::nFrozen, @::nLeftVisible, @::nRightVisible ) - ENDIF - - RETURN nCols - ENDIF - - RETURN ::nFrozen - - -METHOD colorSpec( cColorSpec ) CLASS TBROWSE - - IF cColorSpec != NIL - ::cColorSpec := __eInstVar53( Self, "COLORSPEC", cColorSpec, "C", 1001 ) - ::configure( _TBR_CONF_COLORS ) - ENDIF - - RETURN ::cColorSpec - - -METHOD colCount() CLASS TBROWSE - - RETURN Len( ::columns ) - - -METHOD rowCount() CLASS TBROWSE - - LOCAL nRows - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - nRows := _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ) + 1 - ; - ::nHeadHeight - iif( ::lHeadSep, 1, 0 ) - ; - ::nFootHeight - iif( ::lFootSep, 1, 0 ) - - RETURN iif( nRows > 0, nRows, 0 ) - - -METHOD setRowPos( nRowPos ) CLASS TBROWSE - LOCAL nRow - LOCAL nRowCount := ::rowCount - - IF ISNUMBER( nRowPos ) - nRow := Int( nRowPos ) - ::nRowPos := iif( nRow > nRowCount, nRowCount, ; - iif( nRow < 1, 1, nRow ) ) - RETURN nRow - ELSE - ::nRowPos := Min( nRowCount, 1 ) - RETURN 0 - ENDIF - - RETURN ::nRowPos - - -METHOD getRowPos() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::nRowPos - - -METHOD setColPos( nColPos ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF ISNUMBER( nColPos ) - ::nColPos := nColPos - ELSE - ::nColPos := 0 - ENDIF - - RETURN ::nColPos - - -METHOD getColPos() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::nColPos - - -METHOD getTopFlag() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::lHitTop - - -METHOD setTopFlag( lTop ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF !ISLOGICAL( lTop ) - RETURN .T. - ENDIF - - ::lHitTop := lTop - - RETURN lTop - - -METHOD getBottomFlag() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::lHitBottom - - -METHOD setBottomFlag( lBottom ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF !ISLOGICAL( lBottom ) - RETURN .T. - ENDIF - - ::lHitBottom := lBottom - - RETURN lBottom - - -METHOD getAutoLite() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::lAutoLite - - -METHOD setAutoLite( lAutoLite ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF !ISLOGICAL( lAutoLite ) - RETURN .T. - ENDIF - - ::lAutoLite := lAutoLite - - RETURN lAutoLite - - -METHOD getStableFlag() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::lStable - - -METHOD setStableFlag( lStable ) CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - IF !ISLOGICAL( lStable ) - RETURN .T. - ENDIF - - ::lStable := lStable - - RETURN lStable - - -METHOD leftVisible() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::nLeftVisible - - -METHOD rightVisible() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::nRightVisible - - -/* Adds a TBColumn object to the TBrowse object */ -METHOD addColumn( oCol ) CLASS TBROWSE - - AAdd( ::columns, oCol ) - ::configure( _TBR_CONF_COLUMNS ) - - RETURN Self - - -/* Delete a column object from a browse */ -METHOD delColumn( nColumn ) CLASS TBROWSE - LOCAL oCol - - oCol := ::columns[ nColumn ] - ADel( ::columns, nColumn ) - ASize( ::columns, Len( ::columns ) - 1 ) - ::configure( _TBR_CONF_COLUMNS ) - - RETURN oCol - - -/* Insert a column object in a browse */ -METHOD insColumn( nColumn, oCol ) CLASS TBROWSE - - HB_AIns( ::columns, nColumn, oCol, .T. ) - ::configure( _TBR_CONF_COLUMNS ) - - RETURN oCol - - -/* Replaces one TBColumn object with another */ -METHOD setColumn( nColumn, oCol ) CLASS TBROWSE - LOCAL oPrevCol - - IF nColumn != NIL .AND. oCol != NIL - nColumn := __eInstVar53( Self, "COLUMN", nColumn, "N", 1001 ) - oCol := __eInstVar53( Self, "COLUMN", oCol, "O", 1001 ) - - oPrevCol := ::columns[ nColumn ] - ::columns[ nColumn ] := oCol - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - RETURN oPrevCol - - -/* Gets a specific TBColumn object */ -METHOD getColumn( nColumn ) CLASS TBROWSE - - RETURN iif( nColumn >= 1 .AND. nColumn <= ::colCount, ::columns[ nColumn ], NIL ) - - -METHOD footSep( cFootSep ) CLASS TBROWSE - - IF cFootSep != NIL - ::cFootSep := __eInstVar53( Self, "FOOTSEP", cFootSep, "C", 1001 ) - ENDIF - - RETURN ::cFootSep - - -METHOD colSep( cColSep ) CLASS TBROWSE - - IF cColSep != NIL - ::cColSep := __eInstVar53( Self, "COLSEP", cColSep, "C", 1001 ) - ENDIF - - RETURN ::cColSep - - -METHOD headSep( cHeadSep ) CLASS TBROWSE - - IF cHeadSep != NIL - ::cHeadSep := __eInstVar53( Self, "HEADSEP", cHeadSep, "C", 1001 ) - ENDIF - - RETURN ::cHeadSep - - -METHOD skipBlock( bSkipBlock ) CLASS TBROWSE - - IF bSkipBlock != NIL - ::bSkipBlock := __eInstVar53( Self, "SKIPBLOCK", bSkipBlock, "B", 1001 ) - ENDIF - - RETURN ::bSkipBlock - - -METHOD goTopBlock( bBlock ) CLASS TBROWSE - - IF bBlock != NIL - ::bGoTopBlock := __eInstVar53( Self, "GOTOPBLOCK", bBlock, "B", 1001 ) - ENDIF - - RETURN ::bGoTopBlock - - -METHOD goBottomBlock( bBlock ) CLASS TBROWSE - - IF bBlock != NIL - /* NOTE: In CA-Cl*pper the string is: "GOBOTTOMBL" */ - ::bGoBottomBlock := __eInstVar53( Self, "GOBOTTOMBLOCK", bBlock, "B", 1001 ) - ENDIF - - RETURN ::bGoBottomBlock - - -METHOD nTop( nTop ) CLASS TBROWSE - - IF nTop != NIL - ::n_Top := __eInstVar53( Self, "NTOP", nTop, "N", 1001 ) - IF !Empty( ::cBorder ) - ::n_Top++ - ENDIF - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - IF !Empty( ::cBorder ) - RETURN ::n_Top - 1 - ENDIF - - RETURN ::n_Top - - -METHOD nLeft( nLeft ) CLASS TBROWSE - - IF nLeft != NIL - ::n_Left := __eInstVar53( Self, "NLEFT", nLeft, "N", 1001 ) - IF !Empty( ::cBorder ) - ::n_Left++ - ENDIF - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - IF !Empty( ::cBorder ) - RETURN ::n_Left - 1 - ENDIF - - RETURN ::n_Left - - -METHOD nBottom( nBottom ) CLASS TBROWSE - - IF nBottom != NIL - ::n_Bottom := __eInstVar53( Self, "NBOTTOM", nBottom, "N", 1001, {| o, x | x >= o:nTop } ) - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - ::n_Bottom-- - ENDIF - #endif - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - RETURN ::n_Bottom + 1 - ENDIF - #endif - - RETURN ::n_Bottom - - -METHOD nRight( nRight ) CLASS TBROWSE - - IF nRight != NIL - ::n_Right := __eInstVar53( Self, "NRIGHT", nRight, "N", 1001, {| o, x | x >= o:nLeft } ) - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - ::n_Right-- - ENDIF - #endif - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - RETURN ::n_Right + 1 - ENDIF - #endif - - RETURN ::n_Right - - -#ifdef HB_COMPAT_XPP - -METHOD viewArea() CLASS TBROWSE - - LOCAL nWidth, nFrozenWidth - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - // TOFIX - - nWidth := nFrozenWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 - _MAXFREEZE( ::nFrozen, ::aColData, @nWidth ) - nFrozenWidth -= nWidth - - RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),; - ::n_Left,; - ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),; - ::n_Right,; - nFrozenWidth } - - -/* NOTE: Returns the left margin relative column position of the first - non-frozen column. Xbase++ compatible method. */ -METHOD firstScrCol() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - // TOFIX - - RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] ) - -#endif - - -#ifdef HB_COMPAT_C53 -METHOD nRow() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::n_Row - - -METHOD nCol() CLASS TBROWSE - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - RETURN ::n_Col - - -METHOD hitTest( mRow, mCol ) CLASS TBROWSE - - LOCAL nTop, nLeft, nBottom, nRight, nRet, nCol - LOCAL lFirst - LOCAL aCol - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - -#ifdef HB_BRW_STATICMOUSE - /* This is not CA-Cl*pper compatible, in Clipper ::mRowPos and ::mColPos - * is calculated dynamically by call to MCOL() and MROW() - */ - ::mRowPos := ::mColPos := 0 -#endif - - IF !ISNUMBER( mRow ) .OR. !ISNUMBER( mCol ) .OR. ; - mRow < ( nTop := _TBR_COORD( ::n_Top ) ) .OR. ; - mRow > ( nBottom := _TBR_COORD( ::n_Bottom ) ) .OR. ; - mCol < ( nLeft := _TBR_COORD( ::n_Left ) ) .OR. ; - mCol > ( nRight := _TBR_COORD( ::n_Right ) ) - RETURN HTNOWHERE - ENDIF - - nRet := HTNOWHERE - - IF !Empty( ::cBorder ) - IF mRow == nTop - 1 - IF mCol == nLeft - 1 - nRet := HTTOPLEFT - ELSEIF mCol == nRight + 1 - nRet := HTTOPRIGHT - ELSE - nRet := HTTOP - ENDIF - ELSEIF mRow == nBottom + 1 - IF mCol == nLeft - 1 - nRet := HTBOTTOMLEFT - ELSEIF mCol == nRight + 1 - nRet := HTBOTTOMRIGHT - ELSE - nRet := HTBOTTOM - ENDIF - ELSEIF mCol == nLeft - 1 - nRet := HTLEFT - ELSEIF mCol == nRight + 1 - nRet := HTRIGHT - ENDIF - ENDIF - - IF nRet == HTNOWHERE - IF mRow < nTop + ::nHeadHeight - nRet := HTHEADING - ELSEIF ::lHeadSep .AND. mRow == nTop + ::nHeadHeight - nRet := HTHEADSEP - ELSEIF ::lFootSep .AND. mRow == nBottom - ::nFootHeight - nRet := HTFOOTSEP - ELSEIF mRow > nBottom - ::nFootHeight - nRet := HTFOOTING - ELSE - nRet := HTCELL -#ifdef HB_BRW_STATICMOUSE - ::mRowPos := mRow - nTop - ::nHeadHeight - iif( ::lHeadSep, 1, 0 ) -#endif - lFirst := .T. - nCol := 1 - DO WHILE nCol <= ::nRightVisible - aCol := ::aColData[ nCol ] - IF aCol[ _TBCI_COLPOS ] != NIL - IF lFirst - lFirst := .F. - ELSE - /* NOTE: CA-Cl*pper has bug here, it takes the size of - * next column separator instead of the current one - */ - IF ( nLeft += aCol[ _TBCI_SEPWIDTH ] ) > mCol - nRet := HTCOLSEP - EXIT - ENDIF - ENDIF -#ifdef HB_BRW_STATICMOUSE - ::mColPos := nCol -#endif - IF ( nLeft += aCol[ _TBCI_COLWIDTH ] + ; - aCol[ _TBCI_FROZENSPACE ] + ; - aCol[ _TBCI_LASTSPACE ] ) > mCol - EXIT - ENDIF - ENDIF - IF nCol == ::nFrozen .AND. nCol < ::nLeftVisible - nCol := ::nLeftVisible - ELSE - nCol++ - ENDIF - ENDDO - ENDIF - ENDIF - - RETURN nRet - - -#ifndef HB_BRW_STATICMOUSE -STATIC PROCEDURE _mBrwPos( oBrw, mRow, mCol ) - - LOCAL nTop, nLeft, nBottom, nPos, nCol, aCol - - mRow := MRow() - mCol := MCol() - - IF mRow >= ( nTop := _TBR_COORD( oBrw:n_Top ) ) .AND. ; - mRow <= ( nBottom := _TBR_COORD( oBrw:n_Bottom ) ) .AND. ; - mCol >= ( nLeft := _TBR_COORD( oBrw:n_Left ) ) .AND. ; - mCol <= ( _TBR_COORD( oBrw:n_Right ) ) - - IF mRow < nTop + oBrw:nHeadHeight + iif( oBrw:lHeadSep, 1, 0 ) .OR. ; - mRow > nBottom - oBrw:nFootHeight - iif( oBrw:lFootSep, 1, 0 ) - mRow := 0 - ELSE - mRow -= nTop + oBrw:nHeadHeight - iif( oBrw:lHeadSep, 0, 1 ) - ENDIF - - nPos := 0 - nCol := 1 - DO WHILE nCol <= oBrw:nRightVisible - aCol := oBrw:aColData[ nCol ] - IF aCol[ _TBCI_COLPOS ] != NIL - IF nPos != 0 - IF ( nLeft += aCol[ _TBCI_SEPWIDTH ] ) > mCol - EXIT - ENDIF - ENDIF - nPos := nCol - IF ( nLeft += aCol[ _TBCI_COLWIDTH ] + ; - aCol[ _TBCI_FROZENSPACE ] + ; - aCol[ _TBCI_LASTSPACE ] ) > mCol - EXIT - ENDIF - ENDIF - IF nCol == oBrw:nFrozen .AND. nCol < oBrw:nLeftVisible - nCol := oBrw:nLeftVisible - ELSE - nCol++ - ENDIF - ENDDO - mCol := nPos - IF nPos == 0 - mRow := 0 - ENDIF - ELSE - mRow := mCol := 0 - ENDIF - - RETURN - - -METHOD mRowPos() CLASS TBROWSE - - LOCAL mRow, mCol - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - _mBrwPos( self, @mRow, @mCol ) - - RETURN mRow - - -METHOD mColPos() CLASS TBROWSE - LOCAL mRow, mCol - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - _mBrwPos( self, @mRow, @mCol ) - - RETURN mCol -#endif - - -METHOD border( cBorder ) CLASS TBROWSE - - IF cBorder != NIL - - cBorder := __eInstVar53( Self, "BORDER", cBorder, "C", 1001 ) - - IF Len( cBorder ) == 0 .OR. Len( cBorder ) == 8 - - IF Empty( ::cBorder ) .AND. !Empty( cBorder ) - ::n_Top++ - ::n_Left++ - ::n_Bottom-- - ::n_Right-- - ::configure( _TBR_CONF_COLUMNS ) - ELSEIF !Empty( ::cBorder ) .AND. Empty( cBorder ) - ::n_Top-- - ::n_Left-- - ::n_Bottom++ - ::n_Right++ - ::configure( _TBR_CONF_COLUMNS ) - ENDIF - - ::cBorder := cBorder - ENDIF - ENDIF - - RETURN ::cBorder - - -METHOD message( cMessage ) CLASS TBROWSE - - IF cMessage != NIL - ::cMessage := __eInstVar53( Self, "MESSAGE", cMessage, "C", 1001 ) - ENDIF - - RETURN ::cMessage - - -METHOD applyKey( nKey ) CLASS TBROWSE - - LOCAL bBlock := ::SetKey( nKey ) - - IF bBlock == NIL - bBlock := ::SetKey( 0 ) - - IF bBlock == NIL - RETURN TBR_EXCEPTION - ENDIF - ENDIF - - RETURN Eval( bBlock, Self, nKey ) - - -METHOD setKey( nKey, bBlock ) CLASS TBROWSE - - LOCAL bReturn - LOCAL nPos - - /* NOTE: Assigned codeblock receives two parameters: - {| oTBrowse, nKey | } */ - - IF ::keys == NIL - ::keys := { { K_DOWN , {| o | o:Down() , TBR_CONTINUE } },; - { K_END , {| o | o:End() , TBR_CONTINUE } },; - { K_CTRL_PGDN , {| o | o:GoBottom(), TBR_CONTINUE } },; - { K_CTRL_PGUP , {| o | o:GoTop() , TBR_CONTINUE } },; - { K_HOME , {| o | o:Home() , TBR_CONTINUE } },; - { K_LEFT , {| o | o:Left() , TBR_CONTINUE } },; - { K_PGDN , {| o | o:PageDown(), TBR_CONTINUE } },; - { K_PGUP , {| o | o:PageUp() , TBR_CONTINUE } },; - { K_CTRL_END , {| o | o:PanEnd() , TBR_CONTINUE } },; - { K_CTRL_HOME , {| o | o:PanHome() , TBR_CONTINUE } },; - { K_CTRL_LEFT , {| o | o:PanLeft() , TBR_CONTINUE } },; - { K_CTRL_RIGHT , {| o | o:PanRight(), TBR_CONTINUE } },; - { K_RIGHT , {| o | o:Right() , TBR_CONTINUE } },; - { K_UP , {| o | o:Up() , TBR_CONTINUE } },; - { K_ESC , {| | TBR_EXIT } },; - { K_LBUTTONDOWN, {| o | TBMouse( o, MRow(), MCol() ) } } } - - #ifndef HB_C52_STRICT - AAdd( ::keys, { K_MWFORWARD , {| o | o:Up() , TBR_CONTINUE } } ) - AAdd( ::keys, { K_MWBACKWARD , {| o | o:Down() , TBR_CONTINUE } } ) - #endif - ENDIF - - IF ( nPos := AScan( ::keys, {| x | x[ _TBC_SETKEY_KEY ] == nKey } ) ) == 0 - IF ISBLOCK( bBlock ) - AAdd( ::keys, { nKey, bBlock } ) - ENDIF - bReturn := bBlock - ELSEIF ISBLOCK( bBlock ) - ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] := bBlock - bReturn := bBlock - ELSEIF PCount() == 1 - bReturn := ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] - ELSE - bReturn := ::keys[ nPos ][ _TBC_SETKEY_BLOCK ] - IF PCount() == 2 .AND. bBlock == NIL .AND. nKey != 0 - ADel( ::keys, nPos ) - ASize( ::keys, Len( ::keys ) - 1 ) - ENDIF - ENDIF - - RETURN bReturn - - -METHOD setStyle( nStyle, lNewValue ) CLASS TBROWSE - - /* NOTE: CA-Cl*pper 5.3 will initialize this var on the first - :setStyle() method call. [vszakats] */ - - DEFAULT ::styles TO { .F., .F., .F., .F., .F., NIL } - - /* NOTE: CA-Cl*pper 5.3 does no checks on the value of nStyle, so in case - it is zero or non-numeric, a regular RTE will happen. [vszakats] */ - - IF nStyle > Len( ::styles ) .AND. ; - nStyle <= 4096 /* some reasonable limit for maximum number of styles */ - ASize( ::styles, nStyle ) - ENDIF - - IF ISLOGICAL( lNewValue ) - ::styles[ nStyle ] := lNewValue - ENDIF - - RETURN ::styles[ nStyle ] - - -FUNCTION TBMouse( oBrw, nMRow, nMCol ) - - LOCAL n - - IF oBrw:hitTest( nMRow, nMCol ) == HTCELL - - IF ( n := oBrw:mRowPos - oBrw:rowPos ) < 0 - DO WHILE ++n <= 0 - oBrw:up() - ENDDO - ELSEIF n > 0 - DO WHILE --n >= 0 - oBrw:down() - ENDDO - ENDIF - - IF ( n := oBrw:mColPos - oBrw:colPos ) < 0 - DO WHILE ++n <= 0 - oBrw:left() - ENDDO - ELSEIF n > 0 - DO WHILE --n >= 0 - oBrw:right() - ENDDO - ENDIF - - RETURN TBR_CONTINUE - ENDIF - - RETURN TBR_EXCEPTION -#endif - -#ifdef HB_COMPAT_XPP - -CREATE CLASS xpp_TBrowse INHERIT TBrowse - -EXPORTED: - - METHOD viewArea() - METHOD firstScrCol() - - METHOD _left() - METHOD _right() - METHOD _end() - -ENDCLASS - -METHOD viewArea() CLASS xpp_TBrowse - - LOCAL nWidth, nFrozenWidth - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - // TOFIX - - nWidth := nFrozenWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 - _MAXFREEZE( ::nFrozen, ::aColData, @nWidth ) - nFrozenWidth -= nWidth - - RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),; - ::n_Left,; - ::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),; - ::n_Right,; - nFrozenWidth } - -/* NOTE: Returns the left margin relative column position of the first - non-frozen column. Xbase++ compatible method. */ -METHOD firstScrCol() CLASS xpp_TBrowse - - IF ::nConfigure != 0 - ::doConfigure() - ENDIF - - // TOFIX - - RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] ) - -METHOD _left() CLASS xpp_TBrowse - RETURN ::left() - -METHOD _right() CLASS xpp_TBrowse - RETURN ::right() - -METHOD _end() CLASS xpp_TBrowse - RETURN ::end() - -#endif -/*----------------------------------------------------------------------*/ - #endif // #if 0 -/*----------------------------------------------------------------------*/