home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Datafile PD-CD 3
/
PDCD_3.iso
/
pocketbk
/
utilsf
/
hypoc2
/
PHLIST.OPL
< prev
next >
Wrap
Text File
|
1994-08-23
|
5KB
|
122 lines
app hyperpoc
enda
rem ---------------------------------
proc phlist%:(par$)
rem ---------------------------------
rem
rem phlist% prints a phone list on a ASCII printer.
rem The list is derived from the cards of the address stack.
rem The parameter par$ is not used in this example but is dummy.
rem
rem Note: This program is depends on the layout of the ADRESS stack
rem and should not be used with other stacks.
rem
rem handles for background, card, window
local bgHand&,cdHand&
rem variables
local poff%(6),afile$(128),c%,ob%,l%,cnt%,p%,pfil$(128),pc%,i%
rem address entries
local NamX%,NamY%,NamTxt$(20),bull%(6),phlab$(3,10),phX%(3),phY%(3),phNum$(3,40),phn%
rem define error handler
onerr err1
rem use path information of current stack to access address stack
afile$ = parse$(curstk$,"",poff%())
afile$ = left$(afile$,poff%(4)-1)+"address.sta"
rem find background of address stack
findBg:(afile$,addr(bgHand&))
rem scan all background HotTabs (15) to find Name field and phone fields
while 1
if CdObj%:(afile$,addr(bgHand&),&00008000) = 0 : break : endif
if ObjTxt$ = "Name:" and ObjPar% = 2
rem remember position of linked object
NamX% = ObjX%+ObjW%+3
NamY% = ObjY%
elseif ObjPar% = 5 and phn% < 3
phn% = phn% + 1
phX%(phn%) = ObjX%+ObjW%+3
phY%(phn%) = ObjY%
phlab$(phn%) = ObjTxt$
endif
endwh
rem ask for print target and open line printer
lock on
dinit tx$:(177) : rem "Print phone list"
dchoice p%,tx$:(178),tx$:(133) : rem "to" "Printer,File"
if dialog = 0 : lock off : return : endif
if p% = 2
pfil$ = "m:\wrd\phlist.wrd"
again::
dinit tx$:(179) : rem "Phone list"
dfile pfil$,tx$:(140),17 : rem "File"
if dialog <= 0 : lock off : return : endif
pfil$ = parse$(pfil$,"M:\wrd\*.wrd",bull%())
if bull%(6) : warning:(err$(-38),1) : goto again : endif
lopen pfil$
else
setrs:
endif
lock off
rem find all cards of address stack
pc% = 0
while 1
if findCd%:(afile$,1,"",addr(cdHand&)) = 0 : break : endif
rem scan all card texts (2) and phone numbers (5)
NamTxt$ = "" : pc% = 0
busy tx$:(181) : rem "Printing"
while 1
ob% = CdObj%:(afile$,addr(cdHand&),&00000024)
if ob% = 0 : break : endif : rem no more objects
if ob% = 2 and iabs(NamX% - ObjX%) <= 5 and abs(NamY% - ObjY%) <= 5
rem "Name" field found ( we are not to fussy about the position)
l% = min(20,len(ObjTxt$))
rem truncate text to 20 characters, replace tabs by blank
NamTxt$ = asctxt$:(ObjTxt$,l%," ")
elseif ob% = 5
rem work phone number found
if pc%
lprint rept$(" ",20),
else
if len(NamTxt$) = 0 : break : endif
lprint left$(NamTxt$+rept$(" ",20),20),
cnt% = cnt%+1
pc% = 1
endif
if len(ObjAttr$)
lprint ObjAttr$;":", : rem phone# has own lable
else
i% = 0
while i% < phn%
i% = i%+1
if iabs(PhX%(i%) - ObjX%) <= 5 and abs(PhY%(i%) - ObjY%) <= 5
lprint left$(phlab$(i%),3),
break
endif
endwh
endif
lprint ObjTxt$
endif
endwh
rem only print entries with "Name" and at least one phone number defined
endwh
warning:(num$(cnt%,5)+tx$:(180),0) : rem " entries printed"
bye::
rem return to HyperPoc
if cnt% and p% = 1 : lprint chr$(12) : endif
trap lclose
busy off
return c%
rem error handler
err1::
rem remember error code and bye bye
c% = err
goto bye
endp
rem edParm$: returns an empty string (no parameter used).
proc edParm$:(parm$)
endp