diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 61b0f569ed..9f8c2f2bbd 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,33 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-04-18 02:53 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/rtl/tbrowse.prg + * new TBrowse code - many thanks to Viktor Szakats for his help and + code and to all others who tested this implementation. + It should be very close to Clipper except some minor differences. + Most of them are bugs not replicated intentionally. In few cases + some of them like wrong positioning of logical columns with extended + size by oCol:picture expression the original Clipper behavior is + covered by HB_C53_STRICT macro (with cell overwriting during + navigation but without internal buffer overflows) but it should + be used rather for tests only not for normal applications. + I left three TODO notes in the code for some less important things + which maybe addressed in the future though they should not effect + 99.99% of Clipper programs. + It's a new code so it's possible that it contains bugs so + if you will find any problems then please inform me. + Warning: This TBrowse implementation is strongly Clipper oriented. + It's neither compatible with previous Harbour nor xHarbour + one in intentional or unexpected differences to Clipper. + It also does not have any extensions which existed in the + old code. In the old code there was TODO note about some + xBase++ extensions - I do not have xBase++ so I cannot say + anything about it. If any of you things that they are + important then I can add them if group agree but I will + need detail description of additional methods and probably + results of some tests. + 2008-04-18 01:41 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapigt.h * harbour/source/rtl/gtapi.c diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index c7ceb36c0a..9d9ad3b3e5 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -4,9 +4,11 @@ /* * Harbour Project source code: - * TBrowse Class + * TBrowse Class * - * Copyright 1999 Antonio Linares + * Copyright 2008 Przemyslaw Czerpak + * This implementation contains code and notes by: + * Copyright 2008 Viktor Szakats * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -50,2175 +52,262 @@ * */ - /* - * The following parts are Copyright of the individual authors. - * www - http://www.harbour-project.org - * - * Copyright 2000-2002 Maurilio Longo - * Cursor movement handling, stabilization loop, multi-line headers and footers support - * ::PageUp(), ::PageDown(), ::Down(), ::Up(), ::GoBottom(), ::GoTop(), ::Stabilize() - * ::GotoXY(), ::DispCell(), ::WriteMLineText(), ::RedrawHeaders(), - * ::freeze(), ::SetColumnWidth() - * - * Copyright 2001 Manu Exposito - * Activate data PICTURE DispCell( nColumn, nColor ) - * - * Copyright 2007 Viktor Szakats - * tbr_CookColor(), tbr_GetColor() - * - * See doc/license.txt for licensing terms. - * - */ +#define HB_CLS_NOTOBJECT -/* NOTE: Don't use SAY in this module, use DispOut(), DispOutAt() instead, - otherwise it will not be CA-Cl*pper compatible. - ADDITION: Same goes for DevPos(), always use SetPos() instead. - [vszakats] */ - -/* TODO: :firstScrCol() --> nScreenCol - Determines screen column where the first table column is displayed. - Xbase++ compatible method */ - -/* TODO: :viewArea() --> aViewArea - Determines the coordinates for the data area of a TBrowse object. - Xbase++ compatible method */ - -/* NOTE: These TBColumn properties are _not_ cached inside TBrowse: - :picture, :block, :colorBlock */ - -#include "hbclass.ch" - -#include "button.ch" -#include "color.ch" #include "common.ch" +#include "hbclass.ch" +#include "color.ch" #include "error.ch" #include "inkey.ch" #include "setcurs.ch" +#include "button.ch" #include "tbrowse.ch" -/* TBColumn info constants */ -#define TBCI_OBJ 1 // Object TBColumn -#define TBCI_WIDTH 2 // Column Width -#define TBCI_WIDTHCELL 3 // Width of the Cell -#define TBCI_HEADING 4 // Column Headings -#define TBCI_FOOTING 5 // Column Footings -#define TBCI_COLSEP 6 // Column Seperator -#define TBCI_SEPWIDTH 7 // Width of the Separator -#define TBCI_DEFCOLOR 8 // Array with index of color -#define TBCI_SETWIDTH 9 // If True, only SetFrozen can change TBCI_WIDTH -#define TBCI_LCOLSEP 10 // Should column separator be drawn -#define TBCI_SCRCOLPOS 11 // Temporary column position on screen +/* 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_CELLWIDTH 2 // width of the cell -//#define TBCI_COLWIDTH 3 // width of the column -//#define TBCI_SCRCELLPOS 4 // cell position on screen -//#define TBCI_SCRCOLPOS 5 // column position on screen -//#define TBCI_SEPWIDTH 6 // width of the separator -#define TBC_CLR_STANDARD 1 // first index value to set unselected data color. -#define TBC_CLR_ENHANCED 2 // second index value to set selected data color. -#ifdef HB_COMPAT_C53 -#define TBC_CLR_HEADING 3 // third index value to set heading color. -#define TBC_CLR_FOOTING 4 // fourth index value to set footing color. -#define TBC_CLR_MAX_ 4 -#else -#define TBC_CLR_HEADING TBC_CLR_STANDARD -#define TBC_CLR_FOOTING TBC_CLR_STANDARD -#define TBC_CLR_MAX_ 2 -#endif +#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 _TBR_UNDEF 0 +#define _TBR_VALID 1 +#define _TBR_NONE 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 /* NOTE: In CA-Cl*pper TBROWSE class does not inherit from any other classes and there is no public class function like TBrowse(). There is in XPP though. */ - -#if defined(HB_C52_STRICT) && !defined(HB_COMPAT_XPP) +#if defined( HB_C52_STRICT ) && !defined( HB_COMPAT_XPP ) CREATE CLASS TBrowse STATIC #else CREATE CLASS TBrowse #endif - EXPORT: +/* 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 - VAR cargo // User-definable variable - VAR leftVisible INIT 0 READONLY // Indicates position of leftmost unfrozen column in display - VAR rightVisible INIT 0 READONLY // Indicates position of rightmost unfrozen column in display - VAR rowCount READONLY // Number of visible data rows in the TBrowse display +HIDDEN: + VAR n_Top AS INTEGER INIT 0 // 02. Top row number for the TBrowse display + VAR n_Left AS INTEGER INIT 0 // 03. Leftmost column for the TBrowse display + VAR n_Bottom AS INTEGER INIT 0 // 04. Bottom row number for the TBrowse display + VAR n_Right AS INTEGER INIT 0 // 05. Rightmost column for the TBrowse display - METHOD down() // Moves the cursor down one row - METHOD end() // Moves the cursor to the rightmost visible data column - METHOD goBottom() // Repositions the data source to the bottom of file - METHOD goTop() // Repositions the data source to the top of file - METHOD home() // Moves the cursor to the leftmost visible data column - METHOD left() // Moves the cursor left one column - METHOD pageDown() // Repositions the data source downward - METHOD pageUp() // Repositions the data source upward - METHOD panEnd() // Moves the cursor to the rightmost data column - METHOD panHome() // Moves the cursor to the leftmost visible data column - METHOD panLeft() // Pans left without changing the cursor position - METHOD panRight() // Pans right without changing the cursor position - METHOD right() // Moves the cursor right one column - METHOD up() // Moves the cursor up one row + 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() - METHOD addColumn( oCol ) - METHOD delColumn( nPos ) // Delete a column object from a browse - METHOD insColumn( nPos, oCol ) // Insert a column object in a browse - METHOD getColumn( nColumn ) // Gets a specific TBColumn object - METHOD setColumn( nColumn, oCol ) // Replaces one TBColumn object with another - METHOD colWidth( nColumn ) // Returns the display width of a particular column - METHOD colCount() - METHOD colorRect() // Alters the color of a rectangular group of cells - /* NOTE: nMode is an undocumented Harbour parameter. Should not be used by app code. */ - METHOD configure( nMode ) // Reconfigures the internal settings of the TBrowse object - METHOD deHilite() // Dehighlights the current cell - METHOD forceStable() // Performs a full stabilization - METHOD hilite() // Highlights the current cell - METHOD invalidate() // Forces entire redraw during next stabilization - 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 stabilize() // Performs incremental stabilization #ifdef HB_COMPAT_C53 - METHOD setKey( nKey, bBlock ) - METHOD applyKey( nKey ) - METHOD hitTest( nMRow, nMCol ) - METHOD setStyle( nStyle, lNewValue ) + 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 -#ifdef HB_COMPAT_XPP - MESSAGE _Left() METHOD Left() - MESSAGE _Right() METHOD Right() - MESSAGE _End() METHOD End() + /* === 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 autoLite( lAutoLite ) SETGET - METHOD nBottom( nBottom ) SETGET - METHOD nLeft( nLeft ) SETGET - METHOD nRight( nRight ) SETGET - METHOD nTop( nTop ) SETGET - METHOD colorSpec( cColorSpec ) SETGET - METHOD colSep( cColSep ) SETGET - METHOD footSep( cFootSep ) SETGET - METHOD headSep( cHeadSep ) SETGET - METHOD colPos( nColPos ) SETGET - METHOD goBottomBlock( bBlock ) SETGET - METHOD goTopBlock( bBlock ) SETGET - METHOD hitBottom( lHitBottom ) SETGET - METHOD hitTop( lHitTop ) SETGET - METHOD rowPos( nRowPos ) SETGET - METHOD stable( lStable ) SETGET - METHOD freeze( nFrozenCols ) SETGET - METHOD skipBlock( bSkipBlock ) SETGET -#ifdef HB_COMPAT_C53 - METHOD border( cBorder ) SETGET - METHOD nRow( nRow ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */ - METHOD nCol( nCol ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */ - METHOD mRowPos( nMRowPos ) SETGET - METHOD mColPos( nMColPos ) SETGET - METHOD message( cMessage ) SETGET + 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 New( nTop, nLeft, nBottom, nRight ) /* NOTE: This method is a Harbour extension [vszakats] */ + 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 - PROTECTED: + 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() - VAR lAutoLite INIT .T. // Logical value to control highlighting - VAR n_Top INIT 0 // Top row number for the TBrowse display - VAR n_Left INIT 0 // Leftmost column for the TBrowse display - VAR n_Bottom INIT 0 // Bottom row number for the TBrowse display - VAR n_Right INIT 0 // Rightmost column for the TBrowse display - VAR cBorder // Character value defining characters drawn around object (C5.3) - VAR cColorSpec // Color table for the TBrowse display - VAR aColorSpec // Color table for the TBrowse display (preprocessed) - VAR cColSep INIT " " // Column separator character - VAR cFootSep INIT "" // Footing separator character - VAR cHeadSep INIT "" // Heading separator character - VAR nColPos INIT 1 // Current cursor column position - VAR bGoBottomBlock INIT {|| NIL } // Code block executed by TBrowse:goBottom() - VAR bGoTopBlock INIT {|| NIL } // Code block executed by TBrowse:goTop() - VAR lHitBottom INIT .F. // Indicates the end of available data - VAR lHitTop INIT .F. // Indicates the beginning of available data - VAR nRowPos INIT 1 // Current cursor row position - VAR lStable INIT .F. // Indicates if the TBrowse object is stable - VAR aRect INIT {} // The rectangle specified with ColorRect() - VAR aRectColor INIT {} // The color positions to use in the rectangle specified with ColorRect() - VAR aRedraw INIT {} // Array of logical items indicating, is appropriate row need to be redraw - VAR aColumns INIT {} // Array to hold all browse columns - VAR aColsWidth INIT {} // Array with width of TBrowse's columns - VAR aColsPos INIT {} // Array with position of TBrowse's columns - VAR aColsInfo INIT {} // Array with column data - VAR lHeaders INIT .F. // Internal variable which indicates whether there are column footers to paint - VAR lFooters INIT .F. // Internal variable which indicates whether there are column footers to paint - VAR lRedrawFrame INIT .T. // True if I need to redraw Headers/Footers - VAR nColsWidth INIT 0 // Total width of visible columns plus ColSep - VAR nColsVisible INIT 0 // Number of columns that fit on the browse width - VAR lHitTop INIT .F. // Internal Top reached flag - VAR lHitBottom INIT .F. // Internal Bottom reached flag - VAR nRecsToSkip INIT 0 // Recs to skip on next Stabilize() - VAR nNewRowPos INIT 1 // Next position of data source (after first phase of stabilization) - VAR nLastRetrieved INIT 1 // Position, relative to first row, of last retrieved row (with an Eval(::bSkipBlock, n)) - VAR nHeaderHeight INIT 1 // How many lines is highest Header/Footer and so how many lines of - VAR nFooterHeight INIT 1 // screen space I have to reserve - VAR nFrozenWidth INIT 0 // How many screen column are not available on the left side of TBrowse display. > 0 only when there are frozen columns - VAR bSkipBlock INIT {|| NIL } // Code block used to reposition data source - VAR nFrozenCols INIT 0 // Number of frozen columns on left side of TBrowse - VAR nColumns INIT 0 // Number of columns added to TBrowse - VAR lNeverDisplayed INIT .T. // .T. if TBrowse has never been stabilized() - VAR lHiLited INIT .F. -#ifdef HB_COMPAT_C53 - VAR n_Row INIT 0 // Row number for the actual cell - VAR n_Col INIT 0 // Col number for the actual cell - VAR nMRowPos INIT 0 - VAR nMColPos INIT 0 - VAR cMessage INIT "" - VAR aKeys - VAR rect - VAR aVisibleCols INIT {} - VAR aSetStyle INIT { .F., .F., .F., .F., .F. } /* TBR_APPEND, TBR_APPENDING, TBR_MODIFY, TBR_MOVE, TBR_SIZE */ -#endif + 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 + + METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats] + +HIDDEN: + 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 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 - METHOD InitColumn( oCol, lAddColumn ) - METHOD PosCursor() // Positions the cursor to the beginning of the call, used only when autolite==.F. - METHOD LeftDetermine() // Determine leftmost unfrozen column in display - METHOD DispCell( nRow, nCol, nMode ) // Displays a single cell and returns cell type as a single letter like Valtype() - METHOD HowManyCol() // Counts how many cols can be displayed - METHOD RedrawHeaders() // Repaints TBrowse Headers - METHOD Moved() // Every time a movement key is issued I need to reset certain properties of TBrowse, I do these settings inside this method - METHOD WriteMLineText( cStr, nPadLen, lHeader, cColor ) // Writes a multi-line text where ";" is a line break, lHeader is .T. if it is a header and not a footer - METHOD SetColumnWidth( oCol ) // Calcs width of given column - METHOD MGotoYX( nRow, nCol ) // Given screen coordinates nRow, nCol sets TBrowse cursor on underlaying cell - // _M_GotoXY because this method will mostly be called to handle mouse requests ENDCLASS -/* -------------------------------------------- */ -METHOD invalidate() CLASS TBrowse - AFill( ::aRedraw, .T. ) - ::lStable := .F. - ::lRedrawFrame := .T. +FUNCTION TBrowseNew( nTop, nLeft, nBottom, nRight ) - return Self + RETURN TBrowse():new( nTop, nLeft, nBottom, nRight ) -METHOD refreshAll() CLASS TBrowse - AFill( ::aRedraw, .T. ) - ::lStable := .F. - - return Self - -METHOD refreshCurrent() CLASS TBrowse - - if ! Empty( ::aRedraw ) .and. ::nRowPos > 0 - ::aRedraw[ ::nRowPos ] := .T. - endif - - ::lStable := .F. - - return Self - -METHOD configure( nMode ) CLASS TBrowse - - local n - local nHeight -#ifdef HB_COMPAT_C53 - local nLeft - local nRight -#endif - - // ; Fill the column info array -/* - local xVal - - if nMode == 2 - - for n := 1 to ::nColumns - - xVal := Eval( ::aColumns[ n ]:block ) - - aCol[ TBCI_HEADING ] := ::aColumns[ n ]:heading - aCol[ TBCI_FOOTING ] := ::aColumns[ n ]:footing - aCol[ TBCI_WIDTH ] := ::SetColumnWidth( ::aColumns[ n ] ) - aCol[ TBCI_WIDTHCELL ] := Min( aCol[ TBCI_WIDTH ], tbr_CalcWidth( xVal, ValType( xValue ), ::aColumns[ n ]:picture ) ) - aCol[ TBCI_COLSEP ] := iif( aCol[ TBCI_OBJ ]:ColSep != NIL, aCol[ TBCI_OBJ ]:ColSep, ::ColSep ) - aCol[ TBCI_DEFCOLOR ] := tbr_DefColor( ::aColumns[ n ]:defColor, ::aColorSpec ) - aCol[ TBCI_SEPWIDTH ] := Len( aCol[ TBCI_COLSEP ] ) - aCol[ TBCI_LCOLSEP ] := aCol[ TBCI_WIDTH ] > 0 - aCol[ TBCI_COLSEP ] := iif( aCol[ TBCI_OBJ ]:ColSep != NIL, aCol[ TBCI_OBJ ]:ColSep, ::ColSep ) - next - endif -*/ - // ; - - ::lHeaders := .F. - ::lFooters := .F. - ::lRedrawFrame := .T. - - if nMode == 2 .AND. ::nColumns == 1 - ::leftVisible := 1 - endif - if ::nColumns < ::nFrozenCols - ::nFrozenCols := 0 - endif - - // Are there column headers to paint ? - for n := 1 to ::nColumns - if ! Empty( ::aColumns[ n ]:Heading ) - ::lHeaders := .T. - exit - endif - next - - // Are there column footers to paint ? - for n := 1 to ::nColumns - if ! Empty( ::aColumns[ n ]:Footing ) - ::lFooters := .T. - exit - endif - next - - ::nHeaderHeight := 1 - ::nFooterHeight := 1 - - // Find out highest header and footer - for n := 1 to ::nColumns - - // ... - - if ::lHeaders .and. ! Empty( ::aColumns[ n ]:Heading ) - nHeight := Len( ::aColumns[ n ]:Heading ) - Len( StrTran( ::aColumns[ n ]:Heading, ";" ) ) + 1 - - if nHeight > ::nHeaderHeight - ::nHeaderHeight := nHeight - endif - - endif - - if ::lFooters .and. ! Empty( ::aColumns[ n ]:Footing ) - nHeight := Len( ::aColumns[ n ]:Footing ) - Len( StrTran( ::aColumns[ n ]:Footing, ";" ) ) + 1 - - if nHeight > ::nFooterHeight - ::nFooterHeight := nHeight - endif - - endif - next - - if nMode == NIL - for n := 1 to ::nColumns - ::aColsWidth[ n ] := ::SetColumnWidth( ::aColumns[ n ] ) - next - endif - - // 20/nov/2000 - maurilio.longo@libero.it - // If I add (or remove) header or footer (separator) I have to change number - // of available rows - ::RowCount := ::n_Bottom - ::n_Top + 1 - ; - iif( ::lHeaders, ::nHeaderHeight + iif( Empty( ::cHeadSep ), 0, 1 ), 0 ) - ; - iif( ::lFooters, ::nFooterHeight + iif( Empty( ::cFootSep ), 0, 1 ), 0 ) - - if Len( ::aRedraw ) != ::RowCount - ASize( ::aRedraw, ::RowCount ) - endif - - ::Invalidate() - - // Force re-evaluation of space occupied by frozen columns - if ::nFrozenCols > 0 - ::freeze := ::nFrozenCols - endif - - if nMode == 2 - ::HowManyCol() - endif - - #ifdef HB_COMPAT_C53 - - nLeft := ::n_Left - nRight := ::n_Right - - ::rect := { ::n_Top + iif( ::lHeaders, ::nHeaderHeight + iif( Empty( ::cHeadSep ), 0, 1 ), 0 ),; - ::n_Left,; - ::n_Bottom - iif( ::lFooters, ::nFooterHeight - iif( Empty( ::cFootSep ), 0, 1 ), 0 ),; - ::n_Right } - - for n := nLeft To nRight - AAdd( ::aVisibleCols, n ) - next - - #endif - - return Self - -// Adds a TBColumn object to the TBrowse object -METHOD addColumn( oCol ) CLASS TBrowse - - /* NOTE: CA-Cl*pper does no checks at all on the parameters. */ - - ::Moved() /* TOFIX: This logic should go inside ::configure() */ - - ::nColumns++ - - AAdd( ::aColumns, oCol ) - AAdd( ::aColsWidth, ::SetColumnWidth( oCol ) ) - AAdd( ::aColsPos, 0 ) - AAdd( ::aColsInfo, ::InitColumn( oCol, .T. ) ) - - ::Configure( 2 ) - - return Self - -// Insert a column object in a browse -METHOD insColumn( nPos, oCol ) CLASS TBrowse - - /* NOTE: CA-Cl*pper does no checks at all on the parameters. */ - -#ifndef HB_C52_STRICT - if nPos >= 1 - - if nPos > ::nColumns - - ::Moved() /* TOFIX: This logic should go inside ::configure() */ - - /* NOTE: CA-Cl*pper doesn't do this, but crashes instead. */ - - ::nColumns++ - - AAdd( ::aColumns, oCol ) - AAdd( ::aColsWidth, ::SetColumnWidth( oCol ) ) - AAdd( ::aColsPos, 0 ) - AAdd( ::aColsInfo, ::InitColumn( oCol, .F. ) ) - - ::Configure( 2 ) - - else -#endif - - ::Moved() /* TOFIX: This logic should go inside ::configure() */ - - ::nColumns++ - - ASize( ::aColumns, ::nColumns ) - AIns( ::aColumns, nPos ) - ASize( ::aColsWidth, ::nColumns ) - AIns( ::aColsWidth, nPos ) - ASize( ::aColsPos, ::nColumns ) - AIns( ::aColsPos, nPos ) - ASize( ::aColsInfo, ::nColumns ) - AIns( ::aColsInfo, ::InitColumn( oCol, .F. ) ) - - ::aColumns[ nPos ] := oCol - ::aColsWidth[ nPos ] := ::SetColumnWidth( oCol ) - ::aColsPos[ nPos ] := 0 - ::aColsInfo[ nPos ] := ::InitColumn( oCol, .F. ) - - ::Configure( 2 ) - -#ifndef HB_C52_STRICT - endif - endif -#endif - - return oCol - -// Replaces one TBColumn object with another -METHOD setColumn( nPos, oCol ) CLASS TBrowse - - LOCAL oOldCol - - if nPos != NIL .AND. oCol != NIL - - nPos := _eInstVar( Self, "COLUMN", nPos, "N", 1001 ) - oCol := _eInstVar( Self, "COLUMN", oCol, "O", 1001 ) - - /* NOTE: CA-Cl*pper doesn't check nPos range (and type in C5.3 - I didn't implement this behaviour), - but crashes instead. */ - -#ifndef HB_C52_STRICT - if nPos >= 1 .AND. nPos <= ::nColumns -#endif - - ::Moved() /* TOFIX: This logic should go inside ::configure() */ - - oOldCol := ::aColumns[ nPos ] - - ::aColumns[ nPos ] := oCol - ::aColsWidth[ nPos ] := ::SetColumnWidth( oCol ) - ::aColsPos[ nPos ] := 0 - ::aColsInfo[ nPos ] := ::InitColumn( oCol, .F. ) - - ::Configure( 2 ) - -#ifndef HB_C52_STRICT - endif -#endif - endif - - /* NOTE: CA-Cl*pper 5.2 NG says this will return the previously set - column, but it's returning Self instead. In C5.3 this bug - was fixed and it works as expected (except when wrong - parameter is passed, when it returns NIL). [vszakats] */ -#ifdef HB_C52_STRICT - return Self -#else - return oOldCol -#endif - -METHOD delColumn( nPos ) CLASS TBrowse - - local oCol := ::aColumns[ nPos ] /* NOTE: To keep CA-Cl*pper compatible runtime error generation. [vszakats] */ - - ::Moved() /* TOFIX: This logic should go inside ::configure() */ - - /* Need to adjust variables in case last column is deleted. */ - - /* TOFIX: This logic should go inside ::configure() */ - - if nPos == ::nColPos .or. ; - nPos == ::nColumns .or.; - ::nColPos == ::nColumns .or. ; - ::rightVisible == ::nColumns - - if ::leftVisible == ::rightVisible .and. ::leftVisible > 1 - ::leftVisible-- - endif - - ::rightVisible-- - - if ::nColPos == ::nColumns - ::nColpos-- - endif - - endif - - ::nColumns-- - - ADel( ::aColumns, nPos ) - ASize( ::aColumns, ::nColumns ) - ADel( ::aColsWidth, nPos ) - ASize( ::aColsWidth, ::nColumns ) - ADel( ::aColsPos, nPos ) - ASize( ::aColsPos, ::nColumns ) - ADel( ::aColsInfo, nPos ) - ASize( ::aColsInfo, ::nColumns ) - - ::Configure( 2 ) - - return oCol - -// Gets a specific TBColumn object -METHOD getColumn( nColumn ) CLASS TBrowse -#ifdef HB_C52_STRICT - return ::aColumns[ nColumn ] -#else - return iif( nColumn > 0 .and. nColumn <= ::nColumns, ::aColumns[ nColumn ], NIL ) -#endif - -// Returns the display width of a particular column -METHOD colWidth( nColumn ) CLASS TBrowse - return iif( nColumn > 0 .and. nColumn <= ::nColumns, ::aColsWidth[ nColumn ], 0 ) - -METHOD colCount() CLASS TBrowse - return Len( ::aColumns ) - -METHOD freeze( nFrozenCols ) CLASS TBrowse - - local nCol - local nWidth - - if ISNUMBER( nFrozenCols ) - - if nFrozenCols >= 0 .and. nFrozenCols <= ::nColumns - - nWidth := ::n_Right - ::n_Left + 1 // Visible width of the browse - - ::nFrozenCols := nFrozenCols - // Space inside TBrowse window reserved for frozen columns - ::nFrozenWidth := 0 - - // If I've never displayed this TBrowse before I cannot calc occupied space since - // columns:width is not yet set, ::Stabilize() will call me later - if ! ::lNeverDisplayed - - if nFrozenCols > 0 - for nCol := 1 to nFrozenCols - ::nFrozenWidth += ::aColsWidth[ nCol ] - if nCol < ::nColumns - ::nFrozenWidth += iif( ::aColumns[ nCol + 1 ]:ColSep != NIL,; - Len( ::aColumns[ nCol + 1 ]:ColSep ),; - Len( ::cColSep ) ) - endif - next - endif - - for nCol := 1 to ::nColumns - if nFrozenCols > 0 - // If there are columns which are larger than TBrowse display width minus - // frozen columns reserved space, shrihnk them to fit - if ::nFrozenWidth + ::aColsWidth[ nCol ] > nWidth - ::aColsWidth[ nCol ] := nWidth - ::nFrozenWidth - endif - - else - // Reset column widths - ::aColsWidth[ nCol ] := ::SetColumnWidth( ::aColumns[ nCol ] ) - endif - next - endif - else - return nFrozenCols - endif - endif - - return ::nFrozenCols - -METHOD down() CLASS TBrowse - - ::Moved() - ::nRecsToSkip++ - - return Self - -METHOD up() CLASS TBrowse - - ::Moved() - ::nRecsToSkip-- - - return Self - -METHOD end() CLASS TBrowse - - ::Moved() - - if ::nColPos < ::rightVisible - ::nColPos := ::rightVisible - // ! - ::lRedrawFrame := .T. - ::refreshCurrent() - endif - - return Self - -METHOD goBottom() CLASS TBrowse - - local nToTop - - ::Moved() // ! - - Eval( ::bGoBottomBlock ) - - // Skip back from last record as many records as TBrowse can hold - nToTop := Abs( Eval( ::bSkipBlock, - ( ::RowCount - 1 ) ) ) - -// ::nRecsToSkip := ::RowCount - 1 - - // From top of TBrowse new row position is nToTop + 1 records away - ::nNewRowPos := nToTop + 1 - - // Last read record is first record inside TBrowse - ::nLastRetrieved := 1 -// ::nRowPos := 1 - ::refreshAll() - - return Self - -METHOD goTop() CLASS TBrowse - - ::Moved() // ! - - Eval( ::bGoTopBlock ) - ::nLastRetrieved := 1 - ::nNewRowPos := 1 - ::refreshAll() - - return Self - -METHOD home() CLASS TBrowse - - ::Moved() - - if ::nColPos != ::leftVisible - ::nColPos := ::leftVisible - ::invalidate() -// ::lRedrawFrame := .T. -// ::refreshCurrent() - endif - - return Self - -METHOD right() CLASS TBrowse - - ::Moved() - - if ::nColPos < ::rightVisible - ::nColPos++ - else - if ::nColPos < ::nColumns - ::rightVisible++ - ::leftVisible := ::leftDetermine() - ::nColPos++ - ::invalidate() -// ::lRedrawFrame := .T. -// ::refreshAll() - else - /* 09/08/2004 - - In a ! ::lStable state clipper moves ::nColPos past ::ColCount or - before column 1, so here and on _Left(), Home(), End(), PanEnd() - PanHome() methods I let it go "out of bounds", - PerformStabilization() gives ::nColPos a correct value */ - ::nColPos++ - endif - endif - - return Self - -METHOD left() CLASS TBrowse - - local leftVis - - ::Moved() - - if ::nColPos > ::leftVisible .or.; - ( ::nColPos <= ::nFrozenCols + 1 .and. ::nColPos > 1 ) - ::nColPos-- - else - if ::nColPos <= Max( ::leftVisible, ::nFrozenCols ) .and. ::nColPos > 1 - leftVis := ::leftVisible - do while leftVis == ::leftVisible - ::rightVisible-- - ::leftVisible := ::LeftDetermine() - enddo - ::nColPos-- - ::Invalidate() -// ::lRedrawFrame := .T. -// ::RefreshAll() - else - ::nColPos-- // Can go "out of bounds", here we behave like clipper. - endif - endif - - return Self - -METHOD leftDetermine() CLASS TBrowse - - local nWidthMax := ::n_Right - ::n_Left + 1 // Visible width of the browse - local nWidth := ::nFrozenWidth - local nCol - - nCol := ::rightVisible - do while nWidth < nWidthMax .and. nCol > ::nFrozenCols - - nWidth += ::aColsWidth[ nCol ] +; - iif( ::aColumns[ nCol ]:ColSep != NIL,; - Len( ::aColumns[ nCol ]:ColSep ),; - Len( ::cColSep ) ) - - if nWidth < nWidthMax - nCol-- - endif - enddo - - return Min( nCol + 1, ::nColumns ) - -METHOD pageDown() CLASS TBrowse - - ::Moved() - ::nRecsToSkip := ( ::RowCount - ::nRowPos ) + ::RowCount - - return Self - -METHOD pageUp() CLASS TBrowse - - ::Moved() - ::nRecsToSkip := - ( ( ::nRowPos - 1 ) + ::RowCount ) - - return Self - -METHOD panEnd() CLASS TBrowse - - ::Moved() - - if ::nColPos < ::nColumns - if ::rightVisible < ::nColumns - ::rightVisible := ::nColumns - ::leftVisible := ::LeftDetermine() - ::nColPos := ::rightVisible - ::Invalidate() -// ::lRedrawFrame := .T. -// ::RefreshAll() - else - ::nColPos := ::rightVisible - /* 18/10/2005 - - This is wrong, should not reload datasource. But ::Invalidate() - forces a full repaint, which is overkill. Maybe just a ::aRedraw[ x ] := .T. */ - ::RefreshCurrent() - endif - else - ::nColPos := ::nColumns // Can go "out of bounds", here we behave like clipper - endif - - return Self - -METHOD panHome() CLASS TBrowse - - ::Moved() - - if ::nColPos > 1 - if ::leftVisible > ::nFrozenCols + 1 - ::leftVisible := ::nFrozenCols + 1 - ::nColPos := 1 - ::Invalidate() -// ::RefreshAll() -// ::lRedrawFrame := .T. - else - ::nColPos := 1 - ::RefreshCurrent() - endif - else - ::nColPos := 1 // Can go "out of bounds", here we behave like clipper - endif - - return Self - -METHOD panLeft() CLASS TBrowse - - local leftVis - - ::Moved() - - if ::leftVisible > ::nFrozenCols + 1 - leftVis := ::leftVisible - /* While space left available by columns exiting to the right side of tbrowse - is not enough to contain a new column to the left (::leftVisible doesn't change) */ - do while leftVis == ::leftVisible - ::rightVisible-- - ::leftVisible := ::LeftDetermine() - enddo - - /* Since panel "shifts" to the right, ::nColPos could end up "out of" the - right side of tbrowse, so, change it to ::rightvisible if this happens */ - ::nColPos := Min( ::nColPos, ::rightVisible ) - ::Invalidate() -// ::lRedrawFrame := .T. -// ::RefreshAll() - endif - - return Self - -METHOD panRight() CLASS TBrowse - - local leftVis - - ::Moved() - - if ::rightVisible < ::nColumns - leftVis := ::leftVisible - do while leftVis == ::leftVisible - ::rightVisible++ - ::leftVisible := ::LeftDetermine() - enddo - ::nColPos := Min( ::nColPos, ::rightVisible ) - ::Invalidate() -// ::lRedrawFrame := .T. -// ::RefreshAll() - endif - - return Self - -METHOD forceStable() CLASS TBrowse - - DO WHILE !::Stabilize() - ENDDO - - RETURN Self - -METHOD deHilite() CLASS TBrowse - - local nRow - LOCAL nCol - - IF ::rowPos < 1 .OR. ::rowPos > ::rowCount - ::rowPos := 0 - ELSEIF ::nColPos > 0 .AND. ::nColPos <= Len( ::aColumns ) - - nRow := ::n_Top +; // TOFIX - ::nRowPos +; - iif( ::lHeaders, ::nHeaderHeight, 0 ) +; - iif( Empty( ::cHeadSep ) .or. ! ::lHeaders, 0, 1 ) - 1 - nCol := ::aColsPos[ ::nColPos ] // TOFIX - - SetPos( nRow, nCol ) // TOFIX - nCol += ::DispCell( ::nRowPos, ::nColPos, TBC_CLR_STANDARD ) - SetPos( nRow, nCol ) - ENDIF - - ::lHiLited := .F. - - RETURN Self - -METHOD hilite() CLASS TBrowse - - LOCAL nRow - LOCAL nCol - - IF ::rowPos < 1 .OR. ::rowPos > ::rowCount - ::rowPos := 0 - ELSEIF ::nColPos >= 1 .AND. ::nColPos <= Len( ::aColumns ) - - nRow := ::n_Top +; // TOFIX - ::nRowPos +; - iif( ::lHeaders, ::nHeaderHeight, 0 ) +; - iif( Empty( ::cHeadSep ) .or. ! ::lHeaders, 0, 1 ) - 1 - nCol := ::aColsPos[ ::nColPos ] // TOFIX - - SetPos( nRow, nCol ) - nCol += ::DispCell( ::nRowPos, ::nColPos, TBC_CLR_ENHANCED ) - SetPos( nRow, nCol ) - - ::lHiLited := .T. - ENDIF - - #ifdef HB_COMPAT_C53 - ::n_Row := nRow - ::n_Col := nCol - #endif - - RETURN Self - -METHOD stabilize() CLASS TBrowse - - local nRow, n - local nWidth := ::n_Right - ::n_Left + 1 // Visible width of the browse - local lDisplay // Is there something to show inside current cell? - local nRecsSkipped // How many records do I really skipped? - local nFirstRow // Where is on screen first row of TBrowse? - local nOldCursor // Current shape of cursor (which I remove before stabilization) - - local oStartCol, oEndCol - local nStartCol, nEndCol - - /* First, since ::nColPos can go "out of bounds" we need - to put 1 <= ::nColpos <= ::nColumns - And we need to do this before calling ::Configure() which - needs a ::nColPos "inside bounds" */ - ::nColPos := Max( Min( ::nColPos, ::nColumns ), 1 ) - - // I need to set columns width If TBrowse was never displayed before - if ::lNeverDisplayed - - if !Empty( ::cBorder ) - /* NOTE: Intentionally the external version of coordinate messages. */ - DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, ::cBorder, ::cColorSpec[ 1 ] ) - endif - - ::Configure( 0 ) - //AEval( ::aColumns, {| oCol | ::SetColumnWidth( oCol ) } ) - - // NOTE: It must be before call to ::freeze assigment since this call - // tests this iVar value, and I set it to .F. since I'm going to display TBrowse - // for first time - ::lNeverDisplayed := .F. - - // Force re-evaluation of frozen space since I could not calc it before - // being columns width not set - if ::nFrozenCols > 0 - ::freeze := ::nFrozenCols - endif - endif - - nOldCursor := SetCursor( SC_NONE ) - - if ::lRedrawFrame - // How may columns fit on TBrowse width? - ::HowManyCol() - ::RedrawHeaders() - - // Now that browser frame has been redrawn we don't need to redraw it unless - // displayed columns change - ::lRedrawFrame := .F. - - else - oStartCol := ::aColumns[ iif( ::rightVisible != 0, ::rightVisible, 1 ) ] - nStartCol := ::aColsPos[ iif( ::rightVisible != 0, ::rightVisible, 1 ) ] - oEndCol := ::aColumns[ iif( ::nFrozenCols > 0, 1, ::leftVisible ) ] - nEndCol := ::aColsPos[ iif( ::nFrozenCols > 0, 1, ::leftVisible ) ] - ::nColsWidth := iif( oStartCol != NIL, nStartCol, 0 ) + ; - iif( oStartCol != NIL, ::aColsWidth[ iif( ::rightVisible != 0, ::rightVisible, 1 ) ], 0 ) - nEndCol - endif - - // From this point there is stabilization of rows which is made up of three phases - // 1st repositioning of data source - // 2nd redrawing of rows, after each row we exit stabilization loop with .F. - // 3rd if all rows have been redrawn we set ::lStable state to .T. - if !::lStable - - // NOTE: I can enter here because of a movement key or a ::RefreshAll():ForceStable() call - - // If I have a requested movement still to handle - if ::nRecsToSkip != 0 - - // If I'm not under cursor (maybe I've interrupted an ongoing stabilization) I have to set data source to cursor position - if ::nLastRetrieved != ::nNewRowPos - Eval( ::bSkipBlock, ::nNewRowPos - ::nLastRetrieved ) - ::nLastRetrieved := ::nNewRowPos - endif - - nRecsSkipped := Eval( ::bSkipBlock, ::nRecsToSkip ) - - // I've tried to move past top or bottom margin - if nRecsSkipped == 0 - - if ::nRecsToSkip > 0 - ::lHitBottom := .T. - - elseif ::nRecsToSkip < 0 - ::lHitTop := .T. - - // else ::nRecsToSkip == 0 - // - endif - - elseif nRecsSkipped == ::nRecsToSkip - - // If after movement I'm still inside present TBrowse - if ( ::nNewRowPos + nRecsSkipped >= 1 ) .and. ( ::nNewRowPos + nRecsSkipped <= ::RowCount ) - ::nNewRowPos += nRecsSkipped - ::nLastRetrieved := ::nNewRowPos - // This is needed since present TBrowse has no cache, so I need to repaint current row - // rereading it from data source and to force rereading from data source I have to mark - // row as invalid - ::aRedraw[ ::nNewRowPos ] := .T. - - else - // It was K_PGDN or K_PGUP - if Abs( nRecsSkipped ) >= ::RowCount - - // K_PGDN - if nRecsSkipped > 0 - ::nLastRetrieved := ::RowCount - - else // K_PGUP - ::nLastRetrieved := 1 - - endif - ::RefreshAll() - - else // K_DN or K_UP - - // Where does really start first TBrowse row? - nFirstRow := ::n_Top + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. !::lHeaders, 0, 1 ) - - // I'm at top or bottom of TBrowse so I can scroll - if ::nNewRowPos == ::RowCount - Scroll( nFirstRow + nRecsSkipped - 1, ::n_Left, nFirstRow + ::RowCount - 1, ::n_Right, nRecsSkipped ) - ::nLastRetrieved := ::RowCount - - else - Scroll( nFirstRow, ::n_Left, nFirstRow + ::RowCount + nRecsSkipped, ::n_Right, nRecsSkipped ) - ::nLastRetrieved := 1 - - endif - - // I've scrolled on screen rows, now I need to scroll ::aRedraw array as well! - if nRecsSkipped > 0 - ADel( ::aRedraw, 1 ) - else - AIns( ::aRedraw, 1 ) - endif - - ::aRedraw[ ::nNewRowPos ] := .T. - endif - endif - - else // I couldn't move as far as requested - - // I need to refresh all rows if I go past current top or bottom row - if ( ::nNewRowPos + nRecsSkipped < 1 ) .or. ( ::nNewRowPos + nRecsSkipped > ::RowCount ) - // don't go past boundaries - ::nNewRowPos := iif( nRecsSkipped > 0, ::RowCount, 1 ) - ::RefreshAll() - - else - ::nNewRowPos += nRecsSkipped - ::aRedraw[ ::nNewRowPos ] := .T. - - endif - - ::nLastRetrieved := ::nNewRowPos - - endif - - // Data source moved, so next time I won't enter this stage of stabilization - ::nRecsToSkip := 0 - - // Exit first stage of stabilization - SetCursor( nOldCursor ) - return .F. - - endif - - // Data source is alredy at correct record number, now we need - // to repaint browser accordingly. - for nRow := 1 to ::RowCount - - // if there is a row to repaint - if ::aRedraw[ nRow ] - - DispOutAt( ::n_Top + nRow + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. !::lHeaders, 0, 1 ) - 1, ::n_Left,; - Space( ( nWidth - ::nColsWidth ) / 2 ), ::aColorSpec[ 1 ] ) - - for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible - - if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 - n := ::leftVisible - endif - - if nRow == 1 - ::aColsPos[ n ] := Col() - endif - - // NOTE: If my TBrowse has 20 rows but I have only 3 recs, clipper clears - // remaining 17 rows in a single operation, I will, instead, try to skip - // 17 times. Should be made more clever. - if nRow != ::nLastRetrieved - if lDisplay := Eval( ::bSkipBlock, nRow - ::nLastRetrieved ) == ( nRow - ::nLastRetrieved ) - ::nLastRetrieved := nRow - endif - else - lDisplay := .T. - endif - - if lDisplay - ::DispCell( nRow, n, TBC_CLR_STANDARD ) - else - // Clear cell - DispOut( Space( ::aColsWidth[ n ] ), tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, TBC_CLR_STANDARD ) ) - endif - - if n < ::rightVisible - if ::aColumns[ n + 1 ]:ColSep != NIL - DispOut( ::aColumns[ n + 1 ]:ColSep, ::aColorSpec[ 1 ] ) - - elseif ::cColSep != NIL - DispOut( ::cColSep, ::aColorSpec[ 1 ] ) - - endif - endif - next - - DispOut( Space( Int( Round( ( nWidth - ::nColsWidth ) / 2, 0 ) ) ), ::aColorSpec[ 1 ] ) - - // doesn't need to be redrawn - ::aRedraw[ nRow ] := .F. - - // Exit incremental row stabilization - SetCursor( nOldCursor ) - return .F. - endif - - next - - // If I reach this point I've repainted all rows so I can set ::lStable state - if nRow > ::RowCount - - // If I have fewer records than available TBrowse rows, cursor cannot be lower than - // last record (note ::lHitBottom is set only during a movement) - if ::nLastRetrieved < ::nNewRowPos - ::nNewRowPos := ::nLastRetrieved - endif - - // If I'm not already under cursor I have to set data source to cursor position - if ::nLastRetrieved != ::nNewRowPos - Eval( ::bSkipBlock, ::nNewRowPos - ::nLastRetrieved ) - ::nLastRetrieved := ::nNewRowPos - endif - - // new cursor position - ::nRowPos := ::nNewRowPos - -// ::HitTop := ::lHitTop -// ::HitBottom := ::lHitBottom - - if ::lAutoLite - ::Hilite() - else - ::PosCursor() - endif - SetCursor( nOldCursor ) - ::lStable := .T. - - return .T. - endif - - else - /* NOTE: DBU relies upon current cell being reHilited() even if already stable */ - if ::lAutoLite - ::Hilite() - else - ::PosCursor() - endif - SetCursor( nOldCursor ) - return .T. - - endif - - return .F. - -/* NOTE: Incompatibility: In C5x this function will refresh the - screen if a non-empty aRect was passed. It does this - without skipping/reloading all the records, so I suspect - some internal buffering. For now I left out this feature, - so caller has to refresh manually. [vszakats] */ - -METHOD colorRect( aRect, aRectColor ) CLASS TBrowse - - if ISARRAY( aRect ) .and. ISARRAY( aRectColor ) - ::aRect := aRect - ::aRectColor := aRectColor - endif - - return Self - -/* -------------------------------------------- */ - -METHOD InitColumn( oCol, lAddColumn ) CLASS TBrowse - - IF !lAddColumn .AND. ISOBJECT( oCol ) .AND. ISBLOCK( oCol:block ) - RETURN {; - oCol ,; // TBCI_OBJ - ::SetColumnWidth( oCol ) ,; // TBCI_WIDTH - 0 ,; // TBCI_WIDTHCELL - "" ,; // TBCI_HEADING - "" ,; // TBCI_FOOTING - "" ,; // TBCI_COLSEP - 0 ,; // TBCI_SEPWIDTH - oCol:defColor ,; // TBCI_DEFCOLOR - .F. ,; // TBCI_SETWIDTH - .T. ,; // TBCI_LCOLSEP - 0 } // TBCI_SCRCOLPOS - ENDIF - - RETURN {; - oCol ,; // TBCI_OBJ - 0 ,; // TBCI_WIDTH - 0 ,; // TBCI_WIDTHCELL - "" ,; // TBCI_HEADING - "" ,; // TBCI_FOOTING - "" ,; // TBCI_COLSEP - 0 ,; // TBCI_SEPWIDTH - {} ,; // TBCI_DEFCOLOR - .F. ,; // TBCI_SETWIDTH - .T. ,; // TBCI_LCOLSEP - 0 } // TBCI_SCRCOLPOS - -METHOD PosCursor() CLASS TBrowse - - local nRow := ::n_Top + ::nRowPos + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. ! ::lHeaders, 0, 1 ) - 1 - local nCol - local cType := ValType( Eval( ::aColumns[ ::nColPos ]:block ) ) - - nCol := ::aColsPos[ ::nColPos ] + iif( cType == "L", ::aColsWidth[ ::nColPos ] / 2, 0 ) - - // Put cursor on first char of cell value - SetPos( nRow, nCol ) - - #ifdef HB_COMPAT_C53 - ::n_Row := nRow - ::n_Col := nCol - #endif - - return Self - -// Calculate how many columns fit on the browse width including ColSeps -METHOD HowManyCol() CLASS TBrowse - - local nToAdd - local nWidth := ::n_Right - ::n_Left + 1 - - local nColsVisible - local nColsWidth - -#ifdef COMMENT - - local saveColsWidth - local tryLeftVisible - local nLeftCol - local oErr - - nColsWidth := 0 - nColsVisible := 0 - - if ::nFrozenCols > 0 - nColsVisible := 0 - do while nColsVisible < ::nFrozenCols .and. nColsVisible < ::nColumns - nToAdd := ::aColsWidth[ nColsVisible + 1 ] - - if nColsVisible >= 1 .and. nColsVisible < ::nColumns .and. ::aColsWidth[ nColsVisible ] > 0 - nToAdd += iif( ::aColumns[ nColsVisible + 1 ]:ColSep != NIL, Len( ::aColumns[ nColsVisible + 1 ]:ColSep ), Len( ::cColSep ) ) - endif - - if nColsWidth + nToAdd > nWidth - exit - endif - - nColsWidth += nToAdd - nColsVisible++ - enddo - - if nColsWidth + nToAdd > nWidth .and. nColsVisible < ::nFrozenCols - /* NOTE: Why do I change frozen columns here? */ - ::freeze := 0 - ::nColsWidth := 0 - ::rightVisible := nColsVisible - ::nColsVisible := nColsVisible - return Self - endif - - if ::leftVisible <= ::nFrozenCols - ::leftVisible := ::nFrozenCols + 1 - endif - - endif - - // ; - - // BDj notes: - // Cannot assume that ::leftVisible is correct - // (eg. if ::nColPos was assigned ::rightVisible+1) - // Must do the following in a loop repeatedly until: - // (0) ::nColPos <= ::nFrozenCols (assume ::nColPos > 0) - // or - // (1) ::leftVisible <= ::nColPos <= ::rightVisible - // or - // (2) the above conditions are impossible (runtime error) - - saveColsWidth := nColsWidth - tryLeftVisible := ::leftVisible - - // ::nColPos is to the left of leftVisible - if ::nFrozenCols == 0 .and. tryLeftVisible > ::nColPos - tryLeftVisible := ::nColPos - endif - - do while .T. - - nColsVisible := Max( 0, tryLeftVisible - 1 ) - - do while nColsVisible < ::nColumns - // which column is displayed to the left of next col? - if ::nFrozenCols > 0 .and. nColsVisible + 1 == tryLeftVisible - nLeftCol := ::nFrozenCols - else - nLeftCol := nColsVisible - endif - - nToAdd := ::aColsWidth[ nColsVisible + 1 ] - - // next, we must check against nLeftCol, not nColsVisible: - if ( nColsVisible >= tryLeftVisible .or. ::nFrozenCols > 0 ) .and.; - ( nLeftCol > 0 ) .and.; - ::aColsWidth[ nLeftCol ] > 0 - - nToAdd += iif( ::aColumns[ nColsVisible + 1 ]:ColSep != NIL, Len( ::aColumns[ nColsVisible + 1 ]:ColSep ), Len( ::cColSep ) ) - endif - - if nColsWidth + nToAdd > nWidth - exit - endif - - nColsWidth += nToAdd - nColsVisible++ - enddo - - // check: is ::nColPos fit within these calculated cols? - if ::nColPos <= ::nFrozenCols .or.; - ( tryLeftVisible <= ::nColPos .and. ::nColPos <= nColsVisible ) - exit - endif - - // not ok. can retry? - if tryLeftVisible == ::nColumns - // cannot fit ::nColPos into display, generate Error TBROWSE - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_LIMIT - oErr:subSystem := "TBROWSE" - oErr:subCode := 0 - oErr:description := "Width limit exceeded" - oErr:canRetry := .F. - oErr:canDefault := .F. - oErr:fileName := "" - oErr:osCode := 0 - Eval( ErrorBlock(), oErr ) - endif - - // retry until ::nColPos fit into display - tryLeftVisible++ - nColsWidth := saveColsWidth - - enddo - - ::leftVisible := Max( 1, tryLeftVisible ) - ::rightVisible := Max( 1, nColsVisible ) - ::nColsVisible := Max( 1, nColsVisible ) - ::nColsWidth := nColsWidth - -#endif - - nColsWidth := 0 - nColsVisible := 0 - - if ::nFrozenCols > 0 - - if ::leftVisible <= ::nFrozenCols - ::leftVisible := ::nFrozenCols + 1 - endif - - do while nColsVisible < ::nFrozenCols - - nToAdd := ::aColsWidth[ nColsVisible + 1 ] - - if nColsVisible >= 1 .and. nColsVisible < ::nColumns - nToAdd += iif( ::aColumns[ nColsVisible + 1 ]:ColSep != NIL,; - Len( ::aColumns[ nColsVisible + 1 ]:ColSep ),; - Len( ::cColSep ) ) - endif - - if nColsWidth + nToAdd > nWidth - exit - endif - - nColsWidth += nToAdd - nColsVisible++ - enddo - - if nColsWidth > nWidth - // NOTE: Why do I change frozen columns here? - ::freeze := 0 - nColsWidth := 0 - endif - endif - - nColsVisible := Max( ::leftVisible - 1, 0 ) - - do while nColsVisible < ::nColumns - - nToAdd := ::aColsWidth[ nColsVisible + 1 ] - - if nColsVisible >= ::leftVisible .or. ::nFrozenCols > 0 - nToAdd += iif( ::aColumns[ nColsVisible + 1 ]:ColSep != NIL, Len( ::aColumns[ nColsVisible + 1 ]:ColSep ), Len( ::cColSep ) ) - endif - - if nColsWidth + nToAdd > nWidth - exit - endif - - nColsWidth += nToAdd - nColsVisible++ - enddo - - ::nColsVisible := Max( 1, nColsVisible ) - ::nColsWidth := nColsWidth - ::rightVisible := ::nColsVisible - - return Self - -// Movement keys cause TBrowse to become unstable. -METHOD Moved() CLASS TBrowse - - // Internal flags used to set ::lHitTop/::lHitBottom during next stabilization - ::lHitTop := .F. - ::lHitBottom := .F. - - // No need to DeHilite() current cell more than once - if ::lStable - if ::lAutoLite - ::DeHilite() - else - ::PosCursor() - endif - ::lStable := .F. - endif - - return Self - -METHOD DispCell( nRow, nCol, nMode ) CLASS TBrowse - - LOCAL oCol := ::aColumns[ nCol ] // TOFIX - LOCAL nWidth := ::aColsWidth[ nCol ] // TOFIX - LOCAL ftmp := Eval( oCol:block ) - LOCAL cType := ValType( ftmp ) - LOCAL cPicture := oCol:Picture - LOCAL nSkip := 0 - LOCAL aDefColor - LOCAL cColor - - IF !ISCHARACTER( cPicture ) - cPicture := "" - ENDIF - - IF ! Empty( ::aRect ) .AND. ; // TOFIX: aRect validation ? - nCol >= ::aRect[ 2 ] .AND. ; - nCol <= ::aRect[ 4 ] .AND. ; - nRow >= ::aRect[ 1 ] .AND. ; - nRow <= ::aRect[ 3 ] .AND. ; - ! Empty( ::aRectColor ) // TOFIX: ISEMPTY ? - cColor := tbr_GetColor( ::aColorSpec, ::aRectColor, nMode ) - ELSE - /* NOTE: Not very optimal that we're evaluating this block all the time. - But CA-Cl*pper always has a block here, and there is no other way - to tell if the code in it is NIL (the default) or something valuable. - [vszakats] */ - aDefColor := Eval( oCol:colorBlock, ftmp ) - cColor := tbr_GetColor( ::aColorSpec, iif( ISARRAY( aDefColor ), aDefColor, oCol:defColor ), nMode ) // TOFIX: ISARRAY ? - ENDIF - - SWITCH cType - CASE "C" - CASE "M" - DispOut( PadR( Transform( ftmp, cPicture ), nWidth ), cColor ) - EXIT - - CASE "N" - DispOut( PadL( Transform( ftmp, cPicture ), nWidth ), cColor ) - EXIT - - CASE "D" - DispOut( PadR( Transform( ftmp, iif( cPicture == "", "@D", cPicture ) ), nWidth ), cColor ) - EXIT - - CASE "L" - ftmp := PadC( iif( ftmp, "T", "F" ), nWidth ) - nSkip := nWidth - Len( LTrim( ftmp ) ) - 1 - DispOut( Space( Len( ftmp ) - Len( LTrim( ftmp ) ) ), ::aColorSpec[ 1 ] ) - DispOut( alltrim( ftmp ), cColor ) - DispOut( Space( Len( ftmp ) - Len( RTrim( ftmp ) ) ), ::aColorSpec[ 1 ] ) - EXIT - - OTHERWISE - DispOut( Space( nWidth ), cColor ) - - ENDSWITCH - - RETURN nSkip - -METHOD WriteMLineText( cStr, nPadLen, lHeader, cColor ) CLASS TBrowse - - local n - local nCol := Col() - local nRow := Row() - - // Do I have to write an header or a footer? - if lHeader - - // Simple case, write header as usual - if ::nHeaderHeight == 1 - DispOut( PadR( cStr, nPadLen ), cColor ) - else - // Headers are aligned to bottom - cStr := Replicate( ";", ::nHeaderHeight - hb_TokenCount( cStr, ";" ) ) + cStr - - for n := ::nHeaderHeight to 1 step -1 - SetPos( nRow + n - 1, nCol ) - DispOut( PadR( hb_TokenGet( @cStr, n, ";" ), nPadLen ), cColor ) - next - - SetPos( nRow, nCol + nPadLen ) - endif - - // footer - else - - // Simple case, write footer as usual - if ::nFooterHeight == 1 - DispOut( PadR( cStr, nPadLen ), cColor ) - else - for n := 0 to ::nFooterHeight - 1 - SetPos( nRow - n, nCol ) - DispOut( PadR( hb_TokenGet( @cStr, ::nFooterHeight - n, ";" ), nPadLen ), cColor ) - next - - SetPos( nRow, nCol + nPadLen ) - endif - - endif - - return Self - -METHOD SetColumnWidth( oCol ) CLASS TBrowse - - local nWidth - local xValue - local cString - local nTokenPos - local nLen - - // if oCol has :Width property set I use it - if oCol:width != NIL - - nWidth := oCol:width - - elseif ISBLOCK( oCol:block ) - - xValue := Eval( oCol:block ) - nWidth := tbr_CalcWidth( xValue, ValType( xValue ), oCol:picture ) - - cString := oCol:heading - do while ( nLen := Len( hb_TokenPtr( @cString, @nTokenPos, ";" ) ) ) > 0 - nWidth := Max( nLen, nWidth ) - enddo - - cString := oCol:footing - do while ( nLen := Len( hb_TokenPtr( @cString, @nTokenPos, ";" ) ) ) > 0 - nWidth := Max( nLen, nWidth ) - enddo - - else - - nWidth := 0 - - endif - - return Min( nWidth, ::n_Right - ::n_Left + 1 ) - -// Gets TBrowse width and width of displayed columns plus colsep -METHOD redrawHeaders() CLASS TBrowse - - local n, nTPos, nBPos - local cBlankBox := Space(9) - local nScreenRowT - local nScreenRowB - local nLCS // Len( ColSep ) - local nWidth := ::n_Right - ::n_Left + 1 - local nColor - - if ::lHeaders // Drawing headers - - // Clear area of screen occupied by headers - DispBox( ::n_Top, ::n_Left, ::n_Top + ::nHeaderHeight - 1, ::n_Right, cBlankBox, ::aColorSpec[ 1 ] ) - - if Empty( ::cHeadSep ) // Draw horizontal heading separator line - nScreenRowT := NIL - /* ; NOTE: This is a bug in CA-Cl*pper 5.3. [vszakats] */ - nColor := TBC_CLR_STANDARD - else - DispOutAt( ( nScreenRowT := ::n_Top + ::nHeaderHeight ), ::n_Left,; - Replicate( Right( ::cHeadSep, 1 ), nWidth ), ::aColorSpec[ 1 ] ) - nColor := TBC_CLR_HEADING - endif - - // Set cursor at first field start of description - SetPos( ::n_Top, ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) ) - - for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible - if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 - n := ::leftVisible - endif - - ::WriteMLineText( ::aColumns[ n ]:Heading, ::aColsWidth[ n ], .T., tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, nColor ) ) - - if n < ::rightVisible - // Set cursor at start of next field description - SetPos( Row(), Col() + iif( ::aColumns[ n + 1 ]:ColSep != NIL, Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::cColSep ) ) ) - endif - next - endif - - if ::lFooters // Drawing footers - - // Clear area of screen occupied by footers - DispBox( ::n_Bottom - ::nFooterHeight + 1, ::n_Left, ::n_Bottom, ::n_Right, cBlankBox, ::aColorSpec[ 1 ] ) - - if Empty( ::cFootSep ) // Draw horizontal footing separator line - nScreenRowB := NIL - /* ; NOTE: This is a bug in CA-Cl*pper 5.3. [vszakats] */ - nColor := TBC_CLR_STANDARD - else - DispOutAt( ( nScreenRowB := ::n_Bottom - ::nFooterHeight ), ::n_Left,; - Replicate( Right( ::cFootSep, 1 ), nWidth ), ::aColorSpec[ 1 ] ) - nColor := TBC_CLR_FOOTING - endif - - // Set cursor at first field start of description - SetPos( ::n_Bottom, ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) ) - - for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible - if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 - n := ::leftVisible - endif - - ::WriteMLineText( ::aColumns[ n ]:Footing, ::aColsWidth[ n ], .F., tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, nColor ) ) - - if n < ::rightVisible - // Set cursor at start of next field description - SetPos( Row(), Col() + iif( ::aColumns[ n + 1 ]:ColSep != NIL, Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::cColSep ) ) ) - endif - next - endif - - nTPos := nBPos := ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) - - // Draw headin/footing column separator - for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible - - if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 - n := ::leftVisible - endif - - if n < ::rightVisible - - nLCS := iif( ::aColumns[ n + 1 ]:ColSep != NIL, Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::cColSep ) ) - - if nScreenRowT != NIL - DispOutAt( nScreenRowT, ( nTPos += ::aColsWidth[ n ] ), Left( ::cHeadSep, nLCS ), ::aColorSpec[ 1 ] ) - nTPos += nLCS - endif - - if nScreenRowB != NIL - DispOutAt( nScreenRowB, ( nBPos += ::aColsWidth[ n ] ), Left( ::cFootSep, nLCS ), ::aColorSpec[ 1 ] ) - nBPos += nLCS - endif - - endif - next - - return Self - -// NOTE: Not tested, could be broken -METHOD MGotoYX( nRow, nCol ) CLASS TBrowse - - local nColsLen - local nI - local nNewRow - - // Am I inside TBrowse display area ? - if nRow > ::n_Top .and. nRow < ::n_Bottom .and. ; - nCol > ::n_Left .and. nCol < ::n_Right - - // if not stable force repositioning of data source; maybe this is not first Stabilize() call after - // TBrowse became unstable, but we need to call Stabilize() al least one time before moving again to be sure - // data source is under cursor position - if ::lStable - ::Moved() - else - ::stabilize() - endif - - // Set new row position - nNewRow := nRow - ::n_Top + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. ! ::lHeaders, 0, 1 ) - 1 - ::nRecsToSkip := nNewRow - ::nNewRowPos - - // move data source accordingly - ::Stabilize() - - // Now move to column under nCol - nColsLen := 0 - // NOTE: I don't think it is correct, have to look up docs - nI := iif( ::nFrozenCols > 0, ::nFrozenCols, ::leftVisible ) - - do while nColsLen < nCol .and. nI < ::rightVisible - - nColsLen += ::aColsWidth[ nI ] - if nI >= 1 .and. nI < ::nColumns - nColsLen += iif( ::aColumns[ nI ]:ColSep != NIL, Len( ::aColumns[ nI ]:ColSep ), Len( ::cColSep ) ) - endif - - nI++ - - enddo - - ::nColPos := nI - - // Force redraw of current row with new cell position - ::RefreshCurrent() - - endif - - return Self - -/* -------------------------------------------- */ - -METHOD autoLite( lAutoLite ) CLASS TBrowse - - if ISLOGICAL( lAutoLite ) - ::lAutoLite := lAutoLite - endif - - return ::lAutoLite - -METHOD nTop( nTop ) CLASS TBrowse - - IF nTop != NIL - #ifdef HB_COMPAT_C53 - ::n_Top := _eInstVar( Self, "NTOP", nTop, "N", 1001 ) - IF !Empty( ::cBorder ) - ::n_Top++ - ENDIF - #else - ::n_Top := _eInstVar( Self, "NTOP", nTop, "N", 1001, {| o, x | HB_SYMBOL_UNUSED( o ), x >= 0 } ) - #endif - ::Configure( 2 ) - ENDIF - - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - RETURN ::n_Top - 1 - ENDIF - #endif - - RETURN ::n_Top - -METHOD nLeft( nLeft ) CLASS TBrowse - - IF nLeft != NIL - #ifdef HB_COMPAT_C53 - ::n_Left := _eInstVar( Self, "NLEFT", nLeft, "N", 1001 ) - IF !Empty( ::cBorder ) - ::n_Left++ - ENDIF - #else - ::n_Left := _eInstVar( Self, "NLEFT", nLeft, "N", 1001, {| o, x | HB_SYMBOL_UNUSED( o ), x >= 0 } ) - #endif - ::Configure( 2 ) - ENDIF - - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - RETURN ::n_Left - 1 - ENDIF - #endif - - RETURN ::n_Left - -METHOD nBottom( nBottom ) CLASS TBrowse - - IF nBottom != NIL - ::n_Bottom := _eInstVar( Self, "NBOTTOM", nBottom, "N", 1001, {| o, x | x >= o:nTop } ) - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - ::n_Bottom-- - ENDIF - #endif - ::Configure( 2 ) - 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 := _eInstVar( Self, "NRIGHT", nRight, "N", 1001, {| o, x | x >= o:nLeft } ) - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - ::n_Right-- - ENDIF - #endif - ::Configure( 2 ) - ENDIF - - #ifdef HB_COMPAT_C53 - IF !Empty( ::cBorder ) - RETURN ::n_Right + 1 - ENDIF - #endif - - RETURN ::n_Right - -METHOD colorSpec( cColorSpec ) CLASS TBrowse - - if cColorSpec != NIL - ::cColorSpec := _eInstVar( Self, "COLORSPEC", cColorSpec, "C", 1001 ) - ::aColorSpec := tbr_CookColor( ::cColorSpec ) - ::Configure( 1 ) - endif - - return ::cColorSpec - -METHOD colSep( cColSep ) CLASS TBrowse - - if cColSep != NIL - ::cColSep := _eInstVar( Self, "COLSEP", cColSep, "C", 1001 ) - endif - - return ::cColSep - -METHOD footSep( cFootSep ) CLASS TBrowse - - if cFootSep != NIL - ::cFootSep := _eInstVar( Self, "FOOTSEP", cFootSep, "C", 1001 ) - endif - - return ::cFootSep - -METHOD headSep( cHeadSep ) CLASS TBrowse - - if cHeadSep != NIL - ::cHeadSep := _eInstVar( Self, "HEADSEP", cHeadSep, "C", 1001 ) - endif - - return ::cHeadSep - -/* NOTE: CA-Cl*pper has a bug where negative nColPos value will be translated to 16bit unsigned int, - so the behaviour will be different in this case. [vszakats] */ - -METHOD colPos( nColPos ) CLASS TBrowse - - if PCount() > 0 - if ISNUMBER( nColPos ) - ::nColPos := nColPos - else - ::nColPos := 0 - endif - endif - - return ::nColPos - -/* NOTE: CA-Cl*pper has a bug where negative nRowPos value will be translated to 16bit unsigned int, - so the behaviour will be different in this case. [vszakats] */ - -METHOD rowPos( nRowPos ) CLASS TBrowse - - if PCount() > 0 - if ISNUMBER( nRowPos ) - ::nRowPos := iif( nRowPos < 1 .or. nRowPos > ::RowCount, ::RowCount, nRowPos ) - return nRowPos - else - ::nRowPos := ::RowCount - return 0 - endif - endif - - return ::nRowPos - -METHOD goBottomBlock( bBlock ) CLASS TBrowse - - if bBlock != NIL - /* NOTE: In CA-Cl*pper the string is: "GOBOTTOMBL" */ - ::bGoBottomBlock := _eInstVar( Self, "GOBOTTOMBLOCK", bBlock, "B", 1001 ) - endif - - return ::bGoBottomBlock - -METHOD goTopBlock( bBlock ) CLASS TBrowse - - if bBlock != NIL - ::bGoTopBlock := _eInstVar( Self, "GOTOPBLOCK", bBlock, "B", 1001 ) - endif - - return ::bGoTopBlock - -METHOD hitBottom( lHitBottom ) CLASS TBrowse - - if PCount() > 0 - if ISLOGICAL( lHitBottom ) - ::lHitBottom := lHitBottom - else - return .T. - endif - endif - - return ::lHitBottom - -METHOD hitTop( lHitTop ) CLASS TBrowse - - if PCount() > 0 - if ISLOGICAL( lHitTop ) - ::lHitTop := lHitTop - else - return .T. - endif - endif - - return ::lHitTop - -METHOD stable( lStable ) CLASS TBrowse - - if PCount() > 0 - if ISLOGICAL( lStable ) - ::lStable := lStable - else - return .T. - endif - endif - - return ::lStable - -METHOD skipBlock( bSkipBlock ) CLASS TBrowse - - if bSkipBlock != NIL - ::bSkipBlock := _eInstVar( Self, "SKIPBLOCK", bSkipBlock, "B", 1001 ) - endif - - return ::bSkipBlock - -#ifdef HB_COMPAT_C53 - -#define _TBC_SETKEY_KEY 1 -#define _TBC_SETKEY_BLOCK 2 - -METHOD setKey( nKey, bBlock ) CLASS TBrowse - - LOCAL bReturn - LOCAL nPos - - /* NOTE: Assigned codeblock receives two parameters: - {| oTBrowse, nKey | } */ - - IF ::aKeys == NIL - ::aKeys := { { 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( ::aKeys, { K_MWFORWARD , {| o | o:Up() , TBR_CONTINUE } } ) - AAdd( ::aKeys, { K_MWBACKWARD , {| o | o:Down() , TBR_CONTINUE } } ) - #endif - ENDIF - - IF ( nPos := AScan( ::aKeys, {| x | x[ _TBC_SETKEY_KEY ] == nKey } ) ) == 0 - IF ISBLOCK( bBlock ) - AAdd( ::aKeys, { nKey, bBlock } ) - ENDIF - bReturn := bBlock - ELSEIF ISBLOCK( bBlock ) - ::aKeys[ nPos ][ _TBC_SETKEY_BLOCK ] := bBlock - bReturn := bBlock - ELSEIF PCount() == 1 - bReturn := ::aKeys[ nPos ][ _TBC_SETKEY_BLOCK ] - ELSE - bReturn := ::aKeys[ nPos ][ _TBC_SETKEY_BLOCK ] - IF PCount() == 2 .AND. bBlock == NIL .AND. nKey != 0 - ADel( ::aKeys, nPos ) - ASize( ::aKeys, Len( ::aKeys ) - 1 ) - ENDIF - ENDIF - - RETURN bReturn - -METHOD applyKey( nKey ) CLASS TBrowse - - LOCAL bBlock := ::setKey( nKey ) - - DEFAULT bBlock TO ::setKey( 0 ) - - IF bBlock == NIL - RETURN TBR_EXCEPTION - ENDIF - - RETURN Eval( bBlock, Self, nKey ) - -METHOD hitTest( nMRow, nMCol ) CLASS TBrowse - local i - - ::nmRowPos := ::nRowPos - ::nmColPos := ::nColPos - - if nMRow < ::rect[ 1 ] .or. nMRow > ::rect[ 3 ] - return HTNOWHERE - endif - - if nMCol < ::rect[ 2 ] .or. nMCol > ::rect[ 4 ] - return HTNOWHERE - endif - - ::nmRowPos := nMRow - ::rect[ 1 ] + 1 - - for i := 1 to Len( ::aVisibleCols ) - if nMCol < ::aVisibleCols[ i ] - exit - endif - next - - ::mColPos := ::aVisibleCols[ i ] - - return HTCELL - -METHOD border( cBorder ) CLASS TBrowse - - IF PCount() > 0 - - cBorder := _eInstVar( 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( 2 ) - ELSEIF !Empty( ::cBorder ) .AND. Empty( cBorder ) - ::n_Top-- - ::n_Left-- - ::n_Bottom++ - ::n_Right++ - ::configure( 2 ) - ENDIF - - ::cBorder := cBorder - ENDIF - ENDIF - - RETURN ::cBorder - -METHOD nRow() CLASS TBrowse - return ::n_Row - -METHOD nCol() CLASS TBrowse - return ::n_Col - -METHOD mRowPos() CLASS TBrowse - return ::nmRowPos - -METHOD mColPos() CLASS TBrowse - return ::nmColPos - -METHOD message( cMessage ) CLASS TBrowse - - IF cMessage != NIL - ::cMessage := _eInstVar( Self, "MESSAGE", cMessage, "C", 1001 ) - ENDIF - - RETURN ::cMessage - -METHOD setStyle( nStyle, lNewValue ) CLASS TBrowse - - /* 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( ::aSetStyle ) .AND. nStyle <= 4096 /* Some reasonable limit for maximum number of styles */ - ASize( ::aSetStyle, nStyle ) - ENDIF - - IF ISLOGICAL( lNewValue ) - ::aSetStyle[ nStyle ] := lNewValue - ENDIF - - RETURN ::aSetStyle[ nStyle ] - -#endif - -/* -------------------------------------------- */ - -METHOD New( nTop, nLeft, nBottom, nRight ) CLASS TBrowse +METHOD new( nTop, nLeft, nBottom, nRight ) CLASS TBROWSE DEFAULT nTop TO 0 DEFAULT nLeft TO 0 @@ -2230,137 +319,2412 @@ METHOD New( nTop, nLeft, nBottom, nRight ) CLASS TBrowse ::nBottom := nBottom ::nRight := nRight - ::cColorSpec := SetColor() - ::aColorSpec := tbr_CookColor( ::cColorSpec ) + ::colorSpec := SetColor() - #ifdef HB_COMPAT_C53 - ::rect := { ::n_Top, ::n_Left, ::n_Bottom, ::n_Right } - #endif + RETURN Self - return Self +STATIC FUNCTION _SKIP_RESULT( xResult ) -FUNCTION TBrowseNew( nTop, nLeft, nBottom, nRight ) - return TBrowse():New( nTop, nLeft, nBottom, nRight ) + RETURN IIF( ValType( xResult ) == "N", Int( xResult ), 0 ) -/* -------------------------------------------- */ -/* NOTE: Preprocess user-supplied colorstring for internal usage. This is - needed to keep full C5.x compatibility while maintaining performace. - C5.x would always have at least two items, defaulted to the - current SetColor() values, the rest of the items are defaulted - to "N/N". [vszakats] */ -STATIC FUNCTION tbr_CookColor( cColorSpec ) +STATIC FUNCTION _DISP_FHSEP( nRow, nType, cColor, aColData ) + LOCAL lFirst, lFirstVisible + LOCAL aCol + LOCAL cSep + LOCAL nLen, nWidth - LOCAL nCount := Max( hb_TokenCount( cColorSpec, "," ), 2 ) - LOCAL aColorSpec := Array( nCount ) - LOCAL cColor - LOCAL nPos + lFirst := lFirstVisible := .T. + FOR EACH aCol IN aColData + IF aCol[ _TBCI_COLPOS ] != NIL + cSep := aCol[ nType ] + nWidth := aCol[ _TBCI_COLWIDTH ] - FOR nPos := 1 TO nCount - cColor := hb_TokenGet( @cColorSpec, nPos, "," ) - IF nPos <= 2 - aColorSpec[ nPos ] := iif( hb_ColorToN( cColor ) == 0 .AND. !( Upper( StrTran( cColor, " ", "" ) ) == "N/N" ), hb_ColorIndex( "W/N,N/W", nPos - 1 ), cColor ) - ELSE - aColorSpec[ nPos ] := iif( hb_ColorToN( cColor ) == 0, "N/N", cColor ) + /* 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. + * Now this code should exactly replicate CA-Cl*pper + * behavior. [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 + DispOutAt( nRow, aCol[ _TBCI_COLPOS ] - aCol[ _TBCI_FROZENSPACE ], ; + cSep, cColor ) + ELSEIF aCol[ _TBCI_CELLWIDTH ] > 0 + lFirst := .F. ENDIF NEXT - RETURN aColorSpec + RETURN NIL -/* NOTE: Preprocess defColor so that it can be used "blindly" afterwards. */ -STATIC FUNCTION tbr_DefColor( aDefColor, aColorSpec ) - IF !ISARRAY( aDefColor ) - aDefColor := {} +STATIC FUNCTION _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aColors, aColData ) + + LOCAL lFirst + LOCAL aCol + LOCAL cName + LOCAL nPos, nCol, nWidth + + DispBox( nRow, nLeft, nRow + nHeight - 1, nRight, ; + Space( 9 ), aColors[ _TBC_CLR_STANDARD ] ) + lFirst := .T. + 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 + DispOutAt( nRow + nPos - 1, nCol, ; + PadR( hb_tokenGet( cName, nPos, ";" ), nWidth ), ; + IIF( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ; + aColors[ aCol[ _TBCI_DEFCOLOR ][ nColor ] ] ) ) + NEXT + ENDIF + NEXT + + RETURN NIL + + +METHOD dispFrames() CLASS TBROWSE + + IF ::nConfigure != 0 + ::doConfigure() ENDIF - ASize( aDefColor, TBC_CLR_MAX_ ) + DispBegin() - IF !ISNUMBER( aDefColor[ TBC_CLR_STANDARD ] ) .OR. aDefColor[ TBC_CLR_STANDARD ] > Len( aColorSpec ) - aDefColor[ TBC_CLR_STANDARD ] := 1 + IF ::lInvalid .AND. !Empty( ::cBorder ) + DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, ::cBorder, ::colorValue( _TBC_CLR_STANDARD ) ) ENDIF - IF !ISNUMBER( aDefColor[ TBC_CLR_ENHANCED ] ) .OR. aDefColor[ TBC_CLR_ENHANCED ] > Len( aColorSpec ) - aDefColor[ TBC_CLR_ENHANCED ] := 2 + + 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 -#ifdef HB_COMPAT_C53 - /* NOTE: To be backwards compatible, C5.3 will fall back to C5.2 colors - if the extra HEADING/FOOTING positions are not specified. [vszakats] */ - IF !ISNUMBER( aDefColor[ TBC_CLR_HEADING ] ) .OR. aDefColor[ TBC_CLR_HEADING ] > Len( aColorSpec ) - aDefColor[ TBC_CLR_HEADING ] := aDefColor[ TBC_CLR_STANDARD ] + IF ::lHeadSep + _DISP_FHSEP( ::n_Top + ::nHeadHeight, _TBCI_HEADSEP, ; + ::colorValue( _TBC_CLR_STANDARD ), ::aColData ) ENDIF - IF !ISNUMBER( aDefColor[ TBC_CLR_FOOTING ] ) .OR. aDefColor[ TBC_CLR_FOOTING ] > Len( aColorSpec ) - aDefColor[ TBC_CLR_FOOTING ] := aDefColor[ TBC_CLR_STANDARD ] + 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 .AND. ; + ::aCellStatus[ nRow ] != _TBR_UNDEF + + DispBegin() + + nRowPos := ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 1, 0 ) + nRow - 1 + cStdColor := ::colorValue( _TBC_CLR_STANDARD ) + + 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 + DispOutAt( 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 ::aCellStatus[ nRow ] != _TBR_VALID + cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) + ENDIF + IF aCol[ _TBCI_LASTSPACE ] < 0 + DispOutAt( nRowPos, nColPos, ; + Left( cValue, ::n_Right - nColPos + 1 ), cColor ) + ELSE +#ifdef HB_C52_STRICT + DispOutAt( nRowPos, nColPos, ; + Left( cValue, aCol[ _TBCI_COLWIDTH ] - aCol[ _TBCI_CELLPOS ] ), cColor ) +#else + DispOutAt( nRowPos, nColPos, cValue, cColor ) #endif + ENDIF + ENDIF + NEXT - RETURN aDefColor + ::aDispStatus[ nRow ] := .F. -/* NOTE: Strict sanity check for a color array. We need to use this - for the array returned by a :colorBlock. */ -STATIC FUNCTION tbr_GetColor( aColorSpec, aDefColor, nMode ) - - IF !ISARRAY( aDefColor ) - /* NOTE: This fits both C5.2 and C5.3. In C5.2 nMode is 1 or 2. [vszakats] */ - RETURN aColorSpec[ { 1, 2, 1, 1 }[ nMode ] ] - ELSEIF nMode > Len( aDefColor ) - /* NOTE: C5.3 and C5.2 compatible method. To be backwards compatible, - C5.3 will fall back to C5.2 colors if the extra HEADING/FOOTING - positions are not specified. [vszakats] */ - SWITCH NMODE - CASE TBC_CLR_STANDARD ; RETURN aColorSpec[ 1 ] - CASE TBC_CLR_ENHANCED ; RETURN aColorSpec[ 2 ] - CASE TBC_CLR_HEADING ; RETURN aColorSpec[ iif( Len( aDefColor ) >= TBC_CLR_STANDARD .AND. ISNUMBER( aDefColor[ TBC_CLR_STANDARD ] ) .AND. aDefColor[ 1 ] <= Len( aColorSpec ), aDefColor[ TBC_CLR_STANDARD ], 1 ) ] - CASE TBC_CLR_FOOTING ; RETURN aColorSpec[ iif( Len( aDefColor ) >= TBC_CLR_STANDARD .AND. ISNUMBER( aDefColor[ TBC_CLR_STANDARD ] ) .AND. aDefColor[ 1 ] <= Len( aColorSpec ), aDefColor[ TBC_CLR_STANDARD ], 1 ) ] - ENDSWITCH + DispEnd() ENDIF - RETURN aColorSpec[ iif( ISNUMBER( aDefColor[ nMode ] ) .AND. aDefColor[ nMode ] <= Len( aColorSpec ), aDefColor[ nMode ], { 1, 2, 1, 1 }[ nMode ] ) ] + RETURN Self -STATIC FUNCTION tbr_CalcWidth( xValue, cType, cPicture ) - IF !ISCHARACTER( cPicture ) - cPicture := "" +METHOD colorRect( aRect, aColors ) CLASS TBROWSE + + LOCAL nRow, nCol, nNewPos + + nRow := ::rowCount + 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 ) + + FOR nRow := aRect[ 1 ] TO aRect[ 3 ] + IF ::aCellStatus[ nRow ] == _TBR_UNDEF + IF ::nMoveOffset != 0 + nNewPos := ::nMoveOffset + ::nRowPos + IF nNewPos >= 1 .AND. nNewPos <= ::rowCount + ::nRowPos := nNewPos + ENDIF + ENDIF + ::setPosition( nRow ) + ::readRecord() + ENDIF + FOR nCol := aRect[ 2 ] TO aRect[ 4 ] + ::aCellColors[ nRow, nCol, 1 ] := aColors[ 1 ] + ::aCellColors[ nRow, nCol, 2 ] := aColors[ 2 ] + ::dispRow( nRow ) + NEXT + NEXT ENDIF - SWITCH cType - CASE "M" - CASE "C" ; RETURN Len( iif( Empty( cPicture ), xValue , Transform( xValue, cPicture ) ) ) - CASE "N" ; RETURN Len( iif( Empty( cPicture ), Str( xValue ) , Transform( xValue, cPicture ) ) ) - CASE "D" ; RETURN Len( iif( Empty( cPicture ), DToC( xValue ), Transform( xValue, cPicture ) ) ) - CASE "L" ; RETURN 1 - ENDSWITCH + RETURN Self + + +METHOD readRecord() CLASS TBROWSE + + LOCAL aCol + LOCAL oCol + LOCAL nRow + LOCAL cValue + LOCAL aColor + LOCAL nColors + + nRow := ::nBufferPos + + IF nRow >= 1 .AND. nRow <= ::rowCount .AND. ; + ::aCellStatus[ nRow ] == _TBR_UNDEF + + nColors := Len( ::aColors ) + 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 ) $ "CMNDL" + cValue := PadR( Transform( cValue, oCol:picture ), aCol[ _TBCI_CELLWIDTH ] ) + ELSE + cValue := Space( aCol[ _TBCI_CELLWIDTH ] ) + ENDIF + NEXT + + ::aCellStatus[ nRow ] := _TBR_VALID + ::aDispStatus[ nRow ] := .T. + + ENDIF + + RETURN Self + + +METHOD scrollBuffer( nRows ) CLASS TBROWSE + + LOCAL nRowCount, nStatus + LOCAL aValues, aColors + LOCAL cOldColor + + IF nRows > 0 + nRowCount := ::rowCount + nStatus := ATail( ::aCellStatus ) + IF nStatus != _TBR_NONE + nStatus := _TBR_UNDEF + ENDIF + cOldColor := SetColor( ::colorValue( _TBC_CLR_STANDARD ) ) + Scroll( ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 1, 0 ), ::n_Left, ; + ::n_Bottom - ::nFootHeight - IIF( ::lFootSep, 1, 0 ), ::n_Right, ; + nRows ) + SetColor( cOldColor ) + 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 ] := nStatus + ::aDispStatus[ nRowCount ] := .T. + IF nStatus == _TBR_NONE + _SETDEFCOLOR( ::aColData, aColors ) + ENDIF + ENDDO + ELSEIF nRows < 0 + cOldColor := SetColor( ::colorValue( _TBC_CLR_STANDARD ) ) + Scroll( ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 1, 0 ), ::n_Left, ; + ::n_Bottom - ::nFootHeight - IIF( ::lFootSep, 1, 0 ), ::n_Right, ; + nRows ) + SetColor( cOldColor ) + WHILE ++nRows <= 0 + HB_AIns( ::aCellValues, 1, ATail( ::aCellValues ) ) + HB_AIns( ::aCellColors, 1, ATail( ::aCellColors ) ) + HB_AIns( ::aCellStatus, 1, _TBR_UNDEF ) + HB_AIns( ::aDispStatus, 1, .T. ) + ENDDO + ENDIF + + RETURN Self + + +METHOD setPosition( nPos ) CLASS TBROWSE + + LOCAL nMoved, nToMove, nRowCount + LOCAL lNewPos + + nToMove := ::nMoveOffset + nPos - ::nBufferPos + lNewPos := .F. + nRowCount := ::rowCount + + IF !Empty( ::aCellStatus ) .AND. ; + ( nToMove != 0 .OR. ::aCellStatus[ nPos ] == _TBR_UNDEF ) + + IF nToMove >= nRowCount + nToMove += nRowCount - ::nBufferPos + lNewPos := .T. + ELSEIF nToMove <= -nRowCount + nToMove -= ::nBufferPos - 1 + lNewPos := .T. + ENDIF + + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, nToMove ) ) + + IF nMoved == 0 + IF nToMove > 0 + FOR nPos := ::nBufferPos + 1 TO nRowCount + IF ::aCellStatus[ nPos ] != _TBR_NONE + ::aCellStatus[ nPos ] := _TBR_NONE + ::aDispStatus[ nPos ] := .T. + _SETDEFCOLOR( ::aColData, ::aCellColors[ nPos ] ) + ENDIF + NEXT + IF ::nMoveOffset != 0 + ::lHitBottom := .T. + ENDIF + ELSEIF nToMove < 0 + IF ::nBufferPos > 1 + ::scrollBuffer( ::nBufferPos - 1 ) + ::nBufferPos := 1 + ENDIF + IF ::nMoveOffset != 0 + ::lHitTop := .T. + ENDIF + ENDIF + ELSEIF nMoved >= nRowCount + AFill( ::aCellStatus, _TBR_UNDEF ) + AFill( ::aDispStatus, .T. ) + ::nBufferPos := nRowCount + ELSEIF nMoved <= -nRowCount + AFill( ::aCellStatus, _TBR_UNDEF ) + AFill( ::aDispStatus, .T. ) + ::nBufferPos := 1 + ELSEIF nMoved > 0 + ::nBufferPos += nMoved + IF ::nBufferPos > nRowCount + ::scrollBuffer( ::nBufferPos - nRowCount ) + ::nBufferPos := nRowCount + ENDIF + nPos := 0 + WHILE ( nPos := AScan( ::aCellStatus, _TBR_NONE, nPos, ::nBufferPos - nPos ) ) != 0 + ::aCellStatus[ nPos ] := _TBR_UNDEF + ::aDispStatus[ nPos ] := .T. + ENDDO + ELSE /* nMoved < 0 */ + ::nBufferPos += nMoved + IF ::nBufferPos < 1 + ::scrollBuffer( ::nBufferPos - 1 ) + ::nBufferPos := 1 + ENDIF + ENDIF + + IF lNewPos .AND. AScan( ::aCellStatus, _TBR_UNDEF ) == 0 + IF nToMove > 0 + nPos := AScan( ::aCellStatus, _TBR_NONE ) + ::nRowPos := IIF( nPos == 0, nRowCount, Max( 1, nPos - 1 ) ) + ELSE + ::nRowPos := 1 + ENDIF + ENDIF + ENDIF + + ::nMoveOffset := 0 + + RETURN Self + + +METHOD stabilize() CLASS TBROWSE + + LOCAL nPos, nNewPos + LOCAL lDisp + + IF ::nConfigure != 0 + ::doConfigure() + ENDIF + + IF !::lStable .OR. ::lInvalid .OR. ::lFrames .OR. ::lRefresh .OR. ; + ::nMoveOffset != 0 .OR. ::nBufferPos != ::nRowPos + + IF ::lRefresh + AFill( ::aCellStatus, _TBR_UNDEF ) + ::lRefresh := .F. + ENDIF + + nPos := ::nColPos + IF nPos < 1 .OR. nPos > ::colCount .OR. ::nLastPos != nPos .OR. ; + ::lFrames .OR. ::nLeftVisible == 0 .OR. ::nRightVisible == 0 .OR. ; + ::aColData[ nPos ][ _TBCI_COLPOS ] == NIL + + ::setVisible() + ENDIF + + IF ::lFrames + ::dispFrames() + AFill( ::aDispStatus, .T. ) + ENDIF + + nNewPos := ::nMoveOffset + ::nRowPos + IF nNewPos < 1 .OR. nNewPos > ::rowCount + nPos := ::nBufferPos + ELSE + IF ::aCellStatus[ nNewPos ] == _TBR_NONE + ::setPosition( nNewPos ) + ::readRecord() + ::dispRow( ::nBufferPos ) + ::nRowPos := ::nBufferPos + nPos := 0 + ELSE + ::nRowPos += ::nMoveOffset + ::nMoveOffset := 0 + nPos := AScan( ::aCellStatus, _TBR_UNDEF ) + IF nPos != 0 + IF nPos < ::nBufferPos .AND. ; + HB_RAScan( ::aCellStatus, _TBR_UNDEF ) == ::nBufferPos - 1 + nPos := ::nBufferPos - 1 + ENDIF + ENDIF + ENDIF + ENDIF + + IF nPos != 0 + ::setPosition( nPos ) + ::readRecord() + ::dispRow( ::nBufferPos ) + ENDIF + + nPos := AScan( ::aCellStatus, _TBR_UNDEF ) + IF nPos == 0 + ::setPosition( ::nRowPos ) + ::nRowPos := ::nBufferPos + ::lStable := .T. + ::lInvalid := .F. + + DispBegin() + FOR EACH lDisp IN ::aDispStatus + IF lDisp + ::dispRow( lDisp:__enumIndex() ) + ENDIF + NEXT + DispEnd() + + ELSE + /* TODO: CA-Clipper displays or valid records in the buffer when + * they should be drawn on the screen f.e. after horizontal + * scrolling in each stabilize call not only at the end of + * stabilization process. [druzus] + */ + RETURN .F. + ENDIF + 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: + * 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] + */ + 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 ] == _TBR_VALID + + 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 ] == _TBR_VALID + + RETURN ::aCellColors[ nRow, nCol ] + ENDIF + + RETURN NIL + + +STATIC FUNCTION _DECODECOLORS( cColorSpec ) + LOCAL aColors + LOCAL cColor + LOCAL nColors, nPos + + aColors := {} + nColors := hb_TokenCount( cColorSpec, "," ) + 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 + 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 + LOCAL nColorIndex + LOCAL nPos + + aColorsIdx := { _TBC_CLR_STANDARD, _TBC_CLR_SELECTED, ; + _TBC_CLR_STANDARD, _TBC_CLR_STANDARD } + + 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 _SETDEFCOLOR( aColData, aColors ) + + LOCAL aCol, aClr + + FOR EACH aCol, aClr IN aColData, aColors + aClr := { aCol[ _TBCI_DEFCOLOR ][ 1 ], aCol[ _TBCI_DEFCOLOR ][ 2 ] } + NEXT + +RETURN NIL + + +/* 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 xColor + LOCAL aColors + LOCAL nColorIndex + LOCAL nPos, nMax + + aColors := { aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_STANDARD ], ; + aCol[ _TBCI_DEFCOLOR ][ _TBC_CLR_SELECTED ] } + xColor := Eval( aCol[ _TBCI_COLOBJECT ]:colorBlock, xValue ) + 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 + 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() + + /* 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. + Eval( ::bSkipBlock, 1 - ::nBufferPos ) + ::nBufferPos := 1 + ::lFrames := .T. + + RETURN Self + + +METHOD refreshCurrent() CLASS TBROWSE + + ::setUnstable() + + IF ::nRowPos >= 1 .AND. ::nRowPos <= ::rowCount + ::aCellStatus[ ::nRowPos ] := _TBR_UNDEF + 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() + 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() + 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() + + /* 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. + Eval( ::bGoTopBlock ) + ::nRowPos := 1 + ::nBufferPos := 1 + ::nMoveOffset := 0 + Eval( ::bSkipBlock, 0 ) + + RETURN Self + + +METHOD goBottom() CLASS TBROWSE + + LOCAL nMoved + + ::setUnstable() + + /* 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. + Eval( ::bGoBottomBlock ) + nMoved := _SKIP_RESULT( Eval( ::bSkipBlock, -( ::rowCount - 1 ) ) ) + + AFill( ::aCellStatus, _TBR_NONE, -nMoved + 2 ) + AFill( ::aDispStatus, .T., -nMoved + 2 ) + AEval( ::aCellColors, { |aColors| _SETDEFCOLOR( ::aColData, aColors ) }, -nMoved + 2 ) + + ::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 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-Clipper always evaluates column block even if column is + * hidden by setting :width to 0. [druzus] + */ + xValue := Eval( oCol:block ) + cType := ValType( xValue ) + nWidth := LEN( Transform( xValue, oCol:picture ) ) + 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( ::n_Bottom - ::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( ";", nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], ";" ) ) + ; + 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, _TBR_UNDEF ) + 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 + _SETDEFCOLOR( ::aColData, aCol ) + NEXT + + ::lFrames := .T. + ::lStable := .F. + + /* CA-Clipper update visible columns here but without + * colPos repositioning. [druzus] + */ + _SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ; + @::nFrozen, @::nLeftVisible, @::nRightVisible ) + + ::nLastPos := 0 + + IF ::nRowPos > nRowCount + ::nRowPos := nRowCount + ELSEIF ::nRowPos < 1 + ::nRowPos := 1 + ENDIF + + RETURN Self + + +STATIC FUNCTION _GENLIMITRTE() + + LOCAL oError + + 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 NIL + + +/* 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 ) == ";" + cName := Left( cName, Len( cName ) - 1 ) + ENDIF + nHeight := hb_TokenCount( cName, ";" ) + FOR i := 1 TO nHeight + nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, ";" ) ) ) + NEXT + ENDIF + + ELSE +#ifndef HB_C52_STRICT + /* CA-Cl*per bug, it accepts non character values though cannot + * display them properly + */ + nHeight := 1 +#else + nHeight := 0 +#endif + 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 -/* -------------------------------------------- */ -FUNCTION TBMouse( oBrowse, nMRow, nMCol ) +STATIC FUNCTION _NEXTCOLUMN( aColData, nCol ) + LOCAL aCol + + 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 + + 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, nLast, nColWidth + + 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 FUNCTION _SETVISIBLE( aColData, nWidth, nFrozen, nLeft, nRight ) + + LOCAL nColCount, nPos, nFirst + LOCAL lLeft, lRight, lFirst + + 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 NIL + + +/* set visible columns */ +METHOD setVisible() CLASS TBROWSE + + LOCAL aCol + LOCAL nColumns, nCol, nWidth, nLeft, nColPos, nFrozen, nLast + LOCAL lFirst, lFrames + + lFrames := .F. + nColumns := Len( ::aColData ) + nWidth := ::n_Right - ::n_Left + 1 + + nColPos := ::nColPos + 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-Clipper 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 := ::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, ::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 + + 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 ) > ::n_Right + cValue := Left( cValue, ::n_Right - ::n_Col + 1 ) + ENDIF + DispOut( 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 ) > ::n_Right + cValue := Left( cValue, ::n_Right - ::n_Col + 1 ) + ENDIF + DispOut( 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, ::n_Right - ::n_Left + 1 ) == nCols + + ::nFrozen := nCols + ::lFrames := .T. + ::nLastPos := 0 + /* CA-Clipper update visible columns here but without + * colPos repositioning. [druzus] + */ + _SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ; + @::nFrozen, @::nLeftVisible, @::nRightVisible ) + ENDIF + /* NOTE: CA-Cl*pper compatible behaviour. [vszakats] */ + RETURN nCols + ENDIF + + RETURN ::nFrozen + + +/* get/set string value with color table for the TBrowse display */ +METHOD colorSpec( cColorSpec ) CLASS TBROWSE + + IF cColorSpec != NIL + ::cColorSpec := _eInstVar( 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 := ::n_Bottom - ::n_Top + 1 - ; + ::nHeadHeight - IIF( ::lHeadSep, 1, 0 ) - ; + ::nFootHeight - IIF( ::lFootSep, 1, 0 ) + + RETURN IIF( nRows > 0, nRows, 0 ) + + +/* NOTE: CA-Cl*pper has a bug where negative nRowPos value will be translated + to 16bit unsigned int, so the behaviour will be different in this case. + [vszakats] */ +METHOD setRowPos( nRowPos ) CLASS TBROWSE + + LOCAL nRowCount, nRow + + nRowCount := ::rowCount /* executes doConfigure internally */ + + 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 + + +/* NOTE: CA-Cl*pper has a bug where negative nRowPos value will be translated + to 16bit unsigned int, so the behaviour will be different in this case. + [vszakats] */ +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 + + /* NOTE: CA-Cl*pper does not check at all on the parameters. */ + + AAdd( ::columns, oCol ) + ::configure( _TBR_CONF_COLUMNS ) + + RETURN Self + + +/* Delete a column object from a browse */ +METHOD delColumn( nColumn ) CLASS TBROWSE + + LOCAL oCol + + /* NOTE: CA-Cl*pper does not check at all on the parameters. */ +#ifndef HB_C52_STRICT + IF nColumn >= 1 .AND. nColumn <= ::colCount +#else + IF .T. /* It's optimized by compiler without any RT overhead */ +#endif + oCol := ::columns[ nColumn ] + ADel( ::columns, nColumn ) + ASize( ::columns, LEN( ::columns ) - 1 ) + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + RETURN oCol + + +/* Insert a column object in a browse */ +METHOD insColumn( nColumn, oCol ) CLASS TBROWSE + + /* NOTE: CA-Cl*pper does not check at all on the parameters. */ +#ifndef HB_C52_STRICT + IF nColumn >= 1 .AND. nColumn <= ::colCount + 1 +#else + IF .T. /* It's optimized by compiler without any RT overhead */ +#endif + HB_AIns( ::columns, nColumn, oCol ) + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + RETURN oCol + + +/* Replaces one TBColumn object with another */ +METHOD setColumn( nColumn, oCol ) CLASS TBROWSE + + LOCAL oPrevCol + + IF nColumn != NIL .AND. oCol != NIL + + nColumn := _eInstVar( Self, "COLUMN", nColumn, "N", 1001 ) + oCol := _eInstVar( Self, "COLUMN", oCol, "O", 1001 ) + + /* NOTE: CA-Cl*pper doesn't check nColumn range (and type in C5.3 - I didn't implement this behaviour), + but crashes instead. */ + +#ifndef HB_C52_STRICT + IF nColumn >= 1 .AND. nColumn <= ::colCount +#else + IF .T. /* It's optimized by compiler without any RT overhead */ +#endif + oPrevCol := ::columns[ nColumn ] + ::columns[ nColumn ] := oCol + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + ENDIF + + /* NOTE: CA-Cl*pper 5.2 NG says this will return the previously set + column, but it's returning Self instead. In C5.3 this bug + was fixed and it works as expected (except when wrong + parameter is passed, when it returns NIL). [vszakats] */ +#ifdef HB_C52_STRICT + RETURN Self +#else + RETURN oPrevCol +#endif + + +/* Gets a specific TBColumn object */ +METHOD getColumn( nColumn ) CLASS TBROWSE + +#ifdef HB_C52_STRICT + RETURN ::columns[ nColumn ] +#else + RETURN IIF( nColumn >= 1 .AND. nColumn <= ::colCount, ::columns[ nColumn ], NIL ) +#endif + + +METHOD footSep( cFootSep ) CLASS TBROWSE + + IF cFootSep != NIL + ::cFootSep := _eInstVar( Self, "FOOTSEP", cFootSep, "C", 1001 ) + ENDIF + + RETURN ::cFootSep + + +METHOD colSep( cColSep ) CLASS TBROWSE + + IF cColSep != NIL + ::cColSep := _eInstVar( Self, "COLSEP", cColSep, "C", 1001 ) + ENDIF + + RETURN ::cColSep + + +METHOD headSep( cHeadSep ) CLASS TBROWSE + + IF cHeadSep != NIL + ::cHeadSep := _eInstVar( Self, "HEADSEP", cHeadSep, "C", 1001 ) + ENDIF + + RETURN ::cHeadSep + + +METHOD skipBlock( bSkipBlock ) CLASS TBROWSE + + IF bSkipBlock != NIL + ::bSkipBlock := _eInstVar( Self, "SKIPBLOCK", bSkipBlock, "B", 1001 ) + ENDIF + + RETURN ::bSkipBlock + + +METHOD goTopBlock( bBlock ) CLASS TBROWSE + + IF bBlock != NIL + ::bGoTopBlock := _eInstVar( 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 := _eInstVar( Self, "GOBOTTOMBLOCK", bBlock, "B", 1001 ) + ENDIF + + RETURN ::bGoBottomBlock + + +METHOD nTop( nTop ) CLASS TBROWSE + + IF nTop != NIL + #ifdef HB_COMPAT_C53 + ::n_Top := _eInstVar( Self, "NTOP", nTop, "N", 1001 ) + IF !Empty( ::cBorder ) + ::n_Top++ + ENDIF + #else + ::n_Top := _eInstVar( Self, "NTOP", nTop, "N", 1001, {| o, x | HB_SYMBOL_UNUSED( o ), x >= 0 } ) + #endif + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + #ifdef HB_COMPAT_C53 + IF !Empty( ::cBorder ) + RETURN ::n_Top - 1 + ENDIF + #endif + + RETURN ::n_Top + + +METHOD nLeft( nLeft ) CLASS TBROWSE + + IF nLeft != NIL + #ifdef HB_COMPAT_C53 + ::n_Left := _eInstVar( Self, "NLEFT", nLeft, "N", 1001 ) + IF !Empty( ::cBorder ) + ::n_Left++ + ENDIF + #else + ::n_Left := _eInstVar( Self, "NLEFT", nLeft, "N", 1001, {| o, x | HB_SYMBOL_UNUSED( o ), x >= 0 } ) + #endif + ::configure( _TBR_CONF_COLUMNS ) + ENDIF + + #ifdef HB_COMPAT_C53 + IF !Empty( ::cBorder ) + RETURN ::n_Left - 1 + ENDIF + #endif + + RETURN ::n_Left + + +METHOD nBottom( nBottom ) CLASS TBROWSE + + IF nBottom != NIL + ::n_Bottom := _eInstVar( 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 := _eInstVar( 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_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 := ::n_Top ) .OR. ; + mRow > ( nBottom := ::n_Bottom ) .OR. ; + mCol < ( nLeft := ::n_Left ) .OR. ; + mCol > ( nRight := ::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 + 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, nRight, nPos, nCol, aCol + + mRow := MROW() + mCol := MCOL() + + nTop := oBrw:n_Top + nBottom := oBrw:n_Bottom + nLeft := oBrw:n_Left + nRight := oBrw:n_Right + + IF mRow >= nTop .AND. mRow <= nBottom .AND. ; + mCol >= nLeft .AND. mCol <= nRight + + 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 + 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 := _eInstVar( 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 := _eInstVar( 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 oBrowse:hitTest( nMRow, nMCol ) == HTCELL + IF oBrw:hitTest( nMRow, nMCol ) == HTCELL - n := oBrowse:mRowPos - oBrowse:rowPos - DO WHILE n < 0 - n++ - oBrowse:up() - ENDDO - DO WHILE n > 0 - n-- - oBrowse:down() - ENDDO + IF ( n := oBrw:mRowPos - oBrw:rowPos ) < 0 + WHILE ++n <= 0 + oBrw:up() + ENDDO + ELSEIF n > 0 + WHILE --n >= 0 + oBrw:down() + ENDDO + ENDIF - n := oBrowse:mColPos - oBrowse:colPos - DO WHILE n < 0 - n++ - oBrowse:left() - ENDDO - DO WHILE n > 0 - n-- - oBrowse:right() - ENDDO + IF ( n := oBrw:mColPos - oBrw:colPos ) < 0 + WHILE ++n <= 0 + oBrw:left() + ENDDO + ELSEIF n > 0 + WHILE --n >= 0 + oBrw:right() + ENDDO + ENDIF RETURN TBR_CONTINUE ENDIF RETURN TBR_EXCEPTION +#endif