romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d3501199934b4336a19da6a989c1d18b2a8dab04
comun/utile/GridExtras/gridextras.vc2
Marius Mutu 5f3a17c5c7 fix: exportul Excel din GridExtras respecta ordinea de afisare a coloanelor 
gridutils.copytoexcel parcurgea grid.Columns() pe indexul de creare, care in
VFP nu are legatura cu ColumnOrder. Coloanele se sorteaza acum dupa ColumnOrder
inainte de a construi lista de campuri, deci exportul iese in ordinea de pe
ecran, inclusiv dupa ce utilizatorul muta coloane (ordine salvata de
savegridpreferences).

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01YB2eA3Wd31DZiXjzVRc6VJ
2026-08-03 11:48:03 +03:00

2579 lines
85 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="gridextras.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS checkform AS timer
*< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 23
Name = "checkform"
Width = 23
*</PropValue>
PROCEDURE Timer
IF MROW(ThisForm.Name,3) = -1 OR MCOL(ThisForm.Name,3) = -1
IF This.Parent._InForm
This.Parent._InForm = .F.
This.Parent.tmrFadeForm.Interval = 50
This.Parent._Fade = 255
ENDIF
ELSE
IF NOT This.Parent._InForm
This.Parent._InForm = .T.
This.Parent.tmrFadeForm.Interval = 50
ENDIF
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS fadeform AS timer
*< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" />
*<PropValue>
Height = 23
Name = "fadeform"
Width = 23
*</PropValue>
PROCEDURE Timer
IF This.Parent._InForm
This.Parent._Fade = MIN(This.Parent._Fade + 60,255)
ELSE
This.Parent._Fade = MAX(This.Parent._Fade - 20,100)
ENDIF
_Sol_SetLayeredWindowAttributes(THISFORM.hWnd, 0, This.Parent._Fade, 2)
IF NOT BETWEEN(This.Parent._Fade,101,254)
This.Interval = 0
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS gridcustomfilter AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Combo1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Text2" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: clearfiltersettings
*m: controlsourcetype_assign
*m: filterstring_access
*m: operatorchanged
*m: selectall
*m: setup
*p: columncontrolsource
*p: controlsourcetype
*p: filterstring
*p: interactivechangecombofiring
*p: uniquecursorname
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
BorderWidth = 0
columncontrolsource =
controlsourcetype = C
filterstring =
Height = 76
interactivechangecombofiring = .F.
Name = "gridcustomfilter"
uniquecursorname =
Width = 192
*</PropValue>
ADD OBJECT 'Combo1' AS combobox WITH ;
Height = 24, ;
Left = 1, ;
Name = "Combo1", ;
RowSourceType = 1, ;
Style = 2, ;
Top = 1, ;
Width = 190
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'Text1' AS textbox WITH ;
Format = "K", ;
Height = 23, ;
Left = 1, ;
Name = "Text1", ;
SelectOnEntry = .T., ;
Top = 27, ;
Visible = .F., ;
Width = 190
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Text2' AS textbox WITH ;
Format = "K", ;
Height = 23, ;
Left = 1, ;
Name = "Text2", ;
SelectOnEntry = .T., ;
Top = 52, ;
Visible = .F., ;
Width = 190
*< END OBJECT: BaseClass="textbox" />
PROCEDURE clearfiltersettings
this.combo1.ListIndex = 1
this.controlsourcetype = this.controlsourcetype
ENDPROC
PROCEDURE controlsourcetype_assign
LPARAMETERS vNewVal
LOCAL lvDefaultValue
DO CASE
*!* MARIUS
CASE INLIST(m.vNewVal, "C", "M", "V")
m.lvDefaultValue = ""
*!* MARIUS ^
CASE INLIST(m.vNewVal, "N", "Y")
m.lvDefaultValue = 0.00
CASE m.vNewVal = "D"
m.lvDefaultValue = {}
CASE m.vNewVal = "T"
m.lvDefaultValue = {/:}
CASE m.vNewVal = "L"
m.lvDefaultValue = .T.
ENDCASE
this.text1.Value = m.lvDefaultValue
this.text2.Value = m.lvDefaultValue
this.text1.refresh()
this.text2.refresh()
THIS.ControlSourceType = m.vNewVal
ENDPROC
PROCEDURE Destroy
USE IN Select(This.UniqueCursorName)
DODEFAULT()
ENDPROC
PROCEDURE filterstring_access
LOCAL lcFilterString, lnFilterType, lcAtCommand
m.lcFilterString = ""
IF thisform.casesensitive
m.lcAtCommand = "AT("
ELSE
m.lcAtCommand = "ATC("
ENDIF
IF !EOF(this.uniquecursorname) AND this.combo1.ListIndex != 1
m.lnFilterType = EVALUATE(this.uniquecursorname + ".criteria")
DO case
CASE m.lnFilterType = 1
m.lcFilterString = m.lcAtCommand + "[" + ALLTRIM(this.text1.Value) + "], LEFT(" + this.columncontrolsource + "," + TRANSFORM(LEN(ALLTRIM(this.text1.Value))) + ")) > 0"
CASE m.lnFilterType = 2
m.lcFilterString = m.lcAtCommand + "[" + ALLTRIM(this.text1.Value) + "], " + this.columncontrolsource + ") > 0"
CASE m.lnFilterType = 3
DO case
CASE INLIST(this.controlsourcetype, "C", "M")
m.lcFilterString = this.columncontrolsource + "=[" + ALLTRIM(TRANSFORM(this.text1.Value)) + "]"
CASE INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + "={" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
OTHERWISE
m.lcFilterString = this.columncontrolsource + "=" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDCASE
CASE m.lnFilterType = 4
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + ">{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
ELSE
m.lcFilterString = this.columncontrolsource + ">" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDIF
CASE m.lnFilterType = 5
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + "<{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
ELSE
m.lcFilterString = this.columncontrolsource + "<" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDIF
CASE m.lnFilterType = 6
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = "Between(" + this.columncontrolsource + ",{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "},{" + ALLTRIM(TRANSFORM(this.text2.Value)) + "})"
ELSE
m.lcFilterString = "Between(" + this.columncontrolsource + "," + ALLTRIM(TRANSFORM(this.text1.Value)) + "," + ALLTRIM(TRANSFORM(this.text2.Value)) + ")"
ENDIF
ENDCASE
ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Begins with", "CM", "Text1", "", 1)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Contains", "CM", "Text1", "", 2)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M", "N", "Y", "L", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Equals", "CMNYLDT", "Text1", "", 3)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Greater than", "NYDT", "Text1", "", 4)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Less than", "NYDT", "Text1", "", 5)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Between", "NYDT", "Text1", "Text2", 6)
*!* ENDIF
RETURN m.lcFilterString
ENDPROC
PROCEDURE operatorchanged
LOCAL lcControlOne, lcControlTwo
IF !EOF(this.uniquecursorname) AND this.combo1.ListIndex != 1
m.lcControlOne = EVALUATE(this.uniquecursorname + ".ctrlone")
m.lcControlTwo = EVALUATE(this.uniquecursorname + ".ctrlTwo")
this.text1.Visible = !Empty(m.lcControlOne)
this.text2.Visible = !Empty(m.lcControlTwo)
ELSE
this.text1.Visible = .F.
this.text2.Visible = .F.
ENDIF
ENDPROC
PROCEDURE selectall
IF !thisform.check1.value ;
AND this.combo1.listindex > 1
thisform.check1.value = .T.
thisform.check1.valid()
ENDIF
ENDPROC
PROCEDURE setup
LPARAMETERS tcFieldCaption, tcFieldType, tcColumnControlSource
LOCAL lcUniqueCursorName
this.columncontrolsource = m.tcColumnControlSource
m.lcUniqueCursorName = SYS(2015)
THIS.uniquecursorname = m.lcUniqueCursorName
CREATE CURSOR (m.lcUniqueCursorName) (usrcaption C(30), datatypes C(30), ctrlone C(30), ctrltwo C(30), criteria I)
m.tcFieldType = UPPER(m.tcFieldType)
INSERT INTO (m.lcUniqueCursorName) VALUES ("", "", "", "", 0)
*!* MARIUS
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Begins with", "CM", "Text1", "", 1)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Contains", "CM", "Text1", "", 2)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M", "N", "Y", "L", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Equals", "CMNYLDT", "Text1", "", 3)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Greater than", "NYDT", "Text1", "", 4)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Less than", "NYDT", "Text1", "", 5)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Between", "NYDT", "Text1", "Text2", 6)
*!* ENDIF
IF INLIST(m.tcFieldType, "C", "M", "V")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Incepe cu", "CMV", "Text1", "", 1)
ENDIF
IF INLIST(m.tcFieldType, "C", "M", "V")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Contine", "CMV", "Text1", "", 2)
ENDIF
IF INLIST(m.tcFieldType, "C", "M", "V", "N", "Y", "L", "D", "T")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Egal cu", "CMVNYLDT", "Text1", "", 3)
ENDIF
IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Mai mare decat", "NYDT", "Text1", "", 4)
ENDIF
IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Mai mic decat", "NYDT", "Text1", "", 5)
ENDIF
IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
INSERT INTO (m.lcUniqueCursorName) VALUES ("Intre", "NYDT", "Text1", "Text2", 6)
ENDIF
*!* MARIUS ^
GO TOP IN (m.lcUniqueCursorName)
this.controlsourcetype = m.tcFieldType
this.combo1.RowSourceType = 2
this.combo1.RowSource = m.lcUniqueCursorName
*!* this.combo1.ColumnCount = 5
*!* this.combo1.ColumnWidths = TRANSFORM(this.Width) + ",0,0,0,0"
this.combo1.ListIndex = 1
ENDPROC
PROCEDURE Combo1.InteractiveChange
LOCAL lnListIndexWas
IF this.parent.InteractiveChangeComboFiring
RETURN
ENDIF
this.parent.InteractiveChangeComboFiring = .T.
m.lnListIndexWas = this.listindex
This.Parent.OperatorChanged()
this.parent.SelectAll()
this.listindex = m.lnListIndexWas
this.refresh()
this.parent.InteractiveChangeComboFiring = .F.
ENDPROC
PROCEDURE Combo1.ProgrammaticChange
this.InteractiveChange()
ENDPROC
PROCEDURE Text1.InteractiveChange
this.Parent.SelectAll()
ENDPROC
PROCEDURE Text2.InteractiveChange
This.Parent.selectall()
ENDPROC
ENDDEFINE
DEFINE CLASS gridextra AS custom
*<ClassComment>
*Completeaza proprietatea gridextra.gridexpression cu Thisform.Nume_Grid
*
*In Form.Init apeleaza this.gridextra1.setup()
*</ClassComment>
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: addjoiner
*m: applyfilter
*m: applysort
*m: ascending_assign
*m: bindcolumnevents
*m: bindheaderevents
*m: clearfilter
*m: clearheadersortimages
*m: columnmoved
*m: columnresize
*m: createcombocursor
*m: createscreenreference
*m: exportgrid
*m: getcolumnobject
*m: getcombocursorname
*m: getheaderobject
*m: getsortexpression
*m: getuserapplicationdatapath
*m: getwindowproc
*m: headerclick
*m: headerrightclick
*m: positionform
*m: restorecolumnfilters
*m: restorecolumnsort
*m: restorecustomcolumnfilters
*m: restoregridpreferences
*m: saveacolumnfilters
*m: savecolumnsort
*m: savecustomcolumnfilters
*m: savegridpreferences
*m: search
*m: setheaderimages
*m: setup
*m: templateapply
*m: templatedelete
*m: templatelocate
*m: templatesave
*p: allowgridexport
*p: allowgridfilter
*p: allowgridpreferences
*p: allowgridsort
*p: ascending
*p: casesensitive
*p: columnobject
*p: combocursorcollection
*p: companyname
*p: currentcolumn
*p: currentcombocursorname
*p: delimiter
*p: globalarrayname
*p: gridexportobject
*p: gridexpression
*p: gridobject
*p: gridpreferencefile
*p: headerascendingimage
*p: headerdescendingimage
*p: headerfilterimage
*p: headernosortimage
*p: indexfile
*p: indextag
*p: originalfilter
*p: parentfield
*p: parenttable && Reference to the parent XMLTable object (only one XMLAdapter or ParentTable property can be set).
*p: productname
*p: searchandfilterform
*p: templatetable
*a: acolumnfilters[1,3]
*a: customcolumnfilters[1,5]
*</DefinedPropArrayMethod>
*<PropValue>
allowgridexport = .T.
allowgridfilter = .T.
allowgridpreferences = .T.
allowgridsort = .T.
ascending = .F.
casesensitive = .F.
columnobject = .NULL.
combocursorcollection = .NULL.
companyname = MyCompany
currentcolumn = .NULL.
currentcombocursorname =
delimiter = ||
globalarrayname =
gridexportobject = .NULL.
gridexpression = Thisform.Grid1
gridobject = .NULL.
gridpreferencefile = gridprefs.tmp
headerascendingimage = ascendingsort12.bmp
headerdescendingimage = descendingsort12.bmp
headerfilterimage = filter12.bmp
headernosortimage = nosort12.bmp
Height = 17
indexfile =
indextag =
Name = "gridextra"
originalfilter =
parentfield =
parenttable =
productname = MyProduct
searchandfilterform = .NULL.
templatetable = ["] + FullPath("gridextras.dbf") + ["]
Width = 20
*</PropValue>
PROCEDURE addjoiner
LPARAMETERS tcCurrentFilter, tcFilterNewPart
LOCAL lcReturn, lcCurrentFilterPart
m.lcReturn = ""
IF !EMPTY(m.tcFilterNewPart)
m.tcFilterNewPart = ALLTRIM(m.tcFilterNewPart)
m.tcCurrentFilter = ALLTRIM(m.tcCurrentFilter)
m.lcCurrentFilterPart = RIGHT(m.tcCurrentFilter,1)
IF m.lcCurrentFilterPart != "(" AND m.tcFilterNewPart != ")"
DO CASE
CASE m.tcFilterNewPart = "(" AND EMPTY(m.tcCurrentFilter)
m.lcReturn = m.tcFilterNewPart
CASE m.tcFilterNewPart = "(" AND !EMPTY(m.tcCurrentFilter)
m.lcReturn = " AND " + m.tcFilterNewPart
CASE m.lcCurrentFilterPart = ")"
m.lcReturn = " AND " + m.tcFilterNewPart
OTHERWISE
m.lcReturn = " OR " + m.tcFilterNewPart
ENDCASE
ELSE
m.lcReturn = m.tcFilterNewPart
ENDIF
ENDIF
RETURN m.lcReturn
ENDPROC
PROCEDURE applyfilter
LOCAL lcFilter, lnFilterCounter, lcColumnFilter, lcCurrentFilter, lcCustomFilterString
IF TYPE("this.gridobject.Name") = "C"
m.lcCurrentFilter = FILTER(this.gridobject.recordsource)
*!* Need 8 paranthesis on the right side to handle between() filters correctly
DO WHILE !EMPTY(STREXTRACT(m.lcCurrentFilter,".AND.(((((((","))))))))",1,4))
m.lcCurrentFilter = STRTRAN(m.lcCurrentFilter, STREXTRACT(m.lcCurrentFilter,".AND.(((((((","))))))))",1,4),"",-1,-1,1)
ENDDO
*!* Need 8 paranthesis on the right side to handle between() filters correctly
DO WHILE !EMPTY(STREXTRACT(m.lcCurrentFilter,"(((((((","))))))))",1,4))
m.lcCurrentFilter = STRTRAN(m.lcCurrentFilter, STREXTRACT(m.lcCurrentFilter,"(((((((","))))))))",1,4),"",-1,-1,1)
ENDDO
*!* Now 7 paranthesis
DO WHILE !EMPTY(STREXTRACT(m.lcCurrentFilter,".AND.(((((((",")))))))",1,4))
m.lcCurrentFilter = STRTRAN(m.lcCurrentFilter, STREXTRACT(m.lcCurrentFilter,".AND.(((((((",")))))))",1,4),"",-1,-1,1)
ENDDO
*!* Now 7 paranthesis
DO WHILE !EMPTY(STREXTRACT(m.lcCurrentFilter,"(((((((",")))))))",1,4))
m.lcCurrentFilter = STRTRAN(m.lcCurrentFilter, STREXTRACT(m.lcCurrentFilter,"(((((((",")))))))",1,4),"",-1,-1,1)
ENDDO
m.lcCurrentFilter = IIF(!EMPTY(m.lcCurrentFilter) and (LEFT(ALLTRIM(m.lcCurrentFilter),1) != "(" or RIGHT(ALLTRIM(m.lcCurrentFilter),1) != ")"), ;
"(" + m.lcCurrentFilter + ")", m.lcCurrentFilter)
IF ATC(this.globalarrayname,m.lcCurrentFilter) = 0
this.originalfilter = m.lcCurrentFilter
ENDIF
m.lcCustomFilterString = ""
FOR m.lnFilterCounter = 1 TO ALEN(this.customcolumnfilters,1)
IF !EMPTY(this.customcolumnfilters(m.lnFilterCounter,5))
m.lcCustomFilterString = m.lcCustomFilterString + IIF(!EMPTY(m.lcCustomFilterString)," AND ", " ") + this.customcolumnfilters(m.lnFilterCounter,5)
ENDIF
ENDFOR
this.originalfilter = IIF(!EMPTY(this.originalfilter) and (LEFT(ALLTRIM(this.originalfilter),1) != "(" or RIGHT(ALLTRIM(this.originalfilter),1) != ")"), ;
"(" + this.originalfilter + ")", this.originalfilter)
IF !EMPTY(m.lcCustomFilterString)
m.lcFilter = IIF(!EMPTY(this.originalfilter), this.originalfilter + ".AND.(((((((", "(((((((") + m.lcCustomFilterString + ")))))))"
ELSE
m.lcFilter = This.originalfilter
ENDIF
FOR m.lnFilterCounter = 1 TO ALEN(this.aColumnFilters,1)
m.lcColumnFilter = this.aColumnFilters(m.lnFilterCounter, 1)
IF TYPE("m.lcColumnFilter") = "C" AND !EMPTY(m.lcColumnFilter)
m.lcFilter = m.lcFilter + This.AddJoiner(m.lcFilter, m.lcColumnFilter)
ENDIF
ENDFOR
SET FILTER TO &lcFilter IN (this.gridobject.recordsource)
GO TOP IN (this.gridobject.recordsource)
this.gridobject.refresh()
ENDIF
ENDPROC
PROCEDURE applysort
LPARAMETERS tlIsCombobox, toColumnObject, tlTemplateAscending
LOCAL lcAliasWas, lcSafetyWas, lcSortExpression, ;
lcControlSource, lcParentField, loColumn, ;
lnTagNo, llNewColumn, loHeaderObject, ;
loExc AS EXCEPTION, lnChangedBufferFrom
IF PCOUNT() < 3
m.tlTemplateAscending = .F.
ENDIF
WITH THIS
IF TYPE("m.toColumnObject") = "O"
m.loColumn = m.toColumnObject
ELSE
m.loColumn = This.GetColumnObject()
ENDIF
IF TYPE("m.loColumn.PARENT.RECORDSOURCE") != "C"
RETURN .F.
ENDIF
IF !ISNULL(.currentcolumn) AND m.loColumn.NAME = .currentcolumn.NAME AND VARTYPE(m.toColumnObject) != "O"
m.llNewColumn = .F.
ELSE
m.llNewColumn = .T.
.currentcolumn = m.loColumn
RELEASE m.loColumn
m.loColumn = NULL
ENDIF
IF TYPE([This.CurrentColumn]) != "O" OR TYPE([This.CurrentColumn.ControlSource]) != "C"
m.loHeaderObject = .currentcolumn.CONTROLS(1)
THIS.ClearHeaderSortImages()
m.loHeaderObject.PICTURE = THIS.HeaderNoSortImage &&"navigate_no.png"
.currentcolumn = NULL
IF !EMPTY(m.lcAliasWas) AND ALIAS() != m.lcAliasWas
SELECT (m.lcAliasWas)
ENDIF
RETURN .F.
ENDIF
.currentcolumn.SETFOCUS()
m.lcControlSource = EVALUATE([This.CurrentColumn.ControlSource]) && EVALUATE([.CurrentColumn.] + .currentcolumn.CURRENTCONTROL + [.ControlSource])
m.lcParentField = JUSTEXT(m.lcControlSource) && IIF(AT("(",m.lcControlSource) = 0, JUSTEXT(m.lcControlSource), "")
m.lcAliasWas = ALIAS()
IF m.tlIsCombobox OR EMPTY(FIELD(m.lcParentField,.currentcolumn.PARENT.RECORDSOURCE))&& EMPTY(m.lcParentField) OR LOWER(ALLTRIM(.currentcolumn.PARENT.RECORDSOURCE)) != LOWER(ALLTRIM(JUSTSTEM(m.lcControlSource)))
m.lcParentField = m.lcControlSource
.PARENTTABLE = .currentcolumn.PARENT.RECORDSOURCE
SELECT (.PARENTTABLE)
m.lnTagNo = 0
ELSE
.PARENTTABLE = JUSTSTEM(m.lcControlSource)
SELECT (.PARENTTABLE)
m.lnTagNo = TAGNO(m.lcParentField)
ENDIF
IF !m.llNewColumn OR m.lnTagNo > 0 &&OR ORDER(.PARENTTABLE) == UPPER(m.lcParentField) OR (!EMPTY(.INDEXFILE) AND ORDER(.PARENTTABLE) == UPPER(JUSTSTEM(.INDEXFILE)))
IF !m.llNewColumn
.ASCENDING = !.ASCENDING
ELSE
.ASCENDING = m.tlTemplateAscending && set to .F. so field is indexed in Ascending Order
ENDIF
IF m.lnTagNo = 0 && we're dealing with an idx
m.lcParentField = JUSTSTEM(.INDEXFILE)
ENDIF
* In unele formulare am select din oracle dupa ordonare si se pierde index-ul. trebuie refacut
IF TAGCOUNT(.INDEXFILE) > 0
IF .ASCENDING
SET ORDER TO (m.lcParentField) IN (.PARENTTABLE) DESCENDING
ELSE
SET ORDER TO (m.lcParentField) IN (.PARENTTABLE) ASCENDING
ENDIF
ENDIF
ELSE
.ASCENDING = m.tlTemplateAscending && set to .F. so field is indexed in Ascending Order
m.lcSortExpression = THIS.GetSortExpression(m.lcParentField, m.tlIsCombobox)
IF !EMPTY(m.lcSortExpression)
m.lcSafetyWas = SET("Safety")
SET SAFETY OFF && If idx already exists, overwrite it silently
TRY
m.lnChangedBufferFrom = CURSORGETPROP("Buffering", .PARENTTABLE)
IF BETWEEN(m.lnChangedBufferFrom, 4, 5)
IF GETNEXTMODIFIED(0, .PARENTTABLE, .T.) = 0
CURSORSETPROP("Buffering", 3, .PARENTTABLE) && Must set tables and views to optimistic row buffering in order to create a temp index
ELSE
MESSAGEBOX("The system was unable to sort the selected column due to unsaved changes." + CHR(13) ;
+ "Save your changes and try again.", 64, "Unsaved Changes Detected - Save Required")
EXIT
ENDIF
ENDIF
INDEX ON &lcSortExpression TO (.INDEXFILE)
IF .ASCENDING
SET ORDER TO (ORDER(.PARENTTABLE)) DESCENDING
ELSE
SET ORDER TO (ORDER(.PARENTTABLE)) ASCENDING
ENDIF
CATCH TO m.loExc
*!* MESSAGEBOX(TRANSFORM(m.loExc.lineno) + " " + m.loExc.Message)
m.loHeaderObject = .currentcolumn.CONTROLS(1)
m.loHeaderObject.PICTURE = THIS.HeaderNoSortImage && "navigate_no.png"
.currentcolumn = NULL
FINALLY
IF USED(.PARENTTABLE)
IF BETWEEN(m.lnChangedBufferFrom, 4, 5) AND !BETWEEN(CURSORGETPROP("Buffering", .PARENTTABLE),4,5)
CURSORSETPROP("Buffering", m.lnChangedBufferFrom, .PARENTTABLE)
ENDIF
ENDIF
ENDTRY
SET SAFETY &lcSafetyWas && set it back the way we found it
ENDIF
ENDIF
IF !ISNULL(.currentcolumn)
GO BOTTOM IN (.PARENTTABLE)
GO TOP IN (.PARENTTABLE)
.GridObject.REFRESH()
.currentcolumn.SETFOCUS()
ENDIF
.GridObject.REFRESH()
ENDWITH
IF !EMPTY(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE ascending_assign
LPARAMETERS vNewVal
DIMENSION aryShapePoints(3,2)
IF PCOUNT() = 0 OR TYPE("m.vNewVal") != "L"
m.vNewVal = this.ascending
ENDIF
This.ClearHeaderSortImages()
m.loHeaderObject = THIS.GetHeaderObject()
IF !ISNULL(m.loHeaderObject)
IF m.vNewVal && Descending
m.loHeaderObject.picture = This.HeaderDescendingImage && "navigate_open.png"
ELSE && Ascending
m.loHeaderObject.picture = This.HeaderAscendingImage && "navigate_close.png"
ENDIF
ENDIF
THIS.ASCENDING = m.vNewVal
ENDPROC
PROCEDURE bindcolumnevents
LPARAMETERS toColumnObject
BINDEVENT(m.toColumnObject,"Moved",This,"ColumnMoved")
BINDEVENT(m.toColumnObject,"Resize",This,"ColumnResize")
ENDPROC
PROCEDURE bindheaderevents
LPARAMETERS toHeaderObject
BINDEVENT(m.toHeaderObject,"DblClick",This,"HeaderClick")
BINDEVENT(m.toHeaderObject,"RightClick",This,"HeaderRightClick")
ENDPROC
PROCEDURE clearfilter
LOCAL lcFilter
m.lcFilter = This.originalfilter
IF USED(this.gridobject.recordsource)
SET FILTER TO &lcFilter IN (this.gridobject.recordsource)
GO TOP IN (this.gridobject.recordsource)
ENDIF
this.gridobject.refresh()
ENDPROC
PROCEDURE clearheadersortimages
LOCAL loHeaderObject, lnCounter, loColumn, lcHeaderImage
IF TYPE("THIS.currentcolumn") = "O"
FOR m.lnCounter = 1 TO THIS.currentcolumn.parent.columncount
m.loColumn = THIS.currentcolumn.parent.columns(m.lnCounter)
m.loHeaderObject = m.loColumn.controls(1)
m.lcHeaderImage = UPPER(JUSTFNAME(m.loHeaderObject.picture))
IF !EMPTY(m.lcHeaderImage) AND INLIST(m.lcHeaderImage, UPPER(this.HeaderAscendingImage), UPPER(This.HeaderDescendingImage), UPPER(This.HeaderNoSortImage))
m.loHeaderObject.picture = ""
ENDIF
ENDFOR
ENDIF
ENDPROC
PROCEDURE columnmoved
This.savegridpreferences(this.GridObject)
ENDPROC
PROCEDURE columnresize
This.savegridpreferences(this.GridObject)
ENDPROC
PROCEDURE createcombocursor
LPARAMETERS tcTempCursorName, toComboBox
LOCAL lnCounter, lcControlSourceType, lcAliasWas
m.lcAliasWas = ALIAS()
CREATE CURSOR (m.tcTempCursorName) (disptext V(99), fkid V(99))
FOR m.lnCounter = 1 TO m.toComboBox.listcount
IF this.casesensitive
INSERT INTO (m.tcTempCursorName) ;
VALUES (m.toComboBox.list(m.lnCounter,1), m.toComboBox.list(m.lnCounter, m.toComboBox.boundcolumn))
ELSE
INSERT INTO (m.tcTempCursorName) ;
VALUES (UPPER(m.toComboBox.list(m.lnCounter,1)), m.toComboBox.list(m.lnCounter, m.toComboBox.boundcolumn))
ENDIF
ENDFOR
m.lcControlSourceType = TYPE(m.toComboBox.controlsource)
IF !INLIST(m.lcControlSourceType, "C", "M")
IF m.lcControlSourceType = "N"
m.lcControlSourceType = m.lcControlSourceType + "(16,4)"
ENDIF
ALTER table (m.tcTempCursorName) ALTER COLUMN fkid &lcControlSourceType
ENDIF
SELECT(m.tcTempCursorName)
INDEX on fkid TAG fkid
IF m.lcAliasWas != ALIAS() AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE createscreenreference
IF TYPE("_GEScr") = "U"
PUBLIC _GEScr
ENDIF
IF VARTYPE(_GEScr) != "O"
_GEScr = _Screen
ENDIF
ENDPROC
PROCEDURE Destroy
Local lcAliasWas, lcCursorName
Try
Unbindevents(This)
If Vartype(This.gridobject)="O"
Unbindevents(This.gridobject)
Endif
Removeproperty(_Screen, This.GlobalArrayName)
Use In Select(This.GlobalArrayName)
Unbindevents(0)
If File(This.IndexFile)
m.lcAliasWas = Alias()
Select (This.ParentTable)
Set Index To
If !Empty(m.lcAliasWas)
Select (m.lcAliasWas)
Endif
Erase (This.IndexFile)
If Used(m.lcAliasWas)
Select (m.lcAliasWas)
Endif
Endif
If Vartype(This.combocursorcollection) = "O"
For Each m.lcCursorName In This.combocursorcollection
If Vartype(m.lcCursorName) = "C" And Used(m.lcCursorName)
Use In Select(m.lcCursorName)
Endif
Next
Endif
Store Null To This.gridobject, This.currentcolumn, This.columnobject, This.GridExportObject, This.combocursorcollection
Catch
Endtry
ENDPROC
PROCEDURE exportgrid
ENDPROC
PROCEDURE getcolumnobject
LOCAL ARRAY laObject(1,4)
LOCAL loObject, lcBaseClass
=AMOUSEOBJ(m.laObject)
m.loObject = m.laObject(1,1)
IF TYPE("m.loObject.baseclass") = "C"
m.lcBaseClass = UPPER(m.loObject.baseclass)
DO case
CASE m.lcBaseClass = "COLUMN"
*!* Do nothing as m.loObject is the column
CASE m.lcBaseClass = "HEADER"
m.loObject = m.loObject.Parent
OTHERWISE
m.loObject = NULL
ENDCASE
ELSE
m.loObject = NULL
ENDIF
This.columnobject = m.loObject
RETURN m.loObject
ENDPROC
PROCEDURE getcombocursorname
LPARAMETERS toComboBox
LOCAL lnKeyIndex, lcTempCursorName
IF VARTYPE(this.combocursorcollection) != "O"
This.combocursorcollection = CREATEOBJECT("collection")
ENDIF
m.lcTempCursorName = ""
m.lnKeyIndex = This.combocursorcollection.getkey(m.toComboBox.parent.name)
IF m.lnKeyIndex = 0
m.lcTempCursorName = SYS(2015)
This.combocursorcollection.add(m.lcTempCursorName, m.toComboBox.parent.name)
ELSE
m.lcTempCursorName = This.combocursorcollection.Item(m.lnKeyIndex)
ENDIF
IF !USED(m.lcTempCursorName) AND !EMPTY(m.lcTempCursorName)
this.createcombocursor(m.lcTempCursorName, m.toComboBox)
ENDIF
This.currentcombocursorname = m.lcTempCursorName
RETURN m.lcTempCursorName
ENDPROC
PROCEDURE getheaderobject
LOCAL loObject
m.loObject = this.GetColumnObject()
IF !ISNULL(m.loObject) AND TYPE("m.loObject.baseclass") = "C" AND UPPER(m.loObject.baseclass) = "COLUMN"
m.loObject = m.loObject.Controls(1) && Get header control
ENDIF
RETURN m.loObject
ENDPROC
PROCEDURE getsortexpression
LPARAMETERS tcFieldName, tlIsCombobox
LOCAL lcType, lcSortExpression
m.lcType = TYPE(m.tcFieldName)
IF PCOUNT() < 2
m.tlIsCombobox = .F.
ENDIF
IF m.tlIsCombobox
m.lcSortExpression = this.currentcombocursorname + [.disptext FOR SEEK(&tcFieldName, "] + this.currentcombocursorname + [","fkid")]
ELSE
DO CASE
CASE m.lcType $ "CM"
m.lcSortExpression = [UPPER(LEFT(NVL(] + m.tcFieldName + [,""), 99))]
CASE lcType = "N"
m.lcSortExpression = [NVL(] + m.tcFieldName + [, 0)]
CASE m.lcType $ "D"
m.lcSortExpression = [NVL(] + m.tcFieldName + [, {})]
CASE m.lcType $ "T"
m.lcSortExpression = [NVL(] + m.tcFieldName + [, {/:})]
CASE m.lcType == "L"
m.lcSortExpression = [NVL(] + m.tcFieldName + [, .F.)]
CASE m.lcType == "Y"
m.lcSortExpression = [NVL(] + m.tcFieldName + [, $0.00)]
OTHERWISE
m.lcSortExpression = ""
ENDCASE
ENDIF
RETURN m.lcSortExpression
ENDPROC
PROCEDURE getuserapplicationdatapath
#Define CSIDL_APPDATA 0x001a
Local m.lcSpecialFolderPath, m.lcApplicationDataPath
m.lcSpecialFolderPath = Space(255)
Declare SHGetSpecialFolderPath In SHELL32.Dll ;
LONG hwndOwner, ;
STRING @cSpecialFolderPath, ;
LONG nWhichFolder
SHGetSpecialFolderPath(0, @m.lcSpecialFolderPath, CSIDL_APPDATA)
m.lcApplicationDataPath = Alltrim(m.lcSpecialFolderPath)
m.lcApplicationDataPath = Substr(m.lcApplicationDataPath,1, Len(m.lcApplicationDataPath)-1)
m.lcApplicationDataPath = Addbs(m.lcApplicationDataPath) + This.CompanyName
If !Directory(m.lcApplicationDataPath)
Mkdir (m.lcApplicationDataPath)
Endif
m.lcApplicationDataPath = Addbs(m.lcApplicationDataPath) + This.ProductName
If !Directory(m.lcApplicationDataPath)
Mkdir (m.lcApplicationDataPath)
Endif
Return Addbs(m.lcApplicationDataPath)
ENDPROC
PROCEDURE getwindowproc
LPARAMETERS tnHWND
#DEFINE GWL_WNDPROC -4
LOCAL lnReturn
DECLARE INTEGER GetWindowLong IN Win32API ;
INTEGER HWND, INTEGER nIndex
m.lnReturn = GetWindowLong(m.tnHWND, GWL_WNDPROC)
ENDPROC
PROCEDURE headerclick
LOCAL loObject, lnLeft, lnTop, loActiveControlInColumn, lcColumnCursorName, llIsCombobox
this.currentcombocursorname = ""
m.llIsCombobox = .F.
IF this.allowgridsort
m.loObject = This.GetHeaderObject()
IF !ISNULL(m.loObject)
m.loActiveControlInColumn = EVALUATE("m.loObject.parent." + m.loObject.parent.currentcontrol)
IF LOWER(ALLTRIM(m.loActiveControlInColumn.Baseclass)) = "combobox"
m.lcColumnCursorName = this.getcombocursorname(m.loActiveControlInColumn)
m.llIsCombobox = .T.
ENDIF
this.applysort(m.llIsCombobox)
this.setheaderimages()
ENDIF
ENDIF
ENDPROC
PROCEDURE headerrightclick
LOCAL loObject, lnLeft, lnTop
this.currentcombocursorname = ""
IF this.Allowgridfilter
m.loObject = This.GetHeaderObject()
IF !ISNULL(m.loObject)
This.searchandfilterform = CREATEOBJECT("gridextraform", m.loObject.parent, this)
IF TYPE("This.searchandfilterform.Caption") = "C"
this.positionform(This.searchandfilterform, m.loObject)
This.searchandfilterform.Show()
ENDIF
ENDIF
ENDIF
ENDPROC
PROCEDURE Init
This.GlobalArrayName = SYS(2015)
ADDPROPERTY(_screen, this.GlobalArrayName+"[1,1]",.F.)
THIS.indexfile = ADDBS(SYS(2023)) + This.GlobalArrayName + ".IDX"
ENDPROC
PROCEDURE positionform
LPARAMETERS toSearchAndFilterForm, toHeader
LOCAL lnTop
IF TYPE("m.toSearchAndFilterForm.name") = "C" AND TYPE("m.toHeader.caption") = "C"
WITH m.toSearchAndFilterForm
m.lnTop = OBJTOCLIENT(m.toHeader, 1 ) + IIF(THISFORM.TITLEBAR=1,SYSMETRIC(9),0) + m.toHeader.PARENT.PARENT.HEADERHEIGHT + ;
IIF(THISFORM.BORDERSTYLE = 3, SYSMETRIC(4), SYSMETRIC(13)) + ;
IIF(THISFORM.SHOWWINDOW = 2, THISFORM.TOP, OBJTOCLIENT(THISFORM, 1 )) + 1 && thanks to Vassilis Aggelakos for the Titlebar=1 fix/idea
.LEFT = OBJTOCLIENT(m.toHeader, 2) + IIF(THISFORM.BORDERSTYLE = 3, SYSMETRIC(3), ;
SYSMETRIC(12)) + IIF(THISFORM.SHOWWINDOW = 2, THISFORM.LEFT, OBJTOCLIENT( THISFORM, 2 )) - 1
IF ((m.lnTop + .HEIGHT) > SYSMETRIC(2))
m.lnTop = m.lnTop - .HEIGHT - m.toHeader.PARENT.PARENT.HEADERHEIGHT - (2 * SYSMETRIC(13)) + 4
ENDIF
.TOP = m.lnTop - 2
ENDWITH
ENDIF
ENDPROC
PROCEDURE restorecolumnfilters
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas, lnCounter, lcGlobalArrayNameWas, lcGlobalArrayNameIs, lcGlobalArray
LOCAL ARRAY _GEAColumn(1)
LOCAL ARRAY _GEAGlobal(1)
m.lcAliasWas = ALIAS()
m.lcGlobalArray = [_GEScr.] + this.GlobalArrayName
IF This.TemplateLocate(m.tnTemplatePkID)
RESTORE From Memo FilterCol ADDITIVE
RESTORE From Memo FilterGlob ADDITIVE
m.lcGlobalArrayNameWas = ALLTRIM(globala)
m.lcGlobalArrayNameIs = this.globalarrayname
FOR m.lnCounter = 1 TO ALEN(_GEAColumn, 1)
IF TYPE("_GEAColumn(m.lnCounter, 1)") = "C"
_GEAColumn(m.lnCounter, 1) = STRTRAN(_GEAColumn(m.lnCounter, 1), m.lcGlobalArrayNameWas, m.lcGlobalArrayNameIs, -1, -1, 1)
ENDIF
ENDFOR
this.clearfilter()
IF (ALEN(_GEAGlobal,1) > 0 AND ALEN(_GEAGlobal,2) > 0)
DIMENSION &lcGlobalArray(ALEN(_GEAGlobal,1), ALEN(_GEAGlobal,2))
=ACOPY(_GEAGlobal, &lcGlobalArray)
IF (ALEN(_GEAColumn,1) > 0 AND ALEN(_GEAColumn,2) > 0)
DIMENSION this.acolumnfilters(ALEN(_GEAColumn,1), ALEN(_GEAColumn,2))
=ACOPY(_GEAColumn, this.acolumnfilters)
ENDIF
ELSE
DIMENSION this.acolumnfilters(1, 3)
STORE .F. TO this.acolumnfilters
ENDIF
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE restorecolumnsort
LPARAMETERS tnTemplatePkID, tlSortAscending
LOCAL lcAliasWas, loColumnObject
m.lcAliasWas = ALIAS()
IF This.TemplateLocate(m.tnTemplatePkID) AND !EMPTY(colname)
This.currentcolumn = EVALUATE("this.GridObject." + ALLTRIM(colname))
m.tlSortAscending = sortasc
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE restorecustomcolumnfilters
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas
LOCAL ARRAY _GEACustom(1)
m.lcAliasWas = ALIAS()
IF This.TemplateLocate(m.tnTemplatePkID)
RESTORE From Memo FilterCusT ADDITIVE
IF (ALEN(_GEACustom,1) > 0 AND ALEN(_GEACustom,2) > 0)
DIMENSION this.customcolumnfilters(ALEN(_GEACustom,1),ALEN(_GEACustom,2))
=ACOPY(_GEACustom, this.customcolumnfilters)
ENDIF
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE restoregridpreferences
LPARAMETERS toGridObject
Local lcGridHierarchy, lcString, lcPrefs, lcPrefFileContents, lcBeginPrefs, lcEndPrefs, lcPrefFile, ;
loColumn, lnCounter, lnMax, loExc as Exception
IF this.allowgridpreferences
m.lcPrefFile = This.GetUserApplicationDataPath() + This.GridPreferenceFile
m.lcPrefFileContents = ""
If File(m.lcPrefFile)
Try
m.lcPrefFileContents = Filetostr(m.lcPrefFile)
m.lcGridHierarchy = Sys(1272, m.toGridObject)
m.lcBeginPrefs = m.lcGridHierarchy + "("
m.lcEndPrefs = ")"
m.lcPrefs = Strextract(m.lcPrefFileContents,m.lcBeginPrefs,m.lcEndPrefs,1,1)
If !Empty(m.lcPrefs)
=Alines(laPrefs, m.lcPrefs, 7, ",")
m.lnMax = Min(m.toGridObject.ColumnCount * 2, Alen(laPrefs))
For m.lnCounter = 1 To m.lnMax Step 2
m.loColumn = m.toGridObject.Columns((m.lnCounter + 1)/2)
If Type("m.loColumn.columnorder") = "N"
m.loColumn.ColumnOrder = Val(laPrefs(m.lnCounter))
m.loColumn.Width = Val(laPrefs(m.lnCounter + 1))
Endif
Endfor
Endif
CATCH TO m.loExc
Endtry
ENDIF
ENDIF
ENDPROC
PROCEDURE saveacolumnfilters
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas, lcGlobalArray
LOCAL ARRAY _GEAColumn(1)
LOCAL ARRAY _GEAGlobal(1)
m.lcAliasWas = ALIAS()
m.lcGlobalArray = [_GEScr.] + this.GlobalArrayName
IF This.TemplateLocate(m.tnTemplatePkID)
=ACOPY(this.acolumnfilters, _GEAColumn)
SAVE to Memo FilterCol ALL LIKE _GEAColumn
=ACOPY(&lcGlobalArray, _GEAGlobal)
SAVE to Memo FilterGlob ALL LIKE _GEAGlobal
replace globala WITH this.globalarrayname
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE savecolumnsort
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas
m.lcAliasWas = ALIAS()
IF TYPE("this.currentcolumn.name") = "C" AND This.TemplateLocate(m.tnTemplatePkID)
replace colname WITH this.currentcolumn.name, sortasc WITH this.ascending
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE savecustomcolumnfilters
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas
LOCAL ARRAY _GEACustom(1)
m.lcAliasWas = ALIAS()
IF This.TemplateLocate(m.tnTemplatePkID)
=ACOPY(this.customcolumnfilters, _GEACustom)
SAVE to Memo FilterCust ALL LIKE _GEACustom
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE savegridpreferences
LPARAMETERS toGridObject
Local lcGridHierarchy, lcString, lcPrefs, lcPrefFileContents, ;
lcBeginPrefs, lcEndPrefs, lcPrefFile, loColumn, lnCounter, loExc as Exception
IF this.allowgridpreferences
m.lcGridHierarchy = Sys(1272, m.toGridObject)
m.lcBeginPrefs = m.lcGridHierarchy + "("
m.lcEndPrefs = ")"
m.lcPrefFile = This.GetUserApplicationDataPath() + This.GridPreferenceFile
m.lcPrefFileContents = ""
If File(m.lcPrefFile)
m.lcPrefFileContents = Filetostr(m.lcPrefFile)
Endif
m.lcPrefs = Strextract(m.lcPrefFileContents,m.lcBeginPrefs,m.lcEndPrefs,1,5)
m.lcString = ""
Try
For m.lnCounter = 1 To m.toGridObject.ColumnCount
m.loColumn = m.toGridObject.Columns(m.lnCounter)
m.lcString = m.lcString + Transform(m.loColumn.ColumnOrder) + ","
m.lcString = m.lcString + Transform(m.loColumn.Width) + ","
Endfor
CATCH TO m.loExc
ENDTRY
If !Empty(m.lcString)
m.lcString = m.lcBeginPrefs + m.lcString + m.lcEndPrefs
If Empty(m.lcPrefs) Or m.lcString != m.lcPrefs
If Empty(m.lcPrefs)
m.lcPrefFileContents = m.lcPrefFileContents + m.lcString + Chr(13) + Chr(10)
Else
m.lcPrefFileContents = Strtran(m.lcPrefFileContents, m.lcPrefs, m.lcString, 1, 1, 1)
Endif
Set Safety Off
=Strtofile(m.lcPrefFileContents, m.lcPrefFile, 0)
Endif
ENDIF
ENDIF
ENDPROC
PROCEDURE search
LPARAMETERS tcSearchPhrase, tlFindNext, lcSearchCommand
LOCAL lcRecordSource, lcAliasWas, lcControlSource, lcSearchValue, llLockScreenWas, loActiveControlInColumn, lcCurrentComboCursorName
LOCAL ARRAY aTemp(1)
aTemp(1) = Null
m.lcRecordSource = This.gridobject.recordsource
If Used(m.lcRecordSource) AND TYPE("This.ColumnObject.Name") = "C"
m.lcAliasWas = Alias()
m.lcControlSource = This.ColumnObject.ControlSource
m.loActiveControlInColumn = EVALUATE("This.ColumnObject." + This.ColumnObject.CurrentControl)
IF LOWER(m.loActiveControlInColumn.BaseClass) = "combobox" and m.loActiveControlInColumn.BoundColumn != 1
If This.casesensitive
m.lcSearchCommand = [At(] && m.lcSearchValue, Transform(&lcControlSource)) > 0]
ELSE
m.lcSearchCommand = [Atc(]
ENDIF
m.lcSearchCommand = m.lcSearchCommand + [Alltrim(Transform(m.tcSearchPhrase)), disptext)>0]
m.lcCurrentComboCursorName = this.currentcombocursorname
SELECT fkid FROM (m.lcCurrentComboCursorName) WHERE &lcSearchCommand INTO ARRAY aTemp
IF ISNULL(aTemp(1)) OR _tally < 1
m.lcSearchCommand = [.F.]
ELSE
IF _tally > 1
m.lcSearchCommand = [Ascan(aTemp, &lcControlSource)>0]
ELSE
m.lcSearchCommand = [&lcControlSource = aTemp(1)]
ENDIF
ENDIF
ELSE
m.lcSearchValue = Alltrim(Transform(m.tcSearchPhrase))
If This.casesensitive
m.lcSearchCommand = [At(] && m.lcSearchValue, Transform(&lcControlSource)) > 0]
ELSE
m.lcSearchCommand = [Atc(]
ENDIF
m.lcSearchCommand = m.lcSearchCommand + [m.lcSearchValue,Transform(&lcControlSource))>0]
ENDIF
Select (m.lcRecordSource)
If m.tlFindNext
If !Eof(m.lcRecordSource)
Skip 1 In (m.lcRecordSource)
ELSE
GO TOP IN (m.lcRecordSource)
ENDIF
ELSE
GO TOP IN (m.lcRecordSource)
ENDIF
Locate Rest For &lcSearchCommand
If !Found()
Go Top In (m.lcRecordSource)
IF m.tlFindNext
IF MESSAGEBOX("Search has reached the last record without finding another match. Do you want to continue searching from the first record?",36,"Continue Searching from the Beginning?") = 6
Locate Rest For &lcSearchCommand
IF !FOUND()
MESSAGEBOX("A matching record could not be found.",64,"Unable to Locate Search Phrase")
ENDIF
ENDIF
ELSE
MESSAGEBOX("A matching record could not be found.",64,"Unable to Locate Search Phrase")
ENDIF
ENDIF
*!* work around to allow highlighting/row update to show correctly in grid being searched as record pointer is moved
m.llLockScreenWas = thisform.lockscreen
thisform.lockscreen = .T.
this.gridobject.setfocus()
this.gridobject.refresh()
this.searchandfilterform.cmdSearch.setfocus()
thisform.lockscreen = m.llLockScreenWas
If m.lcAliasWas != Alias() And Used(m.lcAliasWas)
Select (m.lcAliasWas)
Endif
Endif
ENDPROC
PROCEDURE setheaderimages
LOCAL loColumnObject, loHeaderObject, lcHeaderImage, llCustomFilterEnforced, lnCustomFilterIndex
FOR EACH m.loColumnObject IN This.GridObject.Columns
m.llCustomFilterEnforced = .F.
m.loHeaderObject = m.loColumnObject.Controls(1)
m.lcHeaderImage = UPPER(JUSTFNAME(m.loHeaderObject.picture))
m.lnCustomFilterIndex = ASCAN(this.customcolumnfilters,ALLTRIM(m.loColumnObject.Name),-1,-1,1,15)
IF m.lnCustomFilterIndex > 0 AND !EMPTY(this.customcolumnfilters(m.lnCustomFilterIndex,5))
m.llCustomFilterEnforced = .T.
ENDIF
IF m.llCustomFilterEnforced OR ASCAN(this.acolumnfilters,ALLTRIM(m.loColumnObject.name),-1,-1,2,15) > 0
IF !INLIST(m.lcHeaderImage, UPPER(this.HeaderAscendingImage), UPPER(This.HeaderDescendingImage), UPPER(This.HeaderNoSortImage))
m.loHeaderObject.picture = this.headerfilterimage
ENDIF
ELSE
IF !EMPTY(m.lcHeaderImage) AND !INLIST(m.lcHeaderImage, UPPER(this.HeaderAscendingImage), UPPER(This.HeaderDescendingImage), UPPER(This.HeaderNoSortImage))
m.loHeaderObject.picture = ""
ENDIF
ENDIF
ENDFOR
ENDPROC
PROCEDURE setup
LOCAL loGridObject, loColumnObject, loHeaderObject, lcClassLib, lcGlobalArray, lcGridExportObjectName, lnGridExportAnchorValue
STORE Null TO This.GridObject, m.loColumnObject, m.loHeaderObject
UNBINDEVENTS(this)
this.CreateScreenReference()
m.lcGlobalArray = [_GEScr.] + this.GlobalArrayName
DIMENSION &lcGlobalArray.(1,1)
STORE .F. TO &lcGlobalArray
m.lcClassLib = LOWER(JUSTFNAME(this.ClassLibrary))
IF OCCURS(JUSTSTEM(m.lcClassLib),LOWER(SET("Classlib"))) = 0
IF FILE(this.ClassLibrary)
SET CLASSLIB TO (this.ClassLibrary) ADDITIVE
ELSE
SET CLASSLIB TO (LOCFILE(m.lcClassLib)) ADDITIVE
ENDIF
ENDIF
This.GridObject = EVALUATE(this.gridexpression)
IF TYPE("This.GridObject.Name") = "C"
this.restoregridpreferences(This.GridObject)
FOR EACH m.loColumnObject IN This.GridObject.Columns
This.BindColumnEvents(m.loColumnObject)
This.BindHeaderEvents(m.loColumnObject.Controls(1))
ENDFOR
this.originalfilter = FILTER(this.gridobject.recordsource)
this.originalfilter = IIF(!EMPTY(this.originalfilter), "(" + this.originalfilter + ")", "")
IF this.allowgridexport
m.lcGridExportObjectName = SYS(2015)
This.GridObject.parent.AddObject(m.lcGridExportObjectName,"GridExtraExport",this)
this.GridExportObject = EVALUATE("This.GridObject.parent." + m.lcGridExportObjectName)
this.GridExportObject.GridObject = this.gridobject
BINDEVENT(this.gridobject,"zorder",this.GridExportObject,"zorderupdate",1)
BINDEVENT(this.gridobject,"resize",this.GridExportObject,"resizeupdate",1)
IF TYPE("this.GridExportObject.Name") = "C"
m.lnGridExportAnchorValue = 0
IF BITTEST(This.GridObject.anchor,3)
m.lnGridExportAnchorValue = BITSET(m.lnGridExportAnchorValue, 3)
ELSE
IF BITTEST(This.GridObject.anchor,7)
m.lnGridExportAnchorValue = BITSET(m.lnGridExportAnchorValue, 7)
ENDIF
ENDIF
IF BITTEST(This.GridObject.anchor,2)
m.lnGridExportAnchorValue = BITSET(m.lnGridExportAnchorValue, 2)
ELSE
IF BITTEST(This.GridObject.anchor,6)
m.lnGridExportAnchorValue = BITSET(m.lnGridExportAnchorValue, 6)
ENDIF
ENDIF
this.GridExportObject.GridRecordSource = ALLTRIM(SYS(1272, this.GridObject))
this.GridExportObject.GridRecordSource = "Thisform" + SUBSTR(this.GridExportObject.GridRecordSource,AT(".", this.GridExportObject.GridRecordSource,1)) + ".RecordSource"
this.GridExportObject.Anchor = 0
this.GridExportObject.Left = (This.GridObject.Left + This.GridObject.Width - 19)
this.GridExportObject.Top = (This.GridObject.Top + This.GridObject.Height - 18)
this.GridExportObject.Anchor = m.lnGridExportAnchorValue
this.GridExportObject.visible = .T.
ENDIF
ENDIF
ENDIF
ENDPROC
PROCEDURE templateapply
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas, loActiveControlInColumn, llIsCombobox, llLockScreenWas, loHeaderObject, llAscendingSort
m.lcAliasWas = ALIAS()
IF This.TemplateLocate(m.tnTemplatePkID)
m.llLockScreenWas = thisform.LockScreen
thisform.LockScreen = .T.
This.RestoreColumnFilters(m.tnTemplatePkID)
this.RestoreCustomColumnFilters(m.tnTemplatePkID)
this.RestoreColumnSort(m.tnTemplatePkID, @m.llAscendingSort)
this.applyfilter()
m.llIsCombobox = .F.
IF TYPE("this.currentcolumn") = "O" AND TYPE("this.currentcolumn.currentcontrol") = "C" AND !EMPTY(this.currentcolumn.currentcontrol)
m.loActiveControlInColumn = EVALUATE("this.currentcolumn." + this.currentcolumn.currentcontrol)
IF LOWER(ALLTRIM(m.loActiveControlInColumn.Baseclass)) = "combobox"
m.llIsCombobox = .T.
ENDIF
this.applysort(m.llIsCombobox, this.currentcolumn, m.llAscendingSort)
ENDIF
this.setheaderimages()
IF TYPE("this.currentcolumn") = "O" AND TYPE("this.currentcolumn.currentcontrol") = "C" AND !EMPTY(this.currentcolumn.currentcontrol)
m.loHeaderObject = this.currentcolumn.Controls(1)
IF m.llAscendingSort && Descending
m.loHeaderObject.picture = This.HeaderDescendingImage && "navigate_open.png"
ELSE && Ascending
m.loHeaderObject.picture = This.HeaderAscendingImage && "navigate_close.png"
ENDIF
ENDIF
thisform.LockScreen = m.llLockScreenWas
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE templatedelete
LPARAMETERS tnTemplatePkID
LOCAL lcAliasWas
m.lcAliasWas = ALIAS()
IF This.TemplateLocate(m.tnTemplatePkID)
DELETE
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
PROCEDURE templatelocate
LPARAMETERS tnTemplatePkID
LOCAL lcTemplateTable, lcTemplateTableJustStem, lcTemplateGrid, lcTemplateName, llReturn
m.llReturn = .F.
m.lcTemplateTable = EVALUATE(this.templatetable)
m.lcTemplateTableJustStem = JUSTSTEM(m.lcTemplateTable)
IF TYPE("m.lcTemplateTable") = "C" AND FILE(m.lcTemplateTable)
IF !USED(m.lcTemplateTableJustStem)
USE (m.lcTemplateTable) IN 0 SHARED
ENDIF
SELECT (m.lcTemplateTableJustStem)
IF TYPE("m.tnTemplatePkID") = "N"
m.llReturn = (m.tnTemplatePkID = EVALUATE( m.lcTemplateTableJustStem + ".pkid") OR SEEK(m.tnTemplatePkID, m.lcTemplateTableJustStem, "pkid"))
ELSE
IF TYPE("m.tnTemplatePkID") = "C"
m.tnTemplatePkID = UPPER(ALLTRIM(m.tnTemplatePkID))
m.lcTemplateGrid = GETWORDNUM(m.tnTemplatePkID, 1, ":")
m.lcTemplateName = GETWORDNUM(m.tnTemplatePkID, 2, ":")
m.llReturn = (UPPER(ALLTRIM(m.lcTemplateGrid)) == UPPER(ALLTRIM(gridname)) and ;
UPPER(ALLTRIM(m.lcTemplateName)) == UPPER(ALLTRIM(template)))
IF !m.llReturn
LOCATE FOR m.lcTemplateGrid == UPPER(ALLTRIM(gridname)) AND m.lcTemplateName == UPPER(ALLTRIM(template))
m.llReturn = FOUND(m.lcTemplateTableJustStem)
ENDIF
ENDIF
ENDIF
ENDIF
RETURN m.llReturn
ENDPROC
PROCEDURE templatesave
LPARAMETERS tcGridName, tcTemplateName
LOCAL lcAliasWas, lnTemplatePkID
m.lcAliasWas = ALIAS()
IF !This.TemplateLocate(m.tcGridName + ":" + m.tcTemplateName)
APPEND BLANK
replace template WITH m.tcTemplateName, gridname WITH m.tcGridName
m.lnTemplatePkID = pkid
this.saveacolumnfilters(m.lnTemplatePkID)
this.savecustomcolumnfilters(m.lnTemplatePkID)
this.savecolumnsort(m.lnTemplatePkID)
ELSE
m.lnTemplatePkID = pkid
this.saveacolumnfilters(m.lnTemplatePkID)
this.savecustomcolumnfilters(m.lnTemplatePkID)
this.savecolumnsort(m.lnTemplatePkID)
ENDIF
IF ALIAS() != m.lcAliasWas AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS gridextraexport AS image
*< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: resizeupdate
*m: zorderupdate
*p: gridextrasobject
*p: gridobject
*p: gridrecordsource
*</DefinedPropArrayMethod>
*<PropValue>
Anchor = 12
gridextrasobject = .NULL.
gridobject = .NULL.
gridrecordsource = this.parent.grid1.recordsource
Height = 16
Name = "gridextraexport"
Picture = ..\graphics\table_sql_view16.png
Stretch = 1
Visible = .F.
Width = 18
*</PropValue>
PROCEDURE Click
LOCAL loGridUtils
m.loGridUtils = CREATEOBJECT("gridutils", thisform, this.gridobject, this.gridextrasobject)
m.loGridUtils.Show(1)
*!* Local lcGridSource, lcAliasWas, lcXLSFile, lcAction, lcFileName, lcPath
*!* lcGridSource = Evaluate(This.gridrecordsource)
*!* If Used(lcGridSource)
*!* lcAliasWas = Alias()
*!* Select (lcGridSource)
*!* lcXLSFile = Putfile("Excel Filename",Sys(2015) + ".xls", "XLS")
*!* If !Empty(lcXLSFile)
*!* Copy To (lcXLSFile) Type Xls
*!* GO TOP IN (m.lcGridSource)
*!* If File(lcXLSFile)
*!* lcFileName = Justfname(lcXLSFile)
*!* If Messagebox("The File " + lcFileName + Chr(13) + "was successfully exported." + Chr(13) +;
*!* "Would you like to open it now?",36,"EXCEL EXPORT SUCCESSFUL") = 6
*!* Declare Integer ShellExecute In shell32.Dll ;
*!* INTEGER hndWin, ;
*!* STRING cAction, ;
*!* STRING cFileName, ;
*!* STRING cParams, ;
*!* STRING cDir, ;
*!* INTEGER nShowWin
*!* lcAction = "open"
*!* lcPath=Justpath(lcXLSFile)
*!* ShellExecute(0,lcAction,lcFileName,lcPath,"",1)
*!* Endif
*!* Endif
*!* ENDIF
*!* IF USED(m.lcAliasWas)
*!* SELECT(m.lcAliasWas)
*!* ENDIF
*!* Else
*!* Messagebox("Record source for grid does not appear to be open or a table",16,"Unable to Export")
*!* Endif
ENDPROC
PROCEDURE Init
LPARAMETERS toGridExtras
this.gridextrasobject = m.toGridExtras
this.ZOrder(0)
ENDPROC
PROCEDURE resizeupdate
LOCAL lnAnchorWas
m.lnAnchorWas = this.Anchor
this.Anchor = 0
this.Left = (This.GridObject.Left + This.GridObject.Width - 19)
this.Top = (This.GridObject.Top + This.GridObject.Height - 18)
this.Anchor = m.lnAnchorWas
this.ZOrder(0)
ENDPROC
PROCEDURE zorderupdate
LPARAMETERS tnzOrder
this.zorder(0)
*!* this.zorder(Max(0, This.GridObject.zOrder - 1))
ENDPROC
ENDDEFINE
DEFINE CLASS gridextraform AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="shpSplitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdFilter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Check1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Grid1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Grid1.Column1.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Grid1.Column1.Check1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Grid1.Column2.Header1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Grid1.Column2.Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Gridcustomfilter1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Image1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="lblMore" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdExit" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="txtSearch" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdSearch" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdClearFilter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="tmrCheckform" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="tmrFadeform" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: buildfilter
*m: clearfilter
*m: retrievepreviouschecks
*m: retrievepreviouscustomfilter
*m: search
*m: setup
*m: showfilteroptions
*p: casesensitive
*p: columncontrolsource
*p: columnobject
*p: delimiter
*p: findnext
*p: globalarrayname
*p: gridextraobject
*p: gridrecordsource
*p: indexcustomcolumnfilter
*p: rundeactivaterelease
*p: uniquecursorname
*p: _fade
*p: _infademode
*p: _inform
*</DefinedPropArrayMethod>
*<PropValue>
AlwaysOnTop = .T.
BackColor = 255,255,255
BorderStyle = 3
Caption = ""
casesensitive = .T.
columncontrolsource =
columnobject = NULL
delimiter = ||
Desktop = .T.
DoCreate = .T.
findnext = .F.
globalarrayname = .F.
gridextraobject = NULL
gridrecordsource =
Height = 382
indexcustomcolumnfilter = 0
Left = 0
Name = "gridextraform"
rundeactivaterelease = .T.
ShowTips = .T.
TitleBar = 0
Top = 0
uniquecursorname =
Width = 228
WindowType = 0
_fade = 255
_infademode = .T.
_inform = .T.
*</PropValue>
ADD OBJECT 'Check1' AS checkbox WITH ;
Alignment = 0, ;
Anchor = 3, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = " Selecteaza tot", ;
ForeColor = 128,128,255, ;
Height = 17, ;
Left = 5, ;
Name = "Check1", ;
TabIndex = 6, ;
Top = 147, ;
Value = .T., ;
Width = 97
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'cmdClearFilter' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 168, ;
Name = "cmdClearFilter", ;
Picture = clearfilter16.bmp, ;
PicturePosition = 4, ;
TabIndex = 3, ;
ToolTipText = "Sterge filtrul existent", ;
Top = 4, ;
Width = 28
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdExit' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 196, ;
Name = "cmdExit", ;
Picture = close16.bmp, ;
PicturePosition = 4, ;
TabIndex = 4, ;
ToolTipText = "Renunta si inchide", ;
Top = 4, ;
Width = 28
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdFilter' AS commandbutton WITH ;
Caption = "Filtreaza", ;
Height = 26, ;
Left = 144, ;
Name = "cmdFilter", ;
Picture = addfilter16.bmp, ;
PicturePosition = 4, ;
TabIndex = 8, ;
ToolTipText = "Aplica filtrul si inchide", ;
Top = 352, ;
Width = 80
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'cmdSearch' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 25, ;
Left = 140, ;
Name = "cmdSearch", ;
Picture = search16.bmp, ;
TabIndex = 2, ;
ToolTipText = "Cauta", ;
Top = 4, ;
Width = 28
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Grid1' AS grid WITH ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
ColumnCount = 2, ;
DeleteMark = .F., ;
GridLines = 0, ;
HeaderHeight = 0, ;
Height = 182, ;
Highlight = .F., ;
HighlightRow = .F., ;
HighlightRowLineWidth = 0, ;
Left = -1, ;
Name = "Grid1", ;
RecordMark = .F., ;
ScrollBars = 2, ;
SplitBar = .F., ;
TabIndex = 7, ;
Top = 165, ;
Width = 230, ;
Column1.Name = "Column1", ;
Column1.Resizable = .F., ;
Column1.Sparse = .F., ;
Column1.Width = 23, ;
Column2.Name = "Column2", ;
Column2.ReadOnly = .T., ;
Column2.Resizable = .F., ;
Column2.Width = 183
*< END OBJECT: BaseClass="grid" />
ADD OBJECT 'Grid1.Column1.Check1' AS checkbox WITH ;
Alignment = 0, ;
Caption = "", ;
Centered = .T., ;
Height = 17, ;
Left = 12, ;
Name = "Check1", ;
Top = 11, ;
Width = 60
*< END OBJECT: BaseClass="checkbox" />
ADD OBJECT 'Grid1.Column1.Header1' AS header WITH ;
Caption = "Header1", ;
Name = "Header1"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'Grid1.Column2.Header1' AS header WITH ;
Caption = "Header1", ;
Name = "Header1"
*< END OBJECT: BaseClass="header" />
ADD OBJECT 'Grid1.Column2.Text1' AS textbox WITH ;
BackColor = 255,255,255, ;
BorderStyle = 0, ;
ForeColor = 0,0,0, ;
Margin = 0, ;
Name = "Text1", ;
ReadOnly = .T.
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Gridcustomfilter1' AS gridcustomfilter WITH ;
Anchor = 3, ;
Left = 4, ;
Name = "Gridcustomfilter1", ;
TabIndex = 5, ;
Top = 60, ;
Combo1.Left = 1, ;
Combo1.Name = "Combo1", ;
Text1.Height = 23, ;
Text1.Left = 21, ;
Text1.Name = "Text1", ;
Text1.Top = 27, ;
Text1.Width = 170, ;
Text2.Height = 23, ;
Text2.Left = 21, ;
Text2.Name = "Text2", ;
Text2.Top = 52, ;
Text2.Width = 170
*< END OBJECT: ClassLib="gridextras.vcx" BaseClass="container" />
ADD OBJECT 'Image1' AS image WITH ;
Anchor = 3, ;
Height = 16, ;
Left = 5, ;
Name = "Image1", ;
Picture = showfilters16.bmp, ;
Top = 33, ;
Width = 16
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'lblMore' AS label WITH ;
Anchor = 3, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Mai mult...", ;
ForeColor = 128,128,255, ;
Height = 17, ;
Left = 24, ;
Name = "lblMore", ;
TabIndex = 10, ;
Top = 33, ;
Width = 72
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'shpSplitter' AS shape WITH ;
Anchor = 11, ;
Height = 1, ;
Left = -4, ;
Name = "shpSplitter", ;
SpecialEffect = 0, ;
Top = 54, ;
Width = 235
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'tmrCheckform' AS checkform WITH ;
Left = 42, ;
Name = "tmrCheckform", ;
Top = 355
*< END OBJECT: ClassLib="gridextras.vcx" BaseClass="timer" />
ADD OBJECT 'tmrFadeform' AS fadeform WITH ;
Left = 72, ;
Name = "tmrFadeform", ;
Top = 355
*< END OBJECT: ClassLib="gridextras.vcx" BaseClass="timer" />
ADD OBJECT 'txtSearch' AS textbox WITH ;
Anchor = 3, ;
FontItalic = .T., ;
ForeColor = 128,128,255, ;
Format = "K", ;
Height = 23, ;
Left = 5, ;
Name = "txtSearch", ;
SelectOnEntry = .T., ;
TabIndex = 1, ;
Top = 5, ;
Value = Cauta, ;
Width = 135
*< END OBJECT: BaseClass="textbox" />
PROCEDURE buildfilter
LOCAL llAllChecked, lnFilterCounter, lnOriginalLen, ;
lcColumnName, llNoneChecked, lcAtCommand, lcGlobalArray, ;
lnIndexCustomColumnFilter
IF this.casesensitive
m.lcAtCommand= "AT"
else
m.lcAtCommand= "ATC"
ENDIF
this.clearfilter()
m.llAllChecked = .T.
m.llNoneChecked = .T.
m.lnOriginalLen = ALEN(This.gridextraobject.acolumnfilters, 1)
IF TYPE("This.gridextraobject.acolumnfilters(1,2)") != "C" AND m.lnOriginalLen = 1
m.lnOriginalLen = 0
ENDIF
*!* This.GridExtraObject.CustomFilterString = this.gridcustomfilter1.filterstring
****************************************
*!* Save custom filter settings so they can be restored
IF thisform.indexcustomcolumnfilter < 1
thisform.indexcustomcolumnfilter = ALEN(this.GridExtraObject.CustomColumnFilters,1) + 1
DIMENSION this.GridExtraObject.CustomColumnFilters (thisform.indexcustomcolumnfilter,5)
ENDIF
WITH this.GridExtraObject
.CustomColumnFilters(thisform.indexcustomcolumnfilter,1) = this.columnobject.name
.CustomColumnFilters(thisform.indexcustomcolumnfilter,2) = this.gridcustomfilter1.combo1.ListIndex
.CustomColumnFilters(thisform.indexcustomcolumnfilter,3) = this.gridcustomfilter1.text1.Value
.CustomColumnFilters(thisform.indexcustomcolumnfilter,4) = this.gridcustomfilter1.text2.Value
.CustomColumnFilters(thisform.indexcustomcolumnfilter,5) = this.gridcustomfilter1.filterstring
ENDWITH
****************************************
m.lcGlobalArray = [_GEScr.]+This.GlobalArrayname
m.lnFilterCounter = m.lnOriginalLen
IF !This.check1.Value
GO TOP IN (This.uniquecursorname)
m.lcColumnName = ALLTRIM(this.columnobject.name)
DO WHILE !EOF(This.uniquecursorname)
IF EVALUATE(This.uniquecursorname + ".checked")
m.llNoneChecked = .F.
IF m.lnFilterCounter = m.lnOriginalLen
m.lnFilterCounter = m.lnFilterCounter + 1
DIMENSION &lcGlobalArray.(m.lnFilterCounter,1)
DIMENSION This.gridextraobject.acolumnfilters(m.lnFilterCounter,3)
This.gridextraobject.acolumnfilters(m.lnFilterCounter,1) = "("
This.gridextraobject.acolumnfilters(m.lnFilterCounter,2) = m.lcColumnName
m.lnFilterCounter = m.lnFilterCounter + 1
DIMENSION &lcGlobalArray.(m.lnFilterCounter,1)
DIMENSION This.gridextraobject.acolumnfilters(m.lnFilterCounter,3)
This.gridextraobject.acolumnfilters(m.lnFilterCounter,1) = m.lcAtCommand + "([" + this.delimiter + "]+TRANSFORM(" + This.columncontrolsource + ")+[" + this.delimiter + "],"+;
[ _GEScr.]+This.GlobalArrayname+[(]+ALLTRIM(STR(m.lnFilterCounter))+[,1)]
This.gridextraobject.acolumnfilters(m.lnFilterCounter,2) = m.lcColumnName
This.gridextraobject.acolumnfilters(m.lnFilterCounter,3) = ;
this.delimiter + TRANSFORM(EVALUATE(This.uniquecursorname + ".actvalues")) + this.delimiter
ELSE
This.gridextraobject.acolumnfilters(m.lnFilterCounter,3) = ;
This.gridextraobject.acolumnfilters(m.lnFilterCounter,3) + ;
TRANSFORM(EVALUATE(This.uniquecursorname + ".actvalues")) + this.delimiter
ENDIF
ELSE
m.llAllChecked = .F.
ENDIF
SKIP 1 IN (This.uniquecursorname)
ENDDO
ENDIF
IF m.lnFilterCounter = 0
DIMENSION This.gridextraobject.acolumnfilters(1,3)
STORE .F. TO This.gridextraobject.acolumnfilters
DIMENSION &lcGlobalArray.(1,1)
STORE .F. TO &lcGlobalArray
ELSE
IF m.llAllChecked OR m.llNoneChecked
*!* DIMENSION This.gridextraobject.acolumnfilters(1,3)
*!* This.gridextraobject.acolumnfilters(1,1) = ""
*!* This.gridextraobject.acolumnfilters(1,2) = ""
ELSE
&lcGlobalArray.(m.lnFilterCounter,1) = This.gridextraobject.acolumnfilters(m.lnFilterCounter,3)
This.gridextraobject.acolumnfilters(m.lnFilterCounter,1) = ;
This.gridextraobject.acolumnfilters(m.lnFilterCounter,1) + ")>0"
m.lnFilterCounter = m.lnFilterCounter + 1
DIMENSION &lcGlobalArray.(m.lnFilterCounter,1)
DIMENSION This.gridextraobject.acolumnfilters(m.lnFilterCounter,3)
This.gridextraobject.acolumnfilters(m.lnFilterCounter,1) = ")"
This.gridextraobject.acolumnfilters(m.lnFilterCounter,2) = m.lcColumnName
&lcGlobalArray.(m.lnFilterCounter,1) = ""
ENDIF
ENDIF
ENDPROC
PROCEDURE clearfilter
LOCAL lnCounter, lcColumnName, lnIndex, lcGlobalArray, lcFilter
LOCAL ARRAY aTemp(ALEN(This.gridextraobject.acolumnfilters, 1),3)
=ACOPY(This.gridextraobject.acolumnfilters, aTemp)
DIMENSION This.gridextraobject.acolumnfilters(1,3)
STORE .F. TO This.gridextraobject.acolumnfilters
m.lcGlobalArray = [_GEScr.]+This.GlobalArrayname
m.lnIndex = 0
m.lcColumnName = UPPER(ALLTRIM(this.columnobject.name))
FOR m.lnCounter = 1 TO ALEN(aTemp, 1)
IF TYPE("aTemp(m.lnCounter,2)") = "C"
IF UPPER(ALLTRIM(aTemp(m.lnCounter,2))) == m.lcColumnName
*!* =ADEL(This.gridextraobject.acolumnfilters, m.lnCounter)
ELSE
m.lnIndex = m.lnIndex + 1
DIMENSION This.gridextraobject.acolumnfilters(m.lnIndex,3)
DIMENSION &lcGlobalArray.(m.lnIndex,1)
m.lcFilter = aTemp(m.lnCounter,1)
m.lcFilter = STRTRAN(m.lcFilter, m.lcGlobalArray+"("+ALLTRIM(STR(m.lnCounter))+",1)", m.lcGlobalArray+"("+ALLTRIM(STR(m.lnIndex))+",1)")
This.gridextraobject.acolumnfilters(m.lnIndex,1) = m.lcFilter
This.gridextraobject.acolumnfilters(m.lnIndex,2) = aTemp(m.lnCounter,2)
This.gridextraobject.acolumnfilters(m.lnIndex,3) = aTemp(m.lnCounter,3)
&lcGlobalArray.(m.lnIndex,1) = aTemp(m.lnCounter,3)
ENDIF
ENDIF
ENDFOR
IF thisform.indexcustomcolumnfilter > 0
thisform.gridextraobject.CustomColumnFilters(thisform.indexcustomcolumnfilter,5) = ""
ENDIF
ENDPROC
PROCEDURE Deactivate
IF !thisform.RunDeactivateRelease
RETURN
ENDIF
thisform.Release()
ENDPROC
PROCEDURE Init
LPARAMETERS toColumnObject, toGridExtraObject
This.ColumnObject = m.toColumnObject
This.GridExtraObject = m.toGridExtraObject
IF TYPE("This.ColumnObject.Name") != "C" OR TYPE("This.GridExtraObject.Name") != "C"
RETURN .F.
ENDIF
m.toGridExtraObject.CreateScreenReference()
this.casesensitive = This.GridExtraObject.casesensitive
this.UniqueCursorName = m.toGridExtraObject.GlobalArrayName
This.GlobalArrayName = m.toGridExtraObject.GlobalArrayName
this.Height = this.shpSplitter.Top
this.MinHeight = this.Height
this.MaxHeight = this.Height
this.MaxWidth = this.width
this.MinWidth = this.Width
This.Setup()
IF OS() < "Windows 5.00"
RETURN
ENDIF
DECLARE SetWindowLong In Win32Api AS _Sol_SetWindowLong Integer, Integer, Integer
DECLARE SetLayeredWindowAttributes In Win32Api AS _Sol_SetLayeredWindowAttributes Integer, String, Integer, Integer
_Sol_SetWindowLong(THISFORM.hWnd, -20, 0x00080000)
_Sol_SetLayeredWindowAttributes(THISFORM.hWnd, 0, 255, 2)
This.tmrCheckForm.Interval = 200
ENDPROC
PROCEDURE retrievepreviouschecks
LOCAL lnCounter, lcColumnName, llFoundOne, lcIndexOneValue, lcIndexTwoValue, lcAtCommand
IF this.casesensitive
m.lcAtCommand= "AT"
else
m.lcAtCommand= "ATC"
ENDIF
m.lcColumnName = ALLTRIM(this.columnobject.name)
m.llFoundOne = .F.
m.llDoInitialUpdateToFalse = .T.
FOR m.lnCounter = 1 TO ALEN(This.gridextraobject.acolumnfilters,1)
m.lcIndexTwoValue = This.gridextraobject.acolumnfilters(m.lnCounter,2)
IF TYPE("m.lcIndexTwoValue") = "C"
m.lcIndexOneValue = This.gridextraobject.acolumnfilters(m.lnCounter,3)
IF m.lcIndexTwoValue == m.lcColumnName ;
AND NOT EMPTY(m.lcIndexOneValue)
IF m.llDoInitialUpdateToFalse
m.llDoInitialUpdateToFalse = .F.
UPDATE (this.uniquecursorname) SET checked = .F. WHERE .T.
ENDIF
GO TOP IN (this.uniquecursorname)
DO WHILE !EOF(this.uniquecursorname)
IF &lcAtCommand.(this.delimiter + TRANSFORM(EVALUATE(This.uniquecursorname + ".actvalues")) + this.delimiter, m.lcIndexOneValue) > 0
m.llFoundOne = .T.
replace checked WITH .T. IN (this.uniquecursorname)
ENDIF
SKIP 1 IN (this.uniquecursorname)
ENDDO
ENDIF
ENDIF
ENDFOR
IF m.llFoundOne
this.check1.Value = .F.
GO TOP IN (this.uniquecursorname)
this.grid1.Refresh()
ENDIF
ENDPROC
PROCEDURE retrievepreviouscustomfilter
LOCAL lnIndexCustomColumnFilter
m.lnIndexCustomColumnFilter = ASCAN(this.GridExtraObject.CustomColumnFilters, this.columnobject.name, -1, -1, 1, 15)
IF m.lnIndexCustomColumnFilter > 0
this.gridcustomfilter1.combo1.ListIndex = this.GridExtraObject.CustomColumnFilters(m.lnIndexCustomColumnFilter,2)
this.gridcustomfilter1.text1.Value = this.GridExtraObject.CustomColumnFilters(m.lnIndexCustomColumnFilter,3)
this.gridcustomfilter1.text2.Value = this.GridExtraObject.CustomColumnFilters(m.lnIndexCustomColumnFilter,4)
this.gridcustomfilter1.combo1.refresh()
this.gridcustomfilter1.text1.refresh()
this.gridcustomfilter1.text2.refresh()
ENDIF
thisform.indexcustomcolumnfilter = m.lnIndexCustomColumnFilter
ENDPROC
PROCEDURE search
Local lcControlSource, lcRecordSource, lcAliasWas, lcSearchValue
If Thisform.txtSearch.FontItalic
Thisform.txtSearch.SetFocus()
ELSE
this.gridextraobject.Search(this.txtSearch.Value, this.findnext)
this.findnext = .T.
Endif
ENDPROC
PROCEDURE setup
*!* 14.08.2009
*!* marius.mutu
LOCAL lcType, lcColumn
LOCAL lcRecordSource, lcControlSource, lcCursorName, ;
lcControlSourceJustStem, loActiveControlInColumn, ;
lcColumnCursorName, llActiveControlIsCombobox, lcOrderByClause
m.lcRecordSource = ALLTRIM(this.columnobject.parent.recordsource)
m.lcControlSource = ALLTRIM(this.columnobject.controlsource) && ALLTRIM(IIF(AT(".",this.columnobject.controlsource) > 0, JUSTEXT(this.columnobject.controlsource), this.columnobject.controlsource))
this.gridrecordsource = m.lcRecordSource
this.columncontrolsource = m.lcControlSource
m.lcCursorName = This.UniqueCursorName
IF AT(".",m.lcControlSource) > 0
m.lcControlSourceJustStem = JUSTSTEM(m.lcControlSource)
IF UPPER(ALLTRIM(m.lcControlSourceJustStem)) != UPPER(ALLTRIM(m.lcRecordSource)) AND USED(m.lcControlSourceJustStem)
m.lcRecordSource = m.lcControlSourceJustStem
ENDIF
ENDIF
m.loActiveControlInColumn = EVALUATE("this.columnobject." + this.columnobject.currentcontrol)
m.llActiveControlIsCombobox = (LOWER(m.loActiveControlInColumn.BaseClass) = "combobox" AND m.loActiveControlInColumn.BoundColumn > 1)
IF m.llActiveControlIsCombobox
this.gridcustomfilter1.Visible = .F.
ENDIF
m.lcOrderByClause = ""
m.lcDistinct = ""
IF TYPE(m.lcControlSource) != "M"
m.lcOrderByClause = "ORDER BY 2"
m.lcDistinct = "Distinct"
ENDIF
IF !this.casesensitive AND TYPE(m.lcControlSource) = "C"
IF m.llActiveControlIsCombobox
m.lcColumnCursorName = this.gridextraobject.GetComboCursorName(m.loActiveControlInColumn)
IF USED(m.lcColumnCursorName)
SELECT &lcDistinct .T. as checked, UPPER(disptext) as fldvalues, TRANSFORM(fkid) as actvalues;
FROM (m.lcRecordSource) WITH (Buffering = .T.) INNER JOIN &lcColumnCursorName ON &lcControlSource = &lcColumnCursorName..fkid ;
&lcOrderByClause ;
INTO CURSOR &lcCursorName READWRITE
ENDIF
ELSE
SELECT &lcDistinct .T. as checked, UPPER(&lcControlSource) as fldvalues, UPPER(&lcControlSource) as actvalues ;
FROM (m.lcRecordSource) WITH (Buffering = .T.) ;
&lcOrderByClause ;
INTO CURSOR &lcCursorName READWRITE
ENDIF
ELSE
IF m.llActiveControlIsCombobox
m.lcColumnCursorName = this.gridextraobject.GetComboCursorName(m.loActiveControlInColumn)
IF USED(m.lcColumnCursorName)
SELECT &lcDistinct .T. as checked, disptext as fldvalues, TRANSFORM(fkid) as actvalues ;
FROM (m.lcRecordSource) WITH (Buffering = .T.) INNER JOIN &lcColumnCursorName ON &lcControlSource = &lcColumnCursorName..fkid ;
&lcOrderByClause ;
INTO CURSOR &lcCursorName READWRITE
ENDIF
ELSE
SELECT &lcDistinct .T. as checked, &lcControlSource as fldvalues, &lcControlSource as actvalues ;
FROM (m.lcRecordSource) WITH (Buffering = .T.) ;
&lcOrderByClause ;
INTO CURSOR &lcCursorName READWRITE
ENDIF
ENDIF
This.RetrievePreviousChecks()
Go TOP IN (m.lcCursorName)
this.grid1.RecordSource = m.lcCursorName
IF this.grid1.ColumnCount != 2
this.grid1.ColumnCount = 2
ENDIF
this.grid1.column1.ControlSource = "checked"
this.grid1.column2.ControlSource = "fldvalues"
*!* 14.08.2009
lcColumn = IIF('.'$m.lcControlSource, m.lcControlSource, m.lcRecordSource + '.' + m.lcControlSource)
lcType = TYPE(m.lcColumn)
this.gridcustomfilter1.Setup(this.columnobject.controls(1).caption, m.lcType, m.lcControlSource)
*!* 14.08.2009 ^
this.retrievepreviouscustomfilter()
ENDPROC
PROCEDURE showfilteroptions
LPARAMETERS tlShowFilterOptions
IF m.tlShowFilterOptions
this.MaxHeight = -1
this.MaxWidth = -1
this.Width = this.cmdFilter.Left + this.cmdFilter.Width + 4
this.Height = this.cmdFilter.Top + this.cmdFilter.Height + 4
this.grid1.Anchor = 15
this.cmdFilter.Anchor = 12
ELSE
this.grid1.Anchor = 0
this.cmdFilter.Anchor = 0
this.Width = this.cmdExit.Left + this.cmdExit.Width + 4
this.Height = this.shpSplitter.Top
this.MaxHeight = this.Height
this.MaxWidth = this.width
ENDIF
ENDPROC
PROCEDURE Check1.Valid
LOCAL llValue
IF USED(thisform.uniquecursorname)
m.llValue = this.Value
replace ALL checked WITH m.llValue IN (thisform.uniquecursorname)
GO TOP IN (thisform.uniquecursorname)
thisform.grid1.Refresh()
ENDIF
thisform.gridcustomfilter1.clearfiltersettings()
ENDPROC
PROCEDURE cmdClearFilter.Click
IF !thisform.check1.Value
thisform.check1.Value = .T.
thisform.check1.Refresh()
thisform.check1.Valid()
ENDIF
IF thisform.gridcustomfilter1.combo1.ListIndex != 1
thisform.gridcustomfilter1.combo1.ListIndex = 1
thisform.gridcustomfilter1.combo1.InteractiveChange()
ENDIF
thisform.BuildFilter()
thisform.gridextraobject.applyfilter()
thisform.gridextraobject.setheaderimages()
ENDPROC
PROCEDURE cmdExit.Click
thisform.Release()
ENDPROC
PROCEDURE cmdFilter.Click
Thisform.RunDeactivateRelease = .F.
thisform.BuildFilter()
thisform.gridextraobject.applyfilter()
thisform.gridextraobject.setheaderimages()
thisform.Release()
ENDPROC
PROCEDURE cmdSearch.Click
thisform.RunDeactivateRelease = .F.
thisform.Search()
thisform.RunDeactivateRelease = .T.
ENDPROC
PROCEDURE Grid1.Column1.Check1.Valid
LOCAL ARRAY aTemp(1)
IF !this.Value AND thisform.check1.Value
thisform.check1.Value = .F.
thisform.check1.Refresh()
ELSE
IF this.Value
SELECT checked FROM (Thisform.uniquecursorname) WHERE !checked INTO ARRAY aTemp
IF _tally < 1
thisform.check1.Value = .T.
thisform.check1.Refresh()
ELSE
IF thisform.check1.Value
thisform.check1.Value = .F.
thisform.check1.Refresh()
ENDIF
ENDIF
ENDIF
ENDIF
thisform.gridcustomfilter1.clearfiltersettings()
ENDPROC
PROCEDURE Grid1.Resize
this.column2.Width = MAX(this.Width - 45, 20) && JIC we'll make sure this column doesn't get too small or throw error for negative numbers
ENDPROC
PROCEDURE Image1.MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.lblMore.MouseEnter(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE Image1.MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.Parent.lblMore.MouseLeave(nButton, nShift, nXCoord, nYCoord)
ENDPROC
PROCEDURE lblMore.Click
IF this.Caption = "Mai mult..."
this.Caption = "Mai putin..."
Thisform.ShowFilterOptions(.T.)
ELSE
this.Caption = "Mai mult..."
Thisform.ShowFilterOptions(.F.)
ENDIF
ENDPROC
PROCEDURE lblMore.MouseEnter
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.FontUnderline = .T.
this.ForeColor = RGB(0,0,255)
ENDPROC
PROCEDURE lblMore.MouseLeave
LPARAMETERS nButton, nShift, nXCoord, nYCoord
this.FontUnderline = .F.
this.ForeColor = RGB(128,128,255)
ENDPROC
PROCEDURE txtSearch.GotFocus
IF this.FontItalic = .T.
this.Value = ""
this.Refresh()
this.FontItalic = .F.
this.ForeColor = RGB(0,0,0)
ENDIF
ENDPROC
PROCEDURE txtSearch.InteractiveChange
thisform.findnext = .F.
ENDPROC
PROCEDURE txtSearch.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
IF m.nKeyCode = 13
NODEFAULT
this.Parent.cmdSearch.Click()
ENDIF
ENDPROC
PROCEDURE txtSearch.LostFocus
IF EMPTY(this.Value)
this.Value = "Cauta"
this.FontItalic = .T.
this.ForeColor = RGB(128,128,255)
this.Refresh()
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS gridutils AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Shape5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Image1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Combo1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Command3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Command4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Command1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Shape6" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: addtemplate
*m: copytoexcel
*m: deletetemplate
*m: gettemplates
*p: gridextrasobject
*p: gridhierarchy
*p: gridobject
*p: parentform
*p: templatecursorname
*</DefinedPropArrayMethod>
*<PropValue>
AlwaysOnTop = .T.
AutoCenter = .T.
Caption = "Sabloane Filtre si Sortari & Export"
DoCreate = .T.
gridextrasobject = .NULL.
gridhierarchy =
gridobject = .NULL.
Height = 250
Name = "gridutils"
parentform = .NULL.
templatecursorname =
Width = 434
*</PropValue>
ADD OBJECT 'Combo1' AS combobox WITH ;
Anchor = 3, ;
Height = 24, ;
Left = 109, ;
Name = "Combo1", ;
Style = 2, ;
TabIndex = 2, ;
Top = 74, ;
Width = 260
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'Command1' AS commandbutton WITH ;
Anchor = 6, ;
Caption = "Exporta ", ;
Height = 32, ;
Left = 12, ;
Name = "Command1", ;
Picture = excel24.jpg, ;
PicturePosition = 4, ;
TabIndex = 5, ;
Top = 208, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command2' AS commandbutton WITH ;
Anchor = 12, ;
Caption = "Inchide ", ;
Height = 32, ;
Left = 336, ;
Name = "Command2", ;
Picture = exit.png, ;
PicturePosition = 4, ;
TabIndex = 6, ;
Top = 208, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command3' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 369, ;
Name = "Command3", ;
Picture = add16.png, ;
TabIndex = 3, ;
Top = 73, ;
Width = 26
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command4' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 394, ;
Name = "Command4", ;
Picture = delete16.png, ;
TabIndex = 4, ;
Top = 73, ;
Width = 26
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Image1' AS image WITH ;
Height = 48, ;
Left = 18, ;
Name = "Image1", ;
Picture = table_sql_view.png, ;
Top = 16, ;
Width = 48, ;
ZOrderSet = 16
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'Label1' AS label WITH ;
Anchor = 3, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Sabloane Filtre si Sortari", ;
Height = 17, ;
Left = 109, ;
Name = "Label1", ;
TabIndex = 1, ;
Top = 57, ;
Width = 137
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'Shape5' AS shape WITH ;
Anchor = 7, ;
BackColor = 255,255,255, ;
Height = 201, ;
Left = -2, ;
Name = "Shape5", ;
SpecialEffect = 0, ;
Top = -2, ;
Width = 89, ;
ZOrderSet = 15
*< END OBJECT: BaseClass="shape" />
ADD OBJECT 'Shape6' AS shape WITH ;
Anchor = 14, ;
BackStyle = 0, ;
Height = 56, ;
Left = -3, ;
Name = "Shape6", ;
SpecialEffect = 0, ;
Top = 197, ;
Width = 441, ;
ZOrderSet = 8
*< END OBJECT: BaseClass="shape" />
PROCEDURE addtemplate
LOCAL llReturn, lcTemplateName
m.llReturn = .F.
m.lcTemplateName = INPUTBOX("Numele sablonului", "Sablon nou Filtru & Export", "")
IF !EMPTY(m.lcTemplateName)
thisform.gridextrasobject.templatesave(thisform.gridhierarchy, m.lcTemplateName)
m.llReturn = .T.
ENDIF
RETURN m.llReturn
ENDPROC
PROCEDURE copytoexcel
*!* LPARAMETERS tcXLSFile, tcSheet, tvWorkArea, tcExcelFieldList, tcTableFieldList, tcTableForExpr
#DEFINE ALPHANUMERICCHR "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz1234567890"
LOCAL lnCounter, lnOrder, laOrder, loColumn, lcXLSFile, lcSheetName, lcAliasWas, lcGridAlias, ;
lcExcelFieldList, lcTableFieldList, lcTableForExpression, loHeaderObject, ;
lcFileName, lcAction, lcPath, loExcelApp, loWorkBook, lcKeyName
m.lcXLSFile = "C:\" + SYS(2015) + ".xls"
m.lcXLSFile = PUTFILE("Exporta in Excel:", m.lcXLSFile, "XLS;XLSX;XLSM;XLSB")
IF !EMPTY(m.lcXLSFile)
m.lcAliasWas = ALIAS()
m.lcGridAlias = THIS.gridobject.RECORDSOURCE
*!* m.lcTableForExpression = FILTER(this.gridobject.recordsource)
m.lcSheetName = "Sheet1"
STORE "" TO m.lcExcelFieldList, m.lcTableFieldList
*!* coloanele se exporta in ordinea de afisare din grid (ColumnOrder), nu in ordinea de creare
DIMENSION laOrder[MAX(THIS.gridobject.COLUMNCOUNT, 1), 2]
FOR m.lnCounter = 1 TO THIS.gridobject.COLUMNCOUNT
laOrder[m.lnCounter, 1] = THIS.gridobject.COLUMNS(m.lnCounter).COLUMNORDER
laOrder[m.lnCounter, 2] = m.lnCounter
ENDFOR
=ASORT(laOrder)
FOR m.lnOrder = 1 TO THIS.gridobject.COLUMNCOUNT
m.loColumn = THIS.gridobject.COLUMNS(laOrder[m.lnOrder, 2])
IF m.loColumn.VISIBLE AND m.loColumn.WIDTH > 0
m.loHeaderObject = m.loColumn.CONTROLS(1)
m.lcExcelFieldList = m.lcExcelFieldList + IIF(!EMPTY(m.lcExcelFieldList), ',', '') ;
+ ALLTRIM(CHRTRAN(m.loHeaderObject.CAPTION,CHRTRAN(m.loHeaderObject.CAPTION,ALPHANUMERICCHR,""),""))
m.lcTableFieldList = m.lcTableFieldList + IIF(!EMPTY(m.lcTableFieldList), ',', '') ;
+ m.loColumn.CONTROLSOURCE
ENDIF
ENDFOR
*!* MARIUS
CopyToExcelSimple(m.lcXLSFile, m.lcSheetName, m.lcGridAlias, m.lcExcelFieldList, m.lcTableFieldList, FILTER(m.lcGridAlias))
*!* CopyToExcel(m.lcXLSFile, m.lcSheetName, m.lcGridAlias, m.lcExcelFieldList, m.lcTableFieldList, FILTER(m.lcGridAlias))
*!* MARIUS ^
IF FILE(m.lcXLSFile)
m.lcFileName = JUSTFNAME(m.lcXLSFile)
IF MESSAGEBOX('Fisierul ' + m.lcFileName + CHR(13) + 'a fos exportat cu succes.' + CHR(13) +;
'Doriti sa il deschideti?',36,'SUCCES EXPORT EXCEL') = 6
TRY
*!* MARIUS
*!* m.loExcelApp = CREATEOBJECT("EXCEL.APPLICATION")
*!* m.loWorkBook = m.loExcelApp.Workbooks.OPEN(m.lcXLSFile)
*!* m.loExcelApp.VISIBLE = .T.
OPEN_DEFAULT_APP(m.lcXLSFile)
*!* MARIUS ^
CATCH
MESSAGEBOX("Nu s-a putut deschide documentul XLS.",64,"Eroare")
ENDTRY
ENDIF
ENDIF
IF m.lcAliasWas != ALIAS() AND USED(m.lcAliasWas)
SELECT (m.lcAliasWas)
ENDIF
ENDIF
ENDPROC
PROCEDURE deletetemplate
LOCAL lcTemplateName
IF !EMPTY(thisform.combo1.DisplayValue)
IF MESSAGEBOX("Doriti sa stergeti sablonul '" + ALLTRIM(thisform.combo1.DisplayValue) + "'?",36,_screen.caption) = 6
m.lcTemplateName = UPPER(ALLTRIM(thisform.gridhierarchy)) + ":" + ALLTRIM(thisform.combo1.DisplayValue)
thisform.gridextrasobject.templatedelete(m.lcTemplateName)
ENDIF
thisform.gettemplates()
ENDIF
ENDPROC
PROCEDURE gettemplates
LOCAL lcTemplateTable, lcTemplateTableJustStem
m.lcTemplateTable = EVALUATE(this.gridextrasobject.templatetable)
m.lcTemplateTableJustStem = JUSTSTEM(m.lcTemplateTable)
IF TYPE("m.lcTemplateTable") = "C" AND FILE(m.lcTemplateTable)
IF !USED(m.lcTemplateTableJustStem)
USE (m.lcTemplateTable) IN 0 SHARED
ENDIF
thisform.combo1.RowSource = ""
SELECT Template FROM (m.lcTemplateTableJustStem) WHERE .F. INTO CURSOR (thisform.templatecursorname) READWRITE
INSERT INTO (thisform.templatecursorname) VALUES ("")
INSERT INTO (thisform.templatecursorname) ;
SELECT Template FROM (m.lcTemplateTableJustStem) ;
WHERE !DELETED() AND UPPER(ALLTRIM(gridname)) == UPPER(ALLTRIM(thisform.gridhierarchy)) ;
ORDER BY 1
GO TOP IN (thisform.templatecursorname)
thisform.combo1.RowSource = thisform.templatecursorname
thisform.combo1.RowSourceType = 2
thisform.combo1.DisplayValue = ""
thisform.combo1.Refresh()
ENDIF
ENDPROC
PROCEDURE Init
LPARAMETERS toParentForm, toGridObject, toGridExtrasObject
thisform.TemplateCursorName = SYS(2015)
thisform.Icon = _screen.icon
thisform.parentform = m.toParentForm
thisform.gridobject = m.toGridObject
thisform.gridhierarchy = Sys(1272, m.toGridObject)
thisform.gridextrasobject = m.toGridExtrasObject
thisform.GetTemplates()
thisform.shape5.ZOrder(1)
thisform.shape6.ZOrder(1)
ENDPROC
PROCEDURE Load
SET PROCEDURE TO gridextrasprocs.prg ADDITIVE
ENDPROC
PROCEDURE Unload
USE IN SELECT(this.templatecursorname)
ENDPROC
PROCEDURE Combo1.InteractiveChange
IF !EMPTY(this.DisplayValue)
*SET STEP ON
thisform.gridextrasobject.templateapply(UPPER(ALLTRIM(thisform.gridhierarchy)) + ":" + ALLTRIM(this.DisplayValue))
this.SetFocus()
ENDIF
ENDPROC
PROCEDURE Command1.Click
thisform.copytoexcel()
ENDPROC
PROCEDURE Command2.Click
thisform.Release()
ENDPROC
PROCEDURE Command3.Click
IF thisform.addtemplate()
thisform.getTemplates()
ENDIF
ENDPROC
PROCEDURE Command4.Click
IF thisform.combo1.ListIndex > 1
thisform.deletetemplate()
ENDIF
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink