*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="gridextrasselect.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS but_criterii AS _buton_baza OF "..\..\comun\clase\_appbaza.vcx" *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: initform *m: loadfiltru *m: refrehstatus *m: resetstatus *m: updatedetails *p: cvar_afisata *p: filtru_pretty_ro_full *p: lcautare *p: pornit * * cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\find1.bmp cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\find1.bmp cvar_afisata = filtru_pretty_ro_full = FontSize = 9 Height = 28 lcautare = .T. Name = "but_criterii" Picture = find1.bmp pornit = nu RightToLeft = .T. ToolTipText = "Cautare (CTRL + Q)" * PROCEDURE Click *!* This.initform(.T.) ENDPROC PROCEDURE initform *!* Lparameters tlShowForm *!* Local Array lacriterii(1,1) *!* Local lnButon *!* This.loadcriterii(@lacriterii) *!* If(This.pornit="nu") *!* If Not Pemstatus(This.Parent,"oCriterii",5) *!* This.Parent.AddProperty("oCriterii") *!* Endif *!* This.Parent.ocriterii=Null *!* This.Parent.ocriterii=Createobject("frm_criterii",@lacriterii) *!* This.pornit="da" *!* Endif *!* If tlShowForm *!* This.Parent.ocriterii.Show(1) *!* lnButon = gnButon *!* Else *!* lnButon = 2 *!* Endif *!* This.updatedetails(lnButon) ENDPROC PROCEDURE loadfiltru Lparameters tcFiltru This.initform(.F.) This.Parent.ocriterii.do_incarca_filtre(tcFiltru) This.updatedetails(1) ENDPROC PROCEDURE refrehstatus #DEFINE crlf CHR(13) + CHR(10) LOCAL lcText lcText = "" IF PEMSTATUS(THISFORM,"filtru_traducere",5) lcText = IIF(NOT EMPTY(THISFORM.filtru_traducere()), THISFORM.filtru_traducere(),"") ENDIF IF !EMPTY(ALLTRIM(THISFORM.filtru_pretty_ro)) lcText = THISFORM.filtru_pretty_ro + IIF(!EMPTY(lcText), " si " + lcText, "") ENDIF THIS.TOOLTIPTEXT = IIF(!EMPTY(lcText), lcText + crlf, "") + "Cautare (CTRL + Q)" THISFORM.filtru_pretty_ro_full = lcText _SCREEN.STATUSBAR.TAG = lcText IF !EMPTY(lcText) _SCREEN.STATUSBAR.ctlIcon="roastartmic.ico" IF LEN(lcText) < 126 _SCREEN.STATUSBAR.ctlMessage = lcText ELSE _SCREEN.STATUSBAR.ctlMessage=SUBSTR(lcText,1,122) + " ..." ENDIF ELSE _SCREEN.STATUSBAR.ctlMessage=_SCREEN.CAPTION ENDIF ENDPROC PROCEDURE resetstatus IF PEMSTATUS(_SCREEN,"Statusbar",5) _SCREEN.STATUSBAR.ctlPanels(2).ctlCaption="" _SCREEN.STATUSBAR.ctlMessage = _SCREEN.CAPTION _SCREEN.STATUSBAR.TAG = "" ENDIF ENDPROC PROCEDURE updatedetails Lparameters tnButon If Not Pemstatus(This.Parent,"filtru_pretty",5) This.Parent.AddProperty("filtru_pretty") Endif If Not Pemstatus(This.Parent,"filtru_pretty_ro",5) This.Parent.AddProperty("filtru_pretty_ro") Endif If Not Pemstatus(This.Parent,"filtru_cript",5) This.Parent.AddProperty("filtru_cript") Endif This.Parent.filtru_pretty = This.Parent.ocriterii.filtru This.Parent.filtru_pretty_ro = This.Parent.ocriterii.filtruro This.Parent.filtru_cript = This.Parent.ocriterii.filtrucript This.refreshStatus() This.SetFocus If Pemstatus(Thisform,"DO_CAUTA",5) And tnButon = 1 And This.lcautare Thisform.DO_CAUTA() If Reccount()>0 _Screen.StatusBar.ctlPanels(2).ctlCaption=Transform(Reccount()) + " inregistrari" Else _Screen.StatusBar.ctlPanels(2).ctlCaption="" Endif Endif ENDPROC ENDDEFINE 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 ct_paginare AS _container OF "..\..\comun\clase\_baza.vcx" *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="Buton1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Buton2" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> * *p: nrofpage *p: nrpages * * BorderWidth = 0 Height = 26 Name = "ct_paginare" nrofpage = 1 nrpages = Width = 133 * ADD OBJECT 'Buton1' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button fast forward_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button fast forward_32.png, ; ctip = button fast forward_32, ; Left = 75, ; Name = "Buton1", ; Picture = button fast forward_32.png, ; ToolTipText = "Pagina urmatoare", ; Top = 0 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Buton2' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button last_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button last_32.png, ; ctip = button last_32, ; Left = 104, ; Name = "Buton2", ; Picture = button last_32.png, ; ToolTipText = "Ultima pagina", ; Top = 0 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Label1' AS label WITH ; BackStyle = 0, ; Caption = "Label1", ; Height = 17, ; Left = 5, ; Name = "Label1", ; Top = 6, ; Width = 67 *< END OBJECT: BaseClass="label" /> PROCEDURE Buton1.Click thisform.gridextra1.pagenumber = 0 this.Parent.nrofpage = this.Parent.nrofpage + 1 IF this.Parent.nrofpage>this.Parent.nrpages this.Parent.nrofpage = this.Parent.nrpages else thisform.gridextra1.cautacontroller() ENDIF ENDPROC PROCEDURE Buton2.Click thisform.gridextra1.pagenumber = 0 IF this.Parent.nrofpage <> this.Parent.nrpages this.Parent.nrofpage = this.Parent.nrpages thisform.gridextra1.cautacontroller() ENDIF IF this.Parent.nrofpage>this.Parent.nrpages this.Parent.nrofpage = this.Parent.nrpages ENDIF ENDPROC ENDDEFINE DEFINE CLASS ct_paginarenet AS _container OF "..\..\comun\clase\_baza.vcx" *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="label1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Buton1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Buton2" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Buton3" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Buton4" UniqueID="" Timestamp="" /> * *p: nrofpage *p: nrpages * * BorderWidth = 0 Height = 24 Name = "ct_paginare" nrofpage = 1 nrpages = Visible = .F. Width = 189 * ADD OBJECT 'Buton1' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button first_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button first_32.png, ; ctip = button first_32, ; Left = 0, ; Name = "Buton1", ; Picture = button first_32.png, ; ToolTipText = "Prima pagina", ; Top = -1 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Buton2' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button rewind_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button rewind_32.png, ; ctip = button rewind_32, ; Left = 29, ; Name = "Buton2", ; Picture = button rewind_32.png, ; ToolTipText = "Pagina anterioara", ; Top = -1 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Buton3' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button fast forward_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button fast forward_32.png, ; ctip = button fast forward_32, ; Left = 131, ; Name = "Buton3", ; Picture = button fast forward_32.png, ; ToolTipText = "Pagina urmatoare", ; Top = -1 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Buton4' AS buton WITH ; cpicturedown = d:\roa_trunk\roahotel\clase\gridextras_\button last_32.png, ; cpictureup = d:\roa_trunk\roahotel\clase\gridextras_\button last_32.png, ; ctip = button last_32, ; Left = 160, ; Name = "Buton4", ; Picture = button last_32.png, ; ToolTipText = "Ultima pagina", ; Top = -1 *< END OBJECT: ClassLib="..\appbaza.vcx" BaseClass="commandbutton" /> ADD OBJECT 'label1' AS _label WITH ; Height = 17, ; Left = 63, ; Name = "label1", ; Top = 5, ; Width = 40 *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="label" /> PROCEDURE Buton1.Click this.Parent.nrofpage = 1 thisform.gridextra1.cautacontroller() ENDPROC PROCEDURE Buton2.Click this.Parent.nrofpage = this.Parent.nrofpage - 1 IF this.Parent.nrofpage<1 this.Parent.nrofpage = 1 ENDIF thisform.gridextra1.cautacontroller() ENDPROC PROCEDURE Buton3.Click this.Parent.nrofpage = this.Parent.nrofpage + 1 IF this.Parent.nrofpage>this.Parent.nrpages this.Parent.nrofpage = this.Parent.nrpages else thisform.gridextra1.cautacontroller() ENDIF ENDPROC PROCEDURE Buton4.Click this.Parent.nrofpage = this.Parent.nrpages thisform.gridextra1.cautacontroller() IF this.Parent.nrofpage>this.Parent.nrpages this.Parent.nrofpage = this.Parent.nrpages 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 *a: acriteriiuns[1,4] *a: acriterii[1,4] * * 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 **** adaugat de mine 23.04.09 *!* EXTERNAL ARRAY tacriterii *!* DIMENSION this.acriterii(ALEN(tacriterii,1),6) *!* DIMENSION this.acriteriiuns(ALEN(tacriterii,1),5) *!* ACOPY(tacriterii,this.acriteriiuns) *!* FOR x=1 TO ALEN(this.acriterii,1) *!* FOR i = 1 TO 5 *!* this.acriterii(x,i)=tacriterii(x,i) *!* ENDFOR *!* this.acriterii(x,6)=x *!* ENDFOR *!* ncontor=0 *!* ncontorcols=1 *!* nrlines=Ceiling(ALEN(this.acriterii,1)/7) *!* ASORT(this.acriterii) *!* FOR n = 1 TO ALEN(this.acriterii,1) *!* ncontor=ncontor+1 *!* this.combo1.AddItem(this.acriterii(n,1)) *!* IF ncontor=nrlines *!* ncontor=0 *!* ncontorcols=ncontorcols+1 *!* ENDIF *!* ENDFOR **** adaugat de mine 23.04.09 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 = 2 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 *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: addjoiner *m: applyfilter *m: applysort *m: ascending_assign *m: bindcolumnevents *m: bindheaderevents *m: cautacontroller *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: cfiltrufin *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: ocoll *p: originalfilter *p: pagenumber *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: colfilter[5,1] *a: customcolumnfilters[1,5] * * allowgridexport = .T. allowgridfilter = .T. allowgridpreferences = .T. allowgridsort = .T. ascending = .F. casesensitive = .F. cfiltrufin = 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 indexfile = indextag = Name = "gridextra" ocoll = null originalfilter = pagenumber = 0 parentfield = parenttable = productname = MyProduct searchandfilterform = .NULL. templatetable = gridextras.dbf * 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 PARAMETERS tcFiltru this.cfiltrufin = tcFiltru this.cautacontroller() 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 IF .ASCENDING SET ORDER TO (m.lcParentField) IN (.PARENTTABLE) DESCENDING ELSE SET ORDER TO (m.lcParentField) IN (.PARENTTABLE) ASCENDING 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,"Click",This,"HeaderClick") BINDEVENT(m.toHeaderObject,"RightClick",This,"HeaderRightClick") ENDPROC PROCEDURE cautacontroller 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) AEVENTS(m.laObject,0) m.loObject = m.laObject[1] IF varTYPE(m.loObject) = 'O' 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 *!* 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(this.ocoll) 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,this.ocoll,@tacriterii) 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) DIMENSION this.colFilter(ALEN(_GEAColumn,1), ALEN(_GEAColumn,2)) =ACOPY(_GEAColumn, this.colFilter) ENDIF ELSE *DIMENSION this.acolumnfilters(1, 3) *STORE .F. TO this.acolumnfilters DIMENSION this.colFilter(3, 1) STORE .F. TO this.colFilter 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) DIMENSION this.colFilter(ALEN(_GEACustom,1),ALEN(_GEACustom,2)) =ACOPY(_GEACustom, this.colFilter) 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.colFilter, _GEAColumn) *=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.colFilter, _GEACustom) *=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 LPARAMETERS toCol LOCAL loColumnObject, loHeaderObject, lcHeaderImage, llCustomFilterEnforced, lnCustomFilterIndex, lnItems DIMENSION this.colFilter(5,This.GridObject.ColumnCount) *!* lnItems = toCol.count *!* FOR i=1 TO lnItems *!* lcKey = toCol.GetKey(i) *!* loItem = toCol.Item(lcKey) *!* IF !EMPTY(loItem.filter) *!* this.colFilter(1,i) = ALLTRIM(lcKey) *!* ELSE *!* this.colFilter(1,i) = "" *!* ENDIF *!* ENDFOR 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.colFilter,ALLTRIM(m.loColumnObject.Name),-1,-1,-1,1) IF m.lnCustomFilterIndex > 0 AND !EMPTY(this.colFilter(1,m.lnCustomFilterIndex)) m.llCustomFilterEnforced = .T. ENDIF IF m.llCustomFilterEnforced OR ASCAN(this.colFilter,ALLTRIM(m.loColumnObject.name),-1,-1,-1,1) > 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) this.ocoll = CREATEOBJECT("collection") FOR EACH m.loColumnObject IN This.GridObject.Columns This.BindColumnEvents(m.loColumnObject) This.BindHeaderEvents(m.loColumnObject.Controls(1)) loItem = CREATEOBJECT("empty") ADDPROPERTY(loItem,"filter","") this.ocoll.add(loItem,m.loColumnObject.Name) 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() this.cautacontroller() 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, lcTempPath m.llReturn = .F. SET STEP ON If Type("gcTempPath")<>"U" lcTempPath = gcTempPath Else lcTempPath = Addbs(Sys(2023)) Endif m.lcTemplateTable = lcTempPath + This.templatetable m.lcTemplateTableJustStem = Juststem(m.lcTemplateTable) If !File(m.lcTemplateTable) CREATE table (m.lcTemplateTable) (pkid I(4) Autoinc,template C(50),gridname C(254),sortasc L(1),colname C(50),filtercust M(4),filtercol M(4),filterglob M(4),globala C(10)) Index On pkid Tag pkid Use In (m.lcTemplateTable) Endif 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="Gridcustomfilter1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdExit" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="cmdClearFilter" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="tmrCheckform" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="tmrFadeform" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="But_criterii1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="lblMore" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Image1" UniqueID="" Timestamp="" /> * *m: buildfilter *m: clearfilter *m: retrievepreviouschecks *m: retrievepreviouscustomfilter *m: search *m: setup *m: showfilteroptions *p: casesensitive *p: cfiltru *p: columncontrolsource *p: columnobject *p: delimiter *p: findnext *p: globalarrayname *p: gridextraobject *p: gridrecordsource *p: idcamp *p: idvalue *p: indexcustomcolumnfilter *p: ocol *p: rundeactivaterelease *p: uniquecursorname *a: acriterii[1,5] *a: filtersettings[5,1] *p: _fade *p: _infademode *p: _inform * * AlwaysOnTop = .T. BackColor = 255,255,255 BorderStyle = 3 Caption = "" casesensitive = .T. cfiltru = columncontrolsource = columnobject = NULL delimiter = || Desktop = .T. DoCreate = .T. findnext = .F. globalarrayname = .F. gridextraobject = NULL gridrecordsource = Height = 194 idcamp = idvalue = indexcustomcolumnfilter = 0 Left = 0 Name = "gridextraform" ocol = NULL rundeactivaterelease = .T. ShowTips = .T. TitleBar = 0 Top = 0 uniquecursorname = Width = 228 WindowType = 0 _fade = 255 _infademode = .T. _inform = .T. * ADD OBJECT 'But_criterii1' AS but_criterii WITH ; cvar_afisata = , ; Left = 197, ; Name = "But_criterii1", ; TabIndex = 3, ; Top = 88, ; Visible = .F. *< END OBJECT: ClassLib="gridextras.vcx" BaseClass="commandbutton" /> ADD OBJECT 'cmdClearFilter' AS commandbutton WITH ; Anchor = 3, ; Caption = "", ; Height = 26, ; Left = 168, ; Name = "cmdClearFilter", ; Picture = clearfilter16.bmp, ; PicturePosition = 4, ; TabIndex = 6, ; 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 = 5, ; 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 = 4, ; ToolTipText = "Aplica filtrul si inchide", ; Top = 149, ; Width = 80 *< END OBJECT: BaseClass="commandbutton" /> ADD OBJECT 'Gridcustomfilter1' AS gridcustomfilter WITH ; Anchor = 3, ; Left = 4, ; Name = "Gridcustomfilter1", ; TabIndex = 2, ; Top = 62, ; 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 = 7, ; Name = "Image1", ; Picture = showfilters16.bmp, ; Top = 36, ; 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 = 28, ; Name = "lblMore", ; TabIndex = 1, ; Top = 37, ; Width = 72 *< END OBJECT: BaseClass="label" /> ADD OBJECT 'shpSplitter' AS shape WITH ; Anchor = 11, ; Height = 1, ; Left = 0, ; Name = "shpSplitter", ; SpecialEffect = 0, ; Top = 56, ; Width = 235 *< END OBJECT: BaseClass="shape" /> ADD OBJECT 'tmrCheckform' AS checkform WITH ; Left = 42, ; Name = "tmrCheckform", ; Top = 150 *< END OBJECT: ClassLib="gridextras.vcx" BaseClass="timer" /> ADD OBJECT 'tmrFadeform' AS fadeform WITH ; Left = 72, ; Name = "tmrFadeform", ; Top = 150 *< END OBJECT: ClassLib="gridextras.vcx" BaseClass="timer" /> PROCEDURE buildfilter Dimension This.gridextraobject.colFilter(5,Alen(This.acriterii,1)) Local lcTipCriteriu, luValoareCriteriu, lnIdValue, lcvaloare, lcvaloare2, lnIdCamp, lcNumeCriteriu, lcSir, lcLogic, lcExpresie, lcThislogic lcLogic ='AND' *lcTipCriteriu = Thisform.acriterii(Thisform.ColumnObject.ColumnOrder,3) lcTipCriteriu = Thisform.acriterii(Ascan(Thisform.acriterii, This.ColumnObject.Name,-1,-1,-1,15),3) If At('|', lcTipCriteriu) > 0 lcTipCriteriu = Left(lcTipCriteriu, At('|', lcTipCriteriu) -1) && tipul criteriului N|GetMask(12,gnPA) Endif luValoareCriteriu = Thisform.gridcustomfilter1.text1.Value lcExpresie = Alltrim(Thisform.gridcustomfilter1.Combo1.List(Thisform.gridcustomfilter1.Combo1.ListIndex)) Do Case Case lcTipCriteriu = "D" lcvaloare = luValoareCriteriu &&Alltrim(Ttoc(luValoareCriteriu,1)) &&dtos lcvaloare2 = Thisform.gridcustomfilter1.text2.Value Case lcTipCriteriu = "N" lcvaloare = Alltrim(Transform(luValoareCriteriu)) Otherwise lcvaloare = Strtran(Alltrim(luValoareCriteriu),"'",['']) Endcase If Inlist(lcTipCriteriu,[D],[N],[E],[A],[D1]) criteriustring = Alltrim(Thisform.acriterii(Ascan(Thisform.acriterii, This.ColumnObject.Name,-1,-1,-1,15),2)) Else criteriustring = [ UPPER(] + Alltrim(Thisform.acriterii(Ascan(Thisform.acriterii, This.ColumnObject.Name,-1,-1,-1,15),2)) + [) ] Endif If Empty(lcvaloare) criteriustring = "" Endif Thisform.clearfilter() If lcTipCriteriu = "D" Do Case Case lcExpresie = "Egal cu" criteriustring = criteriustring + [= To_Date('] + ALLTRIM(TTOC(lcvaloare,1)) + [','YYYYMMDDhh24miss')] Case lcExpresie = "Mai mic decat" criteriustring = criteriustring + [< To_Date('] + ALLTRIM(TTOC(lcvaloare,1)) + [','YYYYMMDDhh24miss')] Case lcExpresie = "Mai mare decat" criteriustring = criteriustring + [> To_Date('] + ALLTRIM(TTOC(lcvaloare,1)) + [','YYYYMMDDhh24miss')] Case lcExpresie = "Intre" criteriustring = criteriustring + [>= To_Date('] + ALLTRIM(TTOC(lcvaloare,1)) + [','YYYYMMDDhh24miss') and ] + criteriustring + [<= To_Date('] + ALLTRIM(TTOC(lcvaloare2,1)) + [','YYYYMMDDhh24miss')] Endcase Else Do Case Case lcExpresie="Incepe cu" criteriustring= criteriustring + [LIKE '] + Upper(lcvaloare) + [%'] Case lcExpresie="Egal cu" criteriustring= criteriustring + [='] + Upper(lcvaloare) + ['] Case lcExpresie="Contine" criteriustring= criteriustring + [LIKE '%] + Upper(lcvaloare) + [%'] *****criterii numerice***** Case lcExpresie="Egal cu" criteriustring = criteriustring + [=]+Iif(lcvaloare="","0",lcvaloare) Case lcExpresie="Mai mic decat" criteriustring = criteriustring + [<]+Iif(lcvaloare="","0",lcvaloare) Case lcExpresie="Mai mare decat" criteriustring = criteriustring + [>]+Iif(lcvaloare="","0",lcvaloare) Endcase Endif Thisform.ocol(Thisform.ColumnObject.Name).Filter = criteriustring For Each loItem In Thisform.ocol If (loItem.Filter)#"" If Inlist(lcTipCriteriu,[D],[N],[E],[A]) Thisform.cfiltru = Thisform.cfiltru + [ ] + lcLogic + [ ] + loItem.Filter Else Thisform.cfiltru = Thisform.cfiltru + [ ] + lcLogic + [ ] + loItem.Filter Endif Endif Endfor lnItems = This.ocol.Count For i=1 To lnItems lcKey = This.ocol.GetKey(i) loItem =This.ocol.Item(lcKey) If !Empty(loItem.Filter) This.gridextraobject.colFilter(1,i) = Alltrim(lcKey) Else This.gridextraobject.colFilter(1,i) = "" Endif Endfor With This.gridextraobject .colFilter(2,Ascan(This.gridextraobject.colFilter, This.ColumnObject.Name,-1,-1,-1,1)) = This.gridcustomfilter1.Combo1.ListIndex .colFilter(3,Ascan(This.gridextraobject.colFilter, This.ColumnObject.Name,-1,-1,-1,1)) = This.gridcustomfilter1.text1.Value .colFilter(4,Ascan(This.gridextraobject.colFilter, This.ColumnObject.Name,-1,-1,-1,1)) = This.gridcustomfilter1.text2.Value .colFilter(5,Ascan(This.gridextraobject.colFilter, This.ColumnObject.Name,-1,-1,-1,1)) = criteriustring Endwith Thisform.cfiltru = Alltrim(Thisform.cfiltru) If At("AND", Thisform.cfiltru) = 1 Thisform.cfiltru = Substr(Thisform.cfiltru, 4) Endif && curatare AND/OR de la inceputul conditiei If At("OR", Thisform.cfiltru) = 1 Thisform.cfiltru = Substr(Thisform.cfiltru, 3) Endif && curatare AND/OR de la inceputul conditiei Thisform.cfiltru= Alltrim(Thisform.cfiltru) ENDPROC PROCEDURE clearfilter this.ocol(this.columnobject.Name).filter = "" this.gridextraobject.colFilter(5,ASCAN(this.GridExtraObject.colFilter, this.columnobject.name,-1,-1,-1,1)) = "" ENDPROC PROCEDURE Deactivate IF !thisform.RunDeactivateRelease RETURN ENDIF thisform.Release() ENDPROC PROCEDURE Init LPARAMETERS toColumnObject, toGridExtraObject,toGridExtraColl, tacriterii EXTERNAL ARRAY tacriterii DIMENSION this.acriterii(alen(tacriterii,1),5) ACOPY(tacriterii,this.acriterii) This.ColumnObject = m.toColumnObject This.GridExtraObject = m.toGridExtraObject this.ocol = m.toGridExtraColl IF TYPE("This.ColumnObject.Name") != "C" OR TYPE("This.GridExtraObject.Name") != "C" RETURN .F. ENDIF IF !EMPTY(this.acriterii(Ascan(Thisform.acriterii, This.ColumnObject.Name,-1,-1,-1,15),5)) this.but_criterii1.Visible= .t. 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 ENDPROC PROCEDURE retrievepreviouscustomfilter LOCAL lnIndexCustomColumnFilter m.lnIndexCustomColumnFilter = ASCAN(this.GridExtraObject.colFilter, this.columnobject.name,-1,-1,-1,1) IF m.lnIndexCustomColumnFilter > 0 this.gridcustomfilter1.combo1.ListIndex = this.GridExtraObject.colFilter(2,m.lnIndexCustomColumnFilter) this.gridcustomfilter1.text1.Value = this.GridExtraObject.colFilter(3,m.lnIndexCustomColumnFilter) this.gridcustomfilter1.text2.Value = this.GridExtraObject.colFilter(4,m.lnIndexCustomColumnFilter) 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 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.gridcustomfilter1.Setup(this.columnobject.controls(1).caption, TYPE(m.lcRecordSource + '.' + m.lcControlSource), m.lcControlSource) 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 But_criterii1.Click thisform.RunDeactivateRelease=.f. m.loPartener= goCautareController.List() *!* lcVarText = loPartener.nume *!* lnVarId = loPartener.id_part If !Isnull(m.loPartener) If !Empty(loPartener.nume) This.Parent.idValue = loPartener.id_part Thisform.gridcustomfilter1.text1.Value=loPartener.nume Thisform.gridcustomfilter1.text1.Enabled=.F. Thisform.gridcustomfilter1.combo1.ListIndex=4 *this.cvar_afisata = loPartener.nume ELSE Thisform.gridcustomfilter1.text1.Enabled=.T. Thisform.gridcustomfilter1.text1.Value="" Thisform.gridcustomfilter1.combo1.ListIndex=1 Endif Endif ENDPROC PROCEDURE cmdClearFilter.Click IF thisform.gridcustomfilter1.combo1.ListIndex != 1 thisform.gridcustomfilter1.combo1.ListIndex = 1 thisform.gridcustomfilter1.combo1.InteractiveChange() ENDIF thisform.gridcustomfilter1.text1.Value = "" thisform.gridcustomfilter1.text2.Value = "" thisform.BuildFilter() thisform.gridextraobject.pagenumber = 1 thisform.gridextraobject.applyfilter(thisform.cfiltru) thisform.gridextraobject.setheaderimages(thisform.ocol) ENDPROC PROCEDURE cmdExit.Click thisform.Release() ENDPROC PROCEDURE cmdFilter.Click Thisform.RunDeactivateRelease = .F. thisform.BuildFilter() thisform.gridextraobject.pagenumber = 1 thisform.gridextraobject.applyfilter(thisform.cfiltru) thisform.gridextraobject.setheaderimages(thisform.ocol) thisform.Release() 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 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 = "Template-uri tabel si 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 = "Template-uri filtre si sortari", ; Height = 17, ; Left = 109, ; Name = "Label1", ; TabIndex = 1, ; Top = 57, ; Width = 149 *< 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("Template Name", "New Filter & Export Template", "") 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, loColumn, lcXLSFile, lcSheetName, lcAliasWas, lcGridAlias, ; lcExcelFieldList, lcTableFieldList, lcTableForExpression, loHeaderObject, ; lcFileName, lcAction, lcPath, loExcelApp, loWorkBook, lcKeyName m.lcXLSFile = "C:\" + SYS(2015) + ".xls" m.lcXLSFile = PUTFILE("Export to 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 FOR m.lnCounter = 1 TO THIS.gridobject.COLUMNCOUNT m.loColumn = THIS.gridobject.COLUMNS(m.lnCounter) 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('The File ' + m.lcFileName + CHR(13) + 'was successfully exported.' + CHR(13) +; 'Would you like to open it now?',36,'EXCEL EXPORT SUCCESSFUL') = 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("The system encountered a problem opening the Excel document.",64,"Problem Encountered") 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("Are you sure you want to delete the '" + ALLTRIM(thisform.combo1.DisplayValue) + "' template?",36,"Confirmation Required") = 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 If Type("gcTempPath")<>"U" lcTempPath = gcTempPath Else lcTempPath = Sys(2023) Endif m.lcTemplateTable = lcTempPath + This.gridextrasobject.templatetable m.lcTemplateTableJustStem = Juststem(m.lcTemplateTable) If !File(m.lcTemplateTable) CREATE table (m.lcTemplateTable) (pkid I(4) Autoinc,template C(50),gridname C(254),sortasc L(1),colname C(50),filtercust M(4),filtercol M(4),filterglob M(4),globala C(10)) Index On pkid Tag pkid Use In (m.lcTemplateTable) Endif 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 SET STEP ON IF thisform.addtemplate() thisform.getTemplates() ENDIF ENDPROC PROCEDURE Command4.Click IF thisform.combo1.ListIndex > 1 thisform.deletetemplate() ENDIF ENDPROC ENDDEFINE