Jump to content
Fivewin Brasil

ottonico

Membros
  • Posts

    19
  • Joined

  • Last visited

Everything posted by ottonico

  1. 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;
  2. 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;
  3. 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
  4. 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
  5. 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
  6. 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 //---------------------------------------------------------------------------//
  7. 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.
  8. 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.
  9. Ok, mas como faça para obter o objeto get que preciso em MinhaFuncao()? Obrigado, Luciano
  10. 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
  11. 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
  12. 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
  13. 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.
  14. 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
  15. 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.
  16. 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
  17. 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.
  18. 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
  19. 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
×
×
  • Create New...