romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
837b455687b74afa791bc3374fdf802928f5cb23
comun/utile/email/pr_adressbook.sc2

669 lines
17 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="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 View Git Blame Copy Permalink