FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour bChange
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
bChange
Posted: 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 ?

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
bChange
Posted: 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
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
bChange
Posted: Mon Sep 08, 2008 10:58 AM

All text or certain methods ?

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
bChange
Posted: Mon Sep 08, 2008 11:20 AM

All of it :-)

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
bChange
Posted: 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 Gimenez
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 &gt; nToSkip

     ( ::cAlias )-&gt;( DbSkip( -1 ) )

     If ::bFilter != Nil

        While ! Eval( ::bFilter ) .and. ! BoF()
           ( ::cAlias )-&gt;( DbSkip( -1 ) )
        EndDo

     EndIf

     If ( ::cAlias )-&gt;( Bof() )
        ( ::cAlias )-&gt;( 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 ) &lt; nElements
     If ::oTree == Nil
        ::aHeaders := Array( nElements )
        For nI := 1 to nElements
            ::aHeaders[ nI ] := ( cAlias )-&gt;( 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() ) &lt; 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 &gt; nMaxWidth )

    If nAdj &lt; 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 &gt; ::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 &gt;= 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 &lt; 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 &gt;= ::aSuperHead[ nI, 1 ] .and. nPos &lt;= ::aSuperHead[ nI, 2 ]

        ::aSuperHead[ nI, 2 ] --

        If ::aSuperHead[ nI, 2 ] &lt; ::aSuperHead[ nI, 1 ]
           ASize( ADel( ::aSuperHead, nI ), Len( ::aSuperHead ) - 1 )
        EndIf

     ElseIf nPos &lt; ::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 )-&gt;( 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 )-&gt;( RLock() )
             MsgStop( ::aMsg[ 40 ] , ::aMsg[ 28 ] )
             Return Self
          EndIf

          If ! ( cAlias )-&gt;( Deleted() )
             ( cAlias )-&gt;( DbDelete() )
             ( cAlias )-&gt;( DbUnlock() )
             ::nLen := ( cAlias )-&gt;( Eval( ::bLogicLen ) )

             If lUpStable
                ( cAlias )-&gt;( DbSkip() )
                lRefresh :=  ( cAlias )-&gt;( EOF() )
                ( cAlias )-&gt;( DbSkip( -1 ) )
                ::nRowPos -= If( lRefresh .and. ;
                                 ! ( cAlias )-&gt;( BOF() ), 1, 0 )
                ::Refresh( .T. )
             EndIf

          ElseIf lRecall
             ( cAlias )-&gt;( DbRecall() )
             ( cAlias )-&gt;( 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 )-&gt;( Deleted() )

             ::oDbf:Delete()
             ::nLen := ( cAlias )-&gt;( Eval( ::bLogicLen ) )

             If lUpStable
                ( cAlias )-&gt;( DbSkip() )
                lRefresh :=  ( cAlias )-&gt;( EOF() )
                ( cAlias )-&gt;( DbSkip( -1 ) )
                ::nRowPos -= If( lRefresh .and. ;
                                 ! ( cAlias )-&gt;( 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

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
bChange
Posted: 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
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
bChange
Posted: 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 ?

Posts: 4840
Joined: Fri Nov 18, 2005 04:52 PM
bChange
Posted: Mon Sep 08, 2008 02: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

FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
Posts: 1392
Joined: Mon May 14, 2007 09:49 AM
bChange
Posted: Tue Sep 09, 2008 06:54 AM

Thank, James !!!
It resolved my problem. :D

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
bChange
Posted: Tue Sep 09, 2008 08:30 AM

James,

Very good solution, thanks! :-)

regards, saludos

Antonio Linares
www.fivetechsoft.com

Continue the discussion