bChange

bChange

Postby Natter » Mon Sep 08, 2008 10:39 am

Hi, all !
The TSBrowse codeblock bChange be in process after change position.
Can I an event(oe a signal) which results to the change of TSBrowse position before change of position has been performed ?
Natter
 
Posts: 1222
Joined: Mon May 14, 2007 9:49 am

Postby Antonio Linares » Mon Sep 08, 2008 10:47 am

Natter,

Please post here the source code of the Class TSBrowse that you are using, thanks
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42118
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Natter » Mon Sep 08, 2008 10:58 am

All text or certain methods ?
Natter
 
Posts: 1222
Joined: Mon May 14, 2007 9:49 am

Postby Antonio Linares » Mon Sep 08, 2008 11:20 am

All of it :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42118
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Natter » Mon Sep 08, 2008 11:34 am

* ============================================================================
* 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
Natter
 
Posts: 1222
Joined: Mon May 14, 2007 9:49 am

Postby Antonio Linares » Mon Sep 08, 2008 11:42 am

Natter,

It is not complete. Please post the missing part too, thanks :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42118
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Natter » Mon Sep 08, 2008 12:04 pm

I dont' have the mistake !
I want understand how to intercept an event(oe a signal) which results to the change of TSBrowse position before change of position has been performed ?
Natter
 
Posts: 1222
Joined: Mon May 14, 2007 9:49 am

Postby James Bott » Mon Sep 08, 2008 2:05 pm

>I want understand how to intercept an event(oe a signal) which results to the change of TSBrowse position before change of position has been performed ?

Use the bSkip codeblock. Something like this.

oBrw:bSkip:= { | nRecs | doWhatever(), (cAlias)->(dbskip( nRecs ) }

Regards,
James
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Postby Natter » Tue Sep 09, 2008 6:54 am

Thank, James !!!
It resolved my problem. :D
Natter
 
Posts: 1222
Joined: Mon May 14, 2007 9:49 am

Postby Antonio Linares » Tue Sep 09, 2008 8:30 am

James,

Very good solution, thanks! :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42118
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 60 guests