home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / MISC / HYPOC / PHLIST.OPL < prev    next >
Encoding:
Text File  |  1994-08-23  |  4.7 KB  |  122 lines
  1. app hyperpoc
  2. enda
  3. rem ---------------------------------
  4. proc phlist%:(par$)
  5. rem ---------------------------------
  6. rem
  7. rem  phlist% prints a phone list on a ASCII printer. 
  8. rem  The list is derived from the cards of the address stack. 
  9. rem  The parameter par$ is not used in this example but is dummy.
  10. rem
  11. rem  Note: This program is depends on the layout of the ADRESS stack
  12. rem        and should not be used with other stacks.
  13. rem
  14.  
  15. rem handles for background, card, window
  16. local bgHand&,cdHand&
  17. rem variables
  18. local poff%(6),afile$(128),c%,ob%,l%,cnt%,p%,pfil$(128),pc%,i%
  19. rem address entries
  20. local NamX%,NamY%,NamTxt$(20),bull%(6),phlab$(3,10),phX%(3),phY%(3),phNum$(3,40),phn%
  21.  
  22. rem define error handler
  23.         onerr err1
  24. rem use path information of current stack to access address stack
  25.         afile$ = parse$(curstk$,"",poff%())
  26.         afile$ = left$(afile$,poff%(4)-1)+"address.sta"
  27. rem find background of address stack
  28.         findBg:(afile$,addr(bgHand&))
  29. rem scan all background HotTabs (15) to find Name field and phone fields
  30.         while 1
  31.                 if CdObj%:(afile$,addr(bgHand&),&00008000) = 0 : break : endif
  32.                 if ObjTxt$ = "Name:" and ObjPar% = 2
  33. rem remember position of linked object
  34.                         NamX% = ObjX%+ObjW%+3
  35.                         NamY% = ObjY%
  36.                 elseif ObjPar% = 5 and phn% < 3
  37.                         phn% = phn% + 1
  38.                         phX%(phn%) = ObjX%+ObjW%+3
  39.                         phY%(phn%) = ObjY%
  40.                         phlab$(phn%) = ObjTxt$
  41.                 endif
  42.         endwh
  43. rem ask for print target and open line printer
  44.         lock on
  45.         dinit tx$:(177) : rem "Print phone list"
  46.         dchoice p%,tx$:(178),tx$:(133) : rem "to" "Printer,File"
  47.         if dialog = 0 : lock off : return : endif
  48.         if p% = 2
  49.                 pfil$ = "m:\wrd\phlist.wrd"
  50. again::
  51.                 dinit tx$:(179) : rem "Phone list"
  52.                 dfile pfil$,tx$:(140),17 : rem "File"
  53.                 if dialog <= 0 : lock off : return : endif
  54.                 pfil$ = parse$(pfil$,"M:\wrd\*.wrd",bull%())
  55.                   if bull%(6) : warning:(err$(-38),1) : goto again : endif
  56.                 lopen pfil$
  57.         else
  58.                 setrs:
  59.         endif
  60.         lock off
  61. rem find all cards of address stack
  62.         pc% = 0
  63.         while 1
  64.                 if findCd%:(afile$,1,"",addr(cdHand&)) = 0 : break : endif
  65. rem scan all card texts (2) and phone numbers (5)
  66.                 NamTxt$ = "" : pc% = 0
  67.                 busy tx$:(181) : rem "Printing"
  68.                 while 1
  69.                         ob% = CdObj%:(afile$,addr(cdHand&),&00000024)
  70.                         if ob% = 0 : break : endif :    rem no more objects
  71.                         if ob% = 2 and iabs(NamX% - ObjX%) <= 5 and abs(NamY% - ObjY%) <= 5
  72. rem "Name" field found ( we are not to fussy about the position)
  73.                                 l% = min(20,len(ObjTxt$))
  74. rem truncate text to 20 characters, replace tabs by blank
  75.                                 NamTxt$ = asctxt$:(ObjTxt$,l%," ")
  76.                         elseif ob% = 5 
  77. rem work phone number found
  78.                                 if pc%
  79.                                         lprint rept$(" ",20),
  80.                                 else
  81.                                         if len(NamTxt$) = 0 : break : endif
  82.                                         lprint left$(NamTxt$+rept$(" ",20),20),
  83.                                         cnt% = cnt%+1
  84.                                         pc% = 1
  85.                                 endif
  86.                                 if len(ObjAttr$)
  87.                                         lprint ObjAttr$;":", : rem phone# has own lable
  88.                                 else
  89.                                         i% = 0
  90.                                         while i% < phn%
  91.                                             i% = i%+1
  92.                                             if iabs(PhX%(i%) - ObjX%) <= 5 and abs(PhY%(i%) - ObjY%) <= 5
  93.                                                 lprint left$(phlab$(i%),3),
  94.                                                 break
  95.                                             endif
  96.                                         endwh
  97.                                 endif
  98.                                 lprint ObjTxt$
  99.                         endif
  100.                 endwh
  101. rem only print entries with "Name" and at least one phone number defined
  102.         endwh
  103.         warning:(num$(cnt%,5)+tx$:(180),0) : rem " entries printed"
  104. bye::
  105. rem return to HyperPoc
  106.         if cnt% and p% = 1 : lprint chr$(12) : endif
  107.         trap lclose
  108.         busy off
  109.         return c%
  110. rem error handler
  111. err1::
  112. rem remember error code and bye bye
  113.         c% = err
  114.         goto bye
  115. endp
  116.  
  117. rem edParm$: returns an empty string (no parameter used).
  118.  
  119. proc edParm$:(parm$)
  120. endp
  121.  
  122.