From 5342e731981e16117117ead668d56548eb6afa80 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 18 Apr 2008 00:53:09 +0000 Subject: [PATCH] 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. --- harbour/ChangeLog | 27 + harbour/source/rtl/tbrowse.prg | 4816 +++++++++++++++++--------------- 2 files changed, 2617 insertions(+), 2226 deletions(-) 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