Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
668
utile/email/pr_adressbook.sc2
Normal file
668
utile/email/pr_adressbook.sc2
Normal file
@@ -0,0 +1,668 @@
|
||||
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
|
||||
*--------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
*< FOXBIN2PRG: Version="1.21" SourceFile="pr_adressbook.scx" CPID="1254" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
|
||||
*
|
||||
*
|
||||
DEFINE CLASS dataenvironment AS dataenvironment
|
||||
*< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" />
|
||||
|
||||
*<PropValue>
|
||||
DataSource = .NULL.
|
||||
Height = 0
|
||||
Left = 0
|
||||
Name = "Dataenvironment"
|
||||
Top = 0
|
||||
Width = 0
|
||||
*</PropValue>
|
||||
|
||||
ENDDEFINE
|
||||
|
||||
DEFINE CLASS form1 AS form
|
||||
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" />
|
||||
|
||||
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
|
||||
*< OBJECTDATA: ObjPath="lblSearchFld" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="TxtSearch" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="Grid1" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="Gridsort1" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="Command1" UniqueID="" Timestamp="" />
|
||||
*< OBJECTDATA: ObjPath="Container1" UniqueID="" Timestamp="" />
|
||||
|
||||
*<DefinedPropArrayMethod>
|
||||
*m: doselectall
|
||||
*m: doselectinvert
|
||||
*m: dounselectall
|
||||
*m: setlanguage
|
||||
*m: updatesearchfld
|
||||
*p: clocsearchfld
|
||||
*p: crecipients
|
||||
*p: csearchfield
|
||||
*p: lclosetable
|
||||
*p: ngridx
|
||||
*p: ngridy
|
||||
*p: _memberdata && XML Metadata for customizable properties
|
||||
*</DefinedPropArrayMethod>
|
||||
|
||||
*<PropValue>
|
||||
AutoCenter = .T.
|
||||
Caption = "Select recipients"
|
||||
clocsearchfld = Search field
|
||||
Closable = .F.
|
||||
crecipients =
|
||||
csearchfield =
|
||||
Desktop = .T.
|
||||
DoCreate = .T.
|
||||
Height = 422
|
||||
lclosetable = .F.
|
||||
Name = "Form1"
|
||||
ngridx = 0
|
||||
ngridy = 0
|
||||
ShowTips = .T.
|
||||
Width = 635
|
||||
WindowType = 1
|
||||
_memberdata = <VFPData>
|
||||
<memberdata name="crecipients" display="cRecipients"/>
|
||||
<memberdata name="updatesearchfld" display="UpdateSearchFld"/>
|
||||
<memberdata name="csearchfield" display="cSearchField"/>
|
||||
<memberdata name="doselectall" display="DoSelectAll"/>
|
||||
<memberdata name="dounselectall" display="DoUnselectAll"/>
|
||||
<memberdata name="doselectinvert" display="DoSelectInvert"/>
|
||||
<memberdata name="setlanguage" display="SetLanguage"/>
|
||||
<memberdata name="clocsearchfld" display="cLocSearchFld"/>
|
||||
</VFPData>
|
||||
*</PropValue>
|
||||
|
||||
ADD OBJECT 'cmdCancel' AS commandbutton WITH ;
|
||||
Anchor = 12, ;
|
||||
Cancel = .T., ;
|
||||
Caption = "Cancel", ;
|
||||
Height = 27, ;
|
||||
Left = 539, ;
|
||||
Name = "cmdCancel", ;
|
||||
TabIndex = 5, ;
|
||||
Top = 387, ;
|
||||
Width = 84
|
||||
*< END OBJECT: BaseClass="commandbutton" />
|
||||
|
||||
ADD OBJECT 'cmdOK' AS commandbutton WITH ;
|
||||
Anchor = 12, ;
|
||||
Caption = "Ok", ;
|
||||
Height = 27, ;
|
||||
Left = 443, ;
|
||||
Name = "cmdOK", ;
|
||||
TabIndex = 4, ;
|
||||
Top = 387, ;
|
||||
Width = 84
|
||||
*< END OBJECT: BaseClass="commandbutton" />
|
||||
|
||||
ADD OBJECT 'Command1' AS commandbutton WITH ;
|
||||
Caption = "", ;
|
||||
Height = 22, ;
|
||||
Left = 8, ;
|
||||
Name = "Command1", ;
|
||||
Picture = images\pr_locate.bmp, ;
|
||||
SpecialEffect = 2, ;
|
||||
TabStop = .F., ;
|
||||
Top = -1, ;
|
||||
Width = 24
|
||||
*< END OBJECT: BaseClass="commandbutton" />
|
||||
|
||||
ADD OBJECT 'Container1' AS container WITH ;
|
||||
BackStyle = 0, ;
|
||||
BorderWidth = 0, ;
|
||||
Height = 21, ;
|
||||
Left = 7, ;
|
||||
Name = "Container1", ;
|
||||
Top = 0, ;
|
||||
Width = 24
|
||||
*< END OBJECT: BaseClass="container" />
|
||||
|
||||
ADD OBJECT 'Grid1' AS grid WITH ;
|
||||
AllowCellSelection = .F., ;
|
||||
Anchor = 15, ;
|
||||
DeleteMark = .F., ;
|
||||
GridLineColor = 192,192,192, ;
|
||||
Height = 331, ;
|
||||
HighlightBackColor = 159,159,208, ;
|
||||
HighlightForeColor = 255,255,255, ;
|
||||
HighlightStyle = 2, ;
|
||||
Left = 8, ;
|
||||
Name = "Grid1", ;
|
||||
RecordMark = .F., ;
|
||||
Top = 50, ;
|
||||
Width = 620
|
||||
*< END OBJECT: BaseClass="grid" />
|
||||
|
||||
ADD OBJECT 'Gridsort1' AS gridsort WITH ;
|
||||
cgrideval = Thisform.Grid1, ;
|
||||
csortascendinggraphic = images\pr_sortascending.bmp, ;
|
||||
csortdescendinggraphic = images\pr_sortDescending.bmp, ;
|
||||
Height = 17, ;
|
||||
Left = 12, ;
|
||||
Name = "Gridsort1", ;
|
||||
Top = 396, ;
|
||||
Width = 36
|
||||
*< END OBJECT: ClassLib="pr_rcsgridsort.vcx" BaseClass="custom" />
|
||||
|
||||
ADD OBJECT 'lblSearchFld' AS label WITH ;
|
||||
AutoSize = .T., ;
|
||||
BackStyle = 0, ;
|
||||
Caption = "Search Field : ", ;
|
||||
ForeColor = 255,0,0, ;
|
||||
Height = 17, ;
|
||||
Left = 37, ;
|
||||
Name = "lblSearchFld", ;
|
||||
Top = 3, ;
|
||||
Width = 80
|
||||
*< END OBJECT: BaseClass="label" />
|
||||
|
||||
ADD OBJECT 'TxtSearch' AS textbox WITH ;
|
||||
Height = 25, ;
|
||||
Left = 8, ;
|
||||
Name = "TxtSearch", ;
|
||||
Top = 21, ;
|
||||
Width = 227
|
||||
*< END OBJECT: BaseClass="textbox" />
|
||||
|
||||
PROCEDURE Destroy
|
||||
Use In (This.Grid1.RecordSource)
|
||||
If Used("CrsTemp")
|
||||
Use In "CrsTemp"
|
||||
Endif
|
||||
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE doselectall
|
||||
Local lnRec
|
||||
lnRec = Recno(Thisform.Grid1.RecordSource)
|
||||
Update (Thisform.Grid1.RecordSource) Set lSelected = not lSelected
|
||||
Go (m.lnRec)
|
||||
Thisform.Refresh()
|
||||
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE doselectinvert
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE dounselectall
|
||||
Local lnRec
|
||||
lnRec = Recno(Thisform.Grid1.RecordSource)
|
||||
Update (Thisform.Grid1.RecordSource) Set lSelected = .F.
|
||||
Go (m.lnRec)
|
||||
Thisform.Refresh()
|
||||
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Init
|
||||
*!* Author : Soykan OZCELIK
|
||||
*!* Description : email adress collector for FoxyPreviewer SendMail Form
|
||||
*!* Usage : Do form GetEmailAdress with "YourCursor","YourSearchField"
|
||||
*!* Important : YourCursor must contain "email" field which is filled contact emails
|
||||
|
||||
*!* to testing this form first create test cursor with below codes
|
||||
*!* Select "s@s.com" as email,* FROM (_samples + '\data\customer') Where .T. Into Cursor Test readwrite
|
||||
|
||||
*!* You can create your own cursors to test this form
|
||||
|
||||
LPARAMETERS tcCursor,tcSearchField
|
||||
|
||||
IF EMPTY(tcCursor)
|
||||
tcCursor = ALIAS()
|
||||
ENDIF
|
||||
|
||||
|
||||
LOCAL llError
|
||||
llError = .F.
|
||||
|
||||
IF NOT USED(tcCursor)
|
||||
TRY
|
||||
USE (tcCursor) AGAIN IN 0 SHARED ALIAS C_AdressBook
|
||||
* This.lCloseTable = .T.
|
||||
tcCursor = "C_AdressBook"
|
||||
CATCH
|
||||
MESSAGEBOX("Could not load the adress book table!", 48, "Error")
|
||||
llError = .T.
|
||||
ENDTRY
|
||||
ENDIF
|
||||
IF llError
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
|
||||
|
||||
IF EMPTY(tcSearchField)
|
||||
tcSearchField = "EMAIL" && "Contact"
|
||||
ENDIF
|
||||
|
||||
Thisform.UpdateSearchFld(tcSearchField)
|
||||
|
||||
TEXT TO m.lcSQL TEXTMERGE NOSHOW
|
||||
SELECT .F. AS lSelected, * FROM ;
|
||||
<<m.tcCursor>> WHERE .t. ;
|
||||
INTO CURSOR CrsAdresses READWRITE
|
||||
ENDTEXT
|
||||
|
||||
EXECSCRIPT(m.lcSQL)
|
||||
GO TOP
|
||||
|
||||
* Close the table if it was passed as a file
|
||||
IF tcCursor = "C_AdressBook"
|
||||
USE IN SELECT("C_AdressBook")
|
||||
ENDIF
|
||||
|
||||
Thisform.cSearchField = m.tcSearchField
|
||||
|
||||
TRY
|
||||
This.Icon= "pr_mail03.ico"
|
||||
* This.Icon= HOME() + "Graphics\Icons\Mail\mail03.ico"
|
||||
CATCH
|
||||
ENDTRY
|
||||
|
||||
With This.Grid1 as Grid
|
||||
|
||||
.RecordSource=""
|
||||
.RecordSource="CrsAdresses"
|
||||
.ColumnCount = FCOUNT(.RecordSource)
|
||||
.LockColumns = 1
|
||||
LOCAL loColumn as Column
|
||||
|
||||
FOR EACH loColumn IN .Columns
|
||||
WITH loColumn.header1
|
||||
.FontBold = .T.
|
||||
.FontSize = 9
|
||||
.Alignment = 3
|
||||
.ForeColor = RGB(255,0,0)
|
||||
|
||||
IF EMPTY(loColumn.ControlSource)
|
||||
loColumn.Visible = .F.
|
||||
ENDIF
|
||||
ENDWITH
|
||||
ENDFOR
|
||||
|
||||
Thisform.Gridsort1.BindControl()
|
||||
|
||||
|
||||
With .Column1
|
||||
LOCAL loHeader as Header
|
||||
loHeader = .header1
|
||||
WITH loHeader as Header
|
||||
.FontName="wingdings"
|
||||
.Caption = Chr(0xFC) &&"Checkbox"
|
||||
.Alignment = 2
|
||||
* UNBINDEVENTS(loHeader) &&, "DblClick")
|
||||
BINDEVENT(loHeader, "DblClick", This, "DoSelectAll")
|
||||
BINDEVENT(loHeader, "RightClick", This, "DoUnselectAll")
|
||||
ENDWITH
|
||||
|
||||
.Alignment = 2
|
||||
.Width = 20
|
||||
.AddObject("Check1","CheckBox")
|
||||
.Sparse = .F.
|
||||
.CurrentControl = "Check1"
|
||||
With .Check1
|
||||
.Alignment = 2
|
||||
.Caption = ""
|
||||
.Name = "Check1"
|
||||
.Visible = .T.
|
||||
Endwith
|
||||
.RemoveObject("text1")
|
||||
Endwith
|
||||
|
||||
.AutoFit()
|
||||
This.Grid1.Column1.Alignment = 2
|
||||
|
||||
.SetAll("DynamicForeColor", "ICASE(lSelected=.t.,RGB(255,0,0),lSelected=.f.,RGB(0,0,0))" , "Column")
|
||||
.SetAll("DynamicFontBold", "lSelected=.t." , "Column")
|
||||
ENDWITH
|
||||
|
||||
IF VARTYPE(_goFP) = "O"
|
||||
This.SetLanguage()
|
||||
ENDIF
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Load
|
||||
SET TALK OFF
|
||||
SET CONSOLE OFF
|
||||
|
||||
|
||||
IF VARTYPE(_goFP) <> "O"
|
||||
* Creating the cursor with the adress book
|
||||
SELECT CAST(LOWER(GETWORDNUM(Contact, 1, " "))+"@vfp.com" AS C(30)) As email,* From (_samples + '\data\customer') ;
|
||||
Where .T. Into Cursor Test Readwrite
|
||||
ENDIF
|
||||
|
||||
TRY
|
||||
LOCAL loDummy as Image
|
||||
loDummy = CREATEOBJECT("Image")
|
||||
loDummy.Picture = "images\pr_locate.bmp"
|
||||
CATCH
|
||||
ENDTRY
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE setlanguage
|
||||
LOCAL loExc as Exception
|
||||
TRY
|
||||
|
||||
WITH This
|
||||
LOCAL lcCaption
|
||||
lcCaption = _goFP.GetLoc("SEARCHFLD")
|
||||
.lblSearchFld.Caption = lcCaption
|
||||
.cLocSearchFld = lcCaption
|
||||
.CmdOk.Caption = _goFP.GetLoc("GOTOPG_OK")
|
||||
.CmdCancel.Caption = _goFP.GetLoc("CANCEL")
|
||||
.Caption = _goFP.GetLoc("SELECTRECI")
|
||||
ENDWITH
|
||||
|
||||
CATCH TO loExc
|
||||
SET STEP ON
|
||||
|
||||
ENDTRY
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Unload
|
||||
IF NOT EMPTY(Thisform.cRecipients)
|
||||
RETURN Thisform.cRecipients
|
||||
ENDIF
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE updatesearchfld
|
||||
LPARAMETERS tcField
|
||||
|
||||
Thisform.cSearchField = tcField
|
||||
Thisform.lblSearchFld.Caption = Thisform.cLocSearchFld + ": " + PROPER(tcField)
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE cmdCancel.Click
|
||||
Thisform.Release()
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE cmdOK.Click
|
||||
Select email From (Thisform.Grid1.RecordSource);
|
||||
Where Lselected ;
|
||||
And ;
|
||||
Not Empty(email) Into Array emails
|
||||
|
||||
If _Tally = 0
|
||||
Messagebox('No Selected e-mails...',16,_Screen.ActiveForm.Caption)
|
||||
Return
|
||||
Endif
|
||||
|
||||
If Set("Safety")='ON'
|
||||
Set Safety Off
|
||||
Endif
|
||||
|
||||
Local lcRecipentList
|
||||
lcRecipentList=""
|
||||
For ix=1 To Alen("emails")
|
||||
lcRecipentList = lcRecipentList+Trim(emails[ix])+";"
|
||||
Endfor
|
||||
m.lcRecipentList = Left(m.lcRecipentList,Len(m.lcRecipentList)-1)
|
||||
Thisform.cRecipients = m.lcRecipentList
|
||||
Thisform.Release
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Grid1.Click
|
||||
Local lnRelCol, lnRelRow, lnWhere
|
||||
|
||||
Store 0 To lnWhere, lnRelRow, lnRelCol
|
||||
This.GridHitTest(Thisform.ngridx, Thisform.ngridy, @lnWhere, @lnRelRow, @lnRelCol)
|
||||
If lnWhere = 3 && Cell
|
||||
If lnRelCol = 1 && column 1
|
||||
This.Columns(lnRelCol).Check1.Value = Not This.Columns(lnRelCol).Check1.Value
|
||||
Endif
|
||||
Endif
|
||||
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Grid1.DblClick
|
||||
Local lnRelCol, lnRelRow, lnWhere
|
||||
|
||||
Store 0 To lnWhere, lnRelRow, lnRelCol
|
||||
This.GridHitTest(Thisform.ngridx, Thisform.ngridy, @lnWhere, @lnRelRow, @lnRelCol)
|
||||
If lnWhere = 3 && Cell
|
||||
* If lnRelCol = 1 && column 1
|
||||
This.Columns(1).Check1.Value = Not This.Columns(1).Check1.Value
|
||||
* Endif
|
||||
ENDIF
|
||||
|
||||
Thisform.Refresh()
|
||||
|
||||
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Grid1.MouseDown
|
||||
Lparameters nButton, nShift, nXCoord, nYCoord
|
||||
|
||||
* Save mouse position to use in Grid.Click
|
||||
Thisform.ngridx = nXCoord
|
||||
Thisform.ngridy = nYCoord
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Gridsort1.bindcontrol
|
||||
******************************************************************
|
||||
* FUNCTION NAME: Bindcontrol
|
||||
*
|
||||
* AUTHOR, DATE:
|
||||
* Paul Mrozowski, 5/7/2007
|
||||
* PROCEDURE DESCRIPTION:
|
||||
* Bind us to the headers in the grid.
|
||||
* INPUT PARAMETERS:
|
||||
* None
|
||||
* OUTPUT PARAMETERS:
|
||||
* None
|
||||
******************************************************************
|
||||
LOCAL loGrid AS Grid, ;
|
||||
loColumn AS Column, ;
|
||||
loControl
|
||||
|
||||
TRY
|
||||
loGrid = EVALUATE(This.cGridEval)
|
||||
|
||||
IF TYPE("loGrid") = "O"
|
||||
FOR EACH loColumn IN loGrid.Columns
|
||||
FOR EACH loControl IN loColumn.Controls
|
||||
IF loControl.BaseClass = "Header"
|
||||
BINDEVENT(loControl, "DblClick", This, "Sort")
|
||||
BINDEVENT(loControl, "RightClick", This, "Search")
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDFOR
|
||||
ENDFOR
|
||||
|
||||
IF PEMSTATUS(loGrid, "SaveSource", 5)
|
||||
IF This.cAutoCleanOn = "S"
|
||||
BINDEVENT(loGrid, "SaveSource", This, "Cleanup")
|
||||
ENDIF
|
||||
|
||||
IF This.cAutoCleanOn = "R"
|
||||
BINDEVENT(loGrid, "RestoreSource", This, "Cleanup")
|
||||
ENDIF
|
||||
|
||||
ENDIF
|
||||
ENDIF
|
||||
CATCH
|
||||
MESSAGEBOX("This.cGridEval doesn't evaluate to an object: " + This.cGridEval)
|
||||
ENDTRY
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Gridsort1.Init
|
||||
******************************************************************
|
||||
* FUNCTION NAME: Init
|
||||
*
|
||||
* AUTHOR, DATE:
|
||||
* Paul Mrozowski, 5/7/2007
|
||||
* PROCEDURE DESCRIPTION:
|
||||
* Get things started.
|
||||
* INPUT PARAMETERS:
|
||||
* None
|
||||
* OUTPUT PARAMETERS:
|
||||
* None
|
||||
******************************************************************
|
||||
|
||||
This.oIndex = CREATEOBJECT("Collection")
|
||||
|
||||
* This.BindControl()
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE Gridsort1.search
|
||||
LOCAL loGrid AS Grid, ;
|
||||
lcRecordSource, ;
|
||||
loEx AS Exception, ;
|
||||
laEvent[1], ;
|
||||
loHeader AS Header, ;
|
||||
loColumn AS Column, ;
|
||||
lcControlSource, ;
|
||||
lcIndexFile, ;
|
||||
luKey, ;
|
||||
lcField
|
||||
|
||||
TRY
|
||||
lnSelect = SELECT()
|
||||
loGrid = EVALUATE(This.cGridEval)
|
||||
|
||||
IF TYPE("loGrid") <> "O"
|
||||
EXIT
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(This.cRecordSource)
|
||||
lcRecordSource = ALLTRIM(loGrid.RecordSource)
|
||||
ELSE
|
||||
lcRecordSource = ALLTRIM(This.cRecordSource)
|
||||
ENDIF
|
||||
|
||||
IF !EMPTY(lcRecordSource)
|
||||
|
||||
AEVENTS(laEvent, 0)
|
||||
|
||||
loHeader = laEvent[1]
|
||||
loColumn = loHeader.Parent
|
||||
lcControlSource = ALLTRIM(loColumn.ControlSource)
|
||||
|
||||
IF ("." $ lcControlSource)
|
||||
lcField = GETWORDNUM(lcControlSource, 2, ".")
|
||||
ELSE
|
||||
lcField = lcControlSource
|
||||
ENDIF
|
||||
|
||||
* MESSAGEBOX(lcField)
|
||||
Thisform.UpdateSearchFld(lcField)
|
||||
|
||||
ENDIF
|
||||
|
||||
CATCH TO loEx
|
||||
SET STEP ON
|
||||
MESSAGEBOX("Error sorting: " + loEx.Message, 48, "Error")
|
||||
FINALLY
|
||||
SELECT (lnSelect)
|
||||
ENDTRY
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
IF !EMPTY(lcControlSource)
|
||||
IF ("." $ lcControlSource)
|
||||
lcFieldType = VARTYPE(EVALUATE(lcControlSource))
|
||||
ELSE
|
||||
lcFieldType = VARTYPE(EVALUATE(lcRecordSource + "." + lcControlSource))
|
||||
ENDIF
|
||||
|
||||
lcIndexFile = FORCEEXT(ADDBS(SYS(2023)) + "_" + SYS(3), "IDX")
|
||||
|
||||
DO CASE
|
||||
CASE lcFieldType = "T"
|
||||
lcIndexExpr = "INDEX ON TTOC(" + lcControlSource + ", 3) TO " + lcIndexFile + " ADDITIVE"
|
||||
CASE lcFieldType = "D"
|
||||
lcIndexExpr = "INDEX ON DTOS(" + lcControlSource + ") TO " + lcIndexFile + " ADDITIVE"
|
||||
CASE INLIST(lcFieldType, "N", "Y")
|
||||
lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE"
|
||||
CASE lcFieldType = "C"
|
||||
lcIndexExpr = "INDEX ON ALLTRIM(UPPER(" + lcControlSource + ")) TO " + lcIndexFile + " ADDITIVE"
|
||||
CASE lcFieldType = "L"
|
||||
lcIndexExpr = "INDEX ON " + lcControlSource + " TO " + lcIndexFile + " ADDITIVE"
|
||||
OTHERWISE
|
||||
EXIT
|
||||
ENDCASE
|
||||
|
||||
lcNewIndexExpr = This.IndexExpressionHook(lcIndexExpr, lcControlSource)
|
||||
|
||||
IF VARTYPE(lcNewIndexExpr) = "C" AND !EMPTY(lcNewIndexExpr)
|
||||
lcIndexExpr = lcNewIndexExpr
|
||||
ENDIF
|
||||
|
||||
luKey = This.oIndex.GetKey(lcControlSource)
|
||||
|
||||
* Remove any existing header pictures, then add it to the current column
|
||||
loGrid.SetAll("Picture", "")
|
||||
|
||||
SELECT (lcRecordSource)
|
||||
|
||||
IF VARTYPE(luKey) = "N" AND luKey = 0
|
||||
* Index doesn't exist yet
|
||||
This.oIndex.Add(lcIndexFile, lcControlSource)
|
||||
|
||||
&lcIndexExpr
|
||||
|
||||
loHeader.Picture = This.cSortAscendingGraphic
|
||||
|
||||
ELSE
|
||||
lcIndexFile = JUSTSTEM(This.oIndex[luKey])
|
||||
|
||||
IF DESCENDING()
|
||||
SET ORDER TO &lcIndexFile ASCENDING
|
||||
loHeader.Picture = This.cSortAscendingGraphic
|
||||
ELSE
|
||||
SET ORDER TO &lcIndexFile DESCENDING
|
||||
loHeader.Picture = This.cSortDescendingGraphic
|
||||
ENDIF
|
||||
|
||||
ENDIF
|
||||
|
||||
LOCATE
|
||||
|
||||
loGrid.Refresh()
|
||||
ENDIF
|
||||
|
||||
IF lnBuffering > 3
|
||||
CURSORSETPROP("Buffering", lnBuffering, lcRecordSource)
|
||||
ENDIF
|
||||
ENDPROC
|
||||
|
||||
PROCEDURE TxtSearch.Valid
|
||||
IF NOT EMPTY(This.Value)
|
||||
|
||||
Local lcSearchValue,lcSearchField,lcAlias,lnSelect
|
||||
lcAlias = Thisform.Grid1.RecordSource
|
||||
lcSearchField = Thisform.cSearchField
|
||||
lcSearchValue = Chrtran(Trim(LOWER(This.Value)),"'","%")
|
||||
lnSelect = Select(0)
|
||||
|
||||
TEXT TO m.lcSearchSQL TEXTMERGE noshow
|
||||
SELECT RECNO() as nrec,* FROM <<m.lcAlias>> ;
|
||||
WHERE LOWER(<<m.lcSearchField>>) ;
|
||||
like '%' + '<<m.lcSearchValue>>' + '%';
|
||||
INTO CURSOR CrsTemp
|
||||
ENDTEXT
|
||||
|
||||
*_Cliptext = m.lcSearchSQL
|
||||
Execscript(m.lcSearchSQL)
|
||||
|
||||
If _Tally # 0
|
||||
Select (Thisform.Grid1.RecordSource)
|
||||
Go (CrsTemp.nrec) In (Thisform.Grid1.RecordSource)
|
||||
Thisform.Refresh()
|
||||
ENDIF
|
||||
|
||||
ENDIF
|
||||
ENDPROC
|
||||
|
||||
ENDDEFINE
|
||||
Reference in New Issue
Block a user