* ============================================================================
* 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