*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (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" /> * DataSource = .NULL. Height = 0 Left = 0 Name = "Dataenvironment" Top = 0 Width = 0 * 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="" /> * *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 * * 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 = * 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 ; <> 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 <> ; WHERE LOWER(<>) ; like '%' + '<>' + '%'; 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