home *** CD-ROM | disk | FTP | other *** search
app hyperpoc enda rem --------------------------------- proc impdata%:(par$) rem --------------------------------- rem rem impdata% reads records from the PSION database. rem When called at card open time fields from the record found rem are displayed in the card area. rem When called at object activation time it reads the same record rem and offers the phone numbers contained in the record for dialling. rem par$ is a chr$(13) separated list with the following items: rem 1. Search string (can contain wild cards) rem 2. Data File name (can be short name) rem 3. Occurence (the n-th matching record is displayed) rem 4. List of up to 16 fields to be displayed (e.g. 1,3-5,7) rem (Phone numbers are extracted on activation from the rem first 32 fields of the record regardless of this list). rem rem a special edparm routine (see below) supports the definition rem of imported objects during card definition rem rem variables 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% local flds%(16),s$(255),t$(255),off%(6),inf%(32),phone$(6,24),lab$(6,10),pn%,tw%,mxw% onerr err1 rem analyze parameter string abuf& = (int(addr(buf$)) and &00ffff) : rem make save pointer r% = loc(par$,chr$(13)) srch$ = mid$(par$,1,r%-1) p% = r% r% = loc(right$(par$,len(par$)-p%),chr$(13)) fil$ = mid$(par$,p%+1,r%-1) p% = p%+r% r% = loc(right$(par$,len(par$)-p%),chr$(13)) occur& = val(mid$(par$,p%+1,r%-1)) fl$ = right$(par$,len(par$)-p%-r%) fil$ = parse$(fil$,"LOC::M:\DAT\*.DBF",off%()) if onAct% rem activated rem get label information from DBF file r% = ioopen(h%,fil$,$200) if r% < 0 : raise r% : endif r% = ioread(h%,abuf&+1,20) rem read File Header if r% < 0 : raise r% : endif p& = peekw(abuf&+19) rem position of first record pokeb abuf&,15 rem set signature length if buf$ <> "OPLDatabaseFile" : raise -109 : endif while 1 r% = ioseek(h%,1,p&) rem to first record if r% < 0 : break : endif r% = ioread(h%,abuf&,2) rem length byte and tag if r% < 0 : break : endif l% = peekw(abuf&) if (l% and $f000) = $3000 rem Skip instruction p& = p&+2 rem Just ignore it elseif (l% and $f000) <> $4000 p& = p& + (l% and $0fff) + 2 rem ignore any other record else rem Start of labels l% = l% and $0fff rem total length of labels while l% > 0 and i% < 6 r% = ioread(h%,abuf&,1) rem label length byte if r% < 0 : break : endif s% = peekb(abuf&) pn% = pn%+1 rem field number if s% r% = ioread(h%,abuf&+1,s%) rem read label if r% < 0 : break : endif if asc(buf$) = 5 rem label contains phone symbol i% = i%+1 lab$(i%) = left$(right$(buf$,len(buf$)-1),10) flds%(i%) = pn% if i% = 6 : break : endif endif endif l% = l% - s% - 1 endwh break endif endwh ioclose(h%) else rem get default print area px% = gx py% = gy pw% = ObjW%+ObjX%-px% ph% = ObjH%+ObjY%-py% rem process rest of parameter string i% = 0 while j% < 16 and i% < 16 i% = i%+1 t$ = extract$:(fl$,i%) if len(t$) r% = loc(t$,"-") rem range specification if r% u% = val(left$(t$,r%-1)) r% = val(right$(t$,len(t$)-r%)) while u% <= r% and j% < 16 j% = j%+1 flds%(j%) = u% u% = u%+1 endwh else j% = j%+1 flds%(j%) = val(t$) endif endif endwh rem set field default numbers if j% = 0 flds%(1) = 1 : flds%(2) = 2 : flds%(3) = 3 : flds%(4) = 4 endif endif rem open file 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$ rem find record while 1 if find("*"+srch$+"*") = 0 close return endif if occur& = 1 : break : endif occur& = occur& - 1 next endwh rem initialize display if onAct% lock on dinit "Dial" else gfont trfont%:(-1) : gstyle 0 : gtmode 3 : rem illegal value for trfont% returns stack default font. y% = py%+1 ginfo inf%() endif rem process fields while k% < 16 and ( y% < py%+ph%-1 or onAct% ) k% = k%+1 j% = flds%(k%) if j% > 0 and j% <= 32 vector j% 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 endv j1:: s$ = b.f1$ j0:: while len(s$) r% = loc(s$,chr$(21)) rem find line breaks if r% t$ = left$(s$,r%-1) s$ = right$(s$,len(s$)-r%) else t$ = s$ : s$ = "" endif if onAct% if pk% = 4 : break : endif pk% = pk% + 1 phone$(pk%) = strip$:(t$) rem collect phone numbers dedit phone$(pk%),lab$(k%) rem build dialog box else if y% >= py%+ph%-1 : break : endif tw% = min(pw%-4,gtwidth(t$)) if tw% > mxw% gat px%+mxw%+2,py% gfill tw%-mxw%,y%-py%,1 rem extend print area mxw% = tw% else tw% = mxw% endif y% = y% + inf%(3) rem character height gat px%+2,y% gprintclip(t$,tw%) rem print line endif endwh continue j2:: s$ = b.f2$ : goto j0 j3:: s$ = b.f3$ : goto j0 j4:: s$ = b.f4$ : goto j0 j5:: s$ = b.f5$ : goto j0 j6:: s$ = b.f6$ : goto j0 j7:: s$ = b.f7$ : goto j0 j8:: s$ = b.f8$ : goto j0 j9:: s$ = b.f9$ : goto j0 j10:: s$ = b.f10$ : goto j0 j11:: s$ = b.f11$ : goto j0 j12:: s$ = b.f12$ : goto j0 j13:: s$ = b.f13$ : goto j0 j14:: s$ = b.f14$ : goto j0 j15:: s$ = b.f15$ : goto j0 j16:: s$ = b.f16$ : goto j0 j17:: s$ = b.f17$ : goto j0 j18:: s$ = b.f18$ : goto j0 j19:: s$ = b.f19$ : goto j0 j20:: s$ = b.f20$ : goto j0 j21:: s$ = b.f21$ : goto j0 j22:: s$ = b.f22$ : goto j0 j23:: s$ = b.f23$ : goto j0 j24:: s$ = b.f24$ : goto j0 j25:: s$ = b.f25$ : goto j0 j26:: s$ = b.f26$ : goto j0 j27:: s$ = b.f27$ : goto j0 j28:: s$ = b.f28$ : goto j0 j29:: s$ = b.f29$ : goto j0 j30:: s$ = b.f30$ : goto j0 j31:: s$ = b.f31$ : goto j0 j32:: s$ = b.f32$ : goto j0 endif endwh close if onAct% if pk% = 0 : return : endif : rem no phone number found i% = 1 if pk% > 1 i% = dialog - 1 rem Unfortunately we have to use 2 steps if i% <= 0 : return : endif dinit tx$:(104) : rem "Dial" dedit phone$(i%),tx$:(105) : rem "Phone number" endif dbuttons tx$:(106),-27,tx$:(104),9,tx$:(107),13 : rem "Cancel" "Dial" "Dial out" r% = dialog if r% dial:(phone$(i%),(r%=13)) endif else gat px%,py% gborder 0,mxw%+3,y%-py%+1 endif return err1:: r% = err ioclose(h%) trap use b rem make sure we are talking to dbf file if err = 0 trap close rem close dbf file endif return r% endp rem edParm$: supports the editing process for impdata objects. proc edParm$:(parm$) local r%,p%,off%(6),srch$(50),fil$(128),fl$(50),occur& if len(parm$) r% = loc(parm$,chr$(13)) srch$ = mid$(parm$,1,r%-1) p% = r% r% = loc(right$(parm$,len(parm$)-p%),chr$(13)) fil$ = mid$(parm$,p%+1,r%-1) p% = p%+r% r% = loc(right$(parm$,len(parm$)-p%),chr$(13)) occur& = val(mid$(parm$,p%+1,r%-1)) fl$ = right$(parm$,len(parm$)-p%-r%) else occur& = 1 fil$ = "M:\DAT\DATA" fl$ = "1-4" endif fil$ = parse$(fil$,"LOC::M:\DAT\*.DBF",off%()) dinit tx$:(169) : rem "Import database record" dfile fil$,tx$:(170),16 : rem "Data" dedit srch$,tx$:(144) : rem "Search string" dlong occur&,tx$:(171),1,32 : rem "Occurence" dedit fl$,tx$:(172) : rem "Fields displayed" dialog fil$ = parse$(fil$,"",off%()) return srch$+chr$(13)+mid$(fil$,off%(2),off%(5)-off%(2))+chr$(13)+num$(occur&,2)+chr$(13)+fl$ endp 
