home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsf / hypoc2 / IMPDATA.OPL < prev    next >
Text File  |  1994-08-24  |  12KB  |  270 lines
  1. app hyperpoc
  2. enda
  3. rem ---------------------------------
  4. proc impdata%:(par$)
  5. rem ---------------------------------
  6. rem
  7. rem  impdata% reads records from the PSION database.
  8. rem     When called at card open time fields from the record found
  9. rem     are displayed in the card area.
  10. rem     When called at object activation time it reads the same record
  11. rem     and offers the phone numbers contained in the record for dialling.
  12. rem  par$ is a chr$(13) separated list with the following items:
  13. rem     1. Search string (can contain wild cards)
  14. rem     2. Data File name (can be short name)
  15. rem     3. Occurence (the n-th matching record is displayed)
  16. rem     4. List of up to 16 fields to be displayed (e.g. 1,3-5,7)
  17. rem        (Phone numbers are extracted on activation from the 
  18. rem         first 32 fields of the record regardless of this list).
  19. rem
  20. rem  a special edparm routine (see below) supports the definition
  21. rem  of imported objects during card definition
  22. rem
  23.  
  24. rem variables
  25. local r%,p%,i%,k%,j%,u%,px%,py%,pw%,ph%,y%,fil$(128),srch$(50),fl$(50),occur&,h%,buf$(255),abuf&,p&,l%,s%,pk%
  26. local flds%(16),s$(255),t$(255),off%(6),inf%(32),phone$(6,24),lab$(6,10),pn%,tw%,mxw%
  27.  
  28. onerr err1
  29.  
  30. rem analyze parameter string
  31.         abuf& = (int(addr(buf$)) and &00ffff) : rem make save pointer
  32.         r% = loc(par$,chr$(13))
  33.         srch$ = mid$(par$,1,r%-1)
  34.         p% = r%
  35.         r% = loc(right$(par$,len(par$)-p%),chr$(13))
  36.         fil$ = mid$(par$,p%+1,r%-1)
  37.         p% = p%+r%
  38.         r% = loc(right$(par$,len(par$)-p%),chr$(13))
  39.         occur& = val(mid$(par$,p%+1,r%-1))
  40.         fl$ = right$(par$,len(par$)-p%-r%)
  41.         fil$ = parse$(fil$,"LOC::M:\DAT\*.DBF",off%())
  42.         if onAct%       rem activated
  43. rem get label information from DBF file
  44.                 r% = ioopen(h%,fil$,$200)
  45.                 if r% < 0 : raise r% : endif
  46.                 r% = ioread(h%,abuf&+1,20)                 rem read File Header
  47.                 if r% < 0 : raise r% : endif
  48.                 p& = peekw(abuf&+19)                      rem position of first record
  49.                 pokeb abuf&,15                             rem set signature length
  50.                 if buf$ <> "OPLDatabaseFile" : raise -109 : endif
  51.                 while 1
  52.                         r% = ioseek(h%,1,p&)            rem to first record
  53.                         if r% < 0 : break : endif
  54.                         r% = ioread(h%,abuf&,2)  rem length byte and tag
  55.                         if r% < 0 : break : endif
  56.                         l% = peekw(abuf&)
  57.                         if (l% and $f000) = $3000            rem Skip instruction
  58.                                 p& = p&+2                    rem Just ignore it
  59.                         elseif (l% and $f000) <> $4000
  60.                                 p& = p& + (l% and $0fff) + 2    rem ignore any other record
  61.                         else                                rem Start of labels
  62.                                 l% = l% and $0fff            rem total length of labels
  63.                                 while l% > 0 and i% < 6
  64.                                         r% = ioread(h%,abuf&,1)  rem label length byte
  65.                                         if r% < 0 : break : endif
  66.                                         s% = peekb(abuf&)
  67.                                         pn% = pn%+1                     rem field number
  68.                                         if s%
  69.                                                 r% = ioread(h%,abuf&+1,s%) rem read label
  70.                                                 if r% < 0 : break : endif
  71.                                                 if asc(buf$) = 5        rem label contains phone symbol
  72.                                                         i% = i%+1
  73.                                                         lab$(i%) = left$(right$(buf$,len(buf$)-1),10)
  74.                                                         flds%(i%) = pn%
  75.                                                         if i% = 6 : break : endif
  76.                                                 endif
  77.                                         endif
  78.                                         l% = l% - s% - 1
  79.                                 endwh
  80.                                 break
  81.                         endif
  82.                 endwh
  83.                 ioclose(h%)
  84.         else    
  85. rem get default print area
  86.                 px% = gx
  87.                 py% = gy
  88.                 pw% = ObjW%+ObjX%-px%
  89.                 ph% = ObjH%+ObjY%-py%
  90. rem process rest of parameter string
  91.                 i% = 0
  92.                 while j% < 16 and i% < 16
  93.                         i% = i%+1
  94.                         t$ = extract$:(fl$,i%)
  95.                         if len(t$)
  96.                                 r% = loc(t$,"-") rem range specification
  97.                                 if r%
  98.                                         u% = val(left$(t$,r%-1))
  99.                                         r% = val(right$(t$,len(t$)-r%))
  100.                                         while u% <= r% and j% < 16
  101.                                                 j% = j%+1
  102.                                                 flds%(j%) = u%
  103.                                                 u% = u%+1
  104.                                         endwh
  105.                                 else
  106.                                         j% = j%+1
  107.                                         flds%(j%) = val(t$)
  108.                                 endif
  109.                         endif
  110.                 endwh
  111. rem set field default numbers
  112.                 if j% = 0
  113.                         flds%(1) = 1 : flds%(2) = 2 : flds%(3) = 3 : flds%(4) = 4
  114.                 endif
  115.         endif
  116. rem open file
  117.         open fil$,b,f1$,f2$,f3$,f4$,f5$,f6$,f7$,f8$,f9$,f10$,f11$,f12$,f13$,f14$,f15$,f16$,f17$,f18$,f19$,f20$,f21$,f22$,f23$,f24$,f25$,f26$,f27$,f28$,f29$,f30$,f31$,f32$
  118. rem find record
  119.         while 1
  120.                 if find("*"+srch$+"*") = 0
  121.                         close
  122.                         return
  123.                 endif
  124.                 if occur& = 1 : break : endif
  125.                 occur& = occur& - 1
  126.                 next
  127.         endwh
  128. rem initialize display
  129.         if onAct%
  130.                 lock on
  131.                 dinit "Dial"
  132.         else
  133.                 gfont trfont%:(-1) : gstyle 0 : gtmode 3 : rem illegal value for trfont% returns stack default font.
  134.                 y% = py%+1
  135.                 ginfo inf%()
  136.         endif
  137. rem process fields
  138.         while k% < 16 and ( y% < py%+ph%-1 or onAct% )
  139.                 k% = k%+1
  140.                 j% = flds%(k%)
  141.                 if j% > 0 and j% <= 32
  142.                         vector j%
  143.                         j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14,j15,j16,j17,j18,j19,j20,j21,j22,j23,j24,j25,j26,j27,j28,j29,j30,j31,j32
  144.                         endv
  145. j1::
  146.                         s$ = b.f1$
  147. j0::
  148.                         while len(s$)
  149.                                 r% = loc(s$,chr$(21))  rem find line breaks
  150.                                 if r%
  151.                                         t$ = left$(s$,r%-1)
  152.                                         s$ = right$(s$,len(s$)-r%)
  153.                                 else
  154.                                         t$ = s$ : s$ = ""
  155.                                 endif
  156.                                 if onAct%
  157.                                         if pk% = 4 : break : endif
  158.                                         pk% = pk% + 1
  159.                                         phone$(pk%) = strip$:(t$)       rem collect phone numbers
  160.                                         dedit phone$(pk%),lab$(k%)      rem build dialog box
  161.                                 else
  162.                                         if y% >= py%+ph%-1 : break : endif
  163.                                         tw% = min(pw%-4,gtwidth(t$))
  164.                                         if tw% > mxw%
  165.                                                 gat px%+mxw%+2,py%
  166.                                                 gfill tw%-mxw%,y%-py%,1 rem extend print area
  167.                                                 mxw% = tw%
  168.                                         else
  169.                                                 tw% = mxw