* ============================================================================
* TSBrowse.PRG Version 7.0 Jul/15/2004
* ============================================================================
/* This Classs is a recapitulation of the code adapted by Luis Krause Mantilla,
of FiveWin classes: TCBrowse, TWBrowse, TCColumn and Clipper Wrapers in C
that support the visual Windows interface.
Originally TCBrowse was a Sub-Class of TWBrowse, with this work, we have the
new class "TSBrowse" that is no more a Sub-Class. Now, TSBrowse is an
independent control that inherits directly from TControl class.
My work has mainly consisted on putting pieces together with some extra from
my own crop.
Credits:
Luis Krause Mantilla
Selim Anter
Stan Littlefield
Marshall Thomas
Eric Yang
John Stolte
Harry Van Tassell
Martin Vogel
Katy Hayes
Jose -
Hernan Diego Ceccarelli ( some ideas taked from his TWBrowse )
Antonio Carlos Pantaglione (
Toninho@fwi.com.br )
TSBtnGet is an adaptation of the Ricardo Ramirez TBtnGet Class
Gianni Santamarina
Ralph del Castillo
Daniel Andrade
Yamil Bracho
Victor Manuel Tomбs (
VikThor)
FiveTechSoft (original classes)
Many thanks to all of them.
Regards.
Manuel Mercado. July 15th, 2004
Ў Aquн vamos ! | Ў Here we go !... */
//----------------------------------------------------------------------------//
#include "Fivewin.ch"
#include "TSBrw.ch" // trimmed version of TSBrowse.ch (only constants) to avoid preprocessor table overflow
#ifdef __XPP__
#define Super ::TControl
#define New _New
#xtranslate _DbSkipper => DbSkipper
#endIf
#ifdef __HARBOUR__
#xtranslate _DbSkipper => DbSkipper
#ifdef __HBOLE__
#define __OLE__
#endif
EXTERN OrdKeyNo, OrdKeyCount, OrdKeyGoto
#endif
#ifdef __CLIPPER__
#ifdef __OLE2__
#define __OLE__
#endif
#endif
// Windows 95 keyboard's "Context" key
// Tecla "Contexto" en el teclado Winsows 95
#define VK_CONTEXT 93
#define WM_SETFONT 48 // 0x0030
#define WM_ERASEBKGND 20 // 0x0014
// let's save DGroup space
// ahorremos espacio para DGroup
#define nsCol asTSB[1]
#define nsWidth asTSB[2]
#define nsOldPixPos asTSB[3]
#define bCxKeyNo asTSB[4]
#define bCmKeyNo asTSB[5]
#define nGap asTSB[6]
#define nNewEle asTSB[7]
#define nKeyPressed asTSB[8]
#define lNoAppend asTSB[9]
#define nInstance asTSB[10]
// api maximal vertical scrollbar position
#ifdef __CLIPPER__
#define MAX_POS 32767
#else
#define MAX_POS 65535
#endif
// mouse wheel Windows message
#define WM_MOUSEWHEEL 522
// to detect formatted text in memo fields
#define GTF5 "GTF" + Chr( 5 )
Extern TOleAuto
Static asTSB := { Nil, Nil, 0, Nil, Nil, 0, 0, Nil, Nil, Nil }
Static nLapsus
//----------------------------------------------------------------------------//
CLASS TSBrowse FROM TControl
CLASSDATA lRegistered AS LOGICAL
CLASSDATA aProperties AS ARRAY ;
INIT { "aColumns", "cVarName", "nTop", "nLeft", "nWidth", "nHeight" }
CLASSDATA lVScroll, lHScroll
DATA aActions // actions to be executed on header's click
DATA aColors // the whole colors kit
DATA aArray AS ARRAY // browsed array
DATA aBitmaps AS ARRAY INIT {} // array with bitmaps handles
DATA aDefault AS ARRAY INIT {} // default values in append mode
DATA aClipBoard // used by RButtonDown method
DATA aColSizes, aColumns, aHeaders // the core of TSBrowse
DATA aDefValue AS ARRAY INIT {} // for array in append mode
DATA aIcons AS ARRAY INIT {} // array with icons names
DATA aImages AS ARRAY INIT {} // array with bitmaps names
DATA aJustify // compatibility with TWBrowse
DATA aLine // bLine as array
DATA aMsg AS ARRAY INIT {} // multi languaje feature
DATA aKeyRemap AS ARRAY INIT {} // to prevalidate keys at KeyChar method
DATA aPostList // used by ComboWBlock function
DATA aSelected // selected items in select mode
DATA aSuperHead // array with SuperHeads properties
DATA bAddRec // custom function for adding record (with your own message)
DATA bBitMapH // bitmap handle
DATA bContext // evaluates windows keyboard context key
DATA bDelete // evaluated after user deletes a row with lCanDelete mode
DATA bFileLock // custom function for locking database (with your own message)
DATA bGoToPos // scrollbar block
DATA bFilter // a simple filter tool
DATA bIconDraw, bIconText // icons drawing directives
DATA bInit // code block to be evaluated on init
DATA bLine, bSkip, bGoTop, bGoBottom, ;
bLogicLen, bChange // navigation codeblocks
DATA bKeyNo // logical position on indexed databases
DATA bOnDraw // evaluated in DrawSelect()
DATA bPostDel // evaluated after record deletion
DATA bRecLock // custom function for locking record (with your own message)
DATA bSeekChange // used by seeking feature
DATA bSelected // to be evaluated in select mode
DATA bSetOrder // used by seeking feature
DATA bTagOrder // to restore index on GotFocus
DATA bUserKeys // user code block to change the
// behavior of pressed keys
DATA cAlias // data base alias or "ARRAY" or "TEXT_"
DATA cDriver // RDD in use
DATA cField, uValue1, uValue2 // SetFilter Params
DATA cOrderType // index key type for seeking
DATA cPrefix // used by TSBrowse search feature
DATA cSeek // used by TSBrowse search feature
DATA hBmpCursor AS NUMERIC // bitmap cursor for first column
DATA l3DLook AS LOGICAL INIT .F. READONLY // internally control state of ::Look3D() in "Phantom" column
DATA lHitTop, lHitBottom, lCaptured, lMChange // browsing flags
DATA lAppendMode AS LOGICAL INIT .F. READONLY // automatic append flag
DATA lAutoCtx AS LOGICAL // compatibility with TCBrowse
DATA lAutoEdit AS LOGICAL INIT .F. // activates continuous edition mode
DATA lAutoSkip AS LOGICAL INIT .F. // compatibility with TCBrowse
DATA lIconView AS LOGICAL INIT .F. // compatibility with TCBrowse
DATA lCellStyle AS LOGICAL INIT .F. // compatibility with TCBrowse
DATA lCanAppend AS LOGICAL INIT .F. READONLY // activates auto append mode
DATA lCanDelete AS LOGICAL INIT .F. HIDDEN // activates delete capability
DATA lCanSelect AS LOGICAL INIT .F. // activates select mode
DATA lCellBrw // celled browse flag
DATA lChanged AS LOGICAL INIT .F. // field has changed indicator
DATA lClipMore AS LOGICAL INIT .F. // ClipMore RDD
DATA lColDrag AS LOGICAL // dragging feature
DATA lConfirm AS LOGICAL INIT .T. HIDDEN // ask for user confirm to delete a row
DATA lDbfObj AS LOGICAL INIT .F. // using database objects
DATA lDescend AS LOGICAL INIT .F. // descending indexes
DATA lDestroy // flag to destroy bitmap created for selected records
DATA lDrawHeaders AS LOGICAL INIT .T. // condition for headers drawing
DATA lDrawFooters // condition for footers drawing
DATA lEditing AS LOGICAL INIT .F. READONLY // to avoid lost focus at editing time
DATA lFilterMode AS LOGICAL INIT .F. READONLY // index based filters with NTX RDD
DATA lFirstFocus HIDDEN // controls some actions on init
DATA lFirstPaint // controls some actions on init
DATA lFixCaret AS LOGICAL // TSGet fix caret at editing time
DATA lFooting AS LOGICAL // indicates footers can be drawn
DATA lNoPaint // to avoid unnecessary painting
DATA lGrasp AS LOGICAL INIT .F. READONLY // used by drag & drop feature
DATA lHasChanged AS LOGICAL INIT .F. // browsed data has changed flag for further actions
DATA lHasFocus AS LOGICAL INIT .F. // focused flag
DATA lIsArr // browsing an array
DATA lIsDbf AS LOGICAL INIT .F. READONLY // browsed object is a database
DATA lIsTxt // browsing a text file
DATA lIsV22 AS LOGICAL INIT .F. // true if oBmp:hBmpPal is not defined
DATA lLineDrag AS LOGICAL // TSBrowse dragging feature
DATA lLockFreeze AS LOGICAL // avoids cursor positioning on frozen columns
DATA lMoveCols AS LOGICAL // Choose between moving or exchanging columns (::moveColumn() or ::exchange())
DATA lNoExit AS LOGICAL INIT .F. // prevents edit exit with arrow keys
DATA lNoGrayBar AS LOGICAL // don't show inactive cursor
DATA lNoHScroll AS LOGICAL // disables horizontal scroll bar
DATA lNoLiteBar AS LOGICAL // no cursor
DATA lNoMoveCols AS LOGICAL INIT .F. // avoids resize or move columns by the user
DATA lNoResetPos AS LOGICAL // prevents to reset record position on gotfocus
DATA lNoVScroll AS LOGICAL // disables vertical scroll bar
DATA lLogicDrop AS LOGICAL // compatibility with TCBrowse
DATA lPageMode AS LOGICAL INIT .F. // paging mode flag
DATA lPainted AS LOGICAL // controls some actions on init
DATA lRePaint AS LOGICAL // bypass paint if false
DATA lPostEdit // to detect postediting
DATA lUndo AS LOGICAL INIT .F. // used by RButtonDown method
DATA lUpdated AS LOGICAL INIT .F. // replaces lEditCol return value
DATA lUpperSeek AS LOGICAL INIT .T. // controls if char expresions are seek in uppercase or not
DATA lSeek AS LOGICAL INIT .T. // activates TSBrowse seeking feature
DATA nAdjColumn AS NUMERIC // column expands to flush table window right
DATA nAligBmp AS NUMERIC INIT 0 // bitmap layout in selected cell
DATA nCell AS NUMERIC // actual column
DATA nClrHeadBack, nClrHeadFore // headers colors
DATA nClrFocuBack, nClrFocuFore // focused cell colors
DATA nClrEditBack, nClrEditFore // editing cell colors
DATA nClrFootBack, nClrFootFore // footers colors
DATA nClrSeleBack, nClrSeleFore // selected cell no focused
DATA nClrOrdeBack, nClrOrdeFore // order control column colors
DATA nClrLine // grid line color
DATA nColOrder AS NUMERIC // compatibility with TCBrowse
DATA nDragCol AS NUMERIC // drag & drop feature
DATA nFireKey // key to start edition, defaults to VK_F2
DATA nFirstKey AS NUMERIC INIT 0 HIDDEN // First logic pos in filtered databases
DATA nFreeze AS NUMERIC // 0,1,2.. freezes left most columns
DATA nHeightCell AS NUMERIC INIT 0 // resizable cell height
DATA nHeightHead AS NUMERIC INIT 0 // " header "
DATA nHeightFoot AS NUMERIC INIT 0 // " footer "
DATA nHeightSuper AS NUMERIC INIT 0 // " Superhead "
DATA nIconPos // compability with TCBrowse
DATA nLastPainted AS NUMERIC INIT 0 HIDDEN // last painted nRow
DATA nLastPos AS NUMERIC INIT 0 HIDDEN // last record position before lost focus
DATA nLastnAt AS NUMERIC INIT 0 HIDDEN // last ::nAt value before lost focus
DATA nLineStyle // user definable grid lines style
DATA nMaxFilter // maximum number of records to count
// on index based filters
DATA nMemoHE, nMemoWE, nMemoHV, nMemoWV // memo sizes on edit and view mode
// Height in lines and Width in pixels
// default: 3 lines height and 200 pixels width
DATA nOldCell HIDDEN // to control column bGotfocus
DATA nOffset AS NUMERIC INIT 0 HIDDEN // offset marker for text viewer
DATA nPhantom AS NUMERIC INIT PHCOL_GRID // controls drawing state for "Phantom" column (-1 or -2) inside ::Look3D()
DATA nPrevRec // internally used to go previous record back
DATA nRowPos, nAt AS NUMERIC INIT 0 // grid row positions
DATA nColPos AS NUMERIC INIT 0 // grid column position
DATA nColSel AS NUMERIC INIT 0 // column to mark in selected records
DATA nLen AS NUMERIC INIT 0 // total number of browsed items
DATA nWheelLines // lines to scroll with mouse wheel action
DATA oDbf AS OBJECT // TDbf / TDatabase object
DATA oCtx AS OBJECT READONLY // context object
DATA oGet // get object
DATA oItem // tree item object used by SetoTree()
DATA oPhant // phantom column
DATA oTree // tree object
DATA oTxtFile AS OBJECT // for text files browsing (TTxtFile() class)
DATA uBmpSel // bitmap to show in selected records
DATA uLastTag // last TagOrder before losing focus
METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, ;
aColSizes, oWnd, cField, uVal1, uVal2, bChange, ;
bLDblClick, bRClick, oFont, oCursor, aColors, ;
cMsg, lUpdate, uAlias, lPixel, bWhen, ;
lDesign, lCellBrw, nStyle, bLClick, aLine ) CONSTRUCTOR
METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1,;
uVal2, bChange, bLDblClick, bRClick, oFont,;
oCursor, nClrFore, nClrBack, cMsg, lUpdate,;
uAlias, bWhen, lCellBrw, bLClick, aLine ) CONSTRUCTOR
METHOD AddColumn( oColumn )
METHOD AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, ;
uFont, uBitMap, lAdjust, lTransp, lGrid, nHAlign, ;
nVAlign )
METHOD BeginPaint() INLINE If( ::lRepaint, Super:BeginPaint(), 0 )
METHOD BugUp() INLINE ::UpStable()
METHOD BiClr( uClrOdd, uClrPair )
METHOD ChangeFont( oFont, nColumn, nLevel )
METHOD DbSkipper( nToSkip )
METHOD Default()
METHOD Del( nItem )
METHOD DeleteRow()
METHOD DelColumn( nPos )
METHOD Destroy()
METHOD Display()
METHOD DrawFooters() INLINE ::DrawHeaders( .T. )
MESSAGE DrawIcon METHOD _DrawIcon( nIcon, lFocused )
METHOD DrawIcons()
METHOD DrawLine( nRow )
METHOD DrawPressed( nCell, lPressed )
METHOD DrawSelect()
METHOD DrawSuper()
METHOD DrawHeaders()
METHOD Edit( uVar, nCol, nKey, nFlags )
METHOD EditExit( nCol, nKey, uVar, bValid, lLostFocus )
METHOD EndPaint() INLINE If( ::lRePaint, Super:EndPaint(), ;
( ::lRePaint := .T., 0 ) )
METHOD Excel2( cXlsFile, lActivate, oMeter, cTitle, lSave )
#ifdef __OLE__
METHOD ExcelOle( cXlsFile, lActivate, oMeter, cTitle, oFont, lSave )
#endif
METHOD Exchange( nCol1, nCol2 ) INLINE ::SwitchCols( nCol1, nCol2), ;
::SetFocus()
METHOD ExpLocate( cExp )
METHOD ExpSeek( cExp, lSoft )
METHOD FreezeCol( lNext )
METHOD GetColSizes() INLINE ;
If( ValType( ::aColSizes ) == "A", ::aColSizes, Eval( ::aColSizes ) )
METHOD GetColumn( nCol )
METHOD GetDlgCode( nLastKey )
METHOD GetRealPos( nRelPos )
METHOD GetTxtRow( nRowPix ) INLINE ;
RowFromPix( ::hWnd, nRowPix, ::nHeightCell, ;
If( ::lDrawHeaders, ::nHeightHead, 0 ), ;
If( ::lFooting .and. ::lDrawFooters, ::nHeightFoot, 0 ), ;
If( ::lDrawHeaders, ::nHeightSuper, 0 ) )
METHOD GoBottom()
METHOD GoDown()
METHOD GoEnd()
METHOD GoHome()
METHOD GoLeft()
METHOD GoNext()
METHOD GoPos( nNewRow, nNewCol )
METHOD GoRight()
METHOD GotFocus( hCtlLost )
METHOD GoTop()
METHOD GoUp()
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD HiliteCell( nCol, nColPix )
METHOD HScroll( nWParam, nLParam )
METHOD HThumbDrag( nNewCol )
METHOD Init( hDlg ) INLINE ::Initiate( hDlg )
METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
METHOD InsColumn( nPos, oColumn )
METHOD Insert( cItem, nAt )
METHOD Inspect( cData )
METHOD IsColVisible( nCol )
METHOD IsColVis2( nCol )
METHOD IsEditable( nCol ) INLINE ::lCellBrw .and. ::aColumns[ nCol ]:lEdit .and. ;
( ::aColumns[ nCol ]:bWhen == Nil .or. ;
Eval( ::aColumns[ nCol ]:bWhen, Self ) )
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
METHOD KeyUp( nKey, nFlags )
METHOD LButtonDown( nRowPix, nColPix, nKeyFlags )
METHOD LButtonUp( nRowPix, nColPix, nKeyFlags )
METHOD lCloseArea() INLINE If( ::lIsDbf .and. ! Empty( ::cAlias ), ( ;
( ::cAlias )->( DbCloseArea() ), ;
::cAlias := "", .T. ), .F. )
METHOD LDblClick( nRowPix, nColPix, nKeyFlags )
METHOD lEditCol( uVar, nCol, cPicture, bValid, nClrFore, nClrBack )
METHOD lIgnoreKey( nKey, nFlags )
METHOD LoadFields( lEditable, aNames )
METHOD LoadRelated( cAlias, lEditable, aNames )
METHOD Look3D( lOnOff, nColumn, nLevel, lPhantom )
METHOD LostFocus( hCtlFocus )
METHOD MButtonDown( nRow, nCol, nKeyFlags )
METHOD MouseMove( nRowPix, nColPix, nKeyFlags )
METHOD MouseWheel( nKeys, nDelta, nXPos, nYPos )
METHOD MoveColumn( nColPos, nNewPos )
METHOD nAtCol( nColPix, lActual )
METHOD nAtIcon( nRow, nCol )
METHOD nColCount() INLINE Len( ::aColumns )
METHOD nLogicPos()
METHOD nRowCount() INLINE ;
CountRows( ::hWnd, ::nHeightCell, If( ::lDrawHeaders, ::nHeightHead, 0 ), ;
If( ::lFooting .and. ::lDrawFooters, ::nHeightFoot, 0 ), ;
If( ::lDrawHeaders, ::nHeightSuper, 0 ) )
METHOD PageUp( nLines )
METHOD PageDown( nLines )
METHOD Paint()
METHOD PanHome()
METHOD PanEnd()
METHOD PanLeft()
METHOD PanRight()
METHOD PostEdit( uTemp, nCol, bValid )
METHOD RButtonDown( nRowPix, nColPix, nKeyFlags )
MESSAGE RecCount METHOD _RecCount( uSeekValue )
METHOD Refresh( lPaint ) INLINE If( ::lFirstPaint == Nil .or. ::lFirstPaint, 0, ( ;
::lNoPaint := .F., Super:Refresh( lPaint ) ) )
METHOD RelPos( nLogicPos )
METHOD Report( cTitle, lPreview, oFont, cCaption, lModal, aCols, ;
cHeader, cFooter )
METHOD Reset( cField, uVal1, uVal2 )
METHOD ResetBarPos( lInit )
METHOD ResetSeek()
METHOD ReSize( nSizeType, nWidth, nHeight )
METHOD TSBrwScroll( nDir ) INLINE ;
TSBrwScroll( ::hWnd, nDir, If( ::oFont != nil, ::oFont:hFont, 0 ), ;
::nHeightCell, If( ::lDrawHeaders, ::nHeightHead, 0 ), ;
If( ValType( ::lDrawFooters ) == "L" .and. ;
::lDrawFooters , ::nHeightFoot, 0 ), ;
::nHeightSuper )
METHOD Seek( nKey )
METHOD Set3DText( lOnOff, nColumn, nLevel, nClrLight, nClrShadow )
METHOD SetAlign( nColumn, nLevel, nAlign )
METHOD SetAppendMode( lMode )
METHOD SetArray( aArray )
METHOD SetBtnGet( nCol, cResName, bAction, nBmpWidth )
METHOD SetColMsg( cMsg, cEditMsg, nCol )
METHOD SetColor( xColor1, xColor2, nColumn )
METHOD SetColSize( nCol, nWidth )
METHOD SetColumns( aData, aHeaders, aColSizes )
METHOD SetDeleteMode( lOnOff, lConfirm, bDelete, bPostDel )
METHOD SetHeaders( nHeight, aCols, aTitles, aAlign , al3DLook, aFonts, ;
aActions )
METHOD SetContext( oCtx ) INLINE If( oCtx == Nil, ;
::lAutoCtx := .F., ::oCtx := oCtx )
METHOD SetData( nColumn, bData, aList )
METHOD SetFilter( cField, uVal1, uVal2 )
METHOD SetFont( oFont )
METHOD SetIndexCols( aCols )
METHOD SetItems( aItems ) INLINE ::SetArray( aItems, .T. )
METHOD SetoDBF( oDbf )
METHOD SetOrder( nColumn, cPrefix )
METHOD SetSelectMode( lOnOff, bSelected, uBmpSel, nColSel, nAlign )
METHOD SetSpinner( nColumn, lOnOff, bUp, bDown, bMin, bMax )
METHOD SetTree( oTree )
METHOD SetTxtFile( uTxtFile, cTitle, lOemToAnsi )
METHOD ShowSizes()
METHOD Skip( n )
METHOD SortArray( nCol, lDescend )
METHOD SwitchCols( nCol1, nCol2 )
METHOD SyncChild( aoChildBrw, abAction )
METHOD UpStable()
METHOD Proper( cText )
METHOD VertLine( nColPos, nColInit, nGapp )
METHOD VScroll( nWParam, nLParam )
ENDCLASS
* ============================================================================
* METHOD TSBrowse:New() Version 7.0 Jul/15/2004
* ============================================================================
METHOD New( nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, oWnd,;
cField, uVal1, uVal2, bChange, bLDblClick, bRClick,;
oFont, oCursor, aColors, cMsg, lUpdate, uAlias, ;
lPixel, bWhen, lDesign, lCellBrw, nStyle, bLClick, aLine, ;
aActions, nLineStyle ) CLASS TSBrowse
Local aTmpColor := Array( 15 ), ;
cAlias := Alias()
#ifdef __XPP__
#undef New
#endif
If aColors != Nil
Aeval(aColors, { | bColor, nEle | aTmpColor[ nEle ] := bColor } )
EndIf
Default nRow := 0, ;
nCol := 0, ;
nHeight := 100, ;
nWidth := 100, ;
oWnd := GetWndDefault(), ;
nLineStyle := LINES_ALL, ;
aLine := {}
Default aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrText
aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrPane
aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrHeadFore
aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrHeadBack
aTmpColor[ 5 ] := GetSysColor( COLOR_CAPTIONTEXT ), ; // nClrForeFocu
aTmpColor[ 6 ] := GetSysColor( COLOR_ACTIVECAPTION ) // nClrFocuBack
Default aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrEditFore
aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrEditBack
aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrFootFore
aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrFootBack
aTmpColor[ 11 ] := CLR_HGRAY , ; // nClrSeleFore inactive focused
aTmpColor[ 12 ] := CLR_GRAY , ; // nClrSeleBack inactive focused
aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrOrdeFore
aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrOrdeBack
aTmpColor[ 15 ] := GetSysColor( COLOR_BTNSHADOW ) // nClrLine
Default lUpdate := .F., ;
lPixel := .F., ;
lDesign := .F., ;
aColSizes := {}, ;
lCellBrw := .F.
Default nStyle := nOr( WS_CHILD, WS_BORDER, WS_VISIBLE, WS_TABSTOP, 4, ;
If( lDesign, WS_CLIPSIBLINGS, 0 ) )
If ValType( uAlias ) == "A"
cAlias := "ARRAY"
ElseIf ValType( uAlias ) == "C" .and. "." $ uAlias
cAlias := "TEXT_" + AllTrim( uAlias )
ElseIf ValType( uAlias ) == "C"
cAlias := Upper( uAlias )
ElseIf ValType( uAlias ) == "O"
If Upper( uAlias:ClassName() ) == "TDATABASE" .or. ;
Upper( uAlias:ClassName() ) == "TDBF" .or. ;
Upper( uAlias:ClassName() ) == "TMULTIDBF"
cAlias := "ODBF"
ElseIf Upper( uAlias:ClassName() ) == "TTXTFILE"
cAlias := "TEXT_" + AllTrim( uAlias:cName )
ElseIf Upper( uAlias:ClassName() ) == "TLINKLIST"
cAlias := "TREE_"
EndIf
EndIf
::cCaption = ""
::nTop = nRow * If( lPixel, 1, BRSE_CHARPIX_H ) // 14
::nLeft = nCol * If( lPixel, 1, BRSE_CHARPIX_W ) //8
::nBottom = ::nTop + nHeight - 1
::nRight = ::nLeft + nWidth - 1
::oWnd = oWnd
::lHitTop = .F.
::lHitBottom = .F.
::lFocused = .F.
::lCaptured = .F.
::lMChange = .T.
::nRowPos = 1
::nAt = 1
::nColPos = 1
::nStyle = nStyle
::lAutoCtx = .T.
::lRePaint = .F.
::lNoHScroll = .F.
::lNoVScroll = .F.
::lNoLiteBar = .F.
::lNoGrayBar = .F.
::lLogicDrop = .F.
::lColDrag = .F.
::lLineDrag = .F.
::nFreeze = 0
::aColumns = {}
::nColOrder = 0
::cOrderType = ""
::lFooting = .F.
::nCell = 1
::lCellBrw = lCellBrw
::lMoveCols = .F.
::lLockFreeze = .F.
::lCanAppend = .F.
::lAppendMode = .F.
::aImages = {}
::aBitmaps = {}
::nId = ::GetNewId()
::cAlias = cAlias
::bLine = bLine
::aLine = aLine
::lAutoEdit = .F.
::lAutoSkip = .F.
::lIconView = .F.
::lCellStyle = .F.
::nIconPos = 0
::lMChange = .T.
::bChange = bChange
::bLClicked = bLClick
::bLDblClick = bLDblClick
::bRClicked = bRClick
::aHeaders = aHeaders
::aColSizes = aColSizes
::aJustify = {}
::nLen = 0
::lDrag = lDesign
::lDesign = lDesign
::lCaptured = .F.
::lPainted = .F.
::lNoResetPos = .T.
::oCursor = oCursor
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::aActions = aActions
::aColors = aTmpColor
::nLineStyle = nLineStyle
::aSelected = {}
::aSuperHead = {}
::lFixCaret = .F.
::oFont = oFont
::SetColor( , aTmpColor )
#ifdef __XPP__
DEFAULT ::lRegistered := .F.
#endif
::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS ) )
If ( ::lIsV22 := CheckBmpPal() )
::bBitMapH := &( "{|oBmp|If(oBmp!=Nil,oBmp:hBitMap,0)}" )
Else
::bBitMapH := &( "{|oBmp|If(oBmp!=Nil,nLoWord(oBmp:hBmpPal),0)}" )
EndIf
::lIsDbf := ! EmptyAlias( ::cAlias ) .and. ::cAlias != "ARRAY" .and. ;
! ( "TEXT_" $ ::cAlias ) .and. ::cAlias != "TREE_"
If ! Empty( ::oWnd:hWnd )
::Create()
If oFont != Nil
::SetFont( oFont )
EndIf
::lVisible = .T.
::Default()
::oWnd:AddControl( Self )
Else
::oWnd:DefControl( Self )
If oFont != Nil
::SetFont( oFont )
EndIf
::lVisible = .F.
EndIf
::nHeightFoot := 0
::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, If( ::oFont != Nil, ;
::oFont:hFont, 0 ), 0 )
::aMsg := LoadMsg()
If lDesign
::CheckDots()
EndIf
::SetFilter( cField, uVal1, uVal2 )
If ::cAlias == "ARRAY"
If ! Empty( uAlias ) .and. ValType( uAlias[ 1 ] ) != "A"
::SetItems( uAlias )
Else
::SetArray( uAlias )
EndIf
ElseIf "TEXT_" $ ::cAlias
::SetTxtFile( uAlias )
ElseIf ::cAlias == "ODBF"
::SetOdbf( uAlias )
ElseIf ::cAlias == "TREE_"
::SetTree( uAlias )
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:Redefine() Version 7.0 Jul/15/2004
* ============================================================================
METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1, ;
uVal2, bChange, bLDblClick, bRClick, oFont, oCursor, ;
aColors, cMsg, lUpdate, uAlias, bWhen, lCellBrw, bLClick, aLine, ;
aActions, nLineStyle ) CLASS TSBrowse
Local aTmpColor := Array(15), ;
cAlias := Alias()
If aColors != Nil
Aeval(aColors, { | bColor, nEle | aTmpColor[ nEle ] := bColor } )
EndIf
Default oDlg := GetWndDefault(), ;
nLineStyle := LINES_ALL, ;
aLine := {}
Default aTmpColor[ 1 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrText
aTmpColor[ 2 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrPane
aTmpColor[ 3 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrHeadFore
aTmpColor[ 4 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrHeadBack
aTmpColor[ 5 ] := GetSysColor( COLOR_HIGHLIGHTTEXT ), ; // nClrFocuFore
aTmpColor[ 6 ] := GetSysColor( COLOR_HIGHLIGHT ) // nClrFocuBack
Default aTmpColor[ 7 ] := GetSysColor( COLOR_WINDOWTEXT ), ; // nClrEditFore
aTmpColor[ 8 ] := GetSysColor( COLOR_WINDOW ) , ; // nClrEditBack
aTmpColor[ 9 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrFootFore
aTmpColor[ 10 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrFootBack
aTmpColor[ 11 ] := CLR_HGRAY , ; // nClrSeleFore NO focused
aTmpColor[ 12 ] := CLR_GRAY , ; // nClrSeleBack NO focused
aTmpColor[ 13 ] := GetSysColor( COLOR_BTNTEXT ) , ; // nClrOrdeFore
aTmpColor[ 14 ] := GetSysColor( COLOR_BTNFACE ) , ; // nClrOrdeBack
aTmpColor[ 15 ] := GetSysColor( COLOR_BTNSHADOW ) // nClrLine
Default lUpdate := .F.,;
aColSizes := {},;
lCellBrw := .F.
If ValType( uAlias ) == "A"
cAlias := "ARRAY"
ElseIf ValType( uAlias ) == "C" .and. "." $ uAlias
cAlias := "TEXT_" + AllTrim( uAlias )
ElseIf ValType( uAlias ) == "C"
cAlias := Upper( uAlias )
ElseIf ValType( uAlias ) == "O"
If Upper( uAlias:ClassName() ) == "TDATABASE" .or. ;
Upper( uAlias:ClassName() ) == "TDBF" .or. ;
Upper( uAlias:ClassName() ) == "TMULTIDBF"
cAlias := "ODBF"
ElseIf Upper( uAlias:ClassName() ) == "TTXTFILE"
cAlias := "TEXT_" + AllTrim( uAlias:cName )
ElseIf Upper( uAlias:ClassName() ) == "TLINKLIST"
cAlias := "TREE_"
EndIf
EndIf
::oWnd = oDlg
::lHitTop = .F.
::lHitBottom = .F.
::lFocused = .F.
::lCaptured = .F.
::lMChange = .T.
::nRowPos = 1
::nAt = 1
::nColPos = 1
::lAutoCtx = .T.
::lRePaint = .F.
::lNoHScroll = .F.
::lNoVScroll = .F.
::lNoLiteBar = .F.
::lNoGrayBar = .F.
::lLogicDrop = .F.
::lColDrag = .F.
::lLineDrag = .F.
::nFreeze = 0
::aColumns = {}
::nColOrder = 0
::cOrderType = ""
::lFooting = .F.
::nCell = 1
::lCellBrw = lCellBrw
::lMoveCols = .F.
::lLockFreeze = .F.
::lCanAppend = .F.
::lAppendMode = .F.
::aImages = {}
::aBitmaps = {}
::nId = nId
::cAlias = cAlias
::bLine = bLine
::aLine = aLine
::lAutoEdit = .F.
::lAutoSkip = .F.
::lIconView = .F.
::lCellStyle = .F.
::lPainted = .F.
::lNoResetPos = .T.
::nIconPos = 0
::lMChange = .T.
::bChange = bChange
::bLClicked = bLClick
::bLDblClick = bLDblClick
::bRClicked = bRClick
::aHeaders = aHeaders
::aColSizes = aColSizes
::aJustify = {}
::nLen = 0
::lDrag = .F.
::lCaptured = .F.
::oCursor = oCursor
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::aActions = aActions
::aColors = aTmpColor
::nLineStyle = nLineStyle
::aSelected = {}
::aSuperHead = {}
::lFixCaret = .F.
::oFont = oFont
::SetColor( , aTmpColor )
::Register( nOr( CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS ) )
oDlg:DefControl( Self )
If ( ::lIsV22 := CheckBmpPal() )
::bBitMapH := &( "{|oBmp|If(oBmp!=Nil,oBmp:hBitMap,0)}" )
Else
::bBitMapH := &( "{|oBmp|If(oBmp!=Nil,nLoWord(oBmp:hBmpPal),0)}" )
EndIf
If oFont != Nil
::SetFont( oFont )
EndIf
::nHeightFoot := 0
::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, If( ::oFont != Nil, ;
::oFont:hFont, 0 ), 0 ) + 1
::aMsg := LoadMsg()
::lIsDbf := ! EmptyAlias( ::cAlias ) .and. ::cAlias != "ARRAY" .and. ;
! ( "TEXT_" $ ::cAlias ) .and. ::oTree == Nil
::SetFilter( cField, uVal1, uVal2 )
If ::cAlias == "ARRAY"
If ! Empty( uAlias ) .and. ValType( uAlias[ 1 ] ) != "A"
::SetItems( uAlias )
Else
::SetArray( uAlias )
EndIf
ElseIf "TEXT_" $ ::cAlias
::SetTxtFile( uAlias )
ElseIf ::cAlias == "ODBF"
::SetOdbf( uAlias )
ElseIf ::cAlias == "TREE_"
::SetTree( uAlias )
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:AddColumn() Version 7.0 Jul/15/2004
* ============================================================================
METHOD AddColumn( oColumn ) CLASS TSBrowse
Local nHeight, nAt, cHeading, cRest, nOcurs, ;
hFont := If( ::oFont != Nil, ::oFont:hFont, 0 )
If ::lDrawHeaders
cHeading := If( Valtype( oColumn:cHeading ) == "B", ;
Eval( oColumn:cHeading ), oColumn:cHeading )
If Valtype( cHeading ) == "C" .and. ( nAt := At( Chr( 13 ), cHeading ) ) > 0
nOcurs := 1
cRest := Substr( cHeading, nAt + 2 )
While ( nAt := At( Chr( 13 ), cRest ) ) > 0
nOcurs++
cRest := Substr( cRest, nAt + 2 )
EndDo
nHeight := SBGetHeight( ::hWnd, If( oColumn:oFontHead != Nil, ;
oColumn:oFontHead:hFont, hFont ), 0 )
nHeight *= ( nOcurs + 1 )
If ( nHeight + 1 ) > ::nHeightHead
::nHeightHead := nHeight + 1
EndIf
EndIf
EndIf
If ValType( oColumn:cFooting ) $ "CB"
::lDrawFooters := If( ::lDrawFooters == Nil, .T., ::lDrawFooters )
::lFooting := ::lDrawFooters
cHeading := If( Valtype( oColumn:cFooting ) == "B", ;
Eval( oColumn:cFooting ), oColumn:cFooting )
If Valtype( cHeading ) == "C" .and. ( nAt := At( Chr( 13 ), cHeading ) ) > 0
nOcurs := 1
cRest := Substr( cHeading, nAt + 2 )
While ( nAt := At( Chr( 13 ), cRest ) ) > 0
nOcurs++
cRest := Substr( cRest, nAt + 2 )
EndDo
nHeight := SBGetHeight( ::hWnd, If( oColumn:oFontFoot != Nil, ;
oColumn:oFontFoot:hFont, hFont ), 0 )
nHeight *= ( nOcurs + 1 )
If ( nHeight + 1 ) > ::nHeightHead
::nHeightFoot := nHeight + 1
EndIf
Else
nHeight := SBGetHeight( ::hWnd, If( oColumn:oFontFoot != Nil, ;
oColumn:oFontFoot:hFont, hFont ), 0 ) + 1
If nHeight > ::nHeightFoot .and. ::lFooting
::nHeightFoot := nHeight
EndIf
EndIf
EndIf
AAdd( ::aColumns , oColumn )
AAdd( ::aColSizes, oColumn:nWidth )
If ::aPostList != Nil // from ComboWBlock function
If ATail( ::aColumns ):lComboBox
If ValType( ::aPostList[ 1 ] ) == "A"
ATail( ::aColumns ):aItems := AClone( ::aPostList[ 1 ] )
ATail( ::aColumns ):aData := AClone( ::aPostList[ 2 ] )
ATail( ::aColumns ):cDataType := ValType( ::aPostList[ 2, 1 ] )
Else
ATail( ::aColumns ):aItems := AClone( ::aPostList )
EndIf
EndIf
::aPostList := Nil
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:AddSuperHead() Version 7.0 Jul/15/2004
* ============================================================================
Method AddSuperHead( nFromCol, nToCol, uHead, nHeight, aColors, l3dLook, ;
uFont, uBitMap, lAdjust, lTransp, ;
lNoLines, nHAlign, nVAlign ) CLASS TSBrowse
Local cHeading, nAt, nLheight, nOcurs, cRest, nLineStyle, ;
nClrText, nClrBack, nClrLine, ;
hFont := If( ::oFont != Nil, ::oFont:hFont, 0 )
If Empty( ::aColumns )
Return Nil
EndIf
Default lAdjust := .F., ;
l3DLook := ::aColumns[ nFromCol ]:l3DLookHead, ;
nHAlign := DT_CENTER, ;
nVAlign := DT_CENTER, ;
lTransp := .T., ;
uHead := ""
uFont := If( uFont != Nil, If( ValType( uFont ) == "O", uFont:hFont, ;
uFont ), uFont )
hFont := If( ValType( ::aColumns[ nFromCol]:oFontHead ) == "O", ;
::aColumns[ nFromCol]:oFontHead:hFont, ;
If( ::aColumns[ nFromCol]:oFontHead != Nil, ;
::aColumns[ nFromCol]:oFontHead, hFont ) )
hFont := If( uFont != Nil, uFont, hFont )
If ValType( aColors ) == "A"
ASize( aColors, 3 )
nClrText := If( aColors[ 1 ] != Nil, aColors[ 1 ], ::aColumns[ nFromCol ]:nClrHeadFore )
nClrBack := If( aColors[ 2 ] != Nil, aColors[ 2 ], ::aColumns[ nFromCol ]:nClrHeadBack )
nClrLine := If( aColors[ 3 ] != Nil, aColors[ 3 ], ::nClrLine )
Else
nClrText := ::aColumns[ nFromCol ]:nClrHeadFore
nClrBack := ::aColumns[ nFromCol ]:nClrHeadBack
nClrLine := ::nClrLine
EndIf
If uBitMap != Nil .and. ValType( uBitMap ) != "L"
Default lNoLines := .T.
cHeading := If( ValType( uBitMap ) == "B", Eval( uBitMap ), uBitMap )
cHeading := If( ValType( cHeading ) == "O", Eval( ::bBitMapH, cHeading ), cHeading )
nLheight := SBmpHeight( cHeading )
If nHeight != Nil
If nHeight < nLHeight .and. lAdjust
nLheight := nHeight
ElseIf nHeight > nLheight
nLheight := nHeight
EndIf
EndIf
If ( nLheight + 1 ) > ::nHeightSuper
::nHeightSuper := nLHeight + 1
EndIf
Else
uBitMap := Nil
EndIf
cHeading := If( Valtype( uHead ) == "B", Eval( uHead ), uHead )
Do Case
Case Valtype( cHeading ) == "C" .and. ( nAt := At( Chr( 13 ), cHeading ) ) > 0
Default lNoLines := .F.
nOcurs := 1
cRest := Substr( cHeading, nAt + 2 )
While ( nAt := At( Chr( 13 ), cRest ) ) > 0
nOcurs++
cRest := Substr( cRest, nAt + 2 )
EndDo
nLheight := SBGetHeight( ::hWnd, hFont, 0 )
nLheight *= ( nOcurs + 1 )
nLheight := If( nHeight == Nil .or. nLheight > nHeight, ;
nLheight, nHeight )
If ( nLheight + 1 ) > ::nHeightSuper
::nHeightSuper := nLHeight + 1
EndIf
Case Valtype( cHeading ) == "C"
Default lNoLines := .F.
nLheight := SBGetHeight( ::hWnd, hFont, 0 )
nLheight := If( nHeight == Nil .or. nLheight > nHeight, ;
nLheight, nHeight )
If ( nLheight + 1 ) > ::nHeightSuper
::nHeightSuper := nLHeight + 1
EndIf
Case Valtype( cHeading ) == "N" .or. ValType( cHeading ) == "O"
Default lNoLines := .T.
uBitMap := uHead
If ValType( cHeading ) == "O"
uHead := Eval( ::bBitMapH, cHeading )
EndIf
nLheight := SBmpHeight( uHead )
uHead := ""
If nHeight != Nil
If nHeight < nLHeight .and. lAdjust
nLheight := nHeight
ElseIf nHeight > nLheight
nLheight := nHeight
EndIf
EndIf
If ( nLheight + 1 ) > ::nHeightSuper
::nHeightSuper := nLHeight + 1
EndIf
EndCase
nLineStyle := If( lNoLines, 0, 1 )
AAdd( ::aSuperHead, { nFromCol, nToCol, uHead, nClrText, nClrBack, ;
l3dLook, hFont, uBitMap, lAdjust, nLineStyle, ;
nClrLine, nHAlign, nVAlign, lTransp } )
Return Self
* ============================================================================
* METHOD TSBrowse:BiClr() Version 7.0 Jul/15/2004
* ============================================================================
METHOD BiClr( uClrOdd, uClrPair ) CLASS TSBrowse
uClrOdd := If( ValType( uClrOdd ) == "B", Eval( uClrOdd, Self ), ;
uClrOdd )
uClrPair := If( ValType( uClrPair ) == "B", Eval( uClrPair, Self ), ;
uClrPair )
Return If( ::nAt % 2 > 0, uClrOdd, uClrPair )
* ============================================================================
* METHOD TSBrowse:ChangeFont() Version 7.0 Jul/15/2004
* ============================================================================
METHOD ChangeFont( oFont, nColumn, nLevel ) CLASS TSBrowse
Local nEle, ;
lDrawFooters := If( ::lDrawFooters != Nil, ::lDrawFooters, .F. )
Default nColumn := 0 // all columns
If nColumn == 0
If nLevel == Nil
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFont := oFont
Next
If ::lDrawHeaders
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFontHead := oFont
Next
EndIf
If ::lFooting .and. lDrawFooters
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFontFoot := oFont
Next
EndIf
Else
Do Case
Case nLevel == 1 // nLevel 1 = Cells
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFont := oFont
Next
Case nLevel == 2 .and. ::lDrawHeaders // nLevel 2 = Headers
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFontHead := oFont
Next
Case nLevel == 3 .and. ::lFooting .and. lDrawFooters // nLevel 3 = Footers
For nEle := 1 TO Len( ::aColumns )
::aColumns[ nEle ]:oFontFoot := oFont
Next
EndCase
EndIf
Else
If nLevel == Nil
::aColumns[ nColumn ]:oFont := oFont
If ::lDrawHeaders
::aColumns[ nColumn ]:oFontHead := oFont
EndIf
If ::lFooting .and. lDrawFooters
::aColumns[ nColumn ]:oFontFoot := oFont
EndIf
Else
Do Case
Case nLevel == 1 // nLevel 1 = Cells
::aColumns[ nColumn ]:oFont := oFont
Case nLevel == 2 .and. ::lDrawHeaders // nLevel 2 = Headers
::aColumns[ nColumn ]:oFontHead := oFont
Case nLevel == 3 .and. ::lFooting .and. lDrawFooters // nLevel 3 = Footers
::aColumns[ nColumn ]:oFontFoot := oFont
EndCase
EndIf
EndIf
If ::lPainted
SetHeights( Self )
::Refresh( .F. )
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:DbSkipper() Version 7.0 Jul/15/2004
* ============================================================================
METHOD DbSkipper( nToSkip ) CLASS TSBrowse
Local nSkipped := 0
Default nToSkip := 0, ;
::nAt := 1
If nToSkip == 0 .or. ( ::cAlias )->( LastRec() ) == 0
( ::cAlias )->( dbSkip( 0 ) )
ElseIf nToSkip > 0 .and. ! ( ::cAlias )->( EoF() ) // going down
While nSkipped < nToSkip
( ::cAlias )->( DbSkip( 1 ) )
If ::bFilter != Nil
While ! Eval( ::bFilter ) .and. ! EoF()
( ::cAlias )->( DbSkip( 1 ) )
EndDo
EndIf
If ( ::cAlias )->( Eof() )
If ::lAppendMode
nSkipped ++
Else
( ::cAlias )->( DbSkip( -1 ) )
EndIf
Exit
EndIf
nSkipped ++
Enddo
ElseIf nToSkip < 0 .and. ! ( ::cAlias )->( BoF() ) // going up
While nSkipped > nToSkip
( ::cAlias )->( DbSkip( -1 ) )
If ::bFilter != Nil
While ! Eval( ::bFilter ) .and. ! BoF()
( ::cAlias )->( DbSkip( -1 ) )
EndDo
EndIf
If ( ::cAlias )->( Bof() )
( ::cAlias )->( DbGoTop() )
Exit
EndIf
nSkipped --
Enddo
EndIf
::nAt += nSkipped
Return nSkipped
* ============================================================================
* METHOD TSBrowse:Default() Version 7.0 Jul/15/2004
* ============================================================================
METHOD Default() CLASS TSBrowse
Local nI, nTemp, nElements, aFields, nHeight, nStyle, nMin, nMax, nPage, ;
bBlock, aJustify, cBlock, ;
nWidth := 0, ;
nTxtWid := 0, ;
nMaxWidth := ::nWidth() - If( ::oVScroll != Nil, 16, 0 ), ;
cAlias := Alias(), ;
hFont := If( ::oFont != Nil, ::oFont:hFont, 0 ), ;
nAdj := ::nAdjColumn
Default ::aHeaders := {}, ;
::aColSizes := {}, ;
::nOldCell := 1, ;
::lIsTxt := "TEXT_" $ ::cAlias
::lIsArr := ::cAlias == "ARRAY"
If ::bLine == Nil .and. Empty( ::aColumns )
If Empty( ::cAlias )
::cAlias := cAlias
Else
cAlias := ::cAlias
EndIf
If Upper( ::oWnd:ClassName() ) != "TDIALOG" .and. ::lFirstPaint == Nil
If ::lDrag
::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, hFont, 0 )
EndIf
Return Self
EndIf
If ! EmptyAlias( ::cAlias ) .and. ! ::lIsArr .and. ! ::lIsTxt
::LoadFields()
EndIf
EndIf
::lFirstPaint := .F.
If ::bLine != Nil .and. Empty(::aColumns)
Default nElements := Len( Eval(::bLine) )
aJustify := Afill( Array( nElements ), 0 )
aJustify := Afill( Array( nElements ), 0 )
If Len( ::aHeaders ) < nElements
If ::oTree == Nil
::aHeaders := Array( nElements )
For nI := 1 to nElements
::aHeaders[ nI ] := ( cAlias )->( FieldName( nI ) )
Next
Else
::aHeaders := Array( nElements )
AFill( ::aHeaders, "" )
EndIf
EndIf
If ValType( ::aColSizes ) == "B"
::aColSizes := Eval( ::aColSizes )
EndIf
aFields := Eval( ::bLine )
If Len( ::GetColSizes() ) < nElements
::aColSizes := Afill( Array( nElements ), 0 )
nTxtWid := SBGetHeight( ::hWnd, hFont, 1 )
For nI := 1 TO nElements
::aColSizes[ nI ] := If( ValType( aFields[ nI ] ) != "C", 16, ; // Bitmap handle
( nTxtWid * ;
Max( Len( ::aHeaders[ nI ] ), ;
Len( aFields[ nI ] ) ) + 1 ) )
Next
EndIf
If ::oItem != Nil
::nLineStyle := 0
EndIf
For nI := 1 To nElements
If ValType( aFields[ nI ] ) == "N" .or. ;
ValType( aFields[ nI ] ) == "D"
aJustify[ nI ] := 2
ElseIf ValType( aFields[ nI ] ) == "B"
If ValType( Eval( aFields[ nI ] ) ) == "N" .or. ;
ValType( Eval( aFields[ nI ] ) ) == "D"
aJustify[ nI ] := 2
Else
aJustify[ nI ] := 0
EndIf
Else
aJustify[ nI ] := 0
EndIf
Next
For nI := 1 To nElements
bBlock := If( ValType( Eval( ::bLine )[ nI ] ) == "B", ;
Eval( ::bLine )[ nI ], MakeBlock( Self, nI ) )
cBlock := If( ValType( Eval( ::bLine )[ nI ] ) == "B", ::aLine[ nI ], ;
"{||" + cValToChar( ::aLine[ nI ] ) + "}" )
::AddColumn( TSColumn():New( ::aHeaders[ nI ], bBlock,, { ::nClrText, ::nClrPane, ;
::nClrHeadFore, ::nClrHeadBack, ::nClrFocuFore, ;
::nClrFocuBack }, ;
{aJustify[ nI ], 1}, ::aColSizes[ nI ],, ;
ValType( Eval( ::bLine )[ nI ] ) == "B",,,,,,, ;
5,, {.F., .T.},, Self, cBlock ) )
Next
If Upper( ::oWnd:ClassName() ) != "TDIALOG"
If ::lDrag
::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, hFont, 0 )
EndIf
Return Self
EndIf
EndIf
::lIsDbf := ! EmptyAlias( ::cAlias ) .and. ! ::lIsArr .and. ;
! ::lIsTxt .and. ::cAlias != "TREE_"
ASize( ::aColSizes, Len( ::aColumns ) ) // make sure they match sizes
// rebuild build the aColSize, it's needed to Horiz Scroll etc
// and expand selected column to flush table window right
For nI := 1 To Len( ::aColumns )
nTemp := ::aColSizes[ nI ] := ::aColumns[ nI ]:nWidth
If ! Empty( nAdj ) .and. ( nWidth + nTemp > nMaxWidth )
If nAdj < nI
::aColumns[ nAdj ]:nWidth := ;
::aColSizes[ nAdj ] += ( nMaxWidth - nWidth )
EndIf
nAdj := 0
EndIf
nWidth += nTemp
If ::lIsDbf .and. ! Empty( ::aColumns[ nI ]:cOrder ) .and. ;
! ::aColumns[ nI ]:lEdit
If ::nColOrder == 0
::SetOrder( nI ) // establish cOrder as the active index/tag
EndIf
::aColumns[ nI ]:lIndexCol := .T.
EndIf
If ValType( ::aColumns[ nI ]:cFooting ) $ "CB" // informs browse that it has footings to display
::lDrawFooters := If( ::lDrawFooters == Nil, .T., ::lDrawFooters )
::lFooting := ::lDrawFooters
nHeight := SBGetHeight( ::hWnd, ;
If( ::aColumns[ nI ]:oFontFoot != Nil, ;
::aColumns[ nI ]:oFontFoot:hFont, hFont ), 0 ) + 1
If nHeight > ::nHeightFoot .and. ::lFooting
::nHeightFoot := nHeight
EndIf
EndIf
Next
// now catch the odd-ball where last column doesn't fill box
If ! Empty( nAdj ) .and. nWidth < nMaxWidth .and. nAdj < nI
::aColumns[ nAdj ]:nWidth := ;
::aColSizes[ nAdj ] += ( nMaxWidth - nWidth )
EndIf
If ::bLogicLen != Nil
::nLen := If( ::lIsDbf, ( ::cAlias )->( Eval( ::bLogicLen ) ), ;
Eval( ::bLogicLen ) )
EndIf
If ! ::lNoVScroll
nMin := Min( 1, ::nLen )
nMax := Min( ::nLen, MAX_POS )
nPage := Min( ::nRowCount(), ::nLen )
::oVScroll := TSBScrlBar():WinNew( nMin, nMax, nPage, .T., Self )
EndIf
#ifdef USE_CONTEXT
If ::oCtx == Nil .and. ! Empty( ::cAlias ) .and. ! ::lIsArr .and. ;
! ::lIsTxt .and. ::lAutoCtx
// a context hasn't been established, and not browsing arrays
If ::lDbfObj
::oCtx := TWAContext():New( ::oDbf:cAlias )
Else
::oCtx := TWAContext():New( ::cAlias )
EndIf
EndIf
#endif
If ::cDriver == Nil
::ResetBarPos( .T. ) // first time call inits RDD specific ORD functions
EndIf
If ::oTree != Nil
::lDrawHeaders := .F.
::nLineStyle := 0
::lNoHScroll := .F.
::nFreeze := Min( 2, ( Len( ::aColumns ) - 1 ) )
EndIf
If ! ::lNoHScroll
If ! Empty( ::cAlias ) .and. ::lIsTxt
nTxtWid := Max( 1, GetTextWidth( 0, "B", hFont ) )
nMin := 1
nMax := ::oTxtFile:nMaxLineLength - Int( nMaxWidth / nTxtWid )
::oHScroll := TSBScrlBar():WinNew( nMin, nMax,, .F., Self )
Else
nMin := Min( 1, Len( ::aColumns ) )
nMax := Len( ::aColumns )
::oHScroll := TSBScrlBar():WinNew( nMin, nMax,, .F., Self )
EndIf
EndIf
For nI := 1 To Len( ::aColumns )
If ::aColumns[ nI ]:oFont == Nil
::aColumns[ nI ]:oFont := ::oFont
EndIf
If ::aColumns[ nI ]:oFontHead == Nil
::aColumns[ nI ]:oFontHead := ::oFont
EndIf
If ::aColumns[ nI ]:oFontFoot == Nil
::aColumns[ nI ]:oFontFoot := ::oFont
EndIf
If ::lLockFreeze .and. ::nFreeze >= nI
::aColumns[ nI ]:lNoHilite := .T.
EndIf
Next
::nHeightHead := If( ::lDrawHeaders, ::nHeightHead, 0 )
::nHeightFoot := If( ::lFooting .and. ::lDrawFooters, ::nHeightFoot, 0 )
If ! ::lNoVScroll
nPage := Min( ::nRowCount(), ::nLen )
::oVScroll:SetPage( nPage, .T. )
EndIf
If ! ::lNoHScroll
nPage := 1
::oHScroll:SetPage( nPage, .T. )
EndIf
If Len( ::aColumns ) > 0
::HiliteCell( Max( ::nCell, ::nFreeze + 1 ) )
EndIf
::nOldCell := ::nCell
nLapsus := Seconds()
If ::oBrush != Nil .and. ::oBrush:hBrush != ::oWnd:oBrush:hBrush
::oBrush:nCount++
EndIf
If Upper( ::oWnd:ClassName() ) == "TDIALOG"
::Move( ::nTop, ::nLeft, ::nWidth(), ::nHeight(), .T. )
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:Del() Version 7.0 Jul/15/2004
* Only for array browse. (ListBox behavior)
* ============================================================================
METHOD Del( nItem ) CLASS TSBrowse
Default nItem := ::nAt
If ! ::lIsArr
Return Self
EndIf
ADel( ::aArray, nItem )
ASize( ::aArray, Len( ::aArray ) - 1 )
::nLen := Eval( ::bLogicLen )
::Refresh()
Return Self
* ============================================================================
* METHOD TSBrowse:DelColumn() Version 7.0 Jul/15/2004
* ============================================================================
METHOD DelColumn( nPos ) CLASS TSBrowse
Local oCol, nMin, nMax, nI, ;
nLen := Len( ::aSuperHead )
Default nPos := 1
If Len( ::aColumns ) == 1 // cannot delete last column
Return Nil // ... or Nil if last column
EndIf
If nPos < 1
nPos := 1
ElseIf nPos > Len( ::aColumns )
nPos := Len( ::aColumns )
EndIf
oCol := ::aColumns[ nPos ]
ASize( ADel( ::aColumns, nPos ), Len( ::aColumns ) - 1 )
ASize( ADel( ::aColSizes, nPos ), Len( ::aColSizes ) - 1 )
If ::nColOrder == nPos // deleting a ::SetOrder() column
::nColOrder := 0 // to avoid runtime error
::cOrderType := ""
ElseIf ::nColOrder != 0 .and. ::nColOrder > nPos .and. ;
::nColOrder <= Len( ::aColumns )
::nColOrder --
EndIf
If ::nCell > Len( ::aColSizes )
If ! ::IsColVisible( ::nCell - 1 )
::GoLeft()
Else
::nCell--
EndIf
EndIf
::HiliteCell( ::nCell ) // make sure we have a hilited cell
If ::lNoHScroll
nMin := Min( 1, Len( ::aColumns ) )
nMax := Len( ::aColumns )
::oHScroll := TSBScrlBar():WinNew( nMin, nMax,, .F., Self )
::oHScroll:SetRange( 1, Len( ::aColumns ) )
::oHScroll:SetPage( 1 , .T. )
If ::nCell == Len( ::aColSizes )
::oHScroll:GoBottom()
Else
::oHScroll:SetPos( ::nCell )
EndIf
EndIf
If ! Empty( ::aSuperHead )
For nI := 1 To nLen
If nPos >= ::aSuperHead[ nI, 1 ] .and. nPos <= ::aSuperHead[ nI, 2 ]
::aSuperHead[ nI, 2 ] --
If ::aSuperHead[ nI, 2 ] < ::aSuperHead[ nI, 1 ]
ASize( ADel( ::aSuperHead, nI ), Len( ::aSuperHead ) - 1 )
EndIf
ElseIf nPos < ::aSuperHead[ nI, 1 ]
::aSuperHead[ nI, 1 ] --
::aSuperHead[ nI, 2 ] --
EndIf
Next
EndIf
::SetFocus()
::Refresh( .F. )
Return oCol
* ============================================================================
* METHOD TSBrowse:DeleteRow() Version 7.0 Jul/15/2004
* ============================================================================
METHOD DeleteRow() CLASS TSBrowse
Local lRecall, lUpStable, nAt, nRowPos, nRecNo, lRefresh, cAlias, ;
lEval
If ! ::lCanDelete
Return Self
EndIf
If ::lDbfObj
cAlias := ::oDbf:cAlias
ElseIf ::lIsDbf
cAlias := ::cAlias
EndIf
nRecNo := ( cAlias )->( RecNo() )
lRecall := ! Set( _SET_DELETED )
lUpStable := ! lRecall
If ! ::lIsTxt .and. ::oTree == Nil
If ::lConfirm .and. ;
! MsgYesNo( If( ::lIsDbf, ::aMsg[ 37 ], ::aMsg[ 38 ] ), ::aMsg[ 39 ] )
Return Self
EndIf
If ::lAppendMode
Return Self
EndIf
::SetFocus()
If ::lIsDbf
( cAlias )->( DbGoTo( nRecNo ) )
EndIf
Do Case
Case ::lIsDbf .and. ::oDbf == Nil
lEval := .T.
If ::bDelete != Nil
lEval := Eval( ::bDelete, nRecNo, Self )
EndIf
If ValType( lEval ) == "L" .and. ! lEval
Return Self
EndIf
If ! ( cAlias )->( RLock() )
MsgStop( ::aMsg[ 40 ] , ::aMsg[ 28 ] )
Return Self
EndIf
If ! ( cAlias )->( Deleted() )
( cAlias )->( DbDelete() )
( cAlias )->( DbUnlock() )
::nLen := ( cAlias )->( Eval( ::bLogicLen ) )
If lUpStable
( cAlias )->( DbSkip() )
lRefresh := ( cAlias )->( EOF() )
( cAlias )->( DbSkip( -1 ) )
::nRowPos -= If( lRefresh .and. ;
! ( cAlias )->( BOF() ), 1, 0 )
::Refresh( .T. )
EndIf
ElseIf lRecall
( cAlias )->( DbRecall() )
( cAlias )->( DbUnlock() )
EndIf
If ::lCanAppend .and. ::nLen == 0
::nRowPos := ::nColPos := 1
::PostMsg( WM_KEYDOWN, VK_DOWN, nMakeLong( 0, 0 ) )
EndIf
If ::bPostDel != Nil
Eval( ::bPostDel , Self )
EndIf
::lHasChanged := .T.
Case ::oDbf != Nil
lEval := .T.
If ::bDelete != Nil
lEval := Eval( ::bDelete, nRecNo, Self )
EndIf
If ( ValType( lEval ) == "L" .and. ! lEval )
Return Self
EndIf
If ! ( cAlias )->( Deleted() )
::oDbf:Delete()
::nLen := ( cAlias )->( Eval( ::bLogicLen ) )
If lUpStable
( cAlias )->( DbSkip() )
lRefresh := ( cAlias )->( EOF() )
( cAlias )->( DbSkip( -1 ) )
::nRowPos -= If( lRefresh .and. ;
! ( cAlias )->( BOF() ), 1, 0 )
::Refresh( .T. )
EndIf
ElseIf lRecall
::oDbf:Recall()
EndIf
If ::lCanAppend .and. ::nLen == 0
::nRowPos := ::nColPos := 1
::PostMsg( WM_KEYDOWN, VK_RETURN, nMakeLong( 0, 0 ) )
EndIf
If ::bPostDel != Nil
Eval( ::bPostDel , Self )
EndIf
::lHasChanged := .T.
Case ::lIsArr
nAt := ::nAt
nRowPos := ::nRowPos
lEval := .T.
If ::bDelete != Nil
lEval := Eval( ::bDelete, nAt, Self )
EndIf
If ValType( lEval ) == "L" .and. ! lEval
Return Self
EndIf
ADel( ::aArray, nAt )
ASize( ::aArray, Len( ::aArray ) - 1 )
If Len( ::aArray ) == 0
::aArray := { AClone( ::aDefValue ) }
If ::aArray[ 1, 1 ] == Nil
ADel( ::aArray[ 1 ], 1 )
ASize( ::aArray[ 1 ], Len( ::aArray[ 1 ] ) - 1 )
EndIf
EndIf
If ::bPostDel != Nil
Eval( ::bPostDel , Self )
EndIf
::lHasChanged := .T.
::nLen := Len( ::aArray )
::nAt := Min( nAt, ::nLen )
::nRowPos := Min( nRowPos, ::nLen )
::Refresh( .T. )
::DrawSelect()
Endcase
Else
::SetFocus()
::DrawSelect()
EndIf
Return Self
* ============================================================================
* METHOD TSBrowse:Destroy() Version 7.0 Jul/15/2004
* ============================================================================
METHOD Destroy() CLASS TSBrowse
Default ::lDestroy := .F.
If ::uBmpSel != Nil .and. ::lDestroy
::uBmpSel:End()
EndIf
If ::oCtx != Nil
::oCtx:Destroy()
EndIf
If ::oTxtFile != Nil
::oTxtFile:Close()
EndIf
If ::oFont != Nil
::oFont:End()
EndIf
If ::oBrush != Nil
::oBrush:End()
EndIf
If ::oVScroll != Nil
::oVScroll:Destroy()
EndIf
If ::oHScroll != N