/* * BrowseMod.prg * Control TBrowse moderno * * Copyright 2020 Ignacio Ortiz de Zúñiga * Copyright 2020 https://Xailer.com * All rights reserved * */ #include "Xailer.ch" #include "Dataset.ch" #include "error.ch" #define STATE_NORMAL 0 #define STATE_SELECTED 1 #define STATE_HOT 2 #define STATE_ACTIVE 3 //------------------------------------------------------------------------------ CLASS xBrowseMod FROM TWinControl PUBLISHED: PROPERTY oImageList WRITE METHOD SetImageList AS TImageList ; EDITOR PE_ImageList PROPERTY aCols INIT {} AS TBrwColMod[] EDITOR PE_StringListAlt PROPERTY cRecSelectorHeader INIT "" PROPERTY nRecSelectorWidth INIT 0 WRITE METHOD SetRecSelWidth( Value ) PROPERTY nHeaderHeight INIT 0 WRITE SetHeaderHeight PROPERTY nFooterHeight INIT 0 WRITE SetFooterHeight PROPERTY nRowHeight INIT 0 WRITE SetRowHeight PROPERTY nBorderStyle INIT bvWIN10 PROPERTY nBorderSides PROPERTY nWidth INIT 150 PROPERTY nHeight INIT 200 PROPERTY nMargin INIT 5 WRITE SetMargin PROPERTY nClrPane INIT clWindow EDITOR PE_Color ; WRITE METHOD SetClrPane( Value ) PROPERTY nClrText INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrText( Value ) PROPERTY nClrHotPane INIT clActiveCaption EDITOR PE_Color ; WRITE METHOD SetClrHotPane( Value ) PROPERTY nClrHotText INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrHotText( Value ) PROPERTY nClrSelPane INIT clLightYellow EDITOR PE_Color ; WRITE METHOD SetClrSelPane( Value ) PROPERTY nClrSelText INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrSelText( Value ) PROPERTY nClrDivider INIT clGray EDITOR PE_Color ; WRITE INLINE ( ::FnClrDivider := Value, ::Refresh(), Value ) PROPERTY nClrHeaderPane INIT clBtnFace EDITOR PE_Color ; WRITE METHOD SetClrHeaderPane( Value ) PROPERTY nClrHeaderText INIT clBtnText EDITOR PE_Color ; WRITE METHOD SetClrHeaderText( Value ) PROPERTY nClrHeaderDivider INIT clGray EDITOR PE_Color ; WRITE METHOD SetClrHeaderDivider( Value ) PROPERTY nClrHeaderHotPane INIT clActiveCaption EDITOR PE_Color ; WRITE METHOD SetClrHeaderHotPane( Value ) PROPERTY nClrHeaderHotText INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrHeaderHotText( Value ) PROPERTY nClrHeaderSelPane INIT clGradientInactiveCaption EDITOR PE_Color ; WRITE METHOD SetClrHeaderSelPane( Value ) PROPERTY nClrHeaderEditText INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrHeaderEditText( Value ) PROPERTY nClrHeaderEditPane INIT clWindow EDITOR PE_Color ; WRITE METHOD SetClrHeaderEditPane( Value ) PROPERTY nClrHeaderEditTextFocus INIT clWindowText EDITOR PE_Color ; WRITE METHOD SetClrHeaderEditTextFocus( Value ) PROPERTY nClrHeaderEditPaneFocus INIT clWindow EDITOR PE_Color ; WRITE METHOD SetClrHeaderEditPaneFocus( Value ) PROPERTY lHeader INIT .T. WRITE METHOD SetHeader PROPERTY lFooter INIT .F. WRITE METHOD SetFooter PROPERTY lSupraHeader INIT .F. WRITE METHOD SetSupra PROPERTY lFilterBar INIT .F. WRITE METHOD SetFilterBar PROPERTY lShowCellSelected INIT .F. WRITE METHOD SetShowCellSelected( Value ) PROPERTY lColumnSeparator INIT .F. ; WRITE INLINE ::FlColumnSeparator := Value, ; iif( ::oDataGrid != NIL, ::oDataGrid:Refresh(), ), ; Value PROPERTY lRowHeightButtons INIT .F. ; WRITE INLINE ::FlRowHeightButtons := Value, ; iif( ::oDataGrid != NIL, ::oDataGrid:Refresh(), ), ; Value PROPERTY lMultipleSel INIT .F. ; WRITE INLINE ::FlMultipleSel := Value, ; iif( ::oDataGrid != NIL, ::oDataGrid:lMultipleSel := Value, ), ; Value PROPERTY lHideScrollBars INIT .T. PROPERTY nRowIncrement INIT 5 PROPERTY lAllowSort INIT .F. PROPERTY lAllowEdit INIT .F. PROPERTY lAllowAppend INIT .F. PROPERTY lAllowInsert INIT .F. PROPERTY lAllowDelete INIT .F. PROPERTY lAllowColSwapping INIT .T. WRITE METHOD SetAllowColSwapping( Value ) PROPERTY lAllowColSizing INIT .T. WRITE METHOD SetAllowColSizing( Value ) PROPERTY lAllowColHiding INIT .T. PROPERTY lFastEdit INIT .F. PROPERTY lFastAppend INIT .F. PROPERTY lAutoSave INIT .T. PROPERTY lTransparent INIT .F. PROPERTY lAlternateColor INIT .F. PROPERTY lHotTrack INIT .T. WRITE INLINE ::FlHotTrack := Value, ; IIF( ::oDataGrid != NIL, ::oDataGrid:lHotTrack := Value, ) PROPERTY lTransparentGrid INIT .F. WRITE INLINE ::FlTransparentGrid := Value, ; IIF( ::oDataGrid != NIL, ::oDataGrid:lTransparent := Value, ) PROPERTY lTooltips INIT .T. WRITE METHOD SetTooltips EVENT OnHeaderClick( oSender, oItem, aPos ) EVENT OnHeaderRClick( oSender, oItem, aPos ) EVENT OnFooterClick( oSender, oItem, aPos ) EVENT OnFooterRClick( oSender, oItem, aPos ) EVENT OnFilterStart( oSender, oCol ) EVENT OnFilterEnd( oSender, oCol ) EVENT OnDrawHeader( oSender, oItem, cText, nImage, nClrText, nClrPane, hDC, aRect ) EVENT OnDrawFooter( oSender, oItem, cText, nImage, nClrText, nClrPane, hDC, aRect ) EVENT OnDrawCell( oSender, oCol, nIndex, xValue,; BYREF cValue, BYREF nImage, BYREF nClrText, BYREF nClrPane,; nState, hDC, aRect ) EVENT OnDrawRecSelector( oSender, nItem, BYREF cValue, BYREF nImage, BYREF nClrText,; BYREF nClrPane, hDC, aRect ) EVENT OnClickRecSelector( oSender, nItem, aPos ) EVENT OnDrawActiveRow( oSender, hDC, aRect, aSel, lFocus ) EVENT OnDrawGroupHeader( oSender, oSt, BYREF cGroup, nRecord, BYREF nClrText, BYREF nClrPane, hDC, aRect ) EVENT OnDrawGroupFooter( oSender, oSt, oCol, BYREF cValue, BYREF nClrText, BYREF nClrPane, BYREF lLine, hDC, aRect ) EVENT OnEdit( oSender ) EVENT OnEditCol( oSender, oCol, BYREF xValue, nKey ) EVENT OnEditColBtnClick( oSender, oCol, BYREF xValue ) EVENT OnSave( oSender ) EVENT OnSaveCol( oSender, oCol, BYREF xValue ) EVENT OnPostSave( oSender ) EVENT OnAppend( oSender ) EVENT OnInsert( oSender ) EVENT OnDelete( oSender ) EVENT OnCancelEdit( oSender, lSave, nKey ) EVENT OnUpdate( oSender ) EVENT OnChange( oSender, lRowChanged ) EVENT OnClick( oSender, nKeyFlags, oCol, nIndex ) EVENT OnDblClick( oSender, nKeyFlags, oCol, nIndex ) EVENT OnContextMenu( oSender, nX, nY, oCol, nIndex ) EVENT OnChangeSelected( oSender, aSelected ) EVENT OnDispTooltip( oSender, @cText, @cTitle, @nIcon, nIndex, oCol ) PUBLIC: PROPERTY oHeader AS TBrwHeader PROPERTY oSupra AS THeaderMod PROPERTY oFooter AS THeaderMod PROPERTY oRecSelector AS TLabel PROPERTY oDataGrid AS TBrwModGrid PROPERTY aGridData INIT {} ; WRITE METHOD SetGridData PROPERTY aSelected WRITE METHOD SetSelected READ METHOD GetSelected PROPERTY nSelectCol INIT 1 ; // The selected ordinal col number. Use oSelectCol for active BrwCol WRITE METHOD SetSelectCol PROPERTY aDisplayCols AS TBrwColMod[] READ METHOD GetDisplayCols() PROPERTY oGroup AS TBrwGroup PROPERTY oSelectCol AS TBrwColMod PROPERTY oEditCol AS TBrwColMod PROPERTY nEditMode INIT beREAD READONLY ; VALUES beREAD, beEDIT, beAPPEND, beINSERT PROPERTY nIndex INIT 0 WRITE METHOD SetIndex PROPERTY lOnEditUseReturn INIT NIL READ INLINE IIF( ::FlOnEditUseReturn == NIL, ; Application:lUseReturn,; ::FlOnEditUseReturn ) METHOD New( oParent ) CONSTRUCTOR METHOD Create( oParent ) CONSTRUCTOR METHOD Free() METHOD SetGridData( aData, aHeader ) METHOD GetDataRow( nIndex ) INLINE ::DataValue( nIndex, .T. ) METHOD InsCol( oCol, nPos ) METHOD AddCol( oCol ) INLINE ::InsCol( oCol ) METHOD DelCol( xCol ) METHOD AddSupraCol( cHeader, nCols, lSeparator, lResize, lDrag ) METHOD GoUp() INLINE ::nIndex -- METHOD GoDown() INLINE ::nIndex ++ METHOD GoTop() INLINE ::nIndex := 1 METHOD GoBottom() INLINE ::nIndex := ::RecCount() METHOD Goto( nPos ) INLINE ::nIndex := nPos METHOD GoLeft() INLINE ::nSelectCol -- METHOD GoRight() INLINE ::nSelectCol ++ METHOD GoLeftMost() INLINE ::nSelectCol := 1 METHOD GoRightMost() INLINE ::nSelectCol := Len( ::aDisplayCols ) METHOD IsSingleEdit() INLINE !Empty( ::oEditCol ) METHOD IsOnEdit() INLINE ( ::nEditMode != beREAD ) METHOD Refresh( lValue ) METHOD ColAtPos( nValue ) METHOD ColWithHeader( cHeader ) METHOD RecCount() INLINE Len( ::oDataGrid:aWork ) METHOD Record( nPos ) INLINE ::oDataGrid:Record( nPos ) METHOD GroupOn( oCol, lCollapsed, lFooter, lLine ) METHOD IsGroup() INLINE !Empty( ::oGroup ) METHOD Edit( oCol, nKey ) METHOD Append() METHOD Insert() METHOD Delete() METHOD CancelEdit( lSave, nKey ) METHOD Sort( oCol, nSort ) METHOD AdjustColWidth( oCol ) METHOD UnSort() INLINE ::Sort() METHOD IsSorted() INLINE ::oHeader != NIL .AND. ::oHeader:IsSorted() METHOD ClearFilter() INLINE ::oHeader:ClearAllFilters(), ::Filter() METHOD IsFilter() INLINE ::oHeader != NIL .AND. ::oHeader:IsFilter() METHOD Filter( oCol ) METHOD ToExcel( cFile, lXlsNumeric ) METHOD MinimumRowHeight() INLINE ::oDataGrid:MinimumRowHeight() METHOD AdjustCols( lWithImage ) METHOD StretchCols() METHOD SetFocus( lForce ) INLINE IIF( ::oDataGrid != NIL,; ::oDataGrid:SetFocus( lForce ),; ::Super:SetFocus( lForce ) ) METHOD SaveState() INLINE ::oHeader:SaveState() METHOD RestoreState( cState ) METHOD SelectAll() METHOD SelectNone() METHOD HitTest( aPos ) INLINE ::oDataGrid:HitTest( aPos ) METHOD HitTestCol( nX ) INLINE ::oDataGrid:HitTestCol( nX ) PROTECTED: PROPERTY cText PROPERTY cTooltip PROPERTY cBalloon PROPERTY lBorder DATA nRedraw INIT 0 METHOD GetDisplayCols() METHOD SetSelected( aSelected ) METHOD GetSelected() METHOD SetFilterBar( Value, lUpdHeader ) METHOD SetIndex( nValue ) METHOD SetRowHeight( Value ) METHOD SupraSwapRequest( oItem, nPos ) METHOD SetRecSelWidth( Value ) METHOD SetImageList( Value ) METHOD PaintRecSelector( oSender, hDC ) METHOD ClickRecSelector( oSender, nX, nY ) METHOD SetShowCellSelected( Value ) METHOD SetClrPane( Value ) METHOD SetClrText( Value ) METHOD SetClrSelPane( Value ) METHOD SetClrSelText( Value ) METHOD SetClrHotPane( Value ) METHOD SetClrHotText( Value ) METHOD SetClrHeaderPane( Value ) METHOD SetClrHeaderText( Value ) METHOD SetClrHeaderDivider( Value ) METHOD SetClrHeaderHotPane( Value ) METHOD SetClrHeaderHotText( Value ) METHOD SetClrHeaderSelPane( Value ) METHOD SetClrHeaderEditText( Value ) METHOD SetClrHeaderEditPane( Value ) METHOD SetClrHeaderEditTextFocus( Value ) METHOD SetClrHeaderEditPaneFocus( Value ) METHOD SetAllowColSizing( Value ) METHOD SetAllowColSwapping( Value ) METHOD SetMargin( Value ) METHOD SetSelectCol( Value ) METHOD StartEdit( nChr ) METHOD Save() METHOD EditUndo() METHOD Rebuild( nRecord ) METHOD ResetData( aData ) METHOD RunContextMenu( oGrid, nPox, nPosY ) // Method to overload on TDbBrowseMod METHOD RunEdit() VIRTUAL METHOD RunAppend() VIRTUAL METHOD RunEditUndo() VIRTUAL METHOD RunDelete() METHOD RunSave() METHOD RunSort( oCol, nSort ) METHOD RunFilter() METHOD SetTooltips( Value ) METHOD SetTooltipText( cText ) RESERVED: // Friend methods PROPERTY nClrPaneEnd METHOD AdjustChildrenSizes( oItem ) METHOD SetSupra( Value, lUpdHeader ) METHOD SetHeaderHeight( Value, lUpdHeader ) METHOD SetFooterHeight( Value, lUpdHeader ) METHOD SetHeader( Value, lUpdHeader ) METHOD SetFooter( Value, lUpdHeader ) METHOD HeaderChanged() METHOD HeaderClick( oHeader, oItem, aPos ) METHOD HeaderRClick( oHeader, oItem, aPos ) METHOD WMXailer( n ) INLINE ::StartEdit( n ) METHOD IsVisible() INLINE ::flVisible METHOD ResetGroup() METHOD CalcGroup() METHOD BeginPaint() METHOD EndPaint() METHOD Resort( lKeepRecno ) METHOD Reset() METHOD RefreshCurrent() INLINE ::Refresh( .F. ) // Methods to overload on TDbBrowseMod METHOD DataValue( nIndex, lArray, nCol ) METHOD UpdateIndex( nValue ) METHOD SetRecnoPos( nItem ) VIRTUAL METHOD RestoreRecnoPos() VIRTUAL METHOD SortedCol() ENDCLASS //------------------------------------------------------------------------------ METHOD New( oParent ) CLASS xBrowseMod ::Super:New( oParent ) ::FoImageList := TImageList():Create( Self ) RETURN Self //------------------------------------------------------------------------------ METHOD Free() CLASS xBrowseMod IF ::oImageList != NIL .AND. ::oImageList:oParent == Self ::oImageList:Destroy() ENDIF IF ::oGroup != NIL ::oGroup:End() ENDIF RETURN ::Super:Free() //------------------------------------------------------------------------------ METHOD Create( oParent ) CLASS xBrowseMod LOCAL oCol ::Super:Create( oParent ) ::SetRowHeight() ::oRecSelector := TLabel():New( Self ) ::oSupra := TSupraHeader():New( Self ) ::oHeader := TBrwHeader():New( Self ) ::oFooter := TFooter():New( Self ) ::oDataGrid := TBrwModGrid():New( Self ) IF Empty( ::FoImageList ) ::FoImageList := TImageList():Create( Self ) ENDIF WITH OBJECT ::oRecSelector :nWidth := ::nRecSelectorWidth :nAlign := alLEFT :lTransparent := .T. :lAutosize := .F. :lVisible := ( :nWidth > 0 ) :nClrPane := ::nClrPane :nClrText := ::nClrText :OnPainted := "PaintRecSelector" :OnLButtonDown := "ClickRecSelector" :Create() END WITH WITH OBJECT ::oSupra :oImageList := ::oImageList :nAlign := alTOP :lFilterBar := .F. :lVisible := ::lSupraHeader :nHeight := ::nHeaderHeight :OnItemChanging := {| o, i | ::AdjustChildrenSizes( i ) } :OnItemChanged := {| o, i | ::AdjustChildrenSizes( i ) } :OnItemEndDrag := {| o, i, n | ::SupraSwapRequest( i, n ) } :OnDrawItem := {| o, oI, cT, nI, nT, nP, hDC, aRect | ; SupraSeparator( oI, hDC, aRect, :nClrDivider ) } :Create() END WITH WITH OBJECT ::oFooter :oImageList := ::oImageList :nAlign := alBOTTOM :lVisible := ::lFooter :nHeight := ::nFooterHeight :lHotTrack := .F. :lFilterBar := .F. :lResize := .F. :lCanDrag := .F. :nSelect := 0 :nClrPane := ::nClrHeaderPane :nClrText := ::nClrHeaderText :nClrHotPane := ::nClrHeaderHotPane :nClrHotText := ::nClrHeaderHotText :nClrDivider := ::nClrHeaderDivider :nClrSelPane := ::nClrHeaderSelPane :nClrEditPane := ::nClrHeaderEditPane :nMarginHor := ::nMargin :OnDrawItem := {| oSen, oItem, cTxt, nImg, nTxt, nPan, hDC, aRect | ; ::OnDrawFooter( oItem, @cTxt, @nImg, @nTxt, @nPan, hDC, aRect ) } :OnItemClick := {| oSen, oItem, aPos | ::OnHeaderClick( oItem, aPos ) } :OnItemRClick := {| oSen, oItem, aPos | ::OnHeaderRClick( oItem, aPos ) } :Create() END WITH WITH OBJECT ::oHeader :oImageList := ::oImageList :nAlign := alTOP :lVisible := ::lHeader :nHeight := ::nHeaderHeight :lResize := ::lAllowColSizing :lCanDrag := ::lAllowColSwapping :lFilterBar := ::lFilterBar :nSelect := 0 :nClrPane := ::nClrHeaderPane :nClrText := ::nClrHeaderText :nClrHotPane := ::nClrHeaderHotPane :nClrHotText := ::nClrHeaderHotText :nClrDivider := ::nClrHeaderDivider :nClrSelPane := ::nClrHeaderSelPane :nClrEditPane := ::nClrHeaderEditPane :nMarginHor := ::nMargin :OnFilterTimeout := {| oSender, oCol | ::Filter( oCol ) } :OnDrawItem := {| oSen, oItem, cTxt, nImg, nTxt, nPan, hDC, aRect | ; ::OnDrawHeader( oItem, @cTxt, @nImg, @nTxt, @nPan, hDC, aRect ) } :OnItemClick := "HeaderClick" :OnItemRClick := "HeaderRClick" :OnDividerDblClick := {|oSender, oCol| ::AdjustColWidth( oCol ) } :Create() END WITH ::BeginPaint() AEval( ::aCols, {|v| v:Insert() } ) WITH OBJECT ::oDataGrid :nAlign := alCLIENT :nBorderStyle := bvNONE :nClrPane := ::nClrPane :nClrText := ::nClrText :nClrSelPane := ::nClrSelPane :nClrSelText := ::nClrSelText :nClrHotText := ::nClrHotText :nClrHotPane := ::nClrHotPane :nItemHeight := ::nRowHeight :nMargin := ::nMargin :lMultipleSel := ::FlMultipleSel :lTransparent := ::lTransparentGrid :lHideScrollBars := ::lHideScrollBars :lHotTrack := ::lHotTrack :OnChange := {|o| o:RowChanged() } :OnContextMenu := {|o,x,y| ::RunContextMenu( o,x,y ) } :OnEnter := {|oS, oC| ::OnEnter( oS, oC ) } :OnChangeSelected := "OnChangeSelected " //{|o,a| ::UpdSelected( a ) } :OnLButtonDown := "OnLButtonDown" :OnLButtonUp := "OnLButtonUp" :OnRButtonDown := "OnRButtonDown" :OnRButtonUp := "OnRButtonUp" :Create() ::SetToolTips() END WITH AEval( ::aCols, {|v| v:CreateEdit() } ) ::EndPaint() RETURN Self //------------------------------------------------------------------------------ // El header es el que define las columnas visibles y su posición METHOD GetDisplayCols() CLASS xBrowseMod LOCAL oItem LOCAL aCols := {} IF ::oHeader != NIL FOR EACH oItem IN ::oHeader:aItems IF oItem:IsVisible() .AND. oItem:oGridCol != nil AAdd( aCols, oItem:oGridCol ) ENDIF NEXT ENDIF RETURN aCols //------------------------------------------------------------------------------ METHOD InsCol( oCol, nPos ) CLASS xBrowseMod IF oCol:IsKindOf( "TDbBrwColMod" ) .AND. !::IsKindOf( "TDbBrowseMod" ) WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod Invalid column object (TDbBrwColMod)" :Operation := "TBrowseMod:InsCol( oCol )" Eval( ErrorBlock(), :__WithObject() ) END WITH ELSEIF !oCol:IsKindOf( "TDbBrwColMod" ) .AND. ::IsKindOf( "TDbBrowseMod" ) WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TDbBrowseMod Invalid column object (TBrwColMod)" :Operation := "TDbBrowseMod:InsCol( oCol )" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF ::CancelEdit() IF nPos == NIL .OR. nPos > Len( ::aCols ) AAdd( ::aCols, oCol ) nPos := Len( ::aCols ) ELSE AAdd( ::aCols, NIL ) AIns( ::aCols, nPos ) ::aCols[ nPos ] := oCol ENDIF oCol:nIndex := nPos IF ::oHeader != NIL .AND. ::oFooter != Nil oCol:Insert( nPos ) ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD DelCol( xCol ) CLASS xBrowseMod LOCAL oCol LOCAL nCol IF ValType( xCol ) == "O" nCol := Ascan( ::aCols, {|v| v == xCol } ) oCol := xCol ELSE nCol := xCol oCol := ::aCols[ xCol ] ENDIF IF !Empty( nCol ) HB_ADel( ::aCols, nCol, .T. ) AEval( ::aCols, {|v,e| ::aCols[ e ]:nIndex := nCol ++ }, nCol ) oCol:End() ::Refresh() ENDIF RETURN !Empty( nCol ) //------------------------------------------------------------------------------ METHOD DataValue( nIndex, lArray, nCol ) CLASS xBrowseMod LOCAL aText LOCAL cText DEFAULT lArray TO .F. IF nIndex <= 0 RETURN IIF( lArray, {}, "" ) ENDIF aText := ::aGridData[ nIndex ] IF lArray RETURN aText ENDIF cText := "" IF Empty( nCol ).AND. ::lShowCellSelected .AND. ::oSelectCol != NIL WITH OBJECT ::oSelectCol IF :nDataCol > 0 IF !Empty( :cPicture ) cText := Transform( aText[ :nDataCol ], :cPicture ) ELSE cText := ToString( aText[ :nDataCol ] ) ENDIF ENDIF END WITH ELSE DEFAULT nCol TO 1 WITH OBJECT ::aCols[ nCol ] IF :nDatacol > 0 cText := ToString( aText[ :nDataCol ] ) ENDIF END WITH ENDIF RETURN cText //------------------------------------------------------------------------------ METHOD SetImageList( oValue ) CLASS XBrowseMod IF ::FoImageList != NIL .AND. ::FoImageList:oParent == Self ::FoImageList:Destroy() ENDIF ::FoImageList := oValue RETURN oValue //------------------------------------------------------------------------------ METHOD SetSupra( Value, lUpdHeader ) CLASS xBrowseMod DEFAULT lUpdHeader TO .T. ::CancelEdit() ::FlSupraHeader := Value IF lUpdHeader .AND. ::oSupra != NIL ::oSupra:lVisible := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetHeader( Value, lUpdHeader ) CLASS XBrowseMod DEFAULT lUpdHeader TO .T. ::CancelEdit() ::FlHeader := Value IF lUpdHeader .AND. ::oHeader != NIL ::oHeader:lVisible := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetFooter( Value, lUpdHeader ) CLASS XBrowseMod DEFAULT lUpdHeader TO .T. ::CancelEdit() ::FlFooter := Value IF lUpdHeader .AND. ::oFooter != NIL ::oFooter:lVisible := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetFilterBar( Value, lUpdHeader ) CLASS XBrowseMod DEFAULT lUpdHeader TO .T. IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:SetFilterBar()" :Operation := "The filter bar cannot be set while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF ::CancelEdit() ::FlFilterBar := Value IF lUpdHeader .AND. ::oHeader != NIL ::oHeader:lFilterBar := Value ENDIF ::Filter() RETURN Value //------------------------------------------------------------------------------ METHOD SetHeaderHeight( Value, lUpdHeader ) CLASS XBrowseMod DEFAULT lUpdHeader TO .T. ::CancelEdit() ::FnHeaderHeight := Value IF lUpdHeader IF ::oSupra != NIL ::oSupra:nHeight := ::FnHeaderHeight ENDIF IF ::oHeader != NIL ::oHeader:nHeight := ::FnHeaderHeight ENDIF ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetAllowColSizing( Value ) CLASS xBrowseMod DEFAULT Value TO ::FlAllowColSizing ::FlAllowColSizing := Value IF ::oHeader != NIL ::oHeader:lResize := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetAllowColSwapping( Value ) CLASS xBrowseMod DEFAULT Value TO ::FlAllowColSwapping ::FlAllowColSwapping := Value IF ::oHeader != NIL ::oHeader:lCanDrag := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetFooterHeight( Value, lUpdHeader ) CLASS XBrowseMod DEFAULT lUpdHeader TO .T. ::CancelEdit() ::FnFooterHeight := Value IF lUpdHeader .AND. ::oFooter != NIL ::oFooter:nHeight := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetRowHeight( Value ) CLASS xBrowseMod IF Empty( Value ) IF Empty( ::FnRowHeight ) Value := ::GetFont():GetTextHeight( "B", Self ) + 8 ::FnRowHeight := Value ELSE Value := ::FnRowHeight ENDIF ELSE ::FnRowHeight := Value ENDIF ::CancelEdit() IF ::oDataGrid != NIL WITH OBJECT ::oDataGrid :nItemHeight := Value :Refresh() END WITH ::oRecSelector:Refresh() ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD SetMargin( Value ) CLASS xBrowseMod ::fnMargin := Value IF ::oDataGrid != nil ::oDataGrid:nMargin := Value ENDIF IF ::oHeader != nil ::oHeader:nMarginHor := Value ENDIF IF ::oFooter != nil ::oFooter:nMarginHor := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetGridData( aData, aHeader ) CLASS xBrowseMod LOCAL oCol LOCAL aWork LOCAL cHeader, cType, xValue LOCAL nFor, nLen DEFAULT aHeader TO {} ::FaGridData := aData ::CancelEdit() ::ResetGroup() IF Len( ::aCols ) == 0 .AND. Len( aData ) > 0 ::BeginPaint() nLen := Len( aHeader ) FOR nFor := 1 TO Len( aData[ 1 ] ) IF nFor <= nLen cHeader := aHeader[ nFor ] ELSE cHeader := "Column " + ToString( nFor ) ENDIF xValue := aData[ 1, nFor ] cType := ValType( xValue ) WITH OBJECT TBrwColMod():New( Self ) :cHeader := cHeader :nWidth := Max( 100, Min( 400, MulDiv( ::oFont:GetTextWidth( ToString(xValue), Self ), 120, 100 ) ) ) SWITCH cType CASE "N" :nDataAlignment := taRIGHT EXIT CASE "L" :nDataAlignment := taCENTER EXIT OTHERWISE :nDataAlignment := taLEFT END SWITCH :Create() END WITH NEXT ::EndPaint() ENDIF FOR EACH oCol IN ::aCols IF Empty( oCol:nDataCol ) oCol:nDataCol := oCol:__EnumIndex ENDIF NEXT IF ::oDataGrid != NIL aWork := Array( Len( aData ) ) AEval( aWork, {| v, e | aWork[ e ] := e } ) ::oDataGrid:aItems := aWork ENDIF ::nSelectCol := Min( 1, Len( ::aCols ) ) ::nIndex := Min( 1, ::RecCount() ) RETURN aData //------------------------------------------------------------------------------ METHOD SelectAll() CLASS xBrowseMod IF ::oDataGrid == NIL RETURN {} ENDIF ::aSelected := AClone( ::oDataGrid:aWork ) RETURN NIL //------------------------------------------------------------------------------ METHOD SelectNone() CLASS xBrowseMod IF ::oDataGrid == NIL RETURN {} ENDIF ::aSelected := {} RETURN NIL //------------------------------------------------------------------------------ METHOD SetSelected( aSel ) CLASS xBrowseMod LOCAL aSet := {}, aWork LOCAL nSel, nAt IF ::oDataGrid == NIL RETURN {} ENDIF WITH OBJECT ::oDataGrid aWork := :aWork FOR EACH nSel IN aSel IF ( nAt := AScan( aWork, nSel ) ) > 0 AAdd( aSet, nAt ) ENDIF NEXT :aSelected := aSet END WITH RETURN aSel //------------------------------------------------------------------------------ METHOD GetSelected() CLASS xBrowseMod LOCAL aSel := {} LOCAL nRow WITH OBJECT ::oDatagrid FOR EACH nRow IN :aSelected AAdd( aSel, :aWork[ nRow ] ) NEXT END WITH RETURN aSel //------------------------------------------------------------------------------ METHOD ClickRecSelector( oSender, nFlags, nX, nY ) CLASS xBrowseMod LOCAL oSt AS CLASS TBrwGroupSt LOCAL aRect, aPoint LOCAL nHot, nRec, nTmp ::CancelEdit() aPoint := { nX, nY } IF ::lRowHeightButtons aRect := GetClientRect( oSender:Handle ) aRect[ rtBOTTOM ] := aRect[ rtTOP ] + 12 IF PtInRect( aRect, aPoint ) WITH OBJECT ::oDataGrid :nItemHeight += ::nRowIncrement :nClientTop -= ( ::nRowIncrement * ( :nIndex - 1 ) ) ::FnRowHeight := :nItemHeight oSender:Refresh() // oRecSelector END WITH RETURN nil ELSE aRect[ rtBOTTOM ] := aRect[ rtTOP ] + ::oHeader:nHeight + ; iif( ::lSupraHeader, ::oSupra:nHeight, 0 ) aRect[ rtTOP ] := aRect[ rtBOTTOM ] - 12 IF PtInRect( aRect, aPoint ) WITH OBJECT ::oDataGrid IF :nItemHeight > 10 :nItemHeight -= ::nRowIncrement nTmp := :nClientTop + ( ::nRowIncrement * ( :nIndex - 1 ) ) :nClientTop := Min( nTmp, 0 ) ::FnRowHeight := :nItemHeight oSender:Refresh() ENDIF END WITH RETURN nil ENDIF ENDIF ENDIF aPoint[ 1 ] := 0 aPoint[ 2 ] -= ::oHeader:nHeight + iif( ::lSupraHeader, ::oSupra:nHeight, 0 ) WITH OBJECT ::oDataGrid nHot := :HitTest( aPoint ) IF nHot > 0 IF :nIndex != nHot :nIndex := nHot ENDIF nRec = :aWork[ nHot ] ::SetRecnoPos( nRec ) ::OnClickRecSelector( nHot, aPoint ) ::RestoreRecnoPos() IF nRec < 0 .AND. ::oGroup != NIL .AND. Round( nRec, 0 ) == nRec oSt := ::oGroup:FindStByRecord( -nRec ) IF oSt != NIL oSt:lCollapsed := !oSt:lCollapsed ::CalcGroup() ENDIF ENDIF ENDIF END WITH RETURN NIL //------------------------------------------------------------------------------ METHOD SetShowCellSelected( Value ) CLASS xBrowseMod LOCAL oItem DEFAULT Value TO ::FlShowCellSelected ::FlShowCellSelected := Value ::nSelectCol := Min( 1, Len( ::aCols ) ) IF ::oHeader != NIL WITH OBJECT ::oHeader IF ( oItem := :ItemAtPos( ::nSelectCol ) ) != NIL ::oSelectCol := oItem:oGridCol ENDIF :nSelect := iif( Value, ::nSelectCol, 0 ) ::oFooter:nSelect := iif( Value, ::nSelectCol, 0 ) END WITH ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrText ::FnClrText := Value IF ::oDataGrid != NIL ::oDataGrid:nClrText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrPane ::FnClrPane := Value IF ::oDataGrid != NIL ::oDataGrid:nClrPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrSelText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrSelText ::FnClrSelText := Value IF ::oDataGrid != NIL ::oDataGrid:nClrSelText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrSelPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrSelPane ::FnClrSelPane := Value IF ::oDataGrid != NIL ::oDataGrid:nClrSelPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHotText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHotText ::FnClrHotText := Value IF ::oDataGrid != NIL ::oDataGrid:nClrHotText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHotPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHotPane ::FnClrHotPane := Value IF ::oDataGrid != NIL ::oDataGrid:nClrHotPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderDivider( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderDivider ::FnClrHeaderDivider := Value IF ::oHeader != NIL ::oHeader:nClrDivider := Value ::oFooter:nClrDivider := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderPane ::FnClrHeaderPane := Value IF ::oHeader != NIL ::oHeader:nClrPane := Value ::oFooter:nClrPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderText ::FnClrHeaderText := Value IF ::oHeader != NIL ::oHeader:nClrText := Value ::oFooter:nClrText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderHotPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderHotPane ::FnClrHeaderHotPane := Value IF ::oHeader != NIL ::oHeader:nClrHotPane := Value ::oFooter:nClrHotPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderHotText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderHotText ::FnClrHeaderHotText := Value IF ::oHeader != NIL ::oHeader:nClrHotText := Value ::oFooter:nClrHotText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderSelPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderSelPane ::FnClrHeaderSelPane := Value IF ::oHeader != NIL ::oHeader:nClrSelPane := Value ::oFooter:nClrSelPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderEditText( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderEditText ::FnClrHeaderEditText := Value IF ::oHeader != NIL ::oHeader:nClrEditText := Value ::oFooter:nClrEditText := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderEditPane( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderEditPane ::FnClrHeaderEditPane := Value IF ::oHeader != NIL ::oHeader:nClrEditPane := Value ::oFooter:nClrEditPane := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderEditTextFocus( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderEditTextFocus ::FnClrHeaderEditTextFocus := Value IF ::oHeader != NIL ::oHeader:nClrEditTextFocus := Value ::oFooter:nClrEditTextFocus := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetClrHeaderEditPaneFocus( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnClrHeaderEditPaneFocus ::FnClrHeaderEditPaneFocus := Value IF ::oHeader != NIL ::oHeader:nClrEditPaneFocus := Value ::oFooter:nClrEditPaneFocus := Value ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD SetRecSelWidth( Value ) CLASS xBrowseMod DEFAULT Value TO ::FnRecSelectorWidth ::CancelEdit() ::FnRecSelectorWidth := Value IF ::oRecSelector != NIL WITH OBJECT ::oRecSelector :nWidth := Value :lVisible := ( Value > 0 ) END WITH ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD ColAtPos( nValue ) CLASS xBrowseMod LOCAL oCol, oItem IF ::oHeader != NIL IF ( oItem := ::oHeader:ItemAtPos( nValue ) ) != NIL oCol := oItem:oGridCol ENDIF ENDIF RETURN oCol //------------------------------------------------------------------------------ METHOD ColWithHeader( cHeader ) CLASS xBrowseMod LOCAL oCol LOCAL nAt cHeader := Upper( cHeader ) IF ( nAt := Ascan( ::aCols, {|v| Upper( v:cHeader ) == cHeader } ) ) > 0 oCol := ::aCols[ nAt ] ENDIF RETURN oCol //------------------------------------------------------------------------------ METHOD SetSelectCol( Value ) CLASS xBrowseMod LOCAL oItem LOCAL aRect LOCAL nOld, nTmp DEFAULT Value TO ::FnSelectCol IF Value == ::fnSelectCol .AND. ::oSelectCol != NIL RETURN nil ENDIF nOld := ::FnSelectCol ::FnSelectCol := Value ::oSelectCol := NIL IF ::oHeader != NIL WITH OBJECT ::oHeader IF ( oItem := :ItemAtPos( Value ) ) != NIL ::oSelectCol := oItem:oGridCol ENDIF :nSelect := Value ::oFooter:nSelect := Value END WITH WITH OBJECT ::oDataGrid IF Value <= 1 .OR. oItem == NIL ::FnSelectCol := Value :nClientLeft := 0 ELSEIF !::oHeader:IsFullVisible( ::oSelectCol:oHeaderCol ) aRect := ::oSelectCol:oHeaderCol:GetRect() IF Value > nOld nTmp := aRect[ rtRIGHT ] - :nClientWidth :nClientLeft := - nTmp ELSE :nClientLeft += ( aRect[ rtRIGHT ] - aRect[ rtLEFT ] ) ENDIF ENDIF :AdjustHeaders() :Refresh() IF Value != nOld ::OnChange( .F. ) ENDIF END WITH ENDIF RETURN Value //------------------------------------------------------------------------------ METHOD BeginPaint() CLASS xBrowseMod ::nRedraw++ IF ::oHeader != NIL ::oHeader:BeginPaint() ::oFooter:BeginPaint() ::oSupra:BeginPaint() ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD EndPaint() CLASS xBrowseMod --::nRedraw IF ::oHeader != NIL ::oHeader:EndPaint() ::oFooter:EndPaint() ::oSupra:EndPaint() ENDIF IF Empty( ::nSelectCol ) ::SetSelectCol( 1 ) ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD HeaderChanged() CLASS xBrowseMod ::oDataGrid:Adjust() ::oDataGrid:AdjustHeaders() ::oDataGrid:Refresh() ::oHeader:SetEditProperties() RETURN NIL //------------------------------------------------------------------------------ METHOD AddSupraCol( cHeader, nCols, lSeparator, lResize, lDragDrop ) CLASS xBrowseMod LOCAL oItem, oTemp LOCAL aCols LOCAL nFor, nBeg, nWidth, nMax IF nCols > Len( ::aCols ) RETURN NIL ENDIF DEFAULT lSeparator TO .T., ; lResize TO .T., ; lDragDrop TO .T. ::CancelEdit() ::BeginPaint() WITH OBJECT oItem := ::oSupra:AddItem( cHeader ) :lCanResize := lResize :lCanDrag := lDragDrop :Cargo := lSeparator END WITH IF !Empty( nCols ) nBeg := 1 DO WHILE ::aCols[ nBeg ]:oSupraCol != NIL nBeg++ ENDDO nWidth := 0 nMax := nBeg + nCols - 1 FOR nFor := nBeg TO nMax oTemp := ::aCols[ nFor ] oTemp:lCanDrag := .F. oTemp:lCanHide := .F. oTemp:oSupraCol := oItem nWidth += oTemp:nWidth IF nFor < nMax oTemp:lCanResize := .F. nWidth++ ENDIF NEXT ELSE nWidth := 150 ENDIF WITH OBJECT oItem :nWidth := nWidth :lVisible := .T. END WITH IF !::lSupraHeader ::lSupraHeader := .T. ENDIF ::EndPaint() RETURN oItem //------------------------------------------------------------------------------ STATIC FUNCTION SupraSeparator( oItem, hDC, aRect, nColor ) LOCAL hPen IF oItem:Cargo hPen := CreatePen( PS_SOLID, 1, nColor ) MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] - 1 ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtBOTTOM ] - 1, hPen ) aRect[ rtBOTTOM ]-- DeleteObject( hPen ) ENDIF RETURN NIL //------------------------------------------------------------------------------ // Sólo se ejecuta cuando hay supra METHOD AdjustChildrenSizes( oItem ) CLASS xBrowseMod LOCAL oTemp LOCAL nWidth, nCols, nTmp, nLast nCols := 0 nLast := 0 ::CancelEdit() ::BeginPaint() FOR EACH oTemp IN ::aCols IF ( oTemp:oSupraCol == oItem ) nCols++ nLast := oTemp:__EnumIndex() ENDIF NEXT nWidth := MulDiv( oItem:nWidth - nCols + 1, 1, nCols ) nTmp := 0 FOR EACH oTemp IN ::aCols IF ( oTemp:oSupraCol == oItem ) IF oTemp:__EnumIndex() < nLast nTmp += nWidth ELSE nWidth := oItem:nWidth - nCols + 1 - nTmp ENDIF oTemp:nWidth := nWidth oTemp:oFooterCol:nWidth := nWidth ENDIF NEXT ::EndPaint() RETURN NIL //------------------------------------------------------------------------------ METHOD SupraSwapRequest( oItem, nPos ) CLASS xBrowseMod LOCAL oDrop, oTmp LOCAL aFrom, aTo LOCAL nFor IF nPos > 0 ::CancelEdit() oDrop := ::oSupra:aItems[ nPos ] aFrom := {} aTo := {} FOR EACH oTmp IN ::aCols IF oTmp:oSupraCol == oItem AAdd( aFrom, oTmp ) ELSEIF oTmp:oSupraCol == oDrop AAdd( aTo, oTmp ) ENDIF NEXT ::oHeader:BeginPaint() FOR nFor := 1 TO Len( aFrom ) ::oHeader:SwapItems( aFrom[ nFor ]:oHeaderCol, aTo[ nFor ]:oHeaderCol, .T. ) NEXT ::oHeader:EndPaint() ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD PaintRecSelector( oSender, hDC ) CLASS xBrowseMod LOCAL oSt LOCAL aRect, aTmp, aPnt LOCAL cValue LOCAL hBrush, hPen, hOld LOCAL nRight, nTop, nHeight, nColor, nTmp, nIndex, nFirst, nLast LOCAL nImage, nClrText, nClrPane, nMgn, nFlags LOCAL lOk, lEvent nColor := iif( XA_Luminance( ::nClrPane ) < 127, clWhite, clBlack ) lEvent := ::EventAssigned( "OnDrawRecSelector" ) WITH OBJECT oSender nRight := :nClientWidth IF ::lColumnSeparator hPen := CreatePen( PS_SOLID, 1, ::nClrDivider ) nRight-- MoveTo( hDC, nRight, 0 ) LineTo( hDC, nRight, :nClientHeight, hPen ) DeleteObject( hPen ) ENDIF END WITH aRect := { 0, 0, nRight, 0 } aPnt := { 0, 0, nRight, 0 } IF ::lSupraHeader WITH OBJECT ::oSupra aRect[ rtBOTTOM ] := :nHeight hBrush := CreateSolidBrush( :nClrPane ) FillRect( hDC, aRect, hBrush ) DeleteObject( hBrush ) END WITH ENDIF IF ::lHeader aRect[ rtBOTTOM ] += ::oHeader:nHeight ENDIF hBrush := CreateSolidBrush( ::nClrPane ) FillRect( hDC, { 0, aRect[ rtBOTTOM ], nRight, ::nClientHeight }, hBrush ) DeleteObject( hBrush ) WITH OBJECT ::oDataGrid nFirst := :FirstVisible() nLast := :LastVisible() nMgn := ::oDataGrid:nMargin aPnt[ rtLEFT ] := nMgn aPnt[ rtRIGHT ] -= ( nMgn + 6 ) DO WHILE nFirst <= nLast nTmp := :aWork[ nFirst ] nTop := ( nFirst - 1 ) * :nItemHeight + :nClientTop IF nTop < 0 nHeight := :nItemHeight + nTop nTop := aRect[ rtBOTTOM ] + :nClientTop ELSE nTop += aRect[ rtBOTTOM ] nHeight := :nItemHeight ENDIF IF ::oGroup == NIL .AND. lEvent aPnt[ rtTOP ] := nTop + 1 aPnt[ rtBOTTOM ] := nTop + nHeight - 1 cValue := "" nImage := 0 nClrText := ::nClrText nClrPane := ::nClrPane ::SetRecnoPos( nTmp ) lOk := ::OnDrawRecSelector( nFirst, @cValue, @nImage, @nClrText, @nClrPane, hDC, aPnt ) IF lOk == NIL .OR. lOk IF nClrPane != ::nClrPane hBrush := CreateSolidBrush( nClrPane ) FillRect( hDC, aPnt, hBrush ) DeleteObject( hBrush ) ENDIF IF !Empty( nImage ) aTmp := { aPnt[ rtLEFT ],; aPnt[ rtTOP ],; aPnt[ rtLEFT ] + ::oImageList:nWidth,; aPnt[ rtBOTTOM ] } XA_DrawBitmapByPos( hDC, ::oImageList:Handle,; nImage, aTmp ) ENDIF IF !Empty( cValue ) SetTextColor( hDC, nClrText ) SetBkMode( hDC, TRANSPARENT ) hOld := SelectObject( hDC, ::oFont:Handle ) nFlags := nOr( DT_END_ELLIPSIS, DT_SINGLELINE, DT_VCENTER, DT_RIGHT ) DrawText( hDC, cValue, aPnt, nFlags ) SelectObject( hDC, hOld ) ENDIF ENDIF ENDIF IF lEvent ::RestoreRecnoPos() ENDIF nTop += Shr( nHeight - 12, 1 ) IF ::oGroup != NIL .AND. nTmp < 0 IF Round( nTmp, 0 ) == nTmp oSt := ::oGroup:FindStByRecord( - nTmp ) IF oSt != NIL aTmp := { Max( 2, nRight - 14 ), nTop + 2, nRight - 4, nTop + 12 } IF !oSt:lCollapsed XA_PaintTriangle( hDC, aTmp, nColor, orBOTTOM ) ELSE XA_PaintTriangle( hDC, aTmp, nColor, orRIGHT ) ENDIF ENDIF ENDIF ELSEIF nFirst == :nIndex aTmp := { Max( 2, nRight - 6 ), nTop, nRight - 2, nTop + 12 } XA_PaintTriangle( hDC, aTmp, nColor, orRIGHT ) ENDIF nFirst++ ENDDO END WITH IF ::lHeader WITH OBJECT ::oHeader hBrush := CreateSolidBrush( :nClrPane ) FillRect( hDC, aRect, hBrush ) DeleteObject( hBrush ) cValue := ::cRecSelectorHeader IF !Empty( cValue ) aTmp := AClone( aRect ) aTmp[ rtRIGHT ] -= ( nMgn + 6 ) SetTextColor( hDC, nClrText ) SetBkMode( hDC, TRANSPARENT ) hOld := SelectObject( hDC, ::oFont:Handle ) nFlags := nOr( DT_END_ELLIPSIS, DT_SINGLELINE, DT_VCENTER, DT_RIGHT ) DrawText( hDC, cValue, aTmp, nFlags ) SelectObject( hDC, hOld ) ENDIF IF ::lRowHeightButtons IF Empty( cValue ) nTmp := Shr( nRight - 8, 1 ) ELSE nTmp := 4 ENDIF aTmp := { nTmp, aRect[ rtTOP ] + 4, nTmp + 8, aRect[ rtTOP ] + 8 } XA_PaintTriangle( hDC, aTmp, ::nClrDivider, orTOP ) aTmp[ rtBOTTOM ] := aRect[ rtBOTTOM ] - 4 aTmp[ rtTOP ] := aTmp[ rtBOTTOM ] - 4 XA_PaintTriangle( hDC, aTmp, ::nClrDivider, orBOTTOM ) ENDIF END WITH ENDIF IF ::lFooter WITH OBJECT ::oFooter aRect[ rtBOTTOM ] := oSender:nClientHeight aRect[ rtTOP ] := aRect[ rtBOTTOM ] - :nHeight hBrush := CreateSolidBrush( :nClrPane ) FillRect( hDC, aRect, hBrush ) DeleteObject( hBrush ) END WITH ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD HeaderClick( oHeader, oItem, aPos ) CLASS xBrowseMod LOCAL oCol LOCAL lRet ::CancelEdit() oCol := oItem:oGridCol lRet := ::OnHeaderClick( oItem, aPos ) IF ( Empty( lRet ) .OR. lRet ) .AND. ::lAllowSort .AND. !::IsGroup() ::Sort( oCol ) ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD HeaderRClick( oHeader, oItem, aPos ) CLASS xBrowseMod LOCAL oCol, oMenu LOCAL nVis LOCAL lRet, lEna ::CancelEdit() oCol := oItem:oGridCol lRet := ::OnHeaderRClick( oItem, aPos ) IF ( Empty( lRet ) .OR. lRet ) .AND. ::lAllowColHiding nVis := 0 FOR EACH oCol IN ::aCols IF oCol:lCanHide .AND. !Empty( oCol:cHeader ) .AND. oCol:IsVisible() nVis++ ENDIF NEXT MENU oMenu POPUP FOR EACH oCol IN ::aCols IF oCol:lCanHide .AND. !Empty( oCol:cHeader ) lEna := ( nVis != 1 ) .OR. !oCol:IsVisible() XA_MenuItem( StrTran( oCol:cHeader, CRLF, " " ),; {|| oCol:lVisible := !oCol:IsVisible() }, Nil, ; lEna, oCol:IsVisible(), .F., .F., .F. ) ENDIF NEXT ENDMENU ::oHeader:ShowPopupMenu( oMenu, aPos[ 1 ], aPos[ 2 ] ) ENDIF RETURN .F. //------------------------------------------------------------------------------ METHOD SetIndex( nValue ) CLASS xBrowseMod ::UpdateIndex( nValue ) IF ::oDataGrid != NIL ::oDataGrid:SetIndexNoUpdateParent( nValue ) ENDIF RETURN ::FnIndex //------------------------------------------------------------------------------ METHOD UpdateIndex( nValue ) CLASS xBrowseMod DEFAULT nValue TO ::FnIndex ::FnIndex := nValue RETURN NIL //------------------------------------------------------------------------------ METHOD StartEdit( nChr ) CLASS XBrowseMod LOCAL oCol oCol := ::oEditCol IF oCol != NIL oCol:Edit() oCol:oGridEdit:SetFocus() IF !Empty( nChr ) oCol:oGridEdit:PostMsg( WM_CHAR, nChr ) ENDIF ELSE FOR EACH oCol IN ::aCols oCol:Edit() NEXT oCol := ::oDataGrid:FirstColEditable() IF oCol != NIL oCol:oGridEdit:SetFocus() ENDIF ENDIF RETURN NIL //------------------------------------------------------------------------------ // Si oCol != NIL es edición de una única celda // nKey es la tecla con la que se entró en edición. 0 es ratón METHOD Edit( oCol, nKey ) CLASS XBrowseMod LOCAL xValue LOCAL nChr LOCAL lRet, lFast DEFAULT nKey TO 0 IF ::nIndex == 0 RETURN .F. ENDIF IF oCol == NIL .AND. ::oDataGrid:ColsEditable() == 1 oCol := ::oDataGrid:FirstColEditable() ENDIF IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Edit()" :Operation := "Edit cannot be done while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF lRet := ::OnEdit() lFast := ::lFastEdit IF lRet != NIL .AND. !lRet RETURN .F. ENDIF ::oEditCol := oCol IF oCol != NIL xValue := oCol:EditValue() ::OnEditCol( oCol, @xValue, nKey ) oCol:oGridEdit:Value := xValue IF lFast .AND. xValue == oCol:EditValue() .AND. nKey >= 32 nChr := nKey ENDIF ELSE FOR EACH oCol IN ::aCols xValue := oCol:EditValue() ::OnEditCol( oCol, @xValue, 0 ) oCol:oGridEdit:Value := xValue NEXT oCol := NIL ENDIF ::nEditMode := beEDIT WITH OBJECT ::oDataGrid IF !:IsItemVisible( ::nIndex ) :nIndex := ::nIndex ProcessMessages() ENDIF END WITH ::RunEdit() ::PostMsg( WM_XAILER, nChr ) RETURN .T. //------------------------------------------------------------------------------ METHOD CancelEdit( lSave, nKey ) CLASS xBrowseMod LOCAL aRecord LOCAL lRet IF ::nEditMode == beREAD RETURN .F. ENDIF DEFAULT lSave TO .F., nKey TO 0 lRet := ::OnCancelEdit( lSave, nKey ) IF lRet != NIL .AND. !lRet RETURN .T. ENDIF AEval( ::aCols, {|v| v:CancelEdit() } ) IF lSave ::Save() ELSE ::EditUndo() ENDIF ::oEditCol := NIL ::nEditMode := beREAD ::oDataGrid:SetFocus() RETURN .T. //------------------------------------------------------------------------------ METHOD Save() CLASS xBrowseMod LOCAL oCol LOCAL xValue LOCAL lRet lRet := ::OnSave() IF lRet != NIL .AND. !lRet ::EditUndo() RETURN .F. ENDIF IF ::oEditCol == NIL FOR EACH oCol IN ::aCols xValue := oCol:oGridEdit:SaveValue() lRet := ::OnSaveCol( oCol, @xValue ) IF lRet != NIL .AND. !lRet ::EditUndo() RETURN .F. ENDIF oCol:oGridEdit:Value := xValue NEXT ELSE oCol := ::oEditCol xValue := oCol:oGridEdit:SaveValue() lRet := ::OnSaveCol( oCol, @xValue ) IF lRet != NIL .AND. !lRet ::EditUndo() RETURN .F. ENDIF oCol:oGridEdit:Value := xValue ENDIF ::oDataGrid:Save() IF ::lAutoSave lRet := ::RunSave() ELSE lRet := ::OnUpdate() ENDIF IF lRet ::OnPostSave() ENDIF RETURN lRet //------------------------------------------------------------------------------ METHOD RunSave( nRecord ) CLASS XBrowseMod LOCAL oCol AS CLASS TBrwColMod LOCAL nRec, nFields nRec := ::oDataGrid:nEditPos nFields := Len( ::aCols ) SWITCH ::nEditMode CASE beINSERT HB_AIns( ::aGridData, nRec, Array( nFields ), .T. ) EXIT CASE beAPPEND AAdd( ::aGridData, Array( nFields ) ) EXIT END SWITCH nRec := ::oDataGrid:Record() IF ::oEditCol != NIL oCol := ::oEditCol IF !Empty( oCol:nDataCol ) ::aGridData[ nRec, oCol:nDataCol ] := oCol:oGridEdit:Value ENDIF ELSE FOR EACH oCol IN ::aCols IF !Empty( oCol:nDataCol ) ::aGridData[ nRec, oCol:nDataCol ] := oCol:oGridEdit:Value ENDIF NEXT ENDIF IF ::IsSorted() ::Resort( .T. ) ENDIF RETURN .T. //------------------------------------------------------------------------------ METHOD EditUndo() CLASS xBrowseMod LOCAL aWork LOCAL nAt aWork := ::oDataGrid:aWork SWITCH ::nEditMode CASE beAPPEND HB_ADel( aWork, Len( aWork ), .T. ) ::nIndex := Len( aWork ) EXIT CASE beINSERT nAt := AScan( aWork, {|v| v == 0 } ) IF nAt > 0 HB_ADel( aWork, nAt, .T. ) ::nIndex := Max( nAt, 1 ) ENDIF EXIT CASE beEDIT EXIT END SWITCH ::RunEditUndo() RETURN NIL //------------------------------------------------------------------------------ METHOD Append() CLASS xBrowseMod LOCAL oCol LOCAL xValue LOCAL lRet IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Append()" :Operation := "Append cannot be done while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF ::oEditCol := NIL lRet := ::OnAppend() IF lRet != NIL .AND. !lRet RETURN .F. ENDIF ::nEditMode := beAPPEND FOR EACH oCol IN ::aCols xValue := oCol:DefaultValue() ::OnEditCol( oCol, @xValue, 0 ) oCol:oGridEdit:Value := xValue NEXT ::oDataGrid:Append() ::RunAppend() RETURN .T. //------------------------------------------------------------------------------ METHOD Insert() CLASS xBrowseMod LOCAL oCol LOCAL xValue LOCAL lRet IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Insert()" :Operation := "Insert cannot be done while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF lRet := ::OnInsert() IF lRet != NIL .AND. !lRet RETURN .F. ENDIF ::oEditCol := NIL ::nEditMode := beINSERT FOR EACH oCol IN ::aCols xValue := oCol:DefaultValue() ::OnEditCol( oCol, @xValue, 0 ) oCol:oGridEdit:Value := xValue NEXT ::oDataGrid:Insert() RETURN .T. //------------------------------------------------------------------------------ METHOD Delete() CLASS xBrowseMod LOCAL aWork LOCAL lRet IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Delete()" :Operation := "Delete cannot be done while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF ::oEditCol := NIL lRet := ::OnDelete() IF lRet != NIL .AND. !lRet RETURN .F. ENDIF ::RunDelete() WITH OBJECT ::oDataGrid :Delete() IF ::IsSorted() ::Resort( .F. ) ENDIF END WITH RETURN .T. //------------------------------------------------------------------------------ METHOD RunDelete( nRecord ) CLASS xBrowseMod DEFAULT nRecord TO ::oDataGrid:Record() HB_ADel( ::aGridData, nRecord, .t. ) RETURN .T. //------------------------------------------------------------------------------ METHOD ResetData( aWork ) CLASS XBrowseMod DEFAULT aWork TO Array( Len( ::aGridData ) ) AEval( aWork, {|v,e| aWork[ e ] := e } ) ::oDataGrid:SetItems( aWork ) ::FnIndex := 1 RETURN NIL //------------------------------------------------------------------------------ METHOD Reset() CLASS XBrowseMod AEval( ::aCols, {|v| v:End() } ) ::FaCols := {} ::oSelectCol := NIL ::oEditCol := NIL ::nSelectCol := 0 RETURN Nil //------------------------------------------------------------------------------ METHOD Refresh( lValue ) CLASS XBrowseMod DEFAULT lValue TO .F. IF !::lCreated .OR. !IsWindowVisible( ::Handle ) RETURN nil ENDIF IF ::oDataGrid != NIL ::oDataGrid:Refresh( lValue ) ENDIF RETURN ::Super:Refresh( lValue ) //------------------------------------------------------------------------------ METHOD Sort( oCol, nSort ) CLASS xBrowseMod LOCAL aSel LOCAL lRet IF ::IsGroup() WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Sort()" :Operation := "Column sort cannot be set while there is an active group" Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF lRet := .f. IF oCol != NIL WITH OBJECT oCol:oHeaderCol IF nSort == nil IF :nSort = hsNONE .OR. :nSort = hsDESCENDING nSort := hsASCENDING ELSE nSort := hsDESCENDING ENDIF ENDIF aSel := ::GetSelected() IF ::RunSort( oCol, nSort ) :nSort := nSort ::SetSelected( aSel ) lRet := .t. ENDIF END WITH ELSE //UnSort() ::oHeader:ResetSortState() ::RunFilter() ENDIF RETURN lRet //------------------------------------------------------------------------------ METHOD SortedCol() CLASS xBrowseMod LOCAL oCol AS CLASS TBrwColMod FOR EACH oCol IN ::aCols IF oCol:oHeaderCol:nSort != 0 RETURN oCol:__EnumIndex() ENDIF NEXT RETURN 0 //------------------------------------------------------------------------------ METHOD ReSort( lKeepRecno ) CLASS xBrowseMod LOCAL oItem AS CLASS THeaderModItem LOCAL nRecord, nAt DEFAULT lKeepRecno TO .T. oItem := ::oHeader:ColSorted() IF oItem != NIL IF lKeepRecno nRecord := ::oDataGrid:Record() ENDIF ::RunSort( oItem:oGridCol, oItem:nSort ) IF lKeepRecno nAt := AScan( ::oDataGrid:aWork, {|v| v == nRecord } ) IF nAt > 0 ::nIndex := nAt ENDIF ENDIF ENDIF RETURN nil //------------------------------------------------------------------------------ METHOD RunSort( oCol, nSort ) CLASS XBrowseMod LOCAL aData, aWork LOCAL nCol aData := ::aGridData aWork := ::oDataGrid:aWork IF Len( aData ) == 0 .OR. Len( aWork ) == NIL RETURN .F. ENDIF nCol := oCol:nDataCol IF ValType( aData[ 1, nCol ] ) != "C" IF nSort = hsASCENDING ASort( aWork,,, {| x, y | aData[ x, nCol ] < aData[ y, nCol ] } ) ELSE ASort( aWork,,, {| x, y | !( aData[ x, nCol ] < aData[ y, nCol ] ) } ) ENDIF ELSE IF nSort = hsASCENDING ASort( aWork,,, {| x, y | Upper( aData[ x, nCol ] ) < Upper( aData[ y, nCol ] ) } ) ELSE ASort( aWork,,, {| x, y | !( Upper( aData[ x, nCol ] ) < Upper( aData[ y, nCol ] ) ) } ) ENDIF ENDIF RETURN .T. //------------------------------------------------------------------------------ METHOD Filter( oCol ) CLASS xBrowseMod LOCAL nRecno IF ::oDataGrid == NIL RETURN nil ENDIF ::CancelEdit() ::OnFilterStart( oCol ) IF ::nIndex > 0 .AND. ::nIndex <= Len( ::oDataGrid:aWork ) nRecno := ::oDataGrid:aWork[ ::nIndex ] ENDIF IF ::RunFilter() .AND. !Empty( nRecno ) nRecno := AScan( ::oDataGrid:aWork, nRecno ) IF nRecno > 0 ::nIndex := nRecno ELSE ::nIndex := 1 ENDIF ENDIF ::OnFilterEnd( oCol ) IF oCol != NIL IF ::lShowCellSelected ::nSelectCol := oCol:nPos ENDIF ::oDataGrid:SetFocus() ENDIF RETURN NIL //------------------------------------------------------------------------------ STATIC FUNCTION GenBlock( cText ) LOCAL bBlock LOCAL cPars, cBlock LOCAL nAt cText := AllTrim( cText ) nAt := At( "(", cText ) IF nAt > 0 .AND. Right( cText, 1 ) == ")" cPars := SubStr( cText, nAt + 1, Len( cText ) - nAt - 1 ) cBlock := "{|" + cPars + "| " + cText + " }" ELSE cBlock := "{|v|" + cText + "}" ENDIF TRY bBlock := &( cBlock ) CATCH WITH OBJECT ErrorNew() :SubSystem := "XAILER" :SubCode := 0 :Severity := ES_ERROR :Description := "TBrowseMod:Filter()" :Operation := "Invalid FilterEval expression: " + cText Eval( ErrorBlock(), :__WithObject() ) END WITH bBlock := NIL END RETURN bBlock //------------------------------------------------------------------------------ METHOD RunFilter() CLASS XBrowseMod LOCAL oCol LOCAL aWork, aData, aRow, aFilters, aFil LOCAL cFilter, cOper LOCAL bFilter LOCAL lIn aWork := {} aFilters := {} aData := ::aGridData IF Len( aData ) == 0 RETURN .F. ENDIF ::aSelected := {} // With filters we clean rows selected IF !::lFilterBar .OR. !::IsFilter() ::ResetData() RETURN .T. ENDIF FOR EACH oCol IN ::aCols WITH OBJECT oCol IF :IsVisible() cFilter := :oEditFilter:Value IF !Empty( :FilterEval ) IF ValType( :FilterEval ) != "B" :FilterEval := GenBlock( :FilterEval ) ENDIF IF ValType( :FilterEval ) == "B" cFilter := Eval( :FilterEval, oCol, cFilter ) ENDIF ENDIF IF !Empty( cFilter ) SWITCH ValType( aData[ 1, :nDataCol ] ) CASE "L" IF Upper( cFilter ) $ "SVYT" .OR. Upper( cFilter ) = ".T." bFilter := {| v | v } ELSE bFilter := {| v | !v } ENDIF EXIT CASE "N" cOper := FindOper( @cFilter, "=" ) IF IsAllDigits( cFilter, .T. ) bFilter := &( "{|v| v" + cOper + cFilter + "}" ) ELSE bFilter := {| v | .F. } ENDIF EXIT CASE "C" cOper := FindOper( @cFilter, "$" ) cFilter := UpperSinTildes( cFilter ) IF Right( cFilter, 1 ) == "%" cFilter := SubStr( cFilter, 1, Len( cFilter ) - 1 ) bFilter := &( "{|v| UpperSinTildes(v) ='" + cFilter + "'}" ) ELSEIF cOper = "$" bFilter := &( "{|v| '" + cFilter + "' $ UpperSinTildes(v) }" ) ELSE bFilter := &( "{|v| UpperSinTildes(v) " + cOper + "'" + cFilter + "'}" ) ENDIF EXIT CASE "D" CASE "T" cOper := FindOper( @cFilter, "=" ) IF Len( cFilter ) >= 8 .AND. !Empty( CToD( cFilter ) ) cFilter := DToS( CToD( cFilter ) ) bFilter := &( "{|v| Dtos(v)" + cOper + "'" + cFilter + "'}" ) ELSE bFilter := {| v | .F. } ENDIF EXIT OTHERWISE LOOP END SWITCH AAdd( aFilters, { :nDataCol, bFilter } ) ENDIF ENDIF END WITH NEXT TRY FOR EACH aRow IN aData lIn := .T. FOR EACH aFil IN aFilters lIn := Eval( aFil[ 2 ], aRow[ aFil[ 1 ] ] ) IF !lIn EXIT ENDIF NEXT IF lIn AAdd( aWork, aRow:__EnumIndex() ) ENDIF NEXT CATCH aWork := {} END WITH OBJECT ::oDataGrid :SetItems( aWork ) END WITH IF ::IsSorted() ::Resort( .f. ) ENDIF RETURN .T. //------------------------------------------------------------------------------ METHOD Rebuild( nRecord ) CLASS xBrowseMod LOCAL nAt DEFAULT nRecord TO ::oDataGrid:Record() ::RunFilter() IF ::IsSorted() ::ReSort() ENDIF nAt := AScan( ::oDataGrid:aWork, {|v| v == nRecord } ) IF nAt > 0 ::nIndex := nAt ELSE ::nIndex := 1 ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD AdjustColWidth( oCol, lCalc ) CLASS xBrowseMod LOCAL oItem, oFont LOCAL aRow LOCAL xValue LOCAL cPicture LOCAL nDataCol, nWidth, nHeader, nData, nMax DEFAULT lCalc TO .F. oFont := ::oFont IF oCol:IsKindOf( "TBrwColMod" ) oItem := oCol:oHeaderCol ELSE oItem := oCol ENDIF WITH OBJECT oItem:oGridCol nDataCol := :nDataCol cPicture := :cPicture END WITH nHeader := oFont:GetTextWidth( oItem:cHeader, Self ) nHeader += ( ::oDataGrid:nMargin * 2 ) IF oItem:nImage > 0 nHeader += ::oImageList:nWidth ENDIF nHeader := MulDiv( nHeader, 120, 100 ) nData := 0 FOR EACH aRow IN ::aGridData xValue := aRow[ nDataCol ] IF !Empty( xValue ) nWidth := oFont:GetTextWidth( Transform( xValue, cPicture ), Self ) IF nWidth > nData nData := nWidth ENDIF ENDIF NEXT IF oItem:oGridCol:lDataImageUsed nMax += ::oImageList:nWidth ENDIF nData += ( ::oDataGrid:nMargin * 2 ) nMax := Max( nHeader, nData ) nMax := Min( nMax, ::nClientWidth - 50 ) IF !lCalc oItem:oGridCol:nWidth := nMax ENDIF RETURN nMax //------------------------------------------------------------------------------ METHOD GroupOn( oCol, lCollapsed, lFooter, lLine ) CLASS xBrowseMod LOCAL oGrp DEFAULT lCollapsed TO .F. ,; lFooter TO .F. ,; lLine TO .F. IF ValType( oCol ) != "A" oCol := { oCol } ENDIF WITH OBJECT oGrp := TBrwGroup():New( Self ) :aGroupCols := oCol :lCollapsed := lCollapsed :lFooter := lFooter :lLine := lLine END WITH IF ::oGroup != NIL ::oGroup:End() ENDIF ::oGroup := oGrp IF ::nRecSelectorWidth < 20 ::nRecSelectorWidth := 20 ENDIF ::CalcGroup() RETURN oGrp //------------------------------------------------------------------------------ METHOD ResetGroup() CLASS xBrowseMod LOCAL aData IF ::oGroup != NIL aData := ::oGroup:aWrkBackup ::oGroup:End() ::oGroup := NIL ::ResetData( aData ) ::Refresh( .F. ) ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD CalcGroup() CLASS xBrowseMod LOCAL oGrp AS CLASS TBrwGroup LOCAL oSt AS CLASS TBrwGroupSt LOCAL aWork, aTmp LOCAL cGroup, cLast LOCAL nRecord, nRec, nOld, nAt LOCAL lShow IF !::IsGroup() RETURN .F. ENDIF oGrp := ::oGroup aWork := ::oDataGrid:aWork aTmp := {} nOld := 0 IF !::oGroup:Calculated() ::ClearFilter() // Este método ya hace un ResetData() ::Resort( .F. ) FOR EACH nRecord IN aWork // nRecord apunta al record en aDataGrid oGrp:AddReg( nRecord, nRecord:__EnumIndex() ) NEXT oGrp:Complete( aWork ) ::oHeader:ResetSortState() ELSE WITH OBJECT ::oDataGrid IF :nIndex <= Len( aWork ) nOld := aWork[ :nIndex ] ENDIF END WITH aWork := oGrp:Restore() ENDIF // Incorporación de registros según su estado de colapso // Añadiendo líneas para grupos cLast := "" nRec := 0 lShow := .T. FOR EACH nRecord IN aWork cGroup := oGrp:GroupValueByRecord( nRecord ) IF !( cGroup == cLast ) IF oGrp:lFooter .AND. nRec > 0 AAdd( aTmp, - ( nRec + 0.9 ) ) ENDIF AAdd( aTmp, - nRecord ) nRec := nRecord oSt := oGrp:FindStByGroupValue( cGroup ) IF oSt != NIL lShow := !oSt:lCollapsed ELSE lShow := .T. ENDIF cLast := cGroup ENDIF IF lShow AAdd( aTmp, nRecord ) ENDIF NEXT IF oGrp:lFooter .AND. nRec > 0 AAdd( aTmp, - ( nRec + 0.9 ) ) ENDIF ::oDataGrid:SetItems( aTmp ) IF !Empty( nOld ) .AND. ( nAt := AScan( aTmp, {|v| v == nOld } ) ) > 0 ::nIndex := nAt ENDIF ::Refresh() RETURN NIL //-------------------------------------------------------------------------- METHOD ToExcel( cFile, lXlsNumeric ) CLASS XBrowseMod LOCAL oExcel, oWorkBook, oSheet, oCol, oClp, oError LOCAL xVal LOCAL cHeader, cData,cCol, cPic, cVal LOCAL nRec, nAlign, nAt, nLine, nLines, nCol, nCols, nAdj LOCAL lState DEFAULT lXlsNumeric TO .T. IF Len( ::aDisplayCols ) == 0 RETURN .F. ENDIF TRY oExcel := GetActiveObject( "Excel.Application" ) CATCH TRY oExcel := CreateObject( "Excel.Application" ) CATCH MsgAlert( "ERROR! Excel not available. [" + Ole2TxtError()+ "]" ) RETURN .F. END END TRY oWorkBook := oExcel:Workbooks:Add() oSheet := oWorkBook:WorkSheets( 1 ) CATCH MsgAlert( "ERROR! Excel worksheet not available. [" + Ole2TxtError()+ "]" ) oExcel := NIL ::oForm:Close() RETURN .F. END nCol := 0 nCols := 0 cCol := "" TRY // Print Column titles FOR EACH oCol IN ::aDisplayCols WITH OBJECT oCol IF oCol:lVisible nCol ++ nAlign := :nAlignment cHeader := :cHeader WITH OBJECT oSheet:Cells( 1, nCol ) :Value := cHeader IF nAlign == taRIGHT :HorizontalAlignment := 4 ELSEIF nAlign == taCENTER :HorizontalAlignment := 3 ENDIF END WITH IF ( nAdj := Int( nCol / 27 ) ) > 0 cCol := Chr( 64 + nAdj ) + Chr( 65 + ( nCol % 27 ) ) ELSE cCol := Chr( 64 + nCol ) ENDIF IF lXlsNumeric .AND. (nAlign == taRIGHT ) WITH OBJECT oSheet:Columns( cCol ) :HorizontalAlignment := 4 IF ( nAt := At( ".", oCol:cPicture ) ) > 0 :NumberFormat := "#.##0," + Replicate( "0", Len( oCol:cPicture ) - nAt ) ENDIF END WITH ENDIF ENDIF END WITH NEXT nCols := nCol // Format column titles WITH OBJECT oSheet:Range( "A1:" + cCol + "1" ) :Font:Bold := .T. :Font:Size := 8 :Interior:Color := RGB( 192, 192, 192 ) END WITH oClp := TClipboard():Create( ::oParent ) lState := ::oParent:lEnabled ::oParent:lEnabled := .F. Application:lBusy := .T. cData := "" nLine := 2 nLines := 0 FOR EACH nRec IN ::oDataGrid:aWork nCol := 0 FOR EACH oCol IN ::aDisplayCols IF oCol:lVisible cPic := oCol:cPicture xVal := oCol:Value( nRec ) cVal := XlsData( xVal, cPic, lXlsNumeric ) nCol ++ ::OnDrawCell( oCol, oCol:nIndex, xVal, @cVal, 0, 0, 0, 0, 0, {0,0,0,0} ) IF Empty( cVal ) // para cuando se elimina el texto porque sólo se muestra una imagen. cVal := ToString( xVal ) ENDIF cData += cVal + IIF( nCol < nCols, Chr(9), "" ) ENDIF NEXT cData += CRLF nLines ++ IF Len( cData ) > 65000 oClp:Empty() oClp:SetText( cData ) PasteExcel( oSheet, "A" + lTrim( Str( nLine ) ) ) nLine += nLines nLines := 0 cData := "" oClp:Empty() ENDIF NEXT IF !Empty( cData ) oClp:Empty() oClp:SetText( cData ) PasteExcel( oSheet, "A" + lTrim( Str( nLine ) ) ) ENDIF // Last formatting oSheet:Columns( "A:" + Chr( 65 + nCols ) ):AutoFit() // Exit IF !Empty( cFile ) oWorkBook:SaveAs( cFile ) oWorkBook:Close() ELSE oExcel:Visible := .T. ENDIF CATCH oError MsgStop( "EXCEL error: " + oError:Description) END oSheet := NIL oWorkBook := NIL oExcel := NIL IF oClp != NIL oClp:End() ENDIF ::oParent:lEnabled := .T. Application:lBusy := .F. RETURN .T. //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ STATIC PROCEDURE PasteExcel( oSheet, cRange ) LOCAL lError := .T., nRetry := 0, oError WHILE lError .AND. nRetry++ < 5 TRY WITH OBJECT oSheet :Paste( :Range( cRange ) ) END WITH lError := .F. CATCH oError Sleep( 100 ) END ENDDO IF lError Eval( ErrorBlock(), oError ) ENDIF RETURN //------------------------------------------------------------------------------ STATIC FUNCTION XlsData( xVal, cPic, lXlsNumeric ) LOCAL cText, cType cType := Valtype( xVal ) IF lXlsNumeric .AND. cType == "N" cText := XlsStr( xVal, cPic ) ELSEIF cType == "H" cText := "" ELSE IF cType == "C" xVal := StrTran( xVal, CRLF, "\r\n" ) xVal := StrTran( xVal, Chr( 9 ), "\t" ) ENDIF cText := Transform( xVal, cPic ) ENDIF RETURN AllTrim( cText ) //------------------------------------------------------------------------------ STATIC FUNCTION XlsStr( nValue, cPicture ) STATIC lComaDecSep LOCAL cValue, cChar LOCAL nLen, nDec LOCAL lDec IF lComaDecSep == NIL lComaDecSep := ( Application:DecimalSeparator() == "," ) ENDIF nLen := 0 nDec := 0 lDec := .F. FOR EACH cChar IN cPicture SWITCH cChar CASE "9" IF lDec nDec ++ ENDIF nLen ++ EXIT CASE "." lDec := .T. nLen ++ END NEXT cValue := Str( nValue, nLen, nDec ) IF lComaDecSep .AND. lDec XA_SetCharAtPos( @cValue, nLen - nDec, "," ) ENDIF RETURN Ltrim( cValue ) //------------------------------------------------------------------------------ STATIC FUNCTION FindOper( cFilter, cDefault ) LOCAL cOper, cChar LOCAL nPos DEFAULT cDefault TO "=" cOper := "" nPos := 1 cChar := Left( cFilter, 1 ) IF cChar $ "=<>" nPos++ cOper += cChar cChar := SubStr( cFilter, nPos, 1 ) IF cChar == "=" cOper += cChar nPos++ ENDIF ENDIF cFilter := SubStr( cFilter, nPos ) IF Empty( cOper ) cOper := cDefault ENDIF RETURN cOper //------------------------------------------------------------------------------ METHOD AdjustCols( lWithImage ) CLASS xBrowseMod LOCAL oCol LOCAL aWidth := {} FOR EACH oCol IN ::aCols AAdd( aWidth, ::AdjustColWidth( oCol, lWithImage, .T. ) ) NEXT ::lRedraw := .f. FOR EACH oCol IN ::aCols oCol:nWidth := aWidth[ oCol:__enumIndex() ] NEXT ::lRedraw := .t. RETURN NIL //------------------------------------------------------------------------------ METHOD StretchCols( lRight ) CLASS xBrowseMod LOCAL oCol LOCAL aCols, aWidths LOCAL nOffset, nWidth, nFor, nTries, nPos DEFAULT lRight TO .f. aCols := {} aWidths := {} nOffset := 0 nWidth := ::oDataGrid:nClientWidth nTries := 0 nPos := 0 IF lRight nPos := - ::oDataGrid:nClientLeft ENDIF FOR EACH oCol IN ::GetDisplayCols() WITH OBJECT oCol IF :IsVisible() .AND. ( !lRight .OR. oCol:oHeaderCol:RightPos() >= nPos ) AAdd( aCols, oCol ) AAdd( aWidths, :nWidth ) nOffset += ( :nWidth + 1 ) ENDIF END WITH NEXT DO WHILE nOffset > nWidth .AND. nTries++ < 50 // 50 intentos máximo nOffset := 0 FOR nFor := 1 TO Len( aCols ) aWidths[ nFor ] := MulDiv( aWidths[ nFor ], 99, 100 ) // Reducir un 1% nOffset += ( aWidths[ nFor ] + 1 ) NEXT ENDDO IF nTries > 0 ::lRedraw := .f. FOR nFor := 1 TO Len( aCols ) aCols[ nFor ]:nWidth := aWidths[ nFor ] NEXT ::lRedraw := .t. ENDIF RETURN Nil //------------------------------------------------------------------------------ METHOD RunContextMenu( oGrid, nPosX, nPosY ) CLASS xBrowseMod LOCAL aPos LOCAL nCol, nRow IF !::EventAssigned( "OnContextMenu" ) RETURN NIL ENDIF aPos := { nPosX, nPosY } WITH OBJECT ::oDataGrid IF !:IsInScrollZone( aPos, 3 ) nRow := :HitTest( aPos ) nCol := :HitTestCol( aPos[ 1 ] ) ENDIF END WITH IF !Empty( nCol ) ::nSelectCol := nCol ClientToScreen( oGrid:Handle, @nPosX, @nPosY ) ScreenToClient( ::Handle, @nPosX, @nPosY ) ::OnContextMenu( nPosX, nPosY, ::aDisplayCols[ nCol ], nRow ) RETURN 0 ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD RestoreState( cState ) CLASS xBrowseMod ::oHeader:RestoreState( cState ) ::oFooter:RestoreState( cState ) ::Refresh() RETURN nil //------------------------------------------------------------------------------ METHOD SetTooltips( Value ) CLASS XBrowseMod DEFAULT Value TO ::FlTooltips ::FlTooltips := Value IF ::oDataGrid != NIL WITH OBJECT ::oDataGrid IF Value :SetTooltipZones() :OnDispTooltip := {|o, cText, cTitle, nIcon, nItem| ; ::SetTooltipText( @cText, @cTitle, @nIcon, nItem ) } ELSE ::HideTooltip() :OnDispTooltip := NIL ENDIF END WITH ENDIF RETURN ::FlTooltips //------------------------------------------------------------------------------ METHOD SetTooltipText( cText, cTitle, nIcon, nItem ) CLASS xBrowseMod LOCAL oCol LOCAL aPos WITH OBJECT ::oDataGrid aPos := ScreenToClient( :Handle, GetCursorPos() ) nItem := :HitTest( aPos ) IF nItem > 0 oCol := ::ColAtPos( :HitTestCol( aPos[ 1 ] ) ) ::OnDispTooltip( @cText, @cTitle, @nIcon, nItem, oCol ) ENDIF END WITH RETURN NIL //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS TSupraHeader FROM THeaderMod ACCESS oBrowse IS oParent PROPERTY lVisible WRITE INLINE iif( Value, ::Show(), ::Hide() ), ; ::oBrowse:SetSupra( Value, .F. ) PROPERTY nHeight WRITE INLINE ::oBrowse:SetHeaderHeight( Value, .f. ), ; ::Super:SetHeight( Value ) DATA lCanFilter INIT .F. READONLY METHOD WMContextMenu( nWParam, nLParam ) INLINE -1 END CLASS //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS TFooter FROM THeaderMod ACCESS oBrowse IS oParent PROPERTY lVisible WRITE INLINE iif( Value, ::Show(), ::Hide() ), ; ::oBrowse:SetFooter( Value, .F. ) PROPERTY nHeight WRITE INLINE ::oBrowse:SetFooterHeight( Value, .F. ), ; ::Super:SetHeight( Value ) DATA lCanFilter INIT .F. READONLY METHOD WMContextMenu( nWParam, nLParam ) INLINE -1 END CLASS //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS TBrwHeader FROM THeaderMod ACCESS oBrowse IS oParent PUBLIC: PROPERTY lVisible WRITE INLINE iif( Value, ::Show(), ::Hide() ), ; ::oBrowse:SetHeader( Value, .F. ) PROPERTY nHeight WRITE METHOD SetHeight METHOD ItemChanging( oItem ) METHOD ItemChanged( oItem ) METHOD SwapItems( oItem1, oItem2, lRebuild ) METHOD FooterItem( oItem ) METHOD SupraItem( oItem ) METHOD BrowseItem( oItem ) METHOD GoNextControl( oEdit, lPrevious ) METHOD IsFullVisible( oItem ) PROTECTED: METHOD SetHeight( nValue ) END CLASS //------------------------------------------------------------------------------ METHOD SetHeight( nValue ) CLASS TBrwHeader ::oBrowse:SetHeaderHeight( nValue, .F. ) RETURN ::Super:SetHeight( nValue ) //------------------------------------------------------------------------------ METHOD BrowseItem( oItem ) CLASS TBrwHeader IF oItem != NIL RETURN oItem:oGridCol ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD FooterItem( oItem ) CLASS TBrwHeader IF oItem != NIL RETURN oItem:oGridCol:oFooterCol ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD SupraItem( oItem ) CLASS TBrwHeader IF oItem != NIL RETURN oItem:oGridCol:oSupraCol ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD ItemChanging( oItem ) CLASS TBrwHeader LOCAL oTemp, oItemSupra, oItemFooter, oSup LOCAL nWidth oItemFooter := ::FooterItem( oItem ) oItemSupra := ::SupraItem( oItem ) IF oItemFooter != nil oItemFooter:nWidth := oItem:nWidth ENDIF IF oItemSupra != NIL nWidth := 0 FOR EACH oTemp IN ::aItems oSup := ::SupraItem( oTemp ) IF ( oSup == oItemSupra ) .AND. oTemp:nIndex != oItem:nIndex nWidth += oTemp:nWidth + 1 ENDIF NEXT oItemSupra:nWidth := nWidth + oItem:nWidth ENDIF IF ::oBrowse:IsOnEdit() FOR EACH oItem IN ::aItems oItem:oGridCol:SetEditCoors() NEXT ENDIF RETURN ::OnItemChanging( oItem ) //------------------------------------------------------------------------------ METHOD ItemChanged( oItem ) CLASS TBrwHeader LOCAL oTemp, oItemSupra, oSup LOCAL nWidth, nCols, nTmp, nLast ::BeginPaint() oItemSupra := ::SupraItem( oItem ) IF oItemSupra != NIL nCols := 0 nLast := 0 FOR EACH oTemp IN ::aItems oSup := ::SupraItem( oTemp ) IF !Empty( oSup ) .AND. ( oSup == oItemSupra ) nCols++ nLast := oTemp:__EnumIndex() ENDIF NEXT nWidth := MulDiv( oItemSupra:nWidth - nCols + 1, 1, nCols ) nTmp := 0 FOR EACH oTemp IN ::aItems oSup := ::SupraItem( oTemp ) IF !Empty( oSup ) .AND. ( oSup == oItemSupra ) IF oTemp:__EnumIndex() < nLast nTmp += nWidth ELSE nWidth := oItemSupra:nWidth - nCols + 1 - nTmp ENDIF oTemp:nWidth := nWidth ::FooterItem( oTemp ):nWidth := nWidth ENDIF NEXT ENDIF oItem:oGridCol:SetWidth( oItem:nWidth, .F. ) ::oBrowse:HeaderChanged() ::EndPaint() RETURN ::OnItemChanged( oItem ) //------------------------------------------------------------------------------ METHOD SwapItems( oItem1, oItem2, lRebuild ) CLASS TBrwHeader LOCAL oFooter1, oFooter2 oFooter1 := ::FooterItem( oItem1 ) oFooter2 := ::FooterItem( oItem2 ) ::oBrowse:oFooter:SwapItems( oFooter1, oFooter2, .T. ) ::Super:SwapItems( oItem1, oItem2, lRebuild ) ::oBrowse:HeaderChanged() RETURN NIL //------------------------------------------------------------------------------ METHOD GoNextControl( oEdit, lPrevious ) CLASS TBrwHeader LOCAL oNext LOCAL xRet xRet := ::Super:GoNextControl( oEdit, lPrevious ) oNext := GetControlFromHandle( GetFocus() ) IF oNext:IsKindof( "TEditForHeader" ) .AND. !( oNext == oEdit ) ::oBrowse:nSelectCol := oNext:oItem:nPos ENDIF RETURN xRet //------------------------------------------------------------------------------ METHOD IsFullVisible( oItem ) CLASS TBrwHeader LOCAL aItem LOCAL nLeft, nRight LOCAL lVisible nLeft := -::nAlignMarginLeft nRight := ::nClientWidth + nLeft aItem := oItem:GetRect() lVisible := ( aItem[ rtLEFT ] >= nLeft ) .AND. ( aItem[ rtRIGHT ] <= nRight ) IF lVisible aItem[ rtLEFT ] += nLeft aItem[ rtRIGHT ] += nLeft lVisible := ( aItem[ rtLEFT ] >= nLeft ) .AND. ( aItem[ rtRIGHT ] <= nRight ) ENDIF RETURN lVisible //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS XBrwModGrid FROM TListBoxMod PUBLIC: ACCESS oBrowse IS oParent ACCESS aCols IS oParent:aCols ACCESS aDisplayCols IS oParent:aDisplayCols ACCESS oImageList IS oParent:oImageList ACCESS aGridData IS oParent:aGridData PROTECTED: PROPERTY oImageList PROPERTY lCheckboxes INIT .F. PROPERTY lHtmlText INIT .F. RESERVED: PROPERTY aItems PROPERTY nIndex INIT 1 WRITE METHOD SetIndex DATA nActiveRowTop INIT 0 DATA nEditPos INIT 0 // Apunta al número de elemento en aWork, no al registro real DATA lNeedEdit INIT .F. METHOD New( oParent ) CONSTRUCTOR METHOD Create( oParent ) CONSTRUCTOR METHOD Record( nPos ) METHOD ItemText( nItem, lArray, nCol ) METHOD CalcVirtualRect() METHOD AdjustHeaders() METHOD Paint( hDC ) METHOD PaintItem( hDC, nItem, aRect ) METHOD PaintGroupHeader( hDC, nItem, aRect, nRecord ) METHOD PaintGroupFooter( hDC, nItem, aRect, nRecord ) METHOD FirstColVisible() METHOD FirstColEditable() METHOD LastColEditable() METHOD ColsEditable() METHOD HitTestCol( nX ) METHOD GoNextControl( oEdit, lPrevious ) METHOD SetIndex( nValue, lDel, lUpdParent ) METHOD SetIndexNoUpdateParent( nValue ) INLINE ::SetIndex( nValue, .T., .F. ) METHOD Refresh( lValue ) METHOD WMLButtonDown( nWParam, nLParam, hWnd ) METHOD WMLButtonDblClk( nWParam, nLParam, hWnd ) METHOD WMKeyDown( nKey, nFlags, hWnd ) METHOD WMChar( nKey, nFlags, hWnd ) METHOD WMSize( nWParam, nLParam ) METHOD WMXailer() INLINE ::oBrowse:OnChange( .T. ) METHOD WMNotify() EXTERN XTreeViewMod_WMNotify() METHOD Append() METHOD Delete() METHOD Insert( nPos ) METHOD Save() METHOD Click( nWParam, nLParam ) METHOD DblClick( nKeyFlags, nX, nY ) METHOD RowChanged() INLINE ( ::PostMsg( WM_XAILER, 0, 0 ), .T. ) METHOD SearchText( nKey ) METHOD SetTooltipZones() ENDCLASS //-------------------------------------------------------------------------- METHOD New( oParent ) CLASS XBrwModGrid ::FoImagelist := oParent:oImageList RETURN ::Super:New( oParent ) //-------------------------------------------------------------------------- METHOD Create( oParent ) CLASS XBrwModGrid ::OnScrollModV := "AdjustHeaders" ::OnScrollModH := "AdjustHeaders" RETURN ::Super:Create( oParent ) //-------------------------------------------------------------------------- METHOD Click( nWParam, nLParam ) CLASS XBrwModGrid LOCAL oCol LOCAL aPos LOCAL nRow, nCol aPos := { LoInt( nLParam ), HiInt( nLParam ) } nRow := ::HitTest( aPos ) nCol := ::HitTestCol( aPos[ 1 ] ) IF nCol > 0 oCol := ::aDisplayCols[ nCol ] ENDIF RETURN ::oBrowse:OnClick( nWParam, oCol, nRow ) //-------------------------------------------------------------------------- METHOD DblClick( nKeys, nX, nY ) CLASS XBrwModGrid LOCAL oCol LOCAL aPos LOCAL nRow, nCol aPos := { nX, nY } nRow := ::HitTest( aPos ) nCol := ::HitTestCol( aPos[ 1 ] ) IF nCol > 0 oCol := ::aDisplayCols[ nCol ] ENDIF ::oBrowse:OnDblClick( nKeys, oCol, nRow ) RETURN 0 //-------------------------------------------------------------------------- METHOD Record( nPos ) CLASS XBrwModGrid DEFAULT nPos TO ::nIndex IF nPos > 0 .AND. nPos <= Len( ::FaWork ) RETURN ::FaWork[ nPos ] ENDIF RETURN 0 //-------------------------------------------------------------------------- METHOD Append() CLASS XBrwModGrid ::nEditPos := Len( ::FaWork ) + 1 AAdd( ::FaWork, 0 ) ::lNeedEdit := .t. ::nIndex := Len( ::FaWork ) RETURN NIL //-------------------------------------------------------------------------- METHOD Insert( nPos ) CLASS XBrwModGrid DEFAULT nPos TO ::nIndex HB_AIns( ::FaWork, nPos, 0, .t. ) ::nEditPos := nPos ::lNeedEdit := .t. ::nIndex := nPos RETURN NIL //-------------------------------------------------------------------------- METHOD Delete() CLASS XBrwModGrid LOCAL aWork := ::FaWork HB_ADel( aWork, ::nIndex, .t. ) IF ::nIndex <= Len( aWork ) AEval( aWork, {|v,e| aWork[ e ] := v - 1}, ::nIndex ) ENDIF ::nIndex := Min( ::FnIndex, Len( aWork ) ) RETURN NIL //------------------------------------------------------------------------------ METHOD Save() CLASS XBrwModGrid LOCAL aWork := ::FaWork LOCAL nRec := ::nEditPos SWITCH ::oBrowse:nEditMode CASE beINSERT aWork[ nRec ] := nRec AEval( aWork, {|v, e| aWork[ e ] := e }, nRec ) EXIT CASE beAPPEND aWork[ nRec ] := nRec EXIT END SWITCH RETURN NIL //------------------------------------------------------------------------------ METHOD FirstColVisible() CLASS XBrwModGrid LOCAL oCol FOR EACH oCol IN ::aDisplayCols IF oCol:RightPos() > 0 RETURN oCol ENDIF NEXT RETURN oCol //------------------------------------------------------------------------------ METHOD FirstColEditable() CLASS XBrwModGrid LOCAL oCol FOR EACH oCol IN ::aDisplayCols IF oCol:RightPos() > 0 .AND. oCol:lCanEdit RETURN oCol ENDIF NEXT RETURN oCol //------------------------------------------------------------------------------ METHOD LastColEditable() CLASS XBrwModGrid LOCAL oCol FOR EACH oCol IN ::aDisplayCols DESCEND IF oCol:RightPos() > 0 .AND. oCol:lCanEdit RETURN oCol ENDIF NEXT RETURN oCol //------------------------------------------------------------------------------ METHOD ColsEditable() CLASS XBrwModGrid LOCAL oCol LOCAL nCols := 0 FOR EACH oCol IN ::aDisplayCols IF oCol:RightPos() > 0 .AND. oCol:lCanEdit nCols ++ ENDIF NEXT RETURN nCols //------------------------------------------------------------------------------ METHOD ItemText( nItem, lArray, nCol ) CLASS XBrwModGrid DEFAULT nItem TO ::nIndex RETURN ::oBrowse:DataValue( ::FaWork[ nItem ], lArray, nCol ) //------------------------------------------------------------------------------ METHOD CalcVirtualRect() CLASS XBrwModGrid LOCAL oCol LOCAL aCols LOCAL nMax, nVirtualW, nVirtualH, nCount nCount := ::RecCount() aCols := ::aDisplayCols IF Len( aCols ) > 0 nMax := ATail( aCols ):RightPos() ELSE nMax := 0 ENDIF IF nCount == 0 .AND. nMax = 0 RETURN NIL ENDIF nVirtualW := Max( nMax, ::nClientWidth ) nVirtualH := Max( nCount * ::nItemHeight, ::nClientHeight ) ::OnCalcVirtualSize( @nVirtualW, @nVirtualH ) ::FnVirtualWidth := nVirtualW ::FnVirtualHeight := nVirtualH RETURN NIL //------------------------------------------------------------------------------ METHOD AdjustHeaders() CLASS XBrwModGrid LOCAL nLeft := ::nClientLeft WITH OBJECT ::oBrowse :oHeader:nAlignMarginLeft := nLeft :oFooter:nAlignMarginLeft := nLeft :oSupra:nAlignMarginLeft := nLeft END WITH RETURN NIL //------------------------------------------------------------------------------ METHOD Paint( hDC ) CLASS XBrwModGrid LOCAL oCol LOCAL aRect LOCAL nClrPane LOCAL hSep, nLeft, nPos, nHeight, nWidth, hBrush, hOld FOR EACH oCol IN ::oBrowse:aDisplayCols IF !oCol:lTransparent aRect := { oCol:LeftPos(), 0, oCol:RightPos(), ::nClientHeight } WITH OBJECT oCol nClrPane := IIF( :nClrPane != NIL, :nClrPane, clWindow ) END WITH hBrush := CreateSolidBrush( nClrPane ) FillRect( hDC, aRect, hBrush ) DeleteObject( hBrush ) ENDIF NEXT ::Super:Paint( hDC ) WITH OBJECT ::oBrowse IF :lColumnSeparator hSep := CreatePen( PS_SOLID, 1, :nClrDivider ) nLeft := ::nClientLeft nHeight := ::nClientHeight hOld := SelectObject( hDC, hSep ) FOR EACH oCol IN :aDisplayCols nPos := oCol:RightPos() + nLeft MoveTo( hDC, nPos, 0 ) LineTo( hDC, nPos, nHeight ) NEXT SelectObject( hDC, hOld ) DeleteObject( hSep ) ENDIF END WITH RETURN NIL //------------------------------------------------------------------------------ METHOD PaintItem( hDC, nItem, aRect ) CLASS XBrwModGrid LOCAL oCol, oGrp, oSt LOCAL aCell, aImg, aData, aSel, aTmp, aClr LOCAL cValue LOCAL nImage, nClrText, nClrPane, nImg, nMgn, nFlags, nWidth, ; nDataCol, nLen, nLeft, nTmp, nSelCol, nPos, nEst LOCAL lActive, lHot, lSel, lRet, lShowC, lFocus, lAltClr, lOnDraw LOCAL hBrush LOCAL xValue nPos := ::FaWork[ nItem ] IF nPos < 0 // Es un grupo nPos := - nPos IF Round( nPos, 0 ) == nPos // Header ::PaintGroupHeader( hDC, nItem, aRect, Int( nPos ) ) // Int() debido a que las filas de resumen llevan decimales. Ej: 1.9 ELSE ::PaintGroupFooter( hDC, nItem, aRect, Int( nPos ) ) ENDIF RETURN NIL ELSEIF nPos == 0 // Edición ::nActiveRowTop := aRect[ rtTOP ] - ::nClientTop IF ::lNeedEdit ::lNeedEdit := .f. ::oBrowse:PostMsg( WM_XAILER ) ENDIF RETURN nil ENDIF IF Empty( aData := ::ItemText( nItem, .T. ) ) RETURN NIL ENDIF aCell := { 0, aRect[ rtTOP ], 0, aRect[ rtBOTTOM ] } nMgn := ::nMargin nImg := ::oImageList:nWidth nFlags := 0 lActive := ( ::nIndex == nItem ) lHot := ::lHotTrack .AND. ( ::nHotPos == nItem ) .AND. !::IsInScrollZone( ::aHotPos, 0 ) lSel := ::ItemSelected( nItem ) nClrText := ::nClrText nClrPane := ::nClrPane nEst := STATE_NORMAL IF lHot nClrPane := ::nClrHotPane nClrText := ::nClrHotText nEst := STATE_HOT ELSEIF lSel nClrPane := ::nClrSelPane nClrText := ::nClrSelText nEst := STATE_SELECTED ENDIF IF lActive ::nActiveRowTop := aRect[ rtTOP ] - ::nClientTop nEst := STATE_ACTIVE ENDIF nLen := Len( aData ) nWidth := ::nClientWidth nLeft := ::nClientLeft WITH OBJECT ::oBrowse lShowC := :lShowCellSelected lOnDraw := :EventAssigned( "OnDrawCell" ) lAltClr := :lAlternateColor nSelCol := :nSelectCol IF lOnDraw :SetRecnoPos( nItem ) ENDIF END WITH IF lSel .or. lHot .or. !::lTransparent hBrush := CreateSolidBrush( nClrPane ) FillRect( hDC, aRect, hBrush ) DeleteObject( hBrush ) ENDIF aClr := { nClrText, nClrPane } FOR EACH oCol IN ::oBrowse:aDisplayCols WITH OBJECT oCol nDataCol := :nDataCol IF nDataCol > 0 .AND. nDataCol <= nLen xValue := aData[ nDataCol ] ELSE xValue := "" ENDIF aCell[ rtTOP ] := aRect[ rtTOP ] aCell[ rtBOTTOM ] := aRect[ rtBOTTOM ] aCell[ rtLEFT ] := :LeftPos() + nLeft aCell[ rtRIGHT ] := :RightPos() + nLeft IF lShowC .AND. :nPos == nSelCol aSel := AClone( aCell ) ENDIF IF xValue != NIL .AND. !Empty( :cPicture ) cValue := Transform( xValue, :cPicture ) ELSE cValue := ToString( xValue ) ENDIF IF !:lTransparent nClrPane := :nClrPane ENDIF END WITH WITH OBJECT ::oBrowse IF lOnDraw nImage := 0 lRet := :OnDrawCell( oCol, nItem, xValue, @cValue, ; @nImage, @nClrText, @nClrPane, ; nEst, hDC, aCell ) IF lRet != NIL .AND. !lRet LOOP ENDIF IF aClr[ 2 ] != nClrPane hBrush := CreateSolidBrush( nClrPane ) FillRect( hDC, aCell, hBrush ) DeleteObject( hBrush ) ENDIF ENDIF END WITH IF nImg > 1 .AND. !Empty( nImage ) SWITCH oCol:nDataBmpAlignment CASE taLEFT aImg := { aCell[ rtLEFT ] + nMgn, ; aCell[ rtTOP ], ; aCell[ rtLEFT ] + nImg + nMgn, ; aCell[ rtBOTTOM ] } aCell[ rtLEFT ] := aImg[ rtRIGHT ] EXIT CASE taRIGHT aImg := { aCell[ rtRIGHT ] - nMgn - nImg, ; aCell[ rtTOP ], ; aCell[ rtRIGHT ] - nMgn, ; aCell[ rtBOTTOM ] } aCell[ rtRIGHT ] := aImg[ rtLEFT ] EXIT CASE taCENTER nTmp := aCell[ rtLEFT ] + Shr( aCell[ rtRIGHT ] - aCell[ rtLEFT ] - nImg, 1 ) aImg := { nTmp, ; aCell[ rtTOP ], ; nTmp + nImg, ; aCell[ rtBOTTOM ] } END SWITCH XA_DrawBitmapByPos( hDC, ::oImageList:Handle, nImage, aImg ) oCol:lDataImageUsed := .T. ENDIF InflateRect( aCell, - nMgn, 0 ) IF !Empty( cValue ) SetTextColor( hDC, nClrText ) SetBkMode( hDC, TRANSPARENT ) IF !oCol:lDataMultiline nFlags := nOr( DT_END_ELLIPSIS, DT_SINGLELINE ) ELSE nFlags := nOr( DT_WORDBREAK, DT_END_ELLIPSIS ) ENDIF SWITCH ::nVAlignment CASE vaCENTER nFlags := nOr( nFlags, DT_VCENTER ) EXIT CASE vaBOTTOM nFlags := nOr( nFlags, DT_BOTTOM ) EXIT END SWITCH SWITCH oCol:nDataAlignment CASE taCENTER nFlags := nOr( nFlags, DT_CENTER ) EXIT CASE taRIGHT nFlags := nOr( nFlags, DT_RIGHT ) EXIT END SWITCH DrawText( hDC, cValue, aCell, nFlags ) ENDIF nClrText := aClr[ 1 ] nClrPane := aClr[ 2 ] NEXT IF lActive lFocus := ( GetFocus() == ::Handle ) IF ::oBrowse:EventAssigned( "OnDrawActiveRow" ) ::oBrowse:OnDrawActiveRow( hDC, aRect, aSel, lFocus ) ELSE nTmp := iif( XA_Luminance( nClrPane ) < 127, clWhite, clBlack ) IF !lShowC XA_FillRectAlpha( hDC, aRect, nTmp, iif( lFocus, 50, 30 ) ) ELSEIF !Empty( aSel ) XA_FillRectAlpha( hDC, aSel, nTmp, iif( lFocus, 50, 30 ) ) ENDIF ENDIF ELSEIF lAltClr .AND. Is_Odd( nItem ) nTmp := iif( XA_Luminance( nClrPane ) < 127, clWhite, clBlack ) XA_FillRectAlpha( hDC, aRect, nTmp, 20 ) ENDIF IF lOnDraw ::oBrowse:RestoreRecnoPos() ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD PaintGroupHeader( hDC, nItem, aRect, nRecord ) CLASS XBrwModGrid LOCAL oGrp, oSt LOCAL aTmp LOCAL cGrp LOCAL nTmp, nClrT, nClrP, nMgn, hPen LOCAL lRet nMgn := ::nMargin WITH OBJECT ::oBrowse oGrp := :oGroup aTmp := AClone( aRect ) aTmp[ rtLEFT ] := aRect[ rtLEFT ] + nMgn oSt := oGrp:FindStByRecord( nRecord ) IF oSt != NIL cGrp := oSt:Header() nClrT := ::nClrText nClrP := ::nClrPane lRet := :OnDrawGroupHeader( oSt, @cGrp, nRecord, , @nClrT,; @nClrP, hDC, aTmp ) IF lRet == NIL .OR. lRet IF oGrp:lLine nTmp := Shr( aRect[ rtBOTTOM ] - aRect[ rtTOP ], 1 ) hPen := CreatePen( PS_SOLID, 1, :nClrDivider ) MoveTo( hDC, aTmp[ rtLEFT ], aTmp[ rtTOP ] + nTmp ) LineTo( hDC, aTmp[ rtRIGHT ], aTmp[ rtTOP ] + nTmp, hPen ) DeleteObject( hPen ) ENDIF SetBkColor( hDC, nClrP ) SetTextColor( hDC, nClrT ) SetBkMode( hDC, OPAQUE ) DrawText( hDC, cGrp, aTmp, nOr( DT_END_ELLIPSIS, DT_SINGLELINE, DT_VCENTER ) ) SetBkMode( hDC, TRANSPARENT ) ENDIF ENDIF END WITH IF ( ::nIndex == nItem ) XA_FillRectAlpha( hDC, aRect, ::nClrSelPane, 70 ) ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD PaintGroupFooter( hDC, nItem, aRect, nRecord ) CLASS XBrwModGrid LOCAL oSt AS CLASS TBrwGroupSt LOCAL oCol AS CLASS TBrwColMod LOCAL aCell LOCAL cValue LOCAL nMgn, nFlags, nClrT, nClrP, nWidth, nLeft LOCAL hBrush, hPen LOCAL lExit, lRet, lLine lExit := .F. WITH OBJECT ::oBrowse IF !:EventAssigned( "OnDrawGroupFooter" ) lExit := .T. ELSE oSt := :oGroup:FindStByRecord( nRecord ) lExit := ( oSt == nil ) ENDIF IF lExit IF ( ::nIndex == nItem ) XA_FillRectAlpha( hDC, aRect, ::nClrSelPane, 70 ) ENDIF RETURN nil ENDIF nMgn := ::nMargin nWidth := ::nClientWidth nLeft := ::nClientLeft hPen := CreatePen( PS_SOLID, 1, :nClrDivider ) FOR EACH oCol IN :aDisplayCols WITH OBJECT oCol aCell := { :LeftPos() + nLeft,; aRect[ rtTOP ],; :RightPos() + nLeft,; aRect[ rtBOTTOM ] } END WITH cValue := "" lLine := .F. nClrT := ::nClrText nClrP := ::nClrPane lRet := :OnDrawGroupFooter( oSt, oCol, @cValue, @nClrT,; @nClrP, @lLine, hDC, aCell ) IF lRet != NIL .AND. !lRet LOOP ENDIF SetTextColor( hDC, nClrT ) hBrush := CreateSolidBrush( nClrP ) FillRect( hDC, aCell, hBrush ) DeleteObject( hBrush ) InflateRect( aCell, - nMgn, 0 ) IF lLine MoveTo( hDC, aCell[ rtLEFT ], aCell[ rtTOP ] ) LineTo( hDC, aCell[ rtRIGHT ], aCell[ rtTOP ], hPen ) ENDIF IF !Empty( cValue ) nFlags := nOr( DT_END_ELLIPSIS, DT_SINGLELINE ) SWITCH ::nVAlignment CASE vaCENTER nFlags := nOr( nFlags, DT_VCENTER ) EXIT CASE vaBOTTOM nFlags := nOr( nFlags, DT_BOTTOM ) EXIT END SWITCH SWITCH oCol:nDataAlignment CASE taCENTER nFlags := nOr( nFlags, DT_CENTER ) EXIT CASE taRIGHT nFlags := nOr( nFlags, DT_RIGHT ) EXIT END SWITCH DrawText( hDC, cValue, aCell, nFlags ) ENDIF NEXT DeleteObject( hPen ) IF ( ::nIndex == nItem ) XA_FillRectAlpha( hDC, aRect, ::nClrSelPane, 70 ) ENDIF END WITH RETURN nil //------------------------------------------------------------------------------ METHOD WMLButtonDown( nWParam, nLParam, hWnd ) CLASS XBrwModGrid LOCAL aPos := { LoWord( nLParam ), HiWord( nLParam ) } LOCAL nRow, nCol WITH OBJECT ::oBrowse :CancelEdit( (:nEditMode == beEDIT ), 0 ) END WITH IF ::Handle == hWnd .AND. !::IsInScrollZone( aPos, 3 ) nRow := ::HitTest( aPos ) IF nRow > 0 .AND. ( nCol := ::HitTestCol( aPos[ 1 ] ) ) != 0 ::oBrowse:nSelectCol := nCol ENDIF ENDIF RETURN ::Super:WMLButtonDown( nWParam, nLParam, hWnd ) //------------------------------------------------------------------------------ METHOD WMLButtonDblClk( nWParam, nLParam, hWnd ) CLASS XBrwModGrid LOCAL aPos := { LoWord( nLParam ), HiWord( nLParam ) } LOCAL nRow, nCol WITH OBJECT ::oBrowse :CancelEdit( (:nEditMode == beEDIT ), 0 ) END WITH // Al menos una barra de scroll virtual es visible IF ::IsInScrollZone( aPos, 3 ) RETURN 0 ENDIF IF ::Handle == hWnd //.AND. !::IsInScrollZone( aPos, 3 ) nRow := ::HitTest( aPos ) IF nRow > 0 .AND. ( nCol := ::HitTestCol( aPos[ 1 ] ) ) != 0 ::oBrowse:nSelectCol := nCol IF ::nIndex != nRow ::nIndex := nRow ENDIF WITH OBJECT ::oBrowse IF :lAllowEdit .AND. !:IsGroup() IF :lShowCellSeleCted IF :oSelectCol:lCanEdit :Edit( :oSelectCol ) RETURN 0 ENDIF ELSE :Edit() RETURN 0 ENDIF ENDIF END WITH ENDIF ENDIF RETURN ::Super:WMLButtonDblClk( nWParam, nLParam, hWnd ) //------------------------------------------------------------------------------ METHOD WMKeyDown( nKey, nFlags, hWnd ) CLASS XBrwModGrid LOCAL oSt LOCAL nRec LOCAL lRet IF hWnd != ::Handle RETURN ::Super:WMKeyDown( nKey, nFlags, hWnd ) ENDIF SWITCH nKey CASE VK_UP WITH OBJECT ::oBrowse IF :lFilterBar .AND. ::nIndex <= 1 IF :oSelectCol != NIL :oSelectCol:oHeaderCol:oEditFilter:SetFocus() ELSEIF Len( :oHeader:aItems ) > 0 :oHeader:aItems[ 1 ]:oEditFilter:SetFocus() ENDIF RETURN 0 ENDIF END WITH EXIT CASE VK_DOWN WITH OBJECT ::oBrowse IF ::nIndex == Len( ::FaWork ) .AND. :lAllowAppend .AND. :lFastAppend ; .AND. !:IsGroup() :Append() ENDIF END WITH EXIT CASE VK_LEFT WITH OBJECT ::oBrowse IF :nSelectCol > 1 IF !lGetKeyState( VK_CONTROL ) :nSelectCol-- ELSE :nSelectCol := 1 ENDIF RETURN 0 ENDIF END WITH EXIT CASE VK_RIGHT WITH OBJECT ::oBrowse IF :nSelectCol < :oHeader:GetVisibleItems() IF !lGetKeyState( VK_CONTROL ) :nSelectCol++ ELSE :nSelectCol := Len( ::aDisplayCols ) ENDIF RETURN 0 ENDIF END WITH EXIT CASE VK_RETURN WITH OBJECT ::oBrowse IF !:IsGroup() IF :lAllowEdit IF :lShowCellSelected .AND. !lGetKeyState( VK_CONTROL ) :Edit( :oSelectCol, nKey ) ELSE :Edit() ENDIF RETURN 0 ENDIF ELSE nRec = ::aWork[ ::nIndex ] IF nRec < 0 .AND. Round( nRec, 0 ) == nRec oSt := ::oBrowse:oGroup:FindStByRecord( -nRec ) IF oSt != NIL oSt:lCollapsed := !oSt:lCollapsed ::oBrowse:CalcGroup() ENDIF ENDIF ENDIF END WITH EXIT CASE VK_INSERT WITH OBJECT ::oBrowse IF :lAllowInsert .AND. !:IsGroup() IF !lGetKeyState( VK_CONTROL ) .OR. !:lAllowAppend :Insert() ELSE :Append() ENDIF RETURN 0 ELSEIF :lAllowAppend .AND. !:IsGroup() :Append() RETURN 0 ENDIF END WITH EXIT CASE VK_DELETE WITH OBJECT ::oBrowse IF :lAllowDelete .AND. !:IsGroup() :Delete() RETURN 0 ENDIF END WITH EXIT END SWITCH lRet := ::Super:WMKeyDown( nKey, nFlags, hWnd ) /* IOZ: No parece que haga falta. Lo dejo comentado por si acaso IF nKey == VK_LEFT .OR. nKey == VK_RIGHT ::AdjustHeaders() ENDIF */ RETURN lRet //------------------------------------------------------------------------------ # xtranslate IsSpecialChar( ) => ; Chr( ) $ ( " .:,;-_¿¡'?=)(/&%$!ºª*Çç¨{}\|@#[]+<>" + Chr( 32 ) ) METHOD WMChar( nKey, nFlags, hWnd ) CLASS XBrwModGrid LOCAL lRet IF hWnd != ::Handle RETURN ::Super:WMChar( nKey, nFlags, hWnd ) ENDIF WITH OBJECT ::oBrowse IF :lFastEdit .AND. :lShowCellSelected .AND. :oSelectCol != NIL ; .AND. :oSelectCol:lCanEdit ; .AND. ( IsCharAlphaNumeric( nKey ) .OR. IsSpecialChar( nKey ) ) ; .AND. !:IsGroup() :Edit( :oSelectCol, nKey ) RETURN 0 ENDIF END WITH lRet := ::Super:WMChar( nKey, nFlags, hWnd ) IF lRet == nil ::oParent:OnChar( nKey, nFlags ) ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD WMSize( nWParam, nLParam ) CLASS XBrwModGrid ::AdjustHeaders() ::SetTooltipZones() RETURN ::Super:WMSize( nWParam, nLParam ) //------------------------------------------------------------------------------ METHOD SearchText( nKey ) CLASS XBrwModGrid LOCAL cSeek LOCAL nAt, nCol LOCAL lExact, lKey cSeek := ::cSeek nCol := ::oParent:SortedCol() IF ( lKey := !Empty( nKey ) ) cSeek += Upper( Chr( nKey ) ) ENDIF lExact := Set( _SET_EXACT, .F. ) IF nCol == 0 nAt := AScan( ::FaWork, {|v,e| Upper( ::ItemText( e ) ) = cSeek } ) ELSE nAt := AScan( ::FaWork, {|v,e| Upper( ::ItemText( e, .F., nCol ) ) = cSeek } ) ENDIF Set( _SET_EXACT, lExact ) IF nAt > 0 ::nIndex := nAt ::cSeek := cSeek ::lFound := .T. ELSE ::lFound := .F. IF lKey Beep( 150,100 ) ENDIF ENDIF RETURN ::lFound //------------------------------------------------------------------------------ METHOD HitTestCol( nX ) CLASS XBrwModGrid LOCAL oCol LOCAL nCol := 0 nX -= ::nClientLeft FOR EACH oCol IN ::oBrowse:aDisplayCols WITH OBJECT oCol IF :IsVisible() .AND. nX >= :LeftPos() .AND. nX <= :RightPos() nCol := :nPos EXIT ENDIF END WITH NEXT RETURN nCol //------------------------------------------------------------------------------ METHOD SetIndex( nValue, lDel, lUpdParent ) CLASS XBrwModGrid DEFAULT lUpdParent TO .T. ::Super:SetIndex( nValue, lDel ) IF lUpdParent ::oBrowse:UpdateIndex( ::FnIndex ) ENDIF RETURN ::FnIndex //------------------------------------------------------------------------------ METHOD Refresh( lValue ) CLASS XBrwModGrid DEFAULT lValue TO .F. WITH OBJECT ::oBrowse:oRecSelector IF :lVisible :Refresh() ENDIF END WITH RETURN ::Super:Refresh( lValue ) //------------------------------------------------------------------------------ METHOD GoNextControl( oEdit, lPrevious ) CLASS XBrwModGrid LOCAL oNext LOCAL aCols LOCAL nPos, nTmp, nHan IF ValType( oEdit ) != "O" RETURN ::Super:GoNextControl() ENDIF aCols := ::aDisplayCols nPos := oEdit:oCol:nIndex nTmp := nPos nHan := 0 IF !lPrevious DO WHILE ++nTmp <= Len( aCols ) oNext := aCols[ nTmp ]:oGridEdit IF oNext != NIL .AND. oNext:lVisible nHan := oNext:Handle EXIT ENDIF ENDDO nTmp := 0 DO WHILE nHan == 0 .AND. ++nTmp < nPos oNext := aCols[ nTmp ]:oGridEdit IF oNext != nil .AND. oNext:lVisible nHan := oNext:Handle EXIT ENDIF ENDDO ELSE DO WHILE --nTmp > 0 oNext := aCols[ nTmp ]:oGridEdit IF oNext != NIL .AND. oNext:lVisible nHan := oNext:Handle EXIT ENDIF ENDDO nTmp := Len( aCols ) + 1 DO WHILE nHan == 0 .AND. --nTmp > nPos oNext := aCols[ nTmp ]:oGridEdit IF oNext != NIL .AND. oNext:lVisible nHan := oNext:Handle EXIT ENDIF ENDDO ENDIF IF nHan != 0 SetFocus( nHan ) IF oNext:IsKindof( "TEditForGrid" ) .AND. !( oNext == oEdit ) ::oBrowse:nSelectCol := oNext:oCol:oHeaderCol:nPos AEval( ::aDisplayCols, {|v| v:SetEditCoors() } ) ENDIF RETURN nHan ENDIF RETURN ::Super:GoNextControl() //------------------------------------------------------------------------------ METHOD SetTooltipZones() CLASS XBrwModGrid LOCAL nFor, nLen, nStep, nTop, nWidth IF ! ::lCreated RETURN Nil ENDIF IF !Empty( ::Handle ) ::SetTooltip() nStep := ::nItemHeight nWidth := ::nClientWidth nLen := Int( ::nClientHeight / nStep ) + 1 nTop := 0 FOR nFor := 1 TO nLen ::SetToolTip( ToString( nFor ), { 0, nTop, nWidth, nTop + nStep }, nFor ) nTop += nStep NEXT ::FcTooltip := "" ENDIF RETURN nil //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS TBrwGroup FROM TComponent PUBLIC: ACCESS oBrowse IS oParent PROPERTY aGroupCols INIT {} WRITE METHOD SetGroupCols PROPERTY lCollapsed INIT .F. PROPERTY lLine INIT .F. PROPERTY lFooter INIT .F. RESERVED: DATA aSt INIT {} DATA aLastVal INIT {} DATA aWrkBackup INIT {} METHOD Free() METHOD AddSt( aVal ) METHOD AddReg( nRecord ) METHOD SetGroupCols( xCol ) METHOD GroupValueByRecord( nRecord, BYREF aVal ) METHOD FindStByGroupValue( xGroupValues ) METHOD FindStByRecord( nRecord ) INLINE ::FindStByGroupValue( ::GroupValueByRecord( nRecord ) ) METHOD LastValue() INLINE "[" + aJoin( ::aLastVal, "," ) + "]" METHOD Calculated() INLINE Len( ::aSt ) > 0 METHOD Complete( aWork ) INLINE ::aWrkBackup := AClone( aWork ) METHOD Restore() INLINE ::aWrkBackup METHOD Log( lComplete ) METHOD SumTotal( xCol ) END CLASS //------------------------------------------------------------------------------ METHOD SumTotal( xCol ) CLASS TBrwGroup LOCAL oSt LOCAL nSum := 0 FOR EACH oSt IN ::aSt nSum += oSt:Sum( xCol ) NEXT RETURN nSum //------------------------------------------------------------------------------ METHOD Free() CLASS TBrwGroup AEval( ::aSt, {|v| v:End() } ) ::aSt := {} ::aGroupCols := {} ::aLastVal := {} ::aWrkBackup := {} RETURN ::Super:Free() //------------------------------------------------------------------------------ METHOD SetGroupCols( xCol ) CLASS TBrwGroup IF ValType( xCol ) != "A" xCol := { xCol } ENDIF ::FaGroupCols := xCol ::aLastVal := AFill( Array( Len( xCol ) ), "" ) RETURN xCol //------------------------------------------------------------------------------ METHOD AddSt( aVal ) CLASS TBrwGroup LOCAL oSt oSt := TBrwGroupSt():New( Self ) oSt:aValues := aVal AAdd( ::aSt, oSt ) RETURN oSt //------------------------------------------------------------------------------ METHOD AddReg( nRecord ) CLASS TBrwGroup LOCAL oSt AS CLASS TBrwGroupSt LOCAL oGrp AS CLASS TBrwColMod LOCAL aVal LOCAL cVal, cLast cVal := ::GroupValueByRecord( nRecord, @aVal ) cLast := ::LastValue() IF !( cVal == cLast ) oSt := ::AddSt( aVal ) oSt:lCollapsed := ::lCollapsed ELSE oSt := Atail( ::aSt ) ENDIF ::aLastVal := aVal oSt:AddReg( nRecord ) RETURN NIL //------------------------------------------------------------------------------ METHOD FindStByGroupValue( xGroupValues ) CLASS TBrwGroup LOCAL oSt LOCAL cVal LOCAL nAt IF ValType( xGroupValues ) == "A" cVal := "[" + aJoin( xGroupValues, "," ) + "]" ELSE cVal := xGroupValues ENDIF nAt := AScan( ::aSt, {|v| v:GroupValue() == cVal } ) IF nAt > 0 oSt := ::aSt[ nAt ] ENDIF RETURN oSt //------------------------------------------------------------------------------ METHOD GroupValueByRecord( nRecord, aVal ) CLASS TBrwGroup LOCAL oCol aVal := Array( Len( ::aGroupCols ) ) FOR EACH oCol IN ::aGroupCols aVal[ oCol:__EnumIndex() ] := ToString( oCol:Value( nRecord ) ) NEXT RETURN "[" + aJoin( aVal, "," ) + "]" //------------------------------------------------------------------------------ METHOD Log( lComplete ) CLASS TBrwGroup AEval( ::aSt, {|v| v:Log( lComplete ) } ) RETURN nil //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ CLASS TBrwGroupSt FROM TComponent PUBLIC: METHOD Header() METHOD Sum( xCol ) METHOD Max( xCol ) METHOD Min( xCol ) METHOD Average( xCol ) INLINE ( ::Sum( xCol ) / ::Count() ) RESERVED: ACCESS oBrowse IS oParent:oParent DATA aValues INIT {} DATA aColsData INIT {} DATA lCollapsed INIT .F. METHOD Free() METHOD AddReg( nRecord ) METHOD GroupValue() INLINE "[" + aJoin( ::aValues, "," ) + "]" METHOD Count() INLINE Len( ::aColsData ) METHOD Log( lComplete ) END CLASS //------------------------------------------------------------------------------ METHOD Free() CLASS TBrwGroupSt ::aColsData := {} RETURN ::Super:Free() //------------------------------------------------------------------------------ METHOD AddReg( nRecord ) CLASS TBrwGroupSt LOCAL aRow aRow := ::oBrowse:GetDataRow( nRecord ) AAdd( ::aColsData, aRow ) RETURN aRow //------------------------------------------------------------------------------ METHOD Header() CLASS TBrwGroupSt LOCAL oCol AS CLASS TBrwModCol LOCAL cHeader cHeader := "" FOR EACH oCol IN ::oParent:aGroupCols cHeader += oCol:cHeader + ": " + ::aValues[ oCol:__EnumIndex() ] IF !oCol:__EnumIsLast() cHeader += " - " ENDIF NEXT cHeader += " (" + ToString( ::Count() ) + ")" RETURN cHeader //------------------------------------------------------------------------------ METHOD Sum( xCol ) CLASS TBrwGroupSt LOCAL aRow LOCAL nSum := 0 IF ValType( xCol ) == "O" xCol := xCol:nDataCol ENDIF FOR EACH aRow IN ::aColsData IF ValType( aRow[ xCol ] ) == "N" nSum += aRow[ xCol ] ENDIF NEXT RETURN nSum //------------------------------------------------------------------------------ METHOD Max( xCol ) CLASS TBrwGroupSt LOCAL aRow LOCAL nMax IF ValType( xCol ) == "O" xCol := xCol:nDataCol ENDIF FOR EACH aRow IN ::aColsData IF ValType( aRow[ xCol ] ) != "L" IF nMax == NIL nMax := aRow[ xCol ] ENDIF IF aRow[ xCol ] > nMax nMax := aRow[ xCol ] ENDIF ENDIF NEXT RETURN nMax //------------------------------------------------------------------------------ METHOD Min( xCol ) CLASS TBrwGroupSt LOCAL aRow LOCAL nMin IF ValType( xCol ) == "O" xCol := xCol:nDataCol ENDIF FOR EACH aRow IN ::aColsData IF ValType( aRow[ xCol ] ) != "L" IF nMin == NIL nMin := aRow[ xCol ] ENDIF IF aRow[ xCol ] < nMin nMin := aRow[ xCol ] ENDIF ENDIF NEXT RETURN nMin //------------------------------------------------------------------------------ METHOD Log( lComplete ) CLASS TBrwGroupSt LOCAL oCol LOCAL nCol, nAt DEFAULT lComplete TO .T. LogDebug( "St Group Value:", ::GroupValue(), ::Count() ) IF !lComplete RETURN nil ENDIF FOR nCol := 1 TO Len( ::aColsData[ 1 ] ) nAt := AScan( ::oBrowse:aCols, {|v| v:nDataCol == nCol } ) IF nAt > 0 oCol := ::oBrowse:aCols[ nAt ] LogDebug( " Column:", oCol:cHeader ) LogDebug( " Sum:", ::Sum( oCol ) ) LogDebug( " Avg:", ::Average( oCol ) ) LogDebug( " Min:", ::Min( oCol ) ) LogDebug( " Max:", ::Max( oCol ) ) ENDIF NEXT RETURN NIL //------------------------------------------------------------------------------ #pragma BEGINDUMP #include #include HB_FUNC_STATIC( IS_ODD ) { hb_retl( hb_parnl( 1 ) & 1 ); } #pragma ENDDUMP //------------------------------------------------------------------------------