From a13f6d2f515dbc20218b27b10b7037fe9ae2a4f0 Mon Sep 17 00:00:00 2001 From: Pritpal Bedi Date: Fri, 7 Aug 2009 20:52:46 +0000 Subject: [PATCH] 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 */ --- harbour/ChangeLog | 29 + harbour/contrib/hbxbp/appevent.ch | 8 + harbour/contrib/hbxbp/tests/demoxbp.prg | 289 +- harbour/contrib/hbxbp/xbpbrowse.prg | 6402 +++++++++++------------ 4 files changed, 3335 insertions(+), 3393 deletions(-) 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 -/*----------------------------------------------------------------------*/