*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="_grd_base.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS _grdbase AS _grid OF "_baza.vcx" *< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" /> * HighlightStyle = 2 Name = "_grdbase" * ENDDEFINE DEFINE CLASS _grdfooter AS grid *< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: attachtogrid && Attach to source grid *m: calctotal && calculate total in specified columns, in local array aTotals *m: eventhandler && handle source grid events *p: ccolwithlabel && Column with "Total" label *p: crecordsourcecursor && one row temporary cursor needed *p: csourcegrdalias && alias for source grid (in case of SQL/Query) RecordSource. *p: csourcegrid && source grid objects. "this.parent."+property value will be evaluated and attachewd to in Init, if set *p: csumcolumns && comma delimited list with summed columns *p: ctotallabelexpression && If one need to show more than "TOTAL" label in cColWithLabel column *p: lisattached *p: osourcegrid *p: _memberdata && XML Metadata for customizable properties * HIDDEN crecordsourcecursor,lisattached,osourcegrid * ccolwithlabel = crecordsourcecursor = csourcegrdalias = csourcegrid = csumcolumns = ctotallabelexpression = HeaderHeight = 0 Height = 35 lisattached = .F. Name = "_grdfooter" osourcegrid = .NULL. ReadOnly = .T. ScrollBars = 0 SplitBar = .F. Visible = .F. Width = 425 _memberdata = * PROCEDURE attachtogrid && Attach to source grid lparameters oSrcGrd local iAnchor, i with this *create RecordSource cursor this.cRecordSourceCursor = Sys(2015) create cursor ( .cRecordSourceCursor) (temp_column c(1)) insert into ( .cRecordSourceCursor) (temp_column) values (' ') .RecordSource = (.cRecordSourceCursor) .oSourceGrid = oSrcGrd * *first, copy properties .BackColor = oSrcGrd.BackColor .DeleteMark = oSrcGrd.DeleteMark .FontBold = oSrcGrd.FontBold .FontItalic = oSrcGrd.FontItalic .FontName = oSrcGrd.FontName .FontSize = oSrcGrd.FontSize .FontUnderline = oSrcGrd.FontUnderline .ForeColor = oSrcGrd.ForeColor .GridLines = oSrcGrd.GridLines .GridLineColor = oSrcGrd.GridLineColor .GridLineWidth = oSrcGrd.GridLineWidth .Panel = oSrcGrd.Panel .ReadOnly = .t. .Partition = oSrcGrd.Partition .RecordMark = oSrcGrd.RecordMark .RowHeight = oSrcGrd.RowHeight .HighlightBackColor = oSrcGrd.BackColor .HighlightForeColor = oSrcGrd.ForeColor .Themes = oSrcGrd.Themes *handle height, width .Width = oSrcGrd.Width if not .lIsAttached .Height = oSrcGrd.RowHeight + 2 * oSrcGrd.GridLineWidth ; + Iif( oSrcGrd.ScrollBars= 1 or oSrcGrd.ScrollBars= 3,Sysmetric(8),0) .ScrollBars = Iif( oSrcGrd.ScrollBars= 1 or oSrcGrd.ScrollBars= 3, 1 ,0) oSrcGrd.ScrollBars = Iif(oSrcGrd.ScrollBars=2 or oSrcGrd.ScrollBars= 3, 2 ,0) *.Height = oSrcGrd.RowHeight + 2 * oSrcGrd.GridLineWidth iAnchor = oSrcGrd.Anchor oSrcGrd.Anchor = 0 oSrcGrd.Height = oSrcGrd.Height - (oSrcGrd.RowHeight + 2 * oSrcGrd.GridLineWidth) oSrcGrd.Anchor = iAnchor endif .Top = oSrcGrd.Top + oSrcGrd.Height .Left = oSrcGrd.Left .Visible = .t. .HeaderHeight = 0 .ColumnCount = oSrcGrd.ColumnCount .LockColumns = oSrcGrd.LockColumns .LockColumnsLeft = oSrcGrd.LockColumnsLeft .ReadOnly = .T. if Empty(this.cSourceGrdAlias) this.cSourceGrdAlias = oSrcGrd.RecordSource endif &&27.05.2014 -- pentru a nu mai da eroare daca coloanele nu sunt in ordine in gridul pe care se face totalul, am schimbat numele coloanelor adaugand "00000" in coada FOR i=1 TO .COLUMNCOUNT .COLUMNS(i).NAME = .COLUMNS(i).NAME+[00000] NEXT &&27.05.2014 ^ -- pentru a nu mai da eroare daca coloanele nu sunt in ordine in gridul pe care se face totalul, am schimbat numele coloanelor adaugand "00000" in coada for i=1 to .ColumnCount .Columns(i).Alignment = oSrcGrd.Columns(i).Alignment .Columns(i).BackColor = oSrcGrd.Columns(i).BackColor .Columns(i).Bound = .F. .Columns(i).ColumnOrder = oSrcGrd.Columns(i).ColumnOrder .Columns(i).Enabled = .T. .Columns(i).FontBold = .T. .Columns(i).Inputmask = oSrcGrd.Columns(i).InputMask .Columns(i).Format = oSrcGrd.Columns(i).Format .Columns(i).FontName = oSrcGrd.Columns(i).FontName .Columns(i).FontSize = oSrcGrd.Columns(i).FontSize .Columns(i).Controls(2).DisabledForeColor = oSrcGrd.Columns(i).ForeColor .Columns(i).ForeColor = oSrcGrd.Columns(i).ForeColor .Columns(i).FontUnderline = oSrcGrd.Columns(i).FontUnderline .Columns(i).Name = oSrcGrd.Columns(i).Name .Columns(i).Width = oSrcGrd.Columns(i).Width .Columns(i).Visible = oSrcGrd.Columns(i).Visible BindEvent(oSrcGrd.Columns(i),'Resize',this,'eventHandler',1) BindEvent(oSrcGrd.Columns(i),'Moved',this,'eventHandler',1) BindEvent( oSrcGrd, 'Resize' , this, 'eventHandler',1) BindEvent( oSrcGrd, 'Moved' , this, 'eventHandler',1) BindEvent( oSrcGrd, 'AfterRowColChange' , this, 'eventHandler',1) BindEvent( oSrcGrd, 'LockColumns' , this, 'eventHandler',1) BindEvent( this, 'Scrolled',this,'eventHandler',1) next .lIsAttached = .t. endwith ENDPROC PROCEDURE calctotal && calculate total in specified columns, in local array aTotals If Empty(This.cSumColumns) Or Isnull(This.oSourceGrid) *nothing to do Return Endif Local cSQL, iColCount, i, j, cTotalLabel, nWorkArea Local Array aTotals[1], aColumns[1] nWorkArea = Select() Select(This.cSourceGrdAlias) iColCount = Alines(aColumns , This.cSumColumns,1,[,]) *build select command cSQL = [select ] For i = 1 To iColCount If i > 1 cSQL = cSQL + [,] Endif With Getpem(This.oSourceGrid,aColumns[i]) cSQL = cSQL + [Sum(] + .ControlSource + [)] Endwith Next cSQL = cSQL + [ from ] + This.cSourceGrdAlias + [ with (buffering=.t.) ] *if SET KEY, will try to filter on these values first If Not Empty(Set("Key")) Local vLim1, vLim2, cRangeLow, cRangeHigh , cKeyType cSQL = cSQL + ' where ' vLim1 = Set("Key",1) vLim2 = Set("Key",2) cKeyType = Type(Key()) cRangeLow= Icase( cKeyType = 'C' , ["] + Strtran(vLim1,["], [" + Chr(34) + "]) + ["] ; , cKeyType = 'D' , "Ctod(vLim1)" ; , cKeyType = 'T' , "Ctot(vLim1)" ; , vLim1 ) cRangeHigh = Icase( cKeyType = 'C' , ["] + Strtran(vLim2,["], [" + Chr(34) + "]) + ["] ; , cKeyType = 'D' , "Ctod(vLim2)" ; , cKeyType = 'T' , "Ctot(vLim2)" ; , vLim2 ) If Empty( Set("Key",2) ) cSQL = cSQL + Key() + [ >= ] + cRangeLow Else cSQL = cSQL + " Between( " + Key() + " , " + cRangeLow+ " , " + cRangeHigh + ")" Endif Endif *add FILTER() expression if needed If Not Empty( Filter() ) If Not Empty( Set("Key")) cSQL = cSQL + ' and ' + Filter() Else cSQL = cSQL + ' where ' + Filter() Endif Endif cSQL = cSQL + [ into array aTotals] &cSQL cTotalLabel = Iif(Not Empty(This.cTotalLabelExpression), Evaluate( This.cTotalLabelExpression ), 'TOTAL') With Getpem(This,This.cColWithLabel) .ControlSource = ["]+cTotalLabel+["] .Controls(2).ControlSource = [("]+cTotalLabel+[")] Endwith For i = 1 To iColCount For j = 1 To This.ColumnCount If Upper(This.Columns(j).Name) = Upper(aColumns[i]) This.Columns(j).ControlSource = [(]+Transform(Nvl(aTotals[i],0))+[)] This.Columns(j).Controls(2).ControlSource = [(]+Transform(Nvl(aTotals[i],0))+[)] This.Columns(j).Alignment = 1 Endif Next Next Select(nWorkArea) ENDPROC PROCEDURE Destroy if Used(this.cRecordSourceCursor) use in (this.cRecordSourceCursor) endif ENDPROC HIDDEN PROCEDURE eventhandler && handle source grid events Lparameters vParameter Local Array aSrcObj[1] Local oObj, cEvt, cClass, i, nWorkArea,iARow,iACol, iRCol, iACol_1 Local lnColumnOrder lnColumnOrder = 0 Aevents(aSrcObj,0) oObj = aSrcObj[1] cEvt = Lower(aSrcObj[2]) cClass = Lower(oObj.BaseClass) nWorkArea = Select(Alias()) This.Tag = 'evt' Select(This.cRecordSourceCursor) &&to be sure that memvar evaluation doesn't conflict with other alias columns Do Case Case cClass = 'grid' Do Case Case cEvt = 'resize' This.Width = oObj.Width This.Top = oObj.Top + oObj.Height Case cEvt = 'moved' This.Top = oObj.Top + oObj.Height This.Left = oObj.Left Case cEvt = 'afterrowcolchange' *the following never fires when LockColumns > 0 If Not This.oSourceGrid.LeftColumn == This.LeftColumn If This.oSourceGrid.LeftColumn > This.LeftColumn *scroll to R i=0 Do While This.oSourceGrid.LeftColumn > This.LeftColumn i = i + 1 This.DoScroll(5) If i >= This.ColumnCount This.oSourceGrid.DoScroll(4) Endif Enddo Else *scroll to L Do While This.oSourceGrid.LeftColumn < This.LeftColumn This.DoScroll(4) Enddo Endif Endif *try to solve LockColumn > 0 case If This.LockColumns > 0 *the only way seems to be checking ActiveColumn/RelativeColumn iARow = This.oSourceGrid.ActiveRow iACol = This.oSourceGrid.ActiveColumn iRCol = This.oSourceGrid.RelativeColumn *temporary unbind source grid ARCC, Scrolled Unbindevents(This.oSourceGrid,'AfterRowColChange',This,'eventHandler') Unbindevents(This,'Scrolled',This,'eventHandler') *this seems to be needed to avoid flickering Thisform.LockScreen = .T. *column changed in locked portion, scroll both to left If iACol <= This.oSourceGrid.LockColumns This.oSourceGrid.DoScroll(6) For i=1 To 5 &&should be enough This.DoScroll(6) Next Else This.SetFocus() *very interesting next stuff, ActivateCell work relatively to locked columns *need to compare Column index for a given RelativeRow and scroll accordingly This.ActivateCell(1, iRCol) iACol_1 = This.ActiveColumn If Not iACol_1 == iACol If iACol_1 > iACol For i=1 To iACol_1 - iACol This.DoScroll(4) Next Else For i=1 To iACol - iACol_1 This.DoScroll(5) Next Endif Endif This.oSourceGrid.SetFocus() This.oSourceGrid.Visible = .T. Endif *bind ARCC back to this Bindevent(This.oSourceGrid,'AfterRowColChange',This,'eventHandler',1) Bindevent( This, 'Scrolled',This,'eventHandler',1) Thisform.LockScreen = .F. Endif Case cEvt = 'scrolled' If Not This.oSourceGrid.LeftColumn == This.LeftColumn If This.oSourceGrid.LeftColumn > This.LeftColumn *scroll to L i=0 Do While This.oSourceGrid.LeftColumn > This.LeftColumn This.oSourceGrid.DoScroll(4) Enddo Else *scroll to R i=0 Do While This.oSourceGrid.LeftColumn < This.LeftColumn i = i + 1 This.oSourceGrid.DoScroll(5) If i >= This.ColumnCount This.DoScroll(4) Endif Enddo Endif Endif If This.oSourceGrid.LockColumns > 0 This.oSourceGrid.DoScroll(vParameter) Endif Case cEvt = 'lockcolumns' This.LockColumns = This.oSourceGrid.LockColumns Endcase Case cClass = 'column' Do Case Case cEvt = 'moved' For i=1 To This.ColumnCount *!* 24.03.2008 If Type('This.oSourceGrid.Columns(i)') <> 'O' Exit EndIf *!* 24.03.2008 ^ If This.Columns(i).ColumnOrder <> This.oSourceGrid.Columns(i).ColumnOrder This.Columns(i).ColumnOrder = This.oSourceGrid.Columns(i).ColumnOrder Endif Endfor Case cEvt = 'resize' For i=1 To This.ColumnCount *!* 24.03.2008 If Type('This.oSourceGrid.Columns(i)') <> 'O' Exit EndIf *!* 24.03.2008 ^ If This.Columns(i).Width <> This.oSourceGrid.Columns(i).Width This.Columns(i).Width = This.oSourceGrid.Columns(i).Width Endif Next Endcase Endcase This.Tag = '' Select (nWorkArea) &&switch back work area ENDPROC PROCEDURE Init if not Empty(this.cSourceGrid) local oSrcGrid oSrcGrid = .null. try oSrcGrid = GetPem(this.Parent,this.cSourceGrid) catch endtry if Vartype(oSrcGrid) = 'O' and not IsNull(oSrcGrid) and oSrcGrid.BaseClass = 'Grid' if oSrcGrid.ColumnCount > 0 this.attachToGrid(oSrcGrid) this.calcTotal() endif endif endif ENDPROC PROCEDURE When if this.Tag = 'evt' or Mdown() return .t. else return .f. endif ENDPROC ENDDEFINE DEFINE CLASS _grdrow AS _grdbase OF "_grd_base.vcx" *< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" /> * *p: crgb_font *p: crgb_grid *p: crgb_row *p: nrecno *p: nrgbrow && 0 = Nu tine cont de cRGB_row si cRGB_grid; 1 = Tine cont de cRGB_row si cRGB_grid * * crgb_font = 0,0,0 crgb_grid = 255,255,255 crgb_row = 255,255,225 Name = "_grdrow" nrecno = 0 nrgbrow = 1 * PROCEDURE AfterRowColChange Lparameters nColIndex DoDefault() If This.nRgbrow = 1 This.nRecno = Recno(This.RecordSource) This.Refresh Endif ENDPROC PROCEDURE Init DoDefault() If This.nRgbrow = 1 lcRGB_Row = 'RGB(' + This.cRGB_Row + ')' lcRGB_Grid = 'RGB(' + This.cRGB_Grid + ')' lcSetAll = [this.SetAll("DynamicBackColor","iif(RECNO() = this.nRecno,] + ; lcRGB_Row + [,] + lcRGB_Grid + [)","Column")] &lcSetAll This.SetAll("DynamicForeColor","iif(RECNO() = This.nRecno,RGB(" + This.cRGB_Font + "),RGB(0,0,0))","Column") Endif ENDPROC ENDDEFINE