ottonico
-
Posts
19 -
Joined
-
Last visited
Posts posted by ottonico
-
-
Olá,
Gostaria de um exemplo funcional com a Classe TSPLITTER.
Encontrei na documentação alguns exemplos com um ou 2 splitter VERTICAL. O que preciso é de uma Windows com um Splitter VERTICAL e outro HORIZONTAL. Isso é possÃvel? Eu não consegui codificar, um sempre fica remontando sobre o outro.
Obrigado,
Birô 2000.
xHB + FWH 2.7 April 2006 + Pelles C + WinVista;
-
Pessoal,
Parabéns por mais esse encontro de programadores FW. O evento é sempre muito produtivo, tanto pelas palestras quanto pelo networking.
Pena que não deu pra tomar cerveja dessa vez, mas fica para o próximo encontro.
Luciano
-
Pessoal,
Parabéns por mais esse encontro de programadores FW. O evento é sempre muito produtivo, tanto pelas palestras quanto pelo networking.
Pena que não deu pra tomar cerveja dessa vez, mas fica para o próximo encontro.
Luciano
-
Pessoal,
Parabéns por mais esse encontro de programadores FW. O evento é sempre muito produtivo, tanto pelas palestras quanto pelo networking.
Pena que não deu pra tomar cerveja dessa vez, mas fica para o próximo encontro.
Luciano
-
Alberto,
Bom dia,
Tentei fazer as alterações que você me orientou, mas a versão da minha TcBrowse está diferente da sua. Estou utilizando o FiveWin 2.7, de Abril de 2006. Não me recordo de ter esse problema nas versões anteriores do Fivewin. Estou tendo com o Five 2.7.
Segue o código da TcBrowse, se você puder me dizer qual o trecho você alterou eu agradeço:
/////////////////////////////////////////////////////////
#include "Fivewin.ch"
#include "Report.ch"
#include "TcBrowse.ch"
#define K_BS 8
#define LINES_3D 3
#ifdef __XPP__
#define Super ::TWBrowse
#define New _New
#endif
// #define USE_CONTEXT // comment out if not using TWAContext() object
//----------------------------------------------------------------------------//
CLASS TCBrowse FROM TWBrowse
CLASSDATA lRegistered AS LOGICAL
CLASSDATA aProperties AS ARRAY ;
INIT { "aColumns", "cVarName", "nTop", "nLeft", "nWidth", "nHeight" }
DATA aColumns, aArray AS ARRAY
DATA lNoHScroll, lNoLiteBar, lNoGrayBar, lLogicDrop AS LOGICAL
DATA nAdjColumn AS NUMERIC // column expands to flush table window right
DATA lRePaint AS LOGICAL // bypass paint if false
DATA nFreeze AS NUMERIC // 0,1,2.. freezes left most columns
DATA oDbf AS OBJECT
DATA oCtx AS OBJECT
DATA lColDrag, lLineDrag AS LOGICAL
DATA nDragCol AS NUMERIC
DATA lAutoCtx AS LOGICAL
DATA hBmpCursor AS NUMERIC // bitmap cursor for first column
DATA bSeekChange AS CODEBLOCK // added tws 5/15/95
DATA cSeek AS String // added tws 5/15/95
DATA nColOrder AS NUMERIC // added tws 5/15/95
DATA nOClrForeHead AS NUMERIC // added tws 5/15/95
DATA nOClrBackHead AS NUMERIC // added tws 5/15/95
DATA cOrderType AS String // added hmvt
DATA aImages // array with bitmaps names
DATA aBitmaps // array with bitmaps handles
METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, ;
aColSizes, oWnd, cField, uVal1, uVal2, bChange,;
bLDblClick, bRClick, oFont, oCursor, nClrFore,;
nForeBack, cMsg, lUpdate, cAlias, lPixel, bWhen,;
lDesign, bValid ) CONSTRUCTOR
METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1,;
uVal2, bChange, bLDblClick, bRClick, oFont,;
oCursor, nClrFore, nClrBack, cMsg, lUpdate,;
cAlias, bWhen, bValid ) CONSTRUCTOR
METHOD Destroy() INLINE If( ::oCtx != Nil, ::oCtx:Destroy(), nil ), ;
Super:Destroy() // destroy ClipMore filter
METHOD GotFocus() INLINE If( ::oCtx != nil, ::oCtx:Restore(), nil ), ;
Super:GotFocus() // get context first
METHOD Inspect( cData )
METHOD LoadFields()
METHOD LostFocus( hCtlFocus ) INLINE Super:LostFocus( hCtlFocus ), ; // save context last
If( ::oCtx != nil, ::oCtx:Save(), nil )
METHOD BeginPaint() INLINE If(::lRepaint, Super:BeginPaint(), 0 )
METHOD Paint()
METHOD EndPaint() INLINE If(::lRePaint, Super:EndPaint(), ;
(::lRePaint := .t., 0) )
METHOD Default()
METHOD DrawLine( nRow )
METHOD DrawSelect( )
METHOD DrawHeaders( )
METHOD ResetSeek() // added tws 15/5/95
METHOD SetOrder(nColumn) // added tws 15/5/95
METHOD GoDown() // added tws 15/5/95
METHOD GoUp() // added tws 15/5/95
METHOD Seek( nKey ) // added tws 15/5/95
METHOD PageUp(nLines) // added tws 15/5/95
METHOD PageDown(nLines) // added tws 15/5/95
METHOD KeyChar( nKey, nFlags ) // restored to support seek on pressing a key
METHOD LButtonDown( nRowPix, nColPix, nKeyFlags )
METHOD LButtonUp( nRowPix, nColPix, nKeyFlags )
METHOD LDblClick( nRowPix, nColPix, nKeyFlags )
METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack, ;
cMsg, cError )
METHOD nAtCol( nColPix, lActual )
METHOD MouseMove( nRowPix, nColPix, nKeyFlags )
METHOD Report( cTitle, lPreview )
METHOD Reset() INLINE ::nRowPos := 1, ::nColPos := 1, ;
If(::oVScroll != nil, (;
::oVScroll:SetRange( 1, ::nLen := Eval( ::bLogicLen, Self ) ), ;
::oVScroll:SetPos( 1 ) ), nil), ::Refresh(.t.)
METHOD ResetBarPos()
METHOD SetArray( aArray )
METHOD SetoDBF( oDbf )
METHOD SetContext( oCtx ) INLINE If( oCtx == nil, ;
::lAutoCtx := .f., ::oCtx := oCtx )
METHOD VertLine( nColPos, nColInit )
METHOD AddColumn( oColumn ) INLINE AAdd( ::aColumns , oColumn ), ;
AAdd( ::aColSizes, oColumn:nWidth ),;
oColumn
METHOD SwitchCols( nCol1, nCol2)
METHOD Exchange( nCol1, nCol2) INLINE ::SwitchCols( nCol1, nCol2), ;
::Refresh(.f.), ::SetFocus()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, aColSizes, oWnd,;
cField, uVal1, uVal2, bChange, bLDblClick, bRClick,;
oFont, oCursor, nClrFore, nClrBack, cMsg, lUpdate, cAlias,;
lPixel, bWhen, lDesign, bValid ) CLASS TCBrowse
DEFAULT lDesign := .f., aColSizes := {}
// I asked AL to Chg TWBrowse:New() change ::sStyle = nOr(... to
// DEFAULT ::nStyle := nOr(... so we can modify the style
// NS HMVT you gotta take WS_HSCROLL out otherwise you always get it
::nStyle := nOr( WS_CHILD, WS_VSCROLL, ; // WS_HSCROLL,;
WS_BORDER, WS_VISIBLE, WS_TABSTOP,;
If( lDesign, WS_THICKFRAME, 0 ) )
::lAutoCtx := .t.
::lRePaint := .f.
::lNoHScroll := .f.
::lNoLiteBar := .f.
::lNoGrayBar := .f.
::lLogicDrop := .f.
::lColDrag := .f.
::lLineDrag := .f.
::nFreeze := 0
::aColumns := {}
::nColOrder := 0
::cOrderType := ""
::aImages := {}
::aBitmaps := {}
DEFAULT ::lRegistered := .f.
Super:New( nRow, nCol, nWidth, nHeigth, bLine, aHeaders, aColSizes, oWnd, ;
cField, uVal1, uVal2, bChange, bLDblClick, bRClick, ;
oFont, oCursor, nClrFore, nClrBack, cMsg, lUpdate, cAlias, ;
lPixel, bWhen, lDesign, bValid )
#ifdef __XPP__
#undef New
#endif
Return self
//----------------------------------------------------------------------------//
METHOD ReDefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1, uVal2,;
bChange, bLDblClick, bRClick, oFont, oCursor,;
nClrFore, nClrBack, cMsg, lUpdate, cAlias,;
bWhen, bValid ) CLASS TCBrowse
DEFAULT aColSizes := {}
::lAutoCtx := .t.
::lRePaint := .f.
::lNoHScroll := .f.
::lNoLiteBar := .f.
::lNoGrayBar := .f.
::lLogicDrop := .f.
::lColDrag := .f.
::lLineDrag := .f.
::nFreeze := 0
::aColumns := {}
::nColOrder := 0
::cOrderType := ""
::aImages := {}
::aBitmaps := {}
Super:Redefine( nId, bLine, oDlg, aHeaders, aColSizes, cField, uVal1, uVal2, ;
bChange, bLDblClick, bRClick, oFont, oCursor, ;
nClrFore, nClrBack, cMsg, lUpdate, cAlias,;
bWhen, bValid )
Return self
//----------------------------------------------------------------------------//
METHOD LoadFields() CLASS TcBrowse
local n, oCol
for n = 1 to ( ::cAlias )->( FCount() )
::AddColumn( oCol := TcColumn():New( ( ::cAlias )->( FieldName( n ) ),;
FieldSetGetBlock( ::cAlias, n ) ) )
oCol:lEdit = .t.
oCol:cData = ::cAlias + "->" + FieldName( n )
if ( ::cAlias )->( ValType( FieldGet( n ) ) ) == "N"
oCol:nAlign = 2 // RIGHT
endif
next
return nil
//----------------------------------------------------------------------------//
static function FieldSetGetBlock( cAlias, n )
return { | u | If( PCount() == 0,;
( cAlias )->( FieldGet( n ) ),;
( cAlias )->( FieldPut( n, u ) ) ) }
//----------------------------------------------------------------------------//
METHOD nAtCol( nColPixel, lActual ) CLASS TCBrowse
local nColumn := ::nColPos - 1
local aSizes := ::GetColSizes()
local nI, nPos := 0
DEFAULT lActual := .f.
if ::nFreeze > 0
if lActual
nColumn := 0
else
for nI := 1 to ::nFreeze
nPos += ::GetColSizes()[ nI ]
next
endif
endif
while nPos < nColPixel .and. nColumn < Len( aSizes )
nPos += aSizes[ nColumn + 1 ]
nColumn++
end
return nColumn
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TCBrowse
local nI := 1
local nLines := ::nRowCount() + If( ::lNoHScroll, 1, 0 )
local nSkipped := 1
local nRecs
local aInfo := ::DispBegin()
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
// check to bypass area paint routines
if ! ::lRePaint
::DispEnd( aInfo )
return 0
endif
if ::lIconView
::DispEnd( aInfo )
::DrawIcons()
return 0
endif
if ::nRowPos == 1 .and. ( ! Empty( ::cAlias ) ) .and. ;
::cAlias != "ARRAY"
( ::cAlias )->( DbSkip( -1 ) )
if ! ( ::cAlias )->( BoF() )
( ::cAlias )->( DbSkip() )
endif
endif
::DrawHeaders()
if ! ::lFocused .and. ::oCtx != nil
::oCtx:Restore() // window not in focus but needs repainting
endif
if Eval( ::bLogicLen, Self ) == 0
::DispEnd( aInfo )
return 0
endif
::Skip( -::nRowPos + 1) // If(::lNoHScroll, 0, 1 ) )
while nI <= nLines .and. nSkipped == 1
::DrawLine( nI )
nSkipped = ::Skip( 1 )
if nSkipped == 1
nI++
endif
end
::Skip( ::nRowPos - nI )
if ( nRecs := Eval( ::bLogicLen, Self ) ) < ::nRowPos
::nRowPos = nRecs
endif
::DrawSelect()
if ! ::lFocused .and. ::oCtx != nil
::oCtx:Save()
endif
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD DrawHeaders( ) CLASS TCBrowse
Local nI, nJ, nBegin, nStartCol, oColumn, nLastCol
Local nMaxWidth := ::nWidth()
Local aColSizes := ::aColSizes // use local copies for speed
Local aColumns := ::aColumns
Local hFont := If( ::oFont != nil, ::oFont:hFont, 0 )
Local hWnd := ::hWnd, hDC := ::hDC
Local nClrForeHead := ::nClrForeHead
Local nClrBackHead := ::nClrBackHead
Local nOClrForeHead := if(::nOClrForeHead = Nil, ;
nClrForeHead,::nOClrForeHead)
Local nOClrBackHead := if(::nOClrBackHead = Nil, ;
nClrBackHead,::nOClrBackHead)
if ::aColSizes == nil .or. Len( ::aColSizes ) < Len( ::aColumns )
::aColSizes = {}
for nI = 1 to Len( ::aColumns )
AAdd( ::aColSizes, ::aColumns[ nI ]:nWidth )
next
aColSizes = ::aColSizes
endif
nJ := nStartCol := 0
nLastCol := Len(aColumns) // last col width -1 is flag for TCDrawCell
nBegin := Min(If(::nColPos <= ::nFreeze, (::nColPos := ::nFreeze+1,;
::nColPos-::nFreeze),::nColPos-::nFreeze), nLastCol )
if Empty( aColumns )
return Self
endif
for nI := nBegin to nLastCol
if ( nStartCol > nMaxWidth )
Exit
endif
nJ := If( nI < ::nColPos, nJ+1, nI)
oColumn := aColumns[ nJ ]
TCDrawCell( hWnd, hDC, ;
0, nStartCol, If( nJ < nLastCol, aColSizes[ nJ ], -1), ;
oColumn:cHeading, oColumn:nAlign, ;
if(!Empty(oColumn:cOrder),nOClrForeHead,nClrForeHead), ;
if(nJ = ::nColOrder,nOClrBackHead,nClrBackHead), ;
hFont,,, LINES_3D )
// if(nJ = ::nColOrder,nOClrForeHead,nClrForeHead), ;
nStartCol += aColSizes[ nJ ]
next
Return( Self )
//----------------------------------------------------------------------------//
METHOD DrawLine( xRow ) CLASS TCBrowse
Local nI, nJ, nBegin, nStartCol, oColumn, lBitMap, cPicture
Local nClrFore, bClrFore, nClrBack, bClrBack
Local nMaxWidth := ::nWidth()
Local nRowPos := ::nRowPos // use local copies for speed
Local aColSizes := ::aColSizes, nLastCol
Local aColumns := ::aColumns
Local hFont := If( ::oFont != nil, ::oFont:hFont, 0 )
Local hWnd := ::hWnd, hDC := ::hDc
if Eval( ::bLogicLen, Self ) > 0
nJ := nStartCol := 0
nLastCol := Len(aColumns) // last col width -1 is flag for TCDrawCell
nBegin := Min(If(::nColPos <= ::nFreeze, (::nColPos := ::nFreeze+1,;
::nColPos-::nFreeze),::nColPos-::nFreeze), nLastCol )
for nI := nBegin to nLastCol
if ( nStartCol > nMaxWidth )
Exit
endif
nJ := If( nI < ::nColPos, nJ+1, nI)
oColumn := aColumns[ nJ ]
cPicture := oColumn:cPicture
lBitMap := oColumn:lBitMap
if (bClrFore := oColumn:bClrFore) == nil
nClrFore := ::nClrText
else
nClrFore := bClrFore
endif
if ValType( nClrFore ) == "B"
nClrFore := Eval( nClrFore, If( xRow == nil, nRowPos, xRow ), nJ )
endif
if (bClrBack := oColumn:bClrBack) == nil
nClrBack := ::nClrPane
else
nClrBack := bClrBack
endif
if ValType( nClrBack ) == "B"
nClrBack := Eval( nClrBack, If( xRow == nil, nRowPos, xRow ), nJ )
endif
TCDrawCell( hWnd, hDC , ;
If( xRow == nil, nRowPos, xRow ) , nStartCol ,;
If( nJ < nLastCol, aColSizes[ nJ ], -1) , ;
if( cPicture == nil, ;
If( lBitMap, If( ! Empty( ::aBitmaps ),;
::aBitmaps[ Eval( oColumn:bData ) ], Eval( oColumn:bData ) ), ;
cValToChar( Eval( oColumn:bData )) ), ;
Transform( Eval( oColumn:bData ), cPicture ) ), ;
oColumn:nAlign , ;
nClrFore, nClrBack, ;
hFont,;
If(lBitMap, 1, 0),, ::nLineStyle )
nStartCol += aColSizes[ nJ ]
next
endif
Return( Self )
//----------------------------------------------------------------------------//
METHOD DrawSelect() CLASS TCBrowse
local nI, nJ, nBegin, nStartCol, oColumn, nLastCol, lBitMap, cPicture
local bClrFore, bClrBack, nClrFore, nClrBack, lNoLite, uData
local nMaxWidth := ::nWidth()
local nRowPos := ::nRowPos // use local copies for speed
local aColSizes := ::aColSizes
local aColumns := ::aColumns
local hFont := If( ::oFont != nil, ::oFont:hFont, 0 )
local hWnd := ::hWnd, hDC := ::hDc, lFocused := ::lFocused
local nClrForeFocus := ::nClrForeFocus
local nClrBackFocus := ::nClrBackFocus
if ( ::lNoLiteBar .or. (::lNoGrayBar .and. !::LFocused) )
::DrawLine() // don't want no hilited cursor bar of any color
elseif Eval( ::bLogicLen, Self ) > 0
nJ := nStartCol := 0
nLastCol := Len(aColumns) // last col width -1 is flag for TCDrawCell
nBegin := Min(If(::nColPos <= ::nFreeze, (::nColPos := ::nFreeze+1,;
::nColPos-::nFreeze),::nColPos-::nFreeze), nLastCol )
for nI := nBegin to nLastCol
if ( nStartCol > nMaxWidth )
Exit
endif
nJ := If( nI < ::nColPos, nJ+1, nI)
oColumn := aColumns[ nJ ]
if nJ == 1 .and. ! Empty( ::hBmpCursor )
uData := ::hBmpCursor
lBitMap := .t.
lNoLite := .t.
else
uData := Eval( oColumn:bData )
cPicture := oColumn:cPicture
lBitMap := oColumn:lBitMap
lNoLite := oColumn:lNoLite
endif
if lNoLite
if (bClrFore := oColumn:bClrFore) == nil // text
nClrFore := ::nClrText
else
nClrFore := bClrFore
endif
if ValType( nClrFore ) == "B"
nClrFore = Eval( nClrFore, nRowPos, nJ )
endif
if (bClrBack := oColumn:bClrBack) == nil // backgnd nClrBackFocus
nClrBack := ::nClrPane
else
nClrBack := bClrBack
endif
if ValType( nClrBack ) == "B"
nClrBack = Eval( nClrBack, nRowPos, nJ )
endif
else
if ! ::lCellStyle .or. ::nColAct == nJ
nClrFore := nClrForeFocus
else
if (bClrFore := oColumn:bClrFore) == nil // backgnd nClrBackFocus
nClrFore = ::nClrText
else
nClrFore = Eval( bClrFore )
endif
if ValType( nClrFore ) == "B"
nClrFore = Eval( nClrFore, nRowPos, nJ )
endif
endif
if ! ::lCellStyle .or. ::nColAct == nJ
nClrBack := nClrBackFocus
else
if (bClrBack := oColumn:bClrBack) == nil // backgnd nClrBackFocus
nClrBack = ::nClrPane
else
nClrBack = Eval( bClrBack )
endif
if ValType( nClrBack ) == "B"
nClrBack = Eval( nClrBack, nRowPos, nJ )
endif
endif
endif
TCDrawCell( hWnd, hDC, ;
nRowPos, nStartCol, If( nJ < nLastCol, aColSizes[ nJ ], -1), ;
if( cPicture == nil, ;
If( lBitMap, If( ! Empty( ::aBitmaps ),;
::aBitmaps[ uData ], uData ), ;
cValToChar( Eval( oColumn:bData ) ) ), ;
Transform( uData, cPicture ) ), ;
oColumn:nAlign, ;
nClrFore, ;
If( lFocused .or. lNoLite,;
nClrBack,;
If( ::lCellStyle, If( nJ == ::nColAct, CLR_GRAY, nClrBack ), CLR_GRAY ) ),;
hFont, ;
If(lBitMap, If(lNoLite, 1, 2), 0),, ::nLineStyle )
nStartCol += aColSizes[ nJ ]
next
endif
Return( Self )
//----------------------------------------------------------------------------//
METHOD SetoDbf( oDbf ) CLASS TCBrowse
::oDbf = oDbf
if ( Upper( oDbf:ClassName() ) == "TMULTIDBF")
// setup for the parent as the controlling oDbf
::oCtx := oDbf:oCtx
::oDbf:oParent:bBof = nil
::oDbf:oParent:bEof = nil
else
::oDbf:bBof = nil // get rid of those pesky
::oDbf:bEof = nil // dialog boxes
endif
::nRowPos := 1 // reinitialize for multiple calls to this method
::nColPos := 1
::cAlias = "DBFOBJECT" // don't change name, used in method Default()
::bLogicLen = { || ::oDbf:RecCount() }
::bGoTop = { || ::oDbf:GoTop() }
::bGoBottom = { || ::oDbf:GoBottom() }
::bSkip = { | nSkip | ::oDbf:Skipper( nSkip ) }
return nil
//----------------------------------------------------------------------------//
METHOD SetArray( aArray ) CLASS TCBrowse
DEFAULT aArray := {}
::aArray = aArray // NS HMVT added this, it's NICE to have
::nAt = 1
::cAlias = "ARRAY" // don't change name, used in method Default()
::bLogicLen = { || Len( ::aArray ) }
::bGoTop = { || ::nAt := 1 }
::bGoBottom = { || ::nAt := Eval( ::bLogicLen ) }
::bSkip = { | nSkip, nOld | nOld := ::nAt, ::nAt += nSkip,;
::nAt := Min( Max( ::nAt, 1 ), Eval( ::bLogicLen, Self ) ),;
::nAt - nOld }
::nRowPos := 1 // reinitialize for multiple calls to this method
::nColPos := 1
if ::oVScroll != nil
::oVScroll:SetRange( 1, ::nLen := Eval( ::bLogicLen, Self ) )
::oVScroll:SetPos( 1 )
endif
if ::oHScroll != nil
::oHScroll:SetPos( 1 )
endif
return nil
//----------------------------------------------------------------------------//
METHOD Default() CLASS TCBrowse
local nI, nTemp, nWidth := 0
local nMaxWidth := ::nWidth() - 16
ASize( ::aColSizes, Len( ::aColumns ) ) // make sure they match sizes
If( Empty(::nOClrForeHead), ::nOClrForeHead := CLR_HRED, )
If( Empty(::nOClrBackHead), ::nOClrBackHead := CLR_HBLUE, )
// 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(::nAdjColumn).and.(nWidth + nTemp > nMaxWidth)
if ::nAdjColumn < nI
::aColumns[::nAdjColumn]:nWidth := ;
::aColSizes[::nAdjColumn] += (nMaxWidth - nWidth)
endif
::nAdjColumn := 0
endif
nWidth += nTemp
if (::nColOrder == 0) .and. (::cAlias != "ARRAY") .and. ;
( !Empty(::aColumns[nI]:cOrder) )
::SetOrder( nI ) // establish a default if one exists
endif
next
// now catch the odd-ball where last column doesn't fill box
if !Empty(::nAdjColumn).and.(nWidth < nMaxWidth).and.(::nAdjColumn < nI)
::aColumns[::nAdjColumn]:nWidth := ;
::aColSizes[::nAdjColumn] += (nMaxWidth - nWidth)
::nAdjColumn := 0
endif
::nLen = Eval( ::bLogicLen, Self )
IF ::nLen == nil
::nLen = 0
ENDIF
DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self ;
RANGE Min( 1, ::nLen ), ::nLen
#ifdef USE_CONTEXT
if ::oCtx == nil .and. ( !Empty(::cAlias) .and. ::cAlias != "ARRAY" ) ;
.and. ::lAutoCtx
// a context hasn't been established, and not browsing arrays
if ::cAlias == "DBFOBJECT"
::oCtx := TWAContext():New( ::oDbf:cAlias )
else
::oCtx := TWAContext():New( ::cAlias )
endif
endif
#endif
// if ::oCtx != nil .and. !Empty(::oCtx:uRecNo)
// ::oVScroll:SetPos( ::oCtx:uRecNo )
// endif
::ResetBarPos()
if !::lNoHScroll
DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self ;
RANGE Min( 1, Len( ::GetColSizes() ) ), Len( ::GetColSizes() )
endif
if ::oFont == nil
::oFont = ::oWnd:oFont
endif
return self
//----------------------------------------------------------------------------//
METHOD MouseMove( nRowPix, nColPix, nKeyFlags ) CLASS TCBrowse
local nI, nColPixPos := 0, lHeader, lMChange, lFrozen := .f., nIcon
DEFAULT ::lMouseDown := .f.
if ::lIconView
if ( nIcon := ::nAtIcon( nRowPix, nColPix ) ) != 0
if ::nIconPos != 0 .and. ::nIconPos != nIcon
::DrawIcon( ::nIconPos )
endif
::nIconPos = nIcon
::DrawIcon( nIcon, .t. )
CursorHand()
return 0
endif
endif
lHeader := nTCWRow( ::hWnd, ::hDC, nRowPix,;
If( ::oFont != nil, ::oFont:hFont, 0 ) ) == 0
if ::lDrag
return Super:MouseMove( nRowPix, nColPix, nKeyFlags )
endif
if ::nFreeze > 0
for nI := 1 to ::nFreeze
nColPixPos += ::GetColSizes()[ nI ]
next
if (nColPix < nColPixPos)
lFrozen := .t.
endif
endif
if lFrozen .or. !lHeader .or. !::lMChange
// don't allow MouseMove to drag/resize columns
// unless in header row and not in frozen zone
CursorArrow()
if ::lCaptured
if ::lLineDrag
::VertLine()
::lLineDrag := .f.
endif
ReleaseCapture()
::lColDrag := ::lCaptured := ::lMouseDown := .f.
endif
lMChange := ::lMChange // save it for restore
::lMChange := .f.
Super:MouseMove( nRowPix, nColPix, nKeyFlags )
::lMChange := lMChange
return 0
endif
if ::lDrag
return Super:MouseMove( nRowPix, nColPix, nKeyFlags )
else
if ::lMChange
if lHeader
if ::lColDrag
CursorCatch()
else
if ::lLineDrag
::VertLine( nColPix )
CursorWE()
else
if AScan( ::GetColSizes(),;
{ | nColumn | nColPixPos += nColumn,;
nColPix >= nColPixPos - 2 .and. ;
nColPix <= nColPixPos + 2 }, ::nColPos ) != 0
CursorWE()
else
CursorHand()
endif
endif
endif
else
CursorArrow()
endif
else
CursorArrow()
endif
endif
return 0
//----------------------------------------------------------------------------//
METHOD VertLine( nColPixPos, nColInit ) CLASS TCBrowse
local oRect
static nCol, nWidth, nOldPixPos := 0
if nColInit != nil
nCol = nColInit
nWidth = nColPixPos
nOldPixPos = 0
endif
if nColPixPos == nil .and. nColInit == nil // We have finish draging
::aColSizes[ nCol ] -= ( nWidth - nOldPixPos )
::aColumns[ nCol ]:nWidth -= ( nWidth - nOldPixPos ) // HMVT added
::Refresh()
endif
oRect = ::GetRect()
::GetDC()
if nOldPixPos != 0
InvertRect( ::hDC, { 0, nOldPixPos - 1, oRect:nBottom, nOldPixPos + 1 } )
nOldPixPos = 0
endif
if nColPixPos != nil .and. ( nColPixPos - 1 ) > 0
InvertRect( ::hDC, { 0, nColPixPos - 1, oRect:nBottom, nColPixPos + 1 } )
nOldPixPos = nColPixPos
endif
::ReleaseDC()
return nil
//----------------------------------------------------------------------------//
METHOD lEditCol( nCol, uVar, cPicture, bValid, nClrFore, nClrBack, ;
cMsg, cError ) CLASS TCBrowse
local oDlg, oGet, oFont, oBtn
local nWidth := ::aColSizes[ nCol ]
local uTemp := uVar, aDim, lOk := .f.
local lDropBox := ( ValType( uVar )== "L" .and. ::lLogicDrop )
local nI, nStartCol := 0, lLogicDrop := ::lLogicDrop
if ::nFreeze > 0
for nI := 1 to Min(::nFreeze , nCol - 1 )
nStartCol += ::GetColSizes()[ nI ]
next
endif
for nI := ::nColPos to nCol - 1
nStartCol += ::aColSizes[ nI ]
next
DEFAULT nClrFore := ::nClrText, nClrBack := ::nClrPane
if ValType( Eval( ::aColumns[ nCol ]:bData ) ) == "M"
if MemoEdit( @uTemp, "Editing: " + ::aColumns[ nCol ]:cHeading )
uVar = uTemp
return .t.
else
return .f.
endif
endif
if ::oFont != nil .and. ! Empty( ::oFont:nHeight )
// added default font of system 14 500 weight
oFont = TFont():New( ::oFont:cFaceName, ::oFont:nInpWidth,;
If( Abs( ::oFont:nInpHeight ) < 14, 14, ::oFont:nInpHeight ), .f., ;
::oFont:lBold, nil, nil, If(::oFont:lBold, nil, 500) )
endif
aDim := aTCBrWPosRect( ::hWnd, ::nRowPos, nStartCol, nWidth, ;
If( ::oFont != nil, ::oFont:hFont, 0 ) )
DEFINE DIALOG oDlg OF ::oWnd FROM aDim[ 1 ], aDim[ 2 ] TO aDim[ 3 ], aDim[ 4 ] ;
STYLE nOR( WS_VISIBLE, WS_POPUP ) PIXEL
if ( lDropBox )
uTemp = If( uVar, "Yes", "No" )
oGet := TComboBox():New( 0, 0, bSETGET(uTemp), { "Yes", "No" }, ;
aDim[ 4 ] - aDim[ 2 ], 32, oDlg, , , bValid, nClrFore, ;
nClrBack, .t., oFont, cMsg ) // 32 was 100
oGet:oGet := oGet
oGet:cError := cError
else
oGet := TGet():New( 0, 0, bSETGET( uTemp ), oDlg, ;
aDim[ 4 ] - aDim[ 2 ], aDim[ 3 ] - aDim[ 1 ], ;
cPicture, bValid, nClrFore, nClrBack, oFont )
oGet:cMsg := cMsg
oGet:cError := cError
endif
@ 10, 0 BUTTON oBtn PROMPT "" ACTION ( oBtn:SetFocus(), oDlg:End(), lOk := .t. ) OF oDlg
oBtn:nStyle = nOr( WS_CHILD, WS_VISIBLE, BS_DEFPUSHBUTTON )
ACTIVATE DIALOG oDlg ;
ON INIT ( oDlg:Move( aDim[ 1 ] + 1, aDim[ 2 ] + 1,;
aDim[ 4 ] - aDim[ 2 ], aDim[ 3 ] - aDim[ 1 ] ),;
If( lDropBox,;
oGet:Move( -5, -2, aDim[ 4 ] - aDim[ 2 ] + 3, 22 ), ;// 22 was 80
oGet:Move( -2, -1, aDim[ 4 ] - aDim[ 2 ] + 3, ;
aDim[ 3 ] - aDim[ 1 ] + 6 ) ) )
if lOk
if ( lDropBox )
uVar = ( uTemp == "Yes" )
else
uVar = uTemp
endif
endif
return lOk
//----------------------------------------------------------------------------//
METHOD LDblClick( nRowPix, nColPix, nKeyFlags ) CLASS TCBrowse
local nClickRow := nTCWRow( ::hWnd, ::hDC, nRowPix,;
If( ::oFont != nil, ::oFont:hFont, 0 ) )
local nCol
local uTemp
if nClickRow == ::nRowPos
if ::aColumns[ nCol := ::nAtCol( nColPix ) ]:lEdit .and. ::lAutoEdit
uTemp = Eval( ::aColumns[ nCol ]:bData )
if ::lEditCol( nCol, @uTemp )
if ! Empty( ::cAlias ) .and. ::cAlias != "ARRAY"
if ( ::cAlias )->( RLock() )
Eval( ::aColumns[ nCol ]:bData, uTemp )
( ::cAlias )->( DbUnLock() )
else
MsgStop( "Record in use", "Please, try again" )
endif
else
Eval( ::aColumns[ nCol ]:bData, uTemp )
endif
::DrawSelect()
endif
endif
if ::bLDblClick != nil
Eval( ::bLDblClick, nRowPix, nColPix, nKeyFlags )
endif
elseif nClickRow == 0
::SetOrder( ::nAtCol( nColPix ) )
endif
return nil
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRowPix, nColPix, nKeyFlags ) CLASS TCBrowse
local nClickRow, nSkipped, nI
local nColPixPos := 0, nColInit := ::nColPos - 1
local oRect, nIcon
if ::nFreeze > 0
for nI := 1 to ::nFreeze
nColPixPos += ::GetColSizes()[ nI ]
next
endif
if ::lDrag
return Super:LButtonDown( nRowPix, nColPix, nKeyFlags )
endif
nClickRow = nTCWRow( ::hWnd, ::hDC, nRowPix,;
If( ::oFont != nil, ::oFont:hFont, 0 ) )
::SetFocus()
if ::lIconView
if ( nIcon := ::nAtIcon( nRowPix, nColPix ) ) != 0
::DrawIcon( nIcon )
endif
return nil
endif
if ::lMChange
if nClickRow == 0
if AScan( ::GetColSizes(),;
{ | nColumn | nColPixPos += nColumn,;
nColInit++,;
nColPix >= nColPixPos - 2 .and. ;
nColPix <= nColPixPos + 2 }, ::nColPos ) != 0
::lLineDrag = .t.
::VertLine( nColPixPos, nColInit )
else
::lColDrag = .t.
::nDragCol = ::nAtCol( nColPix )
endif
if ! ::lCaptured
::lCaptured = .t.
::Capture()
endif
return nil
endif
endif
if ::nLen < 1
return nil
endif
if nClickRow > 0 .and. nClickRow < ::nRowCount() + 1 //EMG
::DrawLine()
nSkipped = ::Skip( nClickRow - ::nRowPos )
::nRowPos += nSkipped
::oVScroll:SetPos( ::oVScroll:GetPos() + nSkipped )
if ::lCellStyle
::nColAct := ::nAtCol( nColPix )
if ::oHScroll != nil
::oHScroll:SetPos(::nColAct)
endif
endif
::DrawSelect()
::lHitTop = .f.
::lHitBottom = .f.
if ::bChange != nil
Eval( ::bChange )
endif
else
return nil
endif
if nClickRow == ::nRowPos
if ::lCellStyle
::nColAct := ::nAtCol( nColPix )
if ::oHScroll != nil
::oHScroll:SetPos(::nColAct)
endif
::DrawSelect()
endif
endif
Super:LButtonDown( nRowPix, nColPix, nKeyFlags )
return 0
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRowPix, nColPix, nFlags ) CLASS TCBrowse
local nClickRow, nDestCol, nAtCol
if ::lDrag
if ::lColDrag
::lDrag := .f.
else
return Super:LButtonUp( nRowPix, nColPix, nFlags )
endif
endif
nClickRow = nTCWRow( ::hWnd, ::hDC, nRowPix,;
If( ::oFont != nil, ::oFont:hFont, 0 ) )
if ::lCaptured
::lCaptured = .f.
ReleaseCapture()
if ::lLineDrag
::lLineDrag := .f.
::VertLine()
else
::lColDrag := .f.
nDestCol := ::nAtCol( nColPix )
// we gotta be on header row within listbox and not same colm
if nClickRow == 0 .and. nColPix > ::nLeft .and. ;
nColPix < ::nRight - 16 .and. ::nDragCol != nDestCol
::Exchange( ::nDragCol, nDestCol)
endif
endif
endif
if nClickRow == 0 .and. ::aActions != nil .and. ;
( nAtCol := ::nAtCol( nColPix ) ) <= Len( ::aActions )
if ::aActions[ nAtCol ] != nil
Eval( ::aActions[ nAtCol ], Self, nRowPix, nColPix )
return nil
endif
endif
Super:LButtonUp( nRowPix, nColPix, nFlags )
return nil
//----------------------------------------------------------------------------//
METHOD GoDown() CLASS TCBrowse
local nSkipped
local nLines := ::nRowCount()
if ::nLen < 1
return nil
endif
::ResetSeek()
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
if ! ::lHitBottom
::DrawLine()
if ::Skip( 1 ) == 1
::lHitTop = .f.
if ::nRowPos < nLines
::nRowPos++
else
::lRePaint := .f.
TCBrwScroll( ::hWnd, 1, If( ::oFont != nil, ::oFont:hFont, 0 ) )
::nRowPos := nLines
endif
else
::lHitBottom = .t.
endif
::DrawSelect()
if ::oVScroll != nil
::oVScroll:GoDown()
endif
if ::bChange != nil
Eval( ::bChange )
endif
endif
return nil
//---------------------------------------------------------------------------//
METHOD GoUp() CLASS TCBrowse
local nSkipped
local nLines := ::nRowCount()
if ::nLen < 1
return nil
endif
::ResetSeek()
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
if ! ::lHitTop
::DrawLine()
if ::Skip( -1 ) == -1
::lHitBottom = .f.
if ::nRowPos > 1
::nRowPos--
else
::lRePaint := .f.
TCBrwScroll( ::hWnd, -1, If( ::oFont != nil, ::oFont:hFont, 0 ) )
::DrawLine()
endif
else
::lHitTop = .t.
endif
::DrawSelect()
if ::oVScroll != nil
::oVScroll:GoUp()
endif
if ::bChange != nil
Eval( ::bChange )
endif
endif
return nil
//---------------------------------------------------------------------------//
// The following method is dedicated to John Stolte by the 'arry
METHOD SwitchCols( nCol1, nCol2 ) CLASS TcBrowse
local oHolder, nHolder, nMaxCol := Len(::aColumns)
if nCol1 > ::nFreeze .and. nCol2 > ::nFreeze .and. ;
nCol1 <= nMaxCol .and. nCol2 <= nMaxCol
oHolder := ::aColumns[ nCol1 ]
nHolder := ::aColSizes[ nCol1 ]
::aColumns[ nCol1 ] := ::aColumns[ nCol2 ]
::aColSizes[ nCol1 ] := ::aColSizes[ nCol2 ]
::aColumns[ nCol2 ] := oHolder
::aColSizes[ nCol2 ] := nHolder
if ::nColOrder == nCol1
::nColOrder := nCol2
endif
endif
return self
//----------------------------------------------------------------------------//
static function GenHead( aArray, nPos ) ; return {|| aArray[nPos]:cHeading }
static function GenData( aArray, nPos ) ; return {|| ;
If( aArray[nPos]:cPicture!=nil, ;
Transform( Eval(aArray[nPos]:bData), aArray[nPos]:cPicture), ;
cValToChar(Eval(aArray[nPos]:bData))) }
//----------------------------------------------------------------------------//
METHOD Report( cTitle, lPreview ) CLASS TCBrowse
local oRpt, oColumn, cPicture
local nRecNo, nI
DEFAULT cTitle := ::oWnd:GetText(), lPreview := .t.
if ::cAlias != "ARRAY"
if ::cAlias == "DBFOBJECT"
nRecNo := ::oDbf:RecNo()
else
nRecNo := ( ::cAlias )->( RecNo() )
endif
endif
if lPreview
REPORT oRpt TITLE cTitle PREVIEW ;
HEADER "Date: " + DToC( Date() ) + ", Time: " + Time() ;
FOOTER "Page: " + Str( oRpt:nPage, 3 )
else
REPORT oRpt TITLE cTitle ;
HEADER "Date: " + DToC( Date() ) + ", Time: " + Time() ;
FOOTER "Page: " + Str( oRpt:nPage, 3 )
endif
if Empty( oRpt ) .or. oRpt:oDevice:hDC == 0
return nil
else
::GoTop()
endif
for nI = 1 to Len( ::aColumns )
if !(::aColumns[nI]:lBitMap)
oRpt:AddColumn( TrColumn():New( { GenHead( ::aColumns, nI ) },, ;
{ GenData( ::aColumns, nI ) },,,,,, ;
If(ValType(Eval(::aColumns[nI]:bData))$"DN","RIGHT", nil) ;
,,,, oRpt ) )
endif
next
ENDREPORT
oRpt:bSkip = { || oRpt:Cargo := ::Skip( 1 ) }
oRpt:Cargo = 1
ACTIVATE REPORT oRpt ;
WHILE If( ::cAlias == "ARRAY",;
oRpt:nCounter <= Max( ( Eval( ::bLogicLen, Self ) ) - 1, 1 ),;
oRpt:Cargo == 1 )
if ::cAlias != "ARRAY"
if ::cAlias == "DBFOBJECT"
::oDbf:GoTo( nRecNo )
else
( ::cAlias )->( DbGoTo( nRecNo ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD KeyChar( nKey, nFlags ) CLASS TCBrowse
local cKey := upper( chr(nKey) )
local cSeek := ::cSeek
if ::bKeyChar == nil
if ( nKey >= 33 .and. nKey <= 126 ) .or. nKey == K_BS
if ::cAlias != "ARRAY"
::Seek( nKey )
endif
endif
else
Super:KeyChar( nKey, nFlags )
endif
return 0
//----------------------------------------------------------------------------//
METHOD PageDown(nLines) CLASS TCBrowse
::ResetSeek()
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
Super:PageDown(nLines)
return nil
//---------------------------------------------------------------------------//
METHOD PageUp(nLines) CLASS TCBrowse
::ResetSeek()
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
Super:PageUp(nLines)
return nil
//---------------------------------------------------------------------------//
METHOD Seek( nKey ) CLASS TCBrowse
local lFound := .t.
local lEof := .f.
local lTrySeek := .t.
local nRecNo := 0
local cSeek := ::cSeek
local xSeek := cSeek
local oColumn
local nIdxLen
if ::nColOrder > 0
lTrySeek := .t.
if ::cOrderType == "C"
// nIdxLen := Len( Eval( &("{||"+ ordSetFocus()+"}") ) )
nIdxLen := Len( Eval( &( "{||" + OrdKey(OrdSetFocus()) + "}" ) ) )
endif
if nKey == K_BS
if ::cOrderType == "D"
cSeek := DateSeek(cSeek,nKey)
else
cSeek := Left(cSeek, Len(cSeek) - 1 )
endif
else
if ::cOrderType == "D"
cSeek := DateSeek(cSeek,nKey)
elseif ::cOrderType == "N"
/* only 0..9 */
if nKey >= 48 .and. nKey <= 57
cSeek += upper(chr(nKey))
else
tone( 500 ,1 )
lTrySeek := .f.
endif
elseif ::cOrderType == "C"
if Len(cSeek) < nIdxLen
cSeek += upper(chr(nKey))
else
tone( 500 ,1 )
lTrySeek := .f.
endif
endif
endif
if ::cOrderType == "C"
xSeek := cSeek
elseif ::cOrderType == "N"
xSeek := val(cSeek)
elseif ::cOrderType == "D"
xSeek := dtos(ctod(cSeek))
else
xSeek := cSeek
endif
if ! ( ::cOrderType == "D" .and. len(rtrim(cSeek)) < Len(DtoC(Date())) ) ;
.and.lTrySeek
if ::cAlias == "DBFOBJECT"
nRecNo := ::oDbf:recno()
lFound := ::oDbf:Seek( xSeek,.t. )
lEof := ::oDbf:eof()
if lEof .or. ( ::cOrderType == "C" .and. ! lFound )
::oDBf:Goto( nRecNo )
endif
else
nRecNo := ( ::cAlias )->( recno() )
lFound := ( ::cAlias )->( DbSeek( xSeek,.t. ) )
lEof := ( ::cAlias )->( eof() )
if lEof .or. ( ::cOrderType == "C" .and. ! lFound )
( ::cAlias )->( DbGoTo( nRecNo ) )
endif
endif
if ( ::cOrderType == "C" .and. ! lFound ) .or. lEof
tone( 500 ,1 )
if ::cOrderType == "D"
DateSeek(cSeek,K_BS)
else
cSeek := Left(cSeek, Len(cSeek) - 1 )
endif
else
// only refresh if record pointer was moved
if ::cAlias == "DBFOBJECT"
if nRecNo != ::oDbf:recno()
::ResetBarPos()
//::nRowPos := 1
::Refresh()
endif
elseif nRecNo != ( ::cAlias )->( recno() )
::ResetBarPos()
//::nRowPos := 1
::Refresh()
endif
endif
endif
::cSeek := cSeek
if ::oCtx != Nil
::oCtx:Save()
endif
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
endif
return nil
//---------------------------------------------------------------------------//
METHOD SetOrder( nColumn ) CLASS TCBrowse
local lReturn := .f.
local oColumn := ::aColumns[ nColumn ]
if !Empty(oColumn:cOrder)
if ::cAlias != "ARRAY"
if ::cAlias == "DBFOBJECT"
::oDbf:SetOrder( oColumn:cOrder )
// ::oDbf:GoTop()
else
( ::cAlias )->( OrdSetFocus( oColumn:cOrder ) )
// ( ::cAlias )->( DbGoTop() )
endif
if Empty(ordSetFocus())
::cOrderType := ""
else
// ::cOrderType := ValType( Eval( &("{||"+ ordSetFocus()+"}") ) )
::cOrderType := ValType( Eval( &("{||"+ OrdKey(OrdSetFocus()) + "}" ) ) )
endif
if ::oCtx != Nil
::oCtx:ReNew()
endif
::ResetBarPos()
//::nRowPos := 1
::Refresh()
::nColOrder := nColumn
::ResetSeek()
::SetFocus()
if ::bSeekChange != Nil
eval(::bSeekChange)
endif
lReturn := .t.
endif
endif
return lReturn
//---------------------------------------------------------------------------//
static func DateSeek(cSeek,nKey)
local cChar := chr(nKey)
local nSpace := at(" ",cSeek)
local cTemp := ""
/* only 0..9 */
if nKey >= 48 .and. nKey <= 57
if nSpace <> 0
cTemp := left(cSeek,nSpace-1)
cTemp += cChar
cTemp += substr(cSeek,nSpace+1,len(cSeek) )
cSeek := cTemp
else
cSeek := cSeek
tone(500,1)
endif
elseif nKey == K_BS
if nSpace = 4 .or. nSpace = 7
cTemp := left(cSeek,nSpace-3)
cTemp += " "
cTemp += substr(cSeek,nSpace-1,len(cSeek) )
elseif nSpace == 0
cTemp := left(cSeek,len(cSeek)-1)
elseif nSpace == 1
cTemp := cSeek
else
cTemp := left(cSeek,nSpace-2)
cTemp += " "
cTemp += substr(cSeek,nSpace,len(cSeek) )
endif
cSeek := padr(cTemp,10)
else
tone( 500 ,1 )
endif
return cSeek
//---------------------------------------------------------------------------//
METHOD ResetSeek() CLASS TCBrowse
local oColumn
if ::nColOrder > 0
if ::cOrderType == "D"
::cSeek := " / / "
else
::cSeek := ""
endif
endif
return ::cSeek
//---------------------------------------------------------------------------//
METHOD ResetBarPos() CLASS TCBrowse
static bCxKeyNo, bCmKeyNo
local cRDDName
local cOrderName , nRecNo
local lClipMore
local nLogicPos // logical record no position within index
local nLogicLen // for the future when move into Conatext Class
if Used()
cRddName = RddName()
else
cRddName = RddSetDefault()
endif
if ::cAlias != "ARRAY" .and. ! Empty( ::cAlias )
if cRDDName == "COMIX" .or. cRDDName == "ADSDBFCDX"
// must macro the Comix functions since link error if not present
if cRDDName == "COMIX"
DEFAULT bCxKeyNo := &("{ | cTag | cmxKeyNo( cTag ) }")
else
DEFAULT bCxKeyNo := &("{ | cTag | OrdKeyNo( cTag ) }")
endif
if (lClipMore := ( Type("cmKeyNo()")=="C".or. ;
Type("cmKeyNo()")=="UI" ) )
DEFAULT bCmKeyNo := &("{ | cTag | cmKeyNo( cTag ) }")
endif
endif
if ::cAlias == "DBFOBJECT"
cOrderName := (::oDbf:cAlias)->(ordSetFocus())
if Empty(cOrderName) // no active index
nLogicPos := ::oDbf:RecNo()
elseif cRDDName == "DBFNTX"
// cure a little quirk in NtxPos if eof gives 0 as LOGICAL pos
nRecNo := If( ::oDbf:Eof(), ::oDbf:RecNo() - 1, ::oDbf:RecNo())
nLogicPos := NtxPos( (::oDbf:cAlias)->(IndexOrd()), nRecNo )
elseif cRDDName == "COMIX"
if lClipMore
nLogicPos := Eval( bCmKeyNo, cOrderName )
else
nLogicPos := Eval( bCxKeyNo, cOrderName )
endif
else
nLogicPos := ::oDbf:RecNo()
endif
else
cOrderName := ( ::cAlias )->( OrdSetFocus() )
if Empty(cOrderName) // no active index
nLogicPos := (::cAlias)->(RecNo())
elseif cRDDName == "DBFNTX"
// cure a little quirk in NtxPos if eof gives 0 as LOGICAL pos
nRecNo := If( (::cAlias)->(Eof()), (::cAlias)->(RecNo()) - 1, ;
(::cAlias)->(RecNo()) )
nLogicPos := NtxPos( (::cAlias)->(IndexOrd()), nRecNo )
elseif cRDDName == "COMIX"
if lClipMore
nLogicPos := Eval( bCmKeyNo, cOrderName )
else
nLogicPos := Eval( bCxKeyNo, cOrderName )
endif
else
nLogicPos := (::cAlias)->(RecNo())
endif
endif
if cRDDName == "ADSDBFCDX"
::bLogicLen = &( "{ || OrdKeyCount() }" )
endif
::nLen := Eval( ::bLogicLen, Self )
if ::oVScroll != nil
::oVScroll:SetRange( 1, ::nLen )
::oVScroll:SetPos( nLogicPos )
endif
if (nLogicPos > 0) .and. (nLogicPos < ::nRowPos)
::nRowPos := nLogicPos
endif
endif
return nil
//---------------------------------------------------------------------------//
METHOD Inspect( cData ) CLASS TCBrowse
do case
case cData == "aColumns"
return { | aColumns | MsgBeep(), aColumns }
endcase
return nil
//---------------------------------------------------------------------------//
-
Marcelo,
MinhaFuncao() é apenas um exemplo, ela simplesmente retorna FALSO.
No entanto, com xHarbour, o browse avança para o próximo campo, com o Clipper ele permanece no mesmo.
*************************************
static function MinhaFuncao( o )
*************************************
return .F.
Obrigado pela atenção,
Luciano.
-
Marcelo,
Na verdade esse GET é gerenciado pela próprÃo Browse, eu não o Defino. Ele é gerado pelo ADD COLUMN quando eu adiciono a clausula VALID, como no exemplo abaixo:
ADD COLUMN TO BROWSE oBrw ;
DATA FieldWBlock("BAKIYE", Select("Stok")) ;
HEADER "Bakiye" ;
PICTURE "###,###.##" ;
EDITABLE ;
WIDTH 70 PIXELS ;
VALID {|o| MinhaFuncao( o:varGet() ) }
Mas isso eu consegui dessa forma:
trocando:
VALID {|o| MinhaFuncao( o:varGet() ) }
por:
VALID IF MinhaFuncao( o )
Só que o problema persiste.
Luciano.
-
Ok, mas como faça para obter o objeto get que preciso em MinhaFuncao()?
Obrigado,
Luciano
-
Bom dia!
Estou com o seguinte problema: Utilizo o TcBrowse/TwBrowse e valido alguns dos campos quando add as colunas do browse, como segue:
ADD COLUMN TO BROWSE oBrw ;
DATA FieldWBlock("BAKIYE", Select("Stok")) ;
HEADER "Bakiye" ;
PICTURE "###,###.##" ;
EDITABLE ;
WIDTH 70 PIXELS ;
VALID {|o| MinhaFuncao( o:varGet() ) }
Esse é um exemplo do próprio FiveWin (\Samples\Browse.prg). O que ocorre é que se MinhaFuncao() retornar falso ele avança para o próximo campo mesmo assim.
Estou utilizando Fivewin for xHarbour 2.7 April 2006 Release + xHarbour October 2006 + WinXP.
O mesmo programa no Clipper 5.2e + Fivewin 2.4 funciona corretamente, ou seja, quando MinhaFuncao() retorna falso ele não sai do get, aguardando a digitação de um valor válido.
O que eu posso fazer neste caso para resolver o problema?
Obrigado,
Luciano Iuri Pereira
Birô 2000 Serviços Integrados S/A
-
Bom dia!
Estou com o seguinte problema: Utilizo o TcBrowse/TwBrowse e valido alguns dos campos quando add as colunas do browse, como segue:
ADD COLUMN TO BROWSE oBrw ;
DATA FieldWBlock("BAKIYE", Select("Stok")) ;
HEADER "Bakiye" ;
PICTURE "###,###.##" ;
EDITABLE ;
WIDTH 70 PIXELS ;
VALID {|o| MinhaFuncao( o:varGet() ) }
Esse é um exemplo do próprio FiveWin (\Samples\Browse.prg). O que ocorre é que se MinhaFuncao() retornar falso ele avança para o próximo campo mesmo assim.
Estou utilizando Fivewin for xHarbour 2.7 April 2006 Release + xHarbour October 2006 + WinXP.
O mesmo programa no Clipper 5.2e + Fivewin 2.4 funciona corretamente, ou seja, quando MinhaFuncao() retorna falso ele não sai do get, aguardando a digitação de um valor válido.
O que eu posso fazer neste caso para resolver o problema?
Obrigado,
Luciano Iuri Pereira
Birô 2000 Serviços Integrados S/A
-
Marcelo,
o teste com a alteração na Classe TWindow() foi apenas um dos testes, o ultimo. E com essa alteração fica mais rápido do que sem ela. Se eu tirar a TWindow() fica ainda mais lento.
Obrigado,
Luciano
-
Bom dia,
Gilmer,
Sim,estou usando o xBuild do xHarbour.
Marcelo,
Li o seu e-mail e testei. Realmente a versão que vc me enviou ficou tão rápida quanto a do Fivewin. No entanto, quando recompilei aqui, voltou a ficar lenta. Será isso algum problema com a máquina? O que ocorre é que testei em 3 micros com configurações e SOs diferentes e continuou lento.
Quanto ao item do projeto
[L]
MYC_FLAGS =
MYDEFINES =
MYPRG_FLAGS =
Trata-se da classe TWindow.prg do Fivewin, com os methods DispBegin() e DispEnd() alterados para VIRTUAL.
Obrigado pela atenção e auxilio,
Luciano.
-
Olá Gilmer,
Sim, recompilei. Usei o project do site do xHarbour.com quando atualizei o xHb. Estou utilizando o xBuild.
Não seria algum problema de versão do Fivewin isso?
Fiz 2 alterações no meu código, como sugestões que encontrei no forum do fivewin, mas mesmo assim continua lento:
1) redefinir a função AppIsthemed() retornando sempre .f.
2) redefinir os methodos DispBegin() e DispEnd() da classe TWindow() como VIRTUAL.
Ambas as alterações aumentam a performance, mas não resolvem de todo o problema, vc tem alguma outra sugestão?
Esse problema ocorre como vc tb?
Obrigado,
Luciano
-
Olá Gilmer,
Estou compilando com o xHarbour Project Builder, atualizado em Julho/2005, com Fivewin 2.5 adquirido em Dezembro/2004.
Apenas adiciono o programa acima no projeto e compilo... e ele já fica mais lento que em Clipper 5.2e + Fivewin 2.4.
[]´s
Luciano.
-
Boa tarde,
O Do While só se encontra neste código por motivo de teste, para que o programa feche a DIALOG e abra novamente. O meu problema não é isso. Estou com um problema sério de performance.
Já compilei esse programa em 3 computadores e tenho o mesmo resultado. Se rodo esse programa no Win98 ele fica mais lento ainda... vejo cada say e get sendo apresentado na tela.
O mesmo programa em Fivewin 2.4 + Clipper 5.2e fica pelo menos 10x mais rápido. Posso lhe enviar os 2 EXEs anexados para vc testar ai, pq não sei o que acontece.
Já tentei as dicas do Forum de definir a função IsAppThemed() com retorno .F. e também de definir os metodos da DispBegin() e DispEnd() da classe TWindow como Virtual. De fato, a performance melhorá, mas ainda sim continua lento. Você tem alguma notÃcia sobre essas alterações?
Isso, está dificultando a migração em meus clientes, pois não querem usar um programa mais lento do o anterior.
Obrigado,
Luciano
-
Adelson,
segue o código. Estou falando de um programa simples... sem RC. Alias, as telas feitas em RC são mais rápidas que as criadas na mão. Quando compilo esse programa com Clipper 5.2e + FW2.4 fica um foguete, quando compilo com xHarbour + FWH 2.5... em consigo ver os SAYs/GETs serem montados na tela... me recordou os tempos do XT.
[]´s
Luciano
/////////////////////////
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
function Main()
local lClose
local oGet1, oGet2, oGet3, oGet4, oGet5, cTexto1:= space(20)
local oGet6, oGet7, oGet8, oGet9, oGet10, oGet11
do while .t.
lClose := .f.
DEFINE DIALOG oDlg FROM 1,1 to 30, 90 TITLE "Loadind..."
@ 00, 2 say "1. Info:"
@ 00, 10 get oGet0 VAR ctexto1 pict "@!" valid ValMyGet()
@ 01, 2 say "2. Info:"
@ 01, 10 get oGet1 VAR ctexto1 pict "@!" valid ValMyGet()
@ 02, 2 say "3. Info:"
@ 02, 10 get oGet2 VAR ctexto1 pict "@!" valid ValMyGet()
@ 03, 2 say "4. Info:"
@ 03, 10 get oGet3 VAR ctexto1 pict "@!" valid ValMyGet()
@ 04, 2 say "5. Info:"
@ 04, 10 get oGet4 VAR ctexto1 pict "@!" valid ValMyGet()
@ 05, 2 say "6. Info:"
@ 05, 10 get oGet5 VAR ctexto1 pict "@!" valid ValMyGet()
@ 06, 2 say "7. Info:"
@ 06, 10 get oGet6 VAR ctexto1 pict "@!" valid ValMyGet()
@ 07, 2 say "8. Info:"
@ 07, 10 get oGet8 VAR ctexto1 pict "@!" valid ValMyGet()
@ 08, 2 say "9. Info:"
@ 08, 10 get oGet9 VAR ctexto1 pict "@!" valid ValMyGet()
@ 09, 2 say "10. Info:"
@ 09, 10 get oGet10 VAR ctexto1 pict "@!" valid ValMyGet()
@ 10, 2 say "11. Info:"
@ 10, 10 get oGet11 VAR ctexto1 pict "@!" valid ValMyGet()
@ 10, 1 BUTTON " &Next... " OF oDlg SIZE 60, 25 ACTION oDlg:End()
@ 10, 15 BUTTON " &Close " OF oDlg SIZE 60, 25 ACTION (lClose:=.t.,oDlg:End())
ACTIVATE DIALOG oDlg
if lClose
exit
endif
enddo
return NIL
static function ValMyGet()
//MsgInfo("Validando get...")
return .t.
-
Boa tarde,
Uso o FWH 2.5 + xHarbour e estou encontrando um problema de performance no momento em que os Says e Gets são desenhados na tela.
Com FW24 + Clipper 5.2e a tela é exibida rapidamente sem problemas, mas quando compilo o mesmo prg com o FWH e vejo cada say/get sendo desenhado na tela.
Estou usando WinXP em um Celeron 1.3, 512 RAM... não deveria se comportar assim... alguém tem alguma idéia?
Obrigado,
Luciano
-
Bom dia!
Instalei minha aplicação em um windows XP e toda vez que inicio o Sistema aparece uma mensagem dizendo que não foi possivel encontrar a DLL BWCCPTB.DLL. No entanto, estou utilizando a BWCC.DLL... o que preciso fazer para evitar esse problema...
Obrigado
Luciano
Birô 2000
Classe TSplitter
in Classes
Posted
Olá,
Gostaria de um exemplo funcional com a Classe TSPLITTER.
Encontrei na documentação alguns exemplos com um ou 2 splitter VERTICAL. O que preciso é de uma Windows com um Splitter VERTICAL e outro HORIZONTAL. Isso é possÃvel? Eu não consegui codificar, um sempre fica remontando sobre o outro.
Obrigado,
Birô 2000.
xHB + FWH 2.7 April 2006 + Pelles C + WinVista;