romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e21512240f10c5ed9b81170340685114222b684e
comun/clase/_grd_base.vc2

490 lines
16 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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="" />
*<PropValue>
HighlightStyle = 2
Name = "_grdbase"
*</PropValue>
ENDDEFINE
DEFINE CLASS _grdfooter AS grid
*< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
HIDDEN crecordsourcecursor,lisattached,osourcegrid
*<PropValue>
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 = <VFPData>
<memberdata name="osourcegrid" type="property" display="oSourceGrid" favorites="True"/>
<memberdata name="icolwithlabel" type="property" display="iColWithLabel"/>
<memberdata name="calctotal" type="method" display="calcTotal" favorites="True"/>
<memberdata name="csumcolumns" type="property" display="cSumColumns" favorites="True"/>
<memberdata name="eventhandler" type="method" display="eventHandler" favorites="True"/>
<memberdata name="attachtogrid" type="method" display="attachToGrid" favorites="True"/>
<memberdata name="osourcegrid" type="property" display="oSourceGrid" favorites="True"/>
<memberdata name="icolwithlabel" type="property" display="iColWithLabel"/>
<memberdata name="calctotal" type="method" display="calcTotal" favorites="True"/>
<memberdata name="csumcolumns" type="property" display="cSumColumns" favorites="True"/>
<memberdata name="eventhandler" type="method" display="eventHandler" favorites="True"/>
<memberdata name="attachtogrid" type="method" display="attachToGrid" favorites="True"/>
</VFPData>
*</PropValue>
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="" />
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
crgb_font = 0,0,0
crgb_grid = 255,255,255
crgb_row = 255,255,225
Name = "_grdrow"
nrecno = 0
nrgbrow = 1
*</PropValue>
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
Reference in New Issue View Git Blame Copy Permalink