romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
95cf54e4479085fcb1bb438ea93f34ead990cfdd
comun/utile/GridExtras/gridextrasselect.vc2

2823 lines
88 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="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="" />
*<DefinedPropArrayMethod>
*m: initform
*m: loadfiltru
*m: refrehstatus
*m: resetstatus
*m: updatedetails
*p: cvar_afisata
*p: filtru_pretty_ro_full
*p: lcautare
*p: pornit
*</DefinedPropArrayMethod>
*<PropValue>
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)"
*</PropValue>
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="" />
*<PropValue>
Height = 23
Name = "checkform"
Width = 23
*</PropValue>
PROCEDURE Timer
IF MROW(ThisForm.Name,3) = -1 OR MCOL(ThisForm.Name,3) = -1
IF This.Parent._InForm
This.Parent._InForm = .F.
This.Parent.tmrFadeForm.Interval = 50
This.Parent._Fade = 255
ENDIF
ELSE
IF NOT This.Parent._InForm
This.Parent._InForm = .T.
This.Parent.tmrFadeForm.Interval = 50
ENDIF
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS 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="" />
*<DefinedPropArrayMethod>
*p: nrofpage
*p: nrpages
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
Height = 26
Name = "ct_paginare"
nrofpage = 1
nrpages =
Width = 133
*</PropValue>
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="" />
*<DefinedPropArrayMethod>
*p: nrofpage
*p: nrpages
*</DefinedPropArrayMethod>
*<PropValue>
BorderWidth = 0
Height = 24
Name = "ct_paginare"
nrofpage = 1
nrpages =
Visible = .F.
Width = 189
*</PropValue>
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="" />
*<PropValue>
Height = 23
Name = "fadeform"
Width = 23
*</PropValue>
PROCEDURE Timer
IF This.Parent._InForm
This.Parent._Fade = MIN(This.Parent._Fade + 60,255)
ELSE
This.Parent._Fade = MAX(This.Parent._Fade - 20,100)
ENDIF
_Sol_SetLayeredWindowAttributes(THISFORM.hWnd, 0, This.Parent._Fade, 2)
IF NOT BETWEEN(This.Parent._Fade,101,254)
This.Interval = 0
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS gridcustomfilter AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="Combo1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Text1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Text2" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: clearfiltersettings
*m: controlsourcetype_assign
*m: filterstring_access
*m: operatorchanged
*m: selectall
*m: setup
*p: columncontrolsource
*p: controlsourcetype
*p: filterstring
*p: interactivechangecombofiring
*p: uniquecursorname
*a: acriteriiuns[1,4]
*a: acriterii[1,4]
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
BorderWidth = 0
columncontrolsource =
controlsourcetype = C
filterstring =
Height = 76
interactivechangecombofiring = .F.
Name = "gridcustomfilter"
uniquecursorname =
Width = 192
*</PropValue>
ADD OBJECT 'Combo1' AS combobox WITH ;
Height = 24, ;
Left = 1, ;
Name = "Combo1", ;
RowSourceType = 1, ;
Style = 2, ;
Top = 1, ;
Width = 190
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'Text1' AS textbox WITH ;
Format = "!K", ;
Height = 23, ;
Left = 1, ;
Name = "Text1", ;
SelectOnEntry = .T., ;
Top = 27, ;
Visible = .F., ;
Width = 190
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'Text2' AS textbox WITH ;
Format = "!K", ;
Height = 23, ;
Left = 1, ;
Name = "Text2", ;
SelectOnEntry = .T., ;
Top = 52, ;
Visible = .F., ;
Width = 190
*< END OBJECT: BaseClass="textbox" />
PROCEDURE clearfiltersettings
this.combo1.ListIndex = 1
this.controlsourcetype = this.controlsourcetype
ENDPROC
PROCEDURE controlsourcetype_assign
LPARAMETERS vNewVal
LOCAL lvDefaultValue
DO CASE
*!* MARIUS
CASE INLIST(m.vNewVal, "C", "M", "V")
m.lvDefaultValue = ""
*!* MARIUS ^
CASE INLIST(m.vNewVal, "N", "Y")
m.lvDefaultValue = 0.00
CASE m.vNewVal = "D"
m.lvDefaultValue = {}
CASE m.vNewVal = "T"
m.lvDefaultValue = {/:}
CASE m.vNewVal = "L"
m.lvDefaultValue = .T.
ENDCASE
this.text1.Value = m.lvDefaultValue
this.text2.Value = m.lvDefaultValue
this.text1.refresh()
this.text2.refresh()
THIS.ControlSourceType = m.vNewVal
ENDPROC
PROCEDURE Destroy
USE IN Select(This.UniqueCursorName)
DODEFAULT()
ENDPROC
PROCEDURE filterstring_access
LOCAL lcFilterString, lnFilterType, lcAtCommand
m.lcFilterString = ""
IF thisform.casesensitive
m.lcAtCommand = "AT("
ELSE
m.lcAtCommand = "ATC("
ENDIF
IF !EOF(this.uniquecursorname) AND this.combo1.ListIndex != 1
m.lnFilterType = EVALUATE(this.uniquecursorname + ".criteria")
DO case
CASE m.lnFilterType = 1
m.lcFilterString = m.lcAtCommand + "[" + ALLTRIM(this.text1.Value) + "], LEFT(" + this.columncontrolsource + "," + TRANSFORM(LEN(ALLTRIM(this.text1.Value))) + ")) > 0"
CASE m.lnFilterType = 2
m.lcFilterString = m.lcAtCommand + "[" + ALLTRIM(this.text1.Value) + "], " + this.columncontrolsource + ") > 0"
CASE m.lnFilterType = 3
DO case
CASE INLIST(this.controlsourcetype, "C", "M")
m.lcFilterString = this.columncontrolsource + "=[" + ALLTRIM(TRANSFORM(this.text1.Value)) + "]"
CASE INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + "={" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
OTHERWISE
m.lcFilterString = this.columncontrolsource + "=" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDCASE
CASE m.lnFilterType = 4
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + ">{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
ELSE
m.lcFilterString = this.columncontrolsource + ">" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDIF
CASE m.lnFilterType = 5
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = this.columncontrolsource + "<{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "}"
ELSE
m.lcFilterString = this.columncontrolsource + "<" + ALLTRIM(TRANSFORM(this.text1.Value))
ENDIF
CASE m.lnFilterType = 6
IF INLIST(this.controlsourcetype, "D", "T")
m.lcFilterString = "Between(" + this.columncontrolsource + ",{" + ALLTRIM(TRANSFORM(this.text1.Value)) + "},{" + ALLTRIM(TRANSFORM(this.text2.Value)) + "})"
ELSE
m.lcFilterString = "Between(" + this.columncontrolsource + "," + ALLTRIM(TRANSFORM(this.text1.Value)) + "," + ALLTRIM(TRANSFORM(this.text2.Value)) + ")"
ENDIF
ENDCASE
ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Begins with", "CM", "Text1", "", 1)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Contains", "CM", "Text1", "", 2)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "C", "M", "N", "Y", "L", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Equals", "CMNYLDT", "Text1", "", 3)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Greater than", "NYDT", "Text1", "", 4)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Less than", "NYDT", "Text1", "", 5)
*!* ENDIF
*!* IF INLIST(m.tcFieldType, "N", "Y", "D", "T")
*!* INSERT INTO (m.lcUniqueCursorName) VALUES ("Between", "NYDT", "Text1", "Text2", 6)
*!* ENDIF
RETURN m.lcFilterString
ENDPROC
PROCEDURE operatorchanged
LOCAL lcControlOne, lcControlTwo
IF !EOF(this.uniquecursorname) AND this.combo1.ListIndex != 1
m.lcControlOne = EVALUATE(this.uniquecursorname + ".ctrlone")
m.lcControlTwo = EVALUATE(this.uniquecursorname + ".ctrlTwo")
this.text1.Visible = !Empty(m.lcControlOne)
this.text2.Visible = !Empty(m.lcControlTwo)
ELSE
this.text1.Visible = .F.
this.text2.Visible = .F.
ENDIF
ENDPROC
PROCEDURE selectall
*!* IF !thisform.check1.value ;
*!* AND this.combo1.listindex > 1
*!* thisform.check1.value = .T.
*!* thisform.check1.valid()
*!* ENDIF
ENDPROC
PROCEDURE setup
LPARAMETERS tcFieldCaption, tcFieldType, tcColumnControlSource
**** 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="" />
*<DefinedPropArrayMethod>
*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]
*</DefinedPropArrayMethod>
*<PropValue>
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
*</PropValue>
PROCEDURE addjoiner
LPARAMETERS tcCurrentFilter, tcFilterNewPart
LOCAL lcReturn, lcCurrentFilterPart
m.lcReturn = ""
IF !EMPTY(m.tcFilterNewPart)
m.tcFilterNewPart = ALLTRIM(m.tcFilterNewPart)
m.tcCurrentFilter = ALLTRIM(m.tcCurrentFilter)
m.lcCurrentFilterPart = RIGHT(m.tcCurrentFilter,1)
IF m.lcCurrentFilterPart != "(" AND m.tcFilterNewPart != ")"
DO CASE
CASE m.tcFilterNewPart = "(" AND EMPTY(m.tcCurrentFilter)
m.lcReturn = m.tcFilterNewPart
CASE m.tcFilterNewPart = "(" AND !EMPTY(m.tcCurrentFilter)
m.lcReturn = " AND " + m.tcFilterNewPart
CASE m.lcCurrentFilterPart = ")"
m.lcReturn = " AND " + m.tcFilterNewPart
OTHERWISE
m.lcReturn = " OR " + m.tcFilterNewPart
ENDCASE
ELSE
m.lcReturn = m.tcFilterNewPart
ENDIF
ENDIF
RETURN m.lcReturn
ENDPROC
PROCEDURE applyfilter
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="" />
*<DefinedPropArrayMethod>
*m: resizeupdate
*m: zorderupdate
*p: gridextrasobject
*p: gridobject
*p: gridrecordsource
*</DefinedPropArrayMethod>
*<PropValue>
Anchor = 12
gridextrasobject = .NULL.
gridobject = .NULL.
gridrecordsource = this.parent.grid1.recordsource
Height = 16
Name = "gridextraexport"
Picture = ..\graphics\table_sql_view16.png
Stretch = 1
Visible = .F.
Width = 18
*</PropValue>
PROCEDURE Click
LOCAL loGridUtils
m.loGridUtils = CREATEOBJECT("gridutils", thisform, this.gridobject, this.gridextrasobject)
m.loGridUtils.Show(1)
*!* Local lcGridSource, lcAliasWas, lcXLSFile, lcAction, lcFileName, lcPath
*!* lcGridSource = Evaluate(This.gridrecordsource)
*!* If Used(lcGridSource)
*!* lcAliasWas = Alias()
*!* Select (lcGridSource)
*!* lcXLSFile = Putfile("Excel Filename",Sys(2015) + ".xls", "XLS")
*!* If !Empty(lcXLSFile)
*!* Copy To (lcXLSFile) Type Xls
*!* GO TOP IN (m.lcGridSource)
*!* If File(lcXLSFile)
*!* lcFileName = Justfname(lcXLSFile)
*!* If Messagebox("The File " + lcFileName + Chr(13) + "was successfully exported." + Chr(13) +;
*!* "Would you like to open it now?",36,"EXCEL EXPORT SUCCESSFUL") = 6
*!* Declare Integer ShellExecute In shell32.Dll ;
*!* INTEGER hndWin, ;
*!* STRING cAction, ;
*!* STRING cFileName, ;
*!* STRING cParams, ;
*!* STRING cDir, ;
*!* INTEGER nShowWin
*!* lcAction = "open"
*!* lcPath=Justpath(lcXLSFile)
*!* ShellExecute(0,lcAction,lcFileName,lcPath,"",1)
*!* Endif
*!* Endif
*!* ENDIF
*!* IF USED(m.lcAliasWas)
*!* SELECT(m.lcAliasWas)
*!* ENDIF
*!* Else
*!* Messagebox("Record source for grid does not appear to be open or a table",16,"Unable to Export")
*!* Endif
ENDPROC
PROCEDURE Init
LPARAMETERS toGridExtras
this.gridextrasobject = m.toGridExtras
this.ZOrder(0)
ENDPROC
PROCEDURE resizeupdate
LOCAL lnAnchorWas
m.lnAnchorWas = this.Anchor
this.Anchor = 0
this.Left = (This.GridObject.Left + This.GridObject.Width - 19)
this.Top = (This.GridObject.Top + This.GridObject.Height - 18)
this.Anchor = m.lnAnchorWas
this.ZOrder(0)
ENDPROC
PROCEDURE zorderupdate
LPARAMETERS tnzOrder
this.zorder(0)
*!* this.zorder(Max(0, This.GridObject.zOrder - 1))
ENDPROC
ENDDEFINE
DEFINE CLASS gridextraform AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="shpSplitter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdFilter" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="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="" />
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
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.
*</PropValue>
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="" />
*<DefinedPropArrayMethod>
*m: addtemplate
*m: copytoexcel
*m: deletetemplate
*m: gettemplates
*p: gridextrasobject
*p: gridhierarchy
*p: gridobject
*p: parentform
*p: templatecursorname
*</DefinedPropArrayMethod>
*<PropValue>
AlwaysOnTop = .T.
AutoCenter = .T.
Caption = "Template-uri tabel si Export"
DoCreate = .T.
gridextrasobject = .NULL.
gridhierarchy =
gridobject = .NULL.
Height = 250
Name = "gridutils"
parentform = .NULL.
templatecursorname =
Width = 434
*</PropValue>
ADD OBJECT 'Combo1' AS combobox WITH ;
Anchor = 3, ;
Height = 24, ;
Left = 109, ;
Name = "Combo1", ;
Style = 2, ;
TabIndex = 2, ;
Top = 74, ;
Width = 260
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'Command1' AS commandbutton WITH ;
Anchor = 6, ;
Caption = "Exporta ", ;
Height = 32, ;
Left = 12, ;
Name = "Command1", ;
Picture = excel24.jpg, ;
PicturePosition = 4, ;
TabIndex = 5, ;
Top = 208, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command2' AS commandbutton WITH ;
Anchor = 12, ;
Caption = "Inchide ", ;
Height = 32, ;
Left = 336, ;
Name = "Command2", ;
Picture = exit.png, ;
PicturePosition = 4, ;
TabIndex = 6, ;
Top = 208, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command3' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 369, ;
Name = "Command3", ;
Picture = add16.png, ;
TabIndex = 3, ;
Top = 73, ;
Width = 26
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Command4' AS commandbutton WITH ;
Anchor = 3, ;
Caption = "", ;
Height = 26, ;
Left = 394, ;
Name = "Command4", ;
Picture = delete16.png, ;
TabIndex = 4, ;
Top = 73, ;
Width = 26
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Image1' AS image WITH ;
Height = 48, ;
Left = 18, ;
Name = "Image1", ;
Picture = table_sql_view.png, ;
Top = 16, ;
Width = 48, ;
ZOrderSet = 16
*< END OBJECT: BaseClass="image" />
ADD OBJECT 'Label1' AS label WITH ;
Anchor = 3, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "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
Reference in New Issue View Git Blame Copy Permalink