*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (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="" /> * Height = 23 Name = "checkform" Width = 23 * 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="" /> * Height = 23 Name = "fadeform" Width = 23 * 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="" /> * *m: clearfiltersettings *m: controlsourcetype_assign *m: filterstring_access *m: operatorchanged *m: selectall *m: setup *p: columncontrolsource *p: controlsourcetype *p: filterstring *p: interactivechangecombofiring *p: uniquecursorname * * BackStyle = 0 BorderWidth = 0 columncontrolsource = controlsourcetype = C filterstring = Height = 76 interactivechangecombofiring = .F. Name = "gridcustomfilter" uniquecursorname = Width = 192 * 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 * *Completeaza proprietatea gridextra.gridexpression cu Thisform.Nume_Grid * *In Form.Init apeleaza this.gridextra1.setup() * *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> * *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] * * 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 * 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="" /> * *m: resizeupdate *m: zorderupdate *p: gridextrasobject *p: gridobject *p: gridrecordsource * * 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 * 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="" /> * *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 * * 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. * 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="" /> * *m: addtemplate *m: copytoexcel *m: deletetemplate *m: gettemplates *p: gridextrasobject *p: gridhierarchy *p: gridobject *p: parentform *p: templatecursorname * * 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 * 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