home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1998 April B
/
Pcwk4b98.iso
/
Borland
/
Dbase50w
/
SAMPLES1.PAK
/
NAMEINFO.WFM
< prev
next >
Wrap
Text File
|
1994-08-02
|
15KB
|
514 lines
******************************************************************************
* PROGRAM: Nameinfo.wfm
*
* WRITTEN BY: Borland Samples Group
*
* DATE: 12/93
*
* UPDATED: 4/94
*
* REVISION: $Revision: 1.17 $
*
* VERSION: dBASE FOR WINDOWS 5.0
*
* DESCRIPTION: This program shows dBASE for Windows' DDE capabilities. It
* establishes a link with WordPerfect to create a "Thank you"
* letter for customers that purchased software.
*
* PARAMETERS: None
*
* CALLS: Namesrch.wfm (Search form)
* Buttons.cc (Custom controls file)
* Names.qbe (View of table)
*
* USAGE: DO Nameinfo.wfm
*
*******************************************************************************
#include "Messdlg.h"
create session
set talk off
set ldCheck off
** END HEADER -- do not remove this line*
* Generated on 06/18/94
*
LOCAL f
f = NEW NAMEINFOFORM()
f.Open()
CLASS NAMEINFOFORM OF FORM
Set Procedure to Buttons.cc Additive
this.View = "NAMES.QBE"
this.Top = 2.08
this.Text = "WordPerfect Merge"
this.Width = 61.59
this.Height = 17.17
this.Left = 16.10
this.MousePointer = 1
this.OnOpen = CLASS::FORM_ONOPEN
this.Maximize = .F.
this.HelpId = ""
this.Minimize = .F.
this.HelpFile = ""
this.OnClose = {;close procedure Buttons.cc}
DEFINE RECTANGLE MERGERECT OF THIS;
PROPERTY;
BorderStyle 1,;
Top 0.00,;
Text "",;
Width 46.06,;
ColorNormal "N/W",;
Height 17.17,;
Left 0.00,;
Border .T.
DEFINE TEXT TITLETEXT OF THIS;
PROPERTY;
Top 0.54,;
Text "Title:",;
Width 10.46,;
ColorNormal "N/W",;
Height 1.07,;
Left 1.16,;
FontBold .F.,;
Border .F.,;
FontSize 4.00
DEFINE TEXT FIRSTNAMETEXT OF THIS;
PROPERTY;
Top 0.54,;
Text "First name:",;
Width 9.46,;
ColorNormal "N/W",;
Height 1.07,;
Left 12.45,;
FontBold .F.,;
Border .F.
DEFINE TEXT LASTNAMETEXT OF THIS;
PROPERTY;
Top 0.54,;
Text "Last name:",;
Width 9.79,;
ColorNormal "N/W",;
Height 1.07,;
Left 32.87,;
FontBold .F.,;
Border .F.
DEFINE TEXT ADDRESSTEXT OF THIS;
PROPERTY;
Top 3.26,;
Text "Address:",;
Width 8.47,;
ColorNormal "N/W",;
Height 1.07,;
Left 1.16,;
FontBold .F.,;
Border .F.
DEFINE TEXT CITYTEXT OF THIS;
PROPERTY;
Top 6.06,;
Text "City:",;
Width 6.47,;
ColorNormal "N/W",;
Height 1.10,;
Left 1.16,;
FontBold .F.,;
Border .F.
DEFINE TEXT STATETEXT OF THIS;
PROPERTY;
Top 6.06,;
Text "State:",;
Width 5.15,;
ColorNormal "N/W",;
Height 1.10,;
Left 24.40,;
FontBold .F.,;
Border .F.
DEFINE TEXT ZIPCODETEXT OF THIS;
PROPERTY;
Top 6.06,;
Text "Zip Code:",;
Width 10.46,;
ColorNormal "N/W",;
Height 1.10,;
Left 30.21,;
FontBold .F.,;
Border .F.
DEFINE TEXT PHONETEXT OF THIS;
PROPERTY;
Top 8.80,;
Text "Phone:",;
Width 6.47,;
ColorNormal "N/W",;
Height 1.07,;
Left 1.16,;
FontBold .F.,;
Border .F.
DEFINE TEXT PRODUCTTEXT OF THIS;
PROPERTY;
Top 11.52,;
Text "Product:",;
Width 7.80,;
ColorNormal "N/W",;
Height 1.07,;
Left 1.16,;
FontBold .F.,;
Border .F.
DEFINE ENTRYFIELD FIRSTNAMEENTRY OF THIS;
PROPERTY;
DataLink "NAMES->FNAME",;
Top 1.61,;
Width 15.11,;
Height 1.36,;
Left 10.46,;
Border .T.
DEFINE ENTRYFIELD LASTNAMEENTRY OF THIS;
PROPERTY;
DataLink "NAMES->LNAME",;
Top 1.61,;
Width 19.42,;
Height 1.36,;
Left 26.23,;
Border .T.
DEFINE ENTRYFIELD ADDRESSENTRY OF THIS;
PROPERTY;
DataLink "NAMES->ADDRESS",;
Top 4.39,;
Width 44.49,;
Height 1.36,;
Left 1.16,;
Border .T.
DEFINE ENTRYFIELD CITYENTRY OF THIS;
PROPERTY;
DataLink "NAMES->CITY",;
Top 7.13,;
Width 22.41,;
Height 1.36,;
Left 1.16,;
Border .T.
DEFINE ENTRYFIELD STATEENTRY OF THIS;
PROPERTY;
DataLink "NAMES->STATE",;
Top 7.13,;
Picture "AA",;
Width 3.82,;
Function "!",;
Height 1.36,;
Left 24.40,;
Border .T.
DEFINE ENTRYFIELD ZIPENTRY OF THIS;
PROPERTY;
DataLink "NAMES->ZIP",;
Top 7.13,;
Picture "99999",;
Width 15.44,;
Height 1.36,;
Left 30.21,;
Border .T.
DEFINE ENTRYFIELD PHONEENTRY OF THIS;
PROPERTY;
DataLink "NAMES->PHONE",;
Top 9.86,;
Picture "(999)999-9999",;
Width 22.41,;
Function "R(999)999-9999",;
Height 1.36,;
Left 1.16,;
Border .T.
DEFINE ENTRYFIELD PRODUCTENTRY OF THIS;
PROPERTY;
DataLink "NAMES->PRODUCT",;
Top 12.66,;
Width 44.49,;
Height 1.36,;
Left 1.16,;
Border .T.
DEFINE PUSHBUTTON NEWBUTTON OF THIS;
PROPERTY;
Default .T.,;
OnClick {;append blank;go bottom},;
Top 15.09,;
Text "&New",;
Width 14.11,;
ColorNormal "",;
Height 1.50,;
Left 1.16
DEFINE PUSHBUTTON SEARCHBUTTON OF THIS;
PROPERTY;
OnClick CLASS::SEARCHBUTTON_ONCLICK,;
Top 15.09,;
Text "&Search",;
Width 14.11,;
ColorNormal "",;
Height 1.50,;
Left 16.43
DEFINE PUSHBUTTON MERGEBUTTON OF THIS;
PROPERTY;
OnClick CLASS::MERGEBUTTON_ONCLICK,;
Top 15.09,;
Text "&Merge",;
Width 14.11,;
ColorNormal "",;
Height 1.50,;
Left 31.54
DEFINE OKBUTTON OKINFOBUTTON OF THIS;
PROPERTY;
OnClick CLASS::OKINFO_ONCLICK,;
Top 1.07,;
Width 14.11,;
Height 1.50,;
Left 46.70
DEFINE CANCELBUTTON CANCELINFOBUTTON OF THIS;
PROPERTY;
OnClick CLASS::CANCELINFO_ONCLICK,;
Top 3.00,;
Width 14.11,;
Height 1.50,;
Left 46.70
****************************************************************************
PROCEDURE Form_OnOpen
****************************************************************************
form.stateEntry.Width = 3.96
form.zipEntry.Width = 10.56
form.titles = new array(5)
form.titles[1] = "Mr."
form.titles[2] = "Mrs."
form.titles[3] = "Ms."
form.titles[4] = "Dr."
form.titles[5] = "Rev."
DEFINE COMBOBOX TitleCombo OF THIS;
PROPERTY;
Width 7.92,;
Top 1.66,;
Left 1.32,;
Height 1.66,;
Style 2,;
DataLink "NAMES->TITLE",;
DataSource "ARRAY form.titles"
this.netobj = NEW NETLOCKS ()
****************************************************************************
PROCEDURE OKINFO_OnClick
****************************************************************************
local result
if FORM.netobj.reclock()
result = commit()
flush
go top
else
AlertMessage("Warning","Your record was not locked. No data will be saved!")
endif
if dbf() = "NAMES"
use
endif
form.close()
return
****************************************************************************
PROCEDURE CANCELINFO_OnClick
****************************************************************************
if FORM.netobj.reclock()
rollback()
else
AlertMessage("Warning","No data was saved!")
endif
if alias() = "NAMES"
use
endif
form.Close()
return
****************************************************************************
PROCEDURE SEARCHBUTTON_OnClick
****************************************************************************
* Open the search dialog box modal
local srch
set procedure to namesrch.wfm additive
srch = NEW NAMESRCHFORM ()
srch.mdi = .f.
srch.readModal()
close procedure Namesrch.wfm
****************************************************************************
PROCEDURE MERGEBUTTON_OnClick
****************************************************************************
* Macro substitution for International translation
fld1 = field(1)
fld4 = field(4)
fld9 = field(9)
myLink = new DdeLink (form)
if MyLink.initiate("WPWin60_Macros","commands")
* If WordPerfect is already running
*MyLink.execute('FileOpen (Filename:"DDETEST.wpd",4)')
ok2exec = .t.
else
* If WordPerfect has to be started
* object.initiate("appname","filename")
* This will start WordPerfect with file: DDETEST
* DDETEST.WPD has to exist in the WordPerfect Path
*MyLink.initiate("c:\wpwin60\wpwin","ddetest.wpd")
MyLink.initiate("c:\wpwin60\wpwin","")
* This is required to go into command mode
if MyLink.initiate("WPWin60_Macros","commands")
ok2exec = .t.
else
AlertMessage("Unable to establish DDE Link. Start WordPerfect.","DDE Warning")
ok2exec = .f.
endif
endif
if ok2exec
ddeName = 'Type ({"'+FORMNAME()+'"})' && Proper name
ddeAddress = 'Type ({"'+&FLD4+'"})' && Street Address
ddeCity = 'Type ({"'+FORMCITY()+'"})' &&Formatted City, State & Zip
ddeSalutation = 'Type ({"'+FMTSTR("Dear %S:",TRIM(&FLD1))+'"})'
ddeProduct = 'Type ({"'+FMTSTR("Congratulations on purchasing %S!",TRIM(&FLD9))+'"})'
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"DateText()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,ddeName)
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,ddeAddress)
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,ddeCity)
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,ddeSalutation)
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,ddeProduct)
ExecuteLink(Mylink,'Type ({" We trust that using this software will be fun and exciting."})')
ExecuteLink(Mylink,'Type ({"We hope you will continue to use our products."})')
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,'Type ({"Sincerely,"})')
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,'Type ({"Programmer"})')
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,'Type ({"DDE Person"})')
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,"HardReturn()")
ExecuteLink(Mylink,'Type ({"dFW:TJC"})')
ExecuteLink(Mylink,"Filesave(Filename: 'ddetest'; ExportType: 4; Overwrite: Yes!)")
ExecuteLink(Mylink,"Close (Save: 1)")
endif &&ok2execute
MyLink.terminate()
ENDCLASS
CLASS NETLOCKS
*******************************************************************************
FUNCTION RecLock
*******************************************************************************
local cnt, isLocked
cnt = 1
isLocked = .f.
do while .not. isLocked .and. cnt < 11
isLocked = rlock()
cnt = cnt + 1
enddo
return isLocked
*******************************************************************************
FUNCTION FilLock
*******************************************************************************
local cnt, islocked
cnt = 1
islocked = .f.
do while .not. islocked .and. cnt < 11
islocked = frlock()
cnt = cnt + 1
enddo
return islocked
ENDCLASS
*******************************************************************************
FUNCTION FormName
*******************************************************************************
Local fmtLine
fmtLine = "%1 %2 %3"
fld1 = field(1)
fld2 = field(2)
fld3 = field(3)
return Fmt3Str(fmtLine,iif(empty(&fld3),"",trim(&fld3)),trim(&fld1),&fld2)
*******************************************************************************
FUNCTION FormCity
*******************************************************************************
Local fmtLine
fmtLine = "%1, %2 %3"
fld5 = field(5)
fld6 = field(6)
fld7 = field(7)
return Fmt3Str(fmtLine,trim(&fld5),&fld6,&fld7)
*******************************************************************************
FUNCTION FmtStr(string, repStr)
*******************************************************************************
* replaces "%S" with replacement String
return stuff(string, at("%S",string),2,repStr)
*******************************************************************************
FUNCTION Fmt3Str(string,rep1, rep2, rep3)
*******************************************************************************
for i = 1 to 3
do case
case i = 1
string = stuff(string, at("%1",string),2,rep1)
case i = 2
string = stuff(string, at("%2",string),2,rep2)
case i = 3
string = stuff(string, at("%3",string),2,rep3)
endcase
next
return string
*******************************************************************************
PROCEDURE ExecuteLink(link,string)
*******************************************************************************
link.execute(ansi(string))