/* Source code for dDBase. NOTE Though you can experiment with parts/all
the code the copyright still remains with me, Peter Hughes.*/


$P>    !Compiler Functions
$E#    !Compiler Function
$U+    !Compiler Function
DATA "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
maing:
' Main Gadgets
DATA "30 217   "
DATA "61 217   "
DATA "94 217   "
DATA "127217   "
DATA "159217   "
DATA "196218 = "
DATA "286218 Add "
DATA "434240 New "
DATA "556240 Exit "
DATA "391218 Print "
DATA "286229 Create "
DATA "426229 Sort "
DATA "335218 Edit "
DATA "348240 Organise "
DATA "356229 Delete "
DATA "481229 Load "
DATA "456218 Save As "
DATA "235218 ? "
DATA "114241 About "
DATA "30 241 Snap "
DATA "481240 Save "
DATA "114230 Prefs "
DATA "286240Display"
DATA "30 230 List "
DATA "end"
' Search Gadgets
DATA "20 21 Next Record"
DATA "12121  Print "
DATA "48821  Return "
DATA "18421  View "
' Print Gadgets
DATA "32525 Searching"
DATA "24320 Current"
DATA "46021 Table"
DATA "51021 Record"
DATA "5786  Exit"
DATA "80 20 Envelope"
DATA "153 20 All/Range"
DATA "41921 Form"
DATA "23 20 Labels"
' Print External Files Gadgets
DATA "220185 Next "
DATA "340185 Top "
DATA "388185 = "
DATA "421185 Return "
DATA "276185 Print "
DATA "163185 Prev "
' Preferences  (Here at Last)
DATA "20 33 Print"
DATA "20 49 Seperator"
DATA "160109 Labels "
DATA "20 79 Crunch"
DATA "20 94 Currency"
DATA "18094 TaskPriority"
DATA "20 109Edit External"
DATA "20 64 Printer Prefs"
DATA "240109Screen"
DATA "36550    Save   "
DATA "36570   Return  "
' Field Definition
DATA "15 40 String"
DATA "69 40 Date"
DATA "10740 Integer"
DATA "17040 BBox"
DATA "20840 FBox"
DATA "24640 Text"
DATA "28340 External"
DATA "35140 Memo"
DATA "39140 Attach"
DATA "44740 Calc"
DATA "ILBM.library","AmigaGuide.library","Packit"  ! Check
month:
DATA 31,28,31,30,31,30,31,31,30,31,30,31
pubmem%=AvailMem(1)
entry$=_dosCmd$
IF entry$<>"" AND LEFT$(entry$,1)=CHR$(34)
  entry$=MID$(entry$,2)
  entry$=LEFT$(entry$,LEN(entry$)-1)
ENDIF
IF entry$="?"
  output%=Output()
  IF output%>0
    text$=CHR$(10)+prog$+" VERSION 7.66  ©MADCAP-SOFTWARE 12 April 1998"+CHR$(10)+CHR$(10)+CHR$(10)+"dDbase <File to Load>"+CHR$(10)+CHR$(10)
    ll%=LEN(text$)
    v%=V:text$
    ~Write(output%,v%,ll%)
  ENDIF
  cleanup
  EDIT
ENDIF
CHDIR "progdir:"
CHDIR "progdir:"
IF EXIST("t:ddbaseisrunning")
  ALERT 1,"dDBase is running!",2,"Continue|Exit",a%
  IF a%=2
    EDIT
  ENDIF
ENDIF
IF EXIST("ddbase.tools")
  GOSUB getmax
ENDIF
IF reserve%=0 AND entry$<>"?"
  ALERT 1,"Cannot find dDBase Tools|How Many Records?",1,"500|1000|1500",aa%
  IF aa%=1
    reserve%=500*250
  ENDIF
  IF aa%=2
    reserve%=1000*250
  ENDIF
  IF aa%=3
    reserve%=1500*250
  ENDIF
ENDIF
OPEN "o",#1,"ram:ddt"
PRINT #1,reserve%
PRINT #1,prog$
PRINT #1,entry$
CLOSE #1
gnu%=0
RESERVE reserve%
OPEN "i",#5,"ram:ddt"
INPUT #5,reserve%
LINE INPUT #5,prog$
LINE INPUT #5,entry$
CLOSE #5
OPEN "o",#12,"t:ddbaseisrunning"
CLOSE #12
DIM pref$(15)
GOSUB getprefs
IF EXIST("progdir:"+MID$(pref$(9),2)) AND LEFT$(pref$(9),1)="Y"
  GOSUB exec("run "+MID$(pref$(9),2),"")
  DELAY 1
ENDIF
max%=reserve%/250
max1%=reserve%/312
IF max1%>500
  max1%=500
ENDIF
max1%=max%
tskp=0
IF entry$=""
  entry$=_dosCmd$
ENDIF
ON ERROR GOSUB errors
ON BREAK GOSUB break
title$=prog$+" -----MADCAP-SOFTWARE STRIKES AGAIN"
GOSUB mwin
dd$="DATE :"+DATE$+" TIME : "+TIME$
ll=LEN(dd$)
ll=80-ll
ll=INT(ll/2)-1
IF winh%>256
  maxlin1%=maxlin1%+2
ENDIF
IF winh%=256
  maxlin1%=maxlin1%-1
ENDIF
IF winh%=200
  maxlin1%=maxlin1%-4
ENDIF
IF EXIST("ddbase.ini")
  OPEN "i",#15,"ddbase.ini"
  LINE INPUT #15,who$
  CLOSE #15
ENDIF
ON MESSAGE GOSUB msg
wn=0
GOSUB init
bank=0
IF EXIST("ddbase.pic") AND check$(1,1)="y"
  dela$="y"
  iff("ddbase.pic")
  dela$=""
ELSE
  DISPLAY OFF
ENDIF
GOSUB drawgadgets
CLS
wn=0
bank=1
GOSUB display
IF EXIST("ddbase.pic") AND check$(1,1)="y"
  ~CloseWindow(LPEEK(frame%+156))
  ~CloseScreen(LPEEK(frame%+160))
  dela$=""
ELSE
  DISPLAY ON
ENDIF
wn=0
bank=1
~ActivateWindow(WINDOW(wn))
IF entry$<>"" AND RIGHT$(UPPER$(entry$),4)<>".DDB"
  entry$=entry$+".ddb"
ENDIF
IF entry$<>"" AND EXIST(entry$)
  file$=entry$
  file2$=LEFT$(entry$,LEN(entry$)-4)+".dat"
  trs$=""
  GOSUB load
  filename1$=entry$
  wn=0
  bank=1
  qq=0
ENDIF
qq=0
DO
  start:
  mfr=FRE(0)
  mfr=INT(mfr/1000)
  IF filename1$<>""
    IF RIGHT$(UPPER$(filename1$),4)=".DDB"
      filetitl$=LEFT$(filename1$,LEN(filename1$)-4)
    ELSE
      filetitl$=filename1$
    ENDIF
  ENDIF
  IF LEN(filetitl$)>20
    filetitl$=LEFT$(filetitl$,20)
  ENDIF
  IF n>0
    wtitle$=version$+":Record:"+STR$(kk)+" of "+STR$(k)+":Memory: "+STR$(mfr)+"-Kb: File:-"+filetitl$
  ELSE
    wtitle$=version$+":No File Loaded "+":Memory: "+STR$(mfr)+"-Kb: File:-"+filetitl$
  ENDIF
  TITLEW #0,wtitle$
  DO UNTIL qq<>0
    IF kk>k
      kk=k
    ENDIF
    qq=@test
  LOOP
  IF k=0 AND n=0 AND qq<>10 AND qq<>22 AND qq<>24 AND qq<>19 AND qq<>11 AND qq<>16 AND qq<>9 AND qq<>26
    beep
    message("   NO DATA   ")
    PAUSE 20
    moff
  ENDIF
  SELECT qq
    GRAPHMODE 1
    GOSUB display
  CASE 1
    IF k>0
      kk=1
      GOSUB presentdisplay
    ENDIF
  CASE 2
    IF kk-1>0
      kk=kk-1
      GOSUB presentdisplay
    ELSE
      IF k>0
        message("   End Of File   ")
        beep
        PAUSE 10
        moff
      ENDIF
    ENDIF
  CASE 3
    IF k>0
      aa%=@getstring(5,"Goto Record No:","")
      IF VAL(rtstring$)=>1 AND VAL(rtstring$)<=k
        kk=VAL(rtstring$)
      ENDIF
      bank=1
      wn=0
      GOSUB presentdisplay
    ENDIF
  CASE 4
    IF k>0 AND kk<k
      kk=kk+1
      GOSUB presentdisplay
    ELSE
      IF k>0
        message("   End Of File   ")
        beep
        PAUSE 10
        moff
      ENDIF
    ENDIF
  CASE 5
    IF k>0
      kk=k
      GOSUB presentdisplay
    ENDIF
  CASE 6
    IF n>0 AND k>0
      k9=kk
      GOSUB searchit
      IF recount>0
        CLOSEW #1
        record$=" Record"
        IF recount>1
          record$=" Records"
        ENDIF
        message("Found "+STR$(recount)+record$)
        DELAY (1)
        moff
      ENDIF
      DEFMOUSE (msp1%)
      kk=k9
      lightsoff
      GOSUB presentdisplay
    ENDIF
  CASE 7    ! Add
    IF n>0
      IF k=>max%-1 OR FRE(0)<=2000
        a%=@rteasyrequest("MAXIMUM RECORDS IN DATABASE"+CHR$(10)+"     SAVE AND EXIT","OK!","WARNING")
        rtitle$="Please Save Data:  "+prog$
        GOSUB filing
        IF ee=0
          GOSUB savit
        ENDIF
        GOSUB break
      ENDIF
      GOSUB enter
      a%=0
      qq=@rteasyrequest("Accept Data!","Yes|No","dDbase--Enter..")
      a%=qq
      IF a%=1
        sit%=1
        dsit%=1
        k=k+1
        kk=k
        GOSUB pack
      ELSE
        FOR t&=1 TO n
          a$(t&)=""
        NEXT t&
        kk=k
        GOSUB ddisplay
      ENDIF
      GOSUB presentdisplay
    ENDIF
  CASE 8
    IF n>0
      a%=@rteasyrequest("Kill DataBase!"+CHR$(10)+"Delete Data","Kill!|Data!|Transfer|Cancel"+CHR$(0),"dDbase--New")
      IF a%=3
        trs$=""
      ENDIF
      IF a%=1 AND n>0
        lightson
        sit%=0
        file$=""
        startgauge(3,"KILL")
        gauge
        ERASE w$()
        ERASE section$()
        gauge
        FOR t&=1 TO bbx
          FOR tt&=0 TO 4
            box(t&,tt&)=0
          NEXT tt&
        NEXT t&
        bbx=0
        tf=0
        gauge
        FOR t&=1 TO n
          FOR tt&=0 TO 5
            f$(t&,tt&)=""
          NEXT tt&
        NEXT t&
        endgauge
        file$=""
        filename1$=""
        filetitl$=""
        DIM w$(max%)
        DIM section$(20)
        k=0
        kk=0
        n=0
        filetitl$=""
        filename1$=""
        clearscreen
        display
        lightsoff
      ENDIF
      IF a%=2
        sit%=0
        startgauge(k,"CLEAR")
        FOR t&=1 TO tf
          tr(t&,1)=0
          tr(t&,2)=0
        NEXT t&
        tf=0
        FOR t&=1 TO k
          gauge
          w$(t&)=""
        NEXT t&
        k=0
        kk=0
        endgauge
        GOSUB presentdisplay
      ENDIF
    ENDIF
  CASE 9   !Exit
    GOSUB break
  CASE 10  ! Print
    ~ActivateWindow(WINDOW(wn))
    bold%=0
    wn=1
    OPENW #1,3,158+winoff%,634,40,&H80000+&H40000,65536+&H800+4096
    TITLEW #1,""
    wn=1
    wtitle$="dDbase Print Database"
    text(50,12,wtitle$,1,2)
    dbbox(8,2,620,37)
    GOSUB getprinter
    text(270,12,"Printer: "+prit$,1,3)
    ll%=LEN(prit$)+9
    dbbox(14,17,296,18) !!!
    bank=3
    qq=0
    GOSUB display
    dbbox(412,17,155,19)
    text(473,20,"View",1,2)
    qq=0
    qq=0
    DO UNTIL qq=5
      qq=0
      COLOR 0
      GOSUB drawprint
      DO UNTIL qq<>0
        wn=1
        bank=3
        qq=@test
      LOOP
      IF qq=1 AND pr$="y"   !Print While Searching
        pr$=""
        ddprint(1)
        GOTO label1
      ENDIF
      IF qq=1 AND pr$<>"y"
        pr$="y"
        dprint(1)
      ENDIF
      label1:
      IF qq=8   !Form View
        pcode=3
        dprint(8)
      ENDIF
      IF qq=3  !Table View
        pcode=1
        dprint(3)
      ENDIF
      IF qq=4  ! Record View
        pcode=2
        dprint(4)
      ENDIF
      IF qq=2 AND k>0     ! Current Record
        pnumber=1
        pcount=0
        IF pcode=2
          aa%=@getstring(79,"Left Margin",STR$(lmargin%))
          tab%=VAL(rtstring$)
        ELSE
          tab%=0
        ENDIF
        fred%=1
        GOSUB printit
        qq=5
      ENDIF
      IF qq=6 AND k>0     ! Envelope
        GOSUB envelope
        qq=5
      ENDIF
      IF qq=9 AND k>0                !Labels
        lab%=@rteasyrequest("Do you wish to print labels from:","All Records|Or A Range of Records|Cancel","Print Labels")
        IF lab%=1
          tt1=kk
          GOSUB labelstart
          FOR kk=1 TO k
            GOSUB labelout
          NEXT kk
          GOSUB labelend
          kk=tt1
          qq=5
        ELSE IF lab%=2
          ge%=@getstring(5,"Enter Range to Start",STR$(kk))
          lst%=VAL(rtstring$)
          gee%=@getstring(5,"Enter Range to End",STR$(k))
          lse%=VAL(rtstring$)
          tt1=k
          GOSUB labelstart
          FOR kk=lst% TO lse%
            GOSUB labelout
          NEXT kk
          GOSUB labelend
          kk=tt1
          qq=5
        ENDIF
      ENDIF
      IF qq=7             ! Print All/Range
        k9=kk
        askit%=@rteasyrequest("Print:","ALL|RANGE|CANCEL",version$)
        FOR tt=1 TO tf  !Check to see if there is an external field
          IF f$(tr(tt,1),0)="7"
            eel%=1
          ENDIF
        NEXT tt
        text%=0
        IF eel%=1 ! If there is an external field
          text%=@rteasyrequest("Do you want to Insert any External Text Files?","Insert|Cancel",version$)
          IF text%=1
            ~@getstring(12,"Enter File Buffer Size","8000")
            fbuffer%=VAL(rtstring$)
          ENDIF
        ENDIF
        IF askit%>0
          question%=@rteasyrequest("Output to-","Printer|File|Cancel",version$)
          IF question%=>1 AND calc%=TRUE
            IF calc%=TRUE
              cal%=@rteasyrequest("Do you want running totals?","Yes|Cancel",version$)
              GOSUB clearcalc
            ENDIF
          ENDIF
          IF question%=1 AND pcode=1
            GOSUB makehead
          ENDIF
          IF question%=1 AND pcode=2
            pcount=0
            pnumber=0
            GOSUB recordhead
          ENDIF
          IF question%=2
            rtitle$="Select File"
            GOSUB getfile("")
            IF ee=1
              question%=0
            ENDIF
            IF pcode=2
              bold%=@rteasyrequest("Do you want Field titles"+CHR$(10)+"to appear in bold?","Yes|No",version$)
            ENDIF
          ENDIF
          IF question%>0 AND askit%=2
            ~@getstring(5,"RANGE: Start","")
            start%=VAL(rtstring$)
            ~@getstring(5,"RANGE: End       MIN:"+STR$(start%)+"  MAX:"+STR$(k),"")
            fin%=VAL(rtstring$)
            IF start%>fin%
              SWAP start%,fin%
            ENDIF
            IF start%>0 AND fin%<=k
              IF question%=2
                OPEN "o",#13,nfile$
                IF pcode=1
                  GOSUB heading
                  PRINT #13,head$
                  PRINT #13,LEFT$("---------------------------------------------------------------------------",LEN(head$))
                ENDIF
              ENDIF
              IF question%=1
                nfile$="PRT:"
              ENDIF
              startgauge((fin%-start%)+1,"Printing Range To: "+nfile$)
              ask%=1
              FOR kk=start% TO fin%
                gauge
                IF question%=1
                  fred%=1
                  GOSUB printit
                ELSE IF question%=2
                  fred%=0
                  ask%=1
                  GOSUB fileprint
                ENDIF
              NEXT kk
              endgauge
              IF cal%=1
                GOSUB discalc
              ENDIF
              IF question%=1 AND lfeed$="Y"
                LPRINT CHR$(12)
              ELSE
                CLOSE #13
              ENDIF
            ENDIF
          ENDIF
          IF question%>0 AND askit%=1
            IF question%=2
              OPEN "o",#13,nfile$
              IF pcode=1
                GOSUB heading
                PRINT #13,head$
                PRINT #13,LEFT$("---------------------------------------------------------------------------",LEN(head$))
              ENDIF
            ENDIF
            IF question%=1
              nfile$="PRT:"
            ENDIF
            startgauge(k+1,"Printing All To: "+nfile$)
            FOR kk=1 TO k
              gauge
              IF question%=1
                fred%=1
                GOSUB printit
              ELSE
                fred%=0
                ask%=1
                GOSUB fileprint
              ENDIF
            NEXT kk
            endgauge
            IF cal%=1 AND question%=>1
              GOSUB discalc
              cal%=0
            ENDIF
            IF question%=1 AND lfeed$="Y"
              LPRINT CHR$(12)
            ELSE
              CLOSE #13
            ENDIF
          ENDIF
          kk=k9
          qq=5
        ENDIF
      ENDIF
      EXIT IF qq=5
      qq=0
      drawprint
    LOOP
    CLOSEW #1
    bank=1
    qq=0
    wn=0
  CASE 11
    IF k>0 AND n>0
      VOID @rteasyrequest("  Cannot Create Database:"+CHR$(10)+"    Select New First","OK!","dDbase ©MADCAP-SOFTWARE")
    ENDIF
    IF k=0 AND n=0
      GOSUB create
      bank=1
      wn=0
      GOSUB ddisplay
      FOR tt&=1 TO n
        f(tt&)=VAL(f$(tt&,4))
      NEXT tt&
    ENDIF
  CASE 12
    IF k>0
      tb=3
      GOSUB fields
      stx$=""
      GOSUB selectfield("Sort dDbase",n)
      sf=qq
      IF sf>n
        sf=0
      ENDIF
      GOSUB newsort(sf)
    ENDIF
    wn=0
    bank=1
  CASE 13
    IF n>0
      GOSUB unpack
      GOSUB edit
      a%=@rteasyrequest("Accept Changes?","Yes|No","dDbase--Edit")
      IF a%=1
        sit%=1
        dsit%=1
        w$(kk)=""
        GOSUB pack
      ENDIF
      GOSUB presentdisplay
    ENDIF
  CASE 14   ! Organise
    IF n>0
      sel$="Select Field|Edit Field|Add Field|Move Field|Draw Box|Export Data|Import Data|Replace|Statistics|Delete Range|Create Mail List|"
      flag=1
      GOSUB unpackrequired(sel$)
      org%=1
      stx$="Select Option"
      selectfield("Organise",gln)
      org%=0
      IF qq>0 AND qq<=gln
        k9=kk
        IF tf=0
          IF qq=6 OR qq=7 OR qq=11
            ~@rteasyrequest("You have to Select some fields first!","Select Fields",version$)
            bb=qq
            GOSUB selfield
            qq=bb
          ENDIF
        ENDIF
        IF qq=1  ! Select Field 1
          GOSUB selfield
          bank=1
          qq=0
          wn=0
        ENDIF
        IF qq=2 !Edit Field  2
          GOSUB fields
          GOSUB selectfield("Edit Field",n)
          IF qq=>1 AND qq<=n
            ae%=@rteasyrequest("EDIT or DELETE FIELD"+CHR$(10)+"`"+f$(qq,1)+"'","Edit|Delete|Cancel",version$)
            IF ae%=1
              GOSUB editfield
            ENDIF
            IF ae%=2
              GOSUB deletefield
            ENDIF
            qq=0
            bank=1
            clearscreen
            bank=1
            wn=0
            kk=k9
            GOSUB presentdisplay
          ENDIF
          wn=0
          bank=1
          qq=0
        ENDIF
        IF qq=5 AND screenmode%=0  !Draw Box 5
          GOSUB dbox
          bank=1
          wn=0
          kk=k9
          IF aa%<>0
            clearscreen
            GOSUB redraw
            GOSUB presentdisplay
          ENDIF
        ENDIF
        IF qq=6 ! Export 6
          temp$="ASCII DATA|SuperBase|bBaseII|Final Copy|Protext|WordsWorth|ProWrite|ASCII Merge|AmigaGuide|FinalData|Twist Database|"
          flag=1
          GOSUB unpackrequired(temp$)
          selectfield("Export Data",gln)
          aa%=qq
          fdflag%=FALSE
          IF aa%>gln
            aa%=0
          ENDIF
          IF aa%=1
            GOSUB exportasci
          ENDIF
          IF aa%=2
            GOSUB exportsbase
          ENDIF
          IF aa%=3
            GOSUB expbbase
          ENDIF
          IF aa%=4
            GOSUB export("Final-Copy",2)
          ENDIF
          IF aa%=5
            GOSUB export("Protext",1)
          ENDIF
          IF aa%=6
            GOSUB export("Words Worth",3)
          ENDIF
          IF aa%=7
            GOSUB export("Pro-Write",4)
          ENDIF
          IF aa%=8
            GOSUB xpascii
          ENDIF
          IF aa%=9
            bank=1
            wn=0
            GOSUB amigaguide
          ENDIF
          IF aa%=10
            GOSUB exportfd
            bank=1
            wn=0
          ENDIF
          IF aa%=11
            fdflag%=FALSE
            GOSUB xpascii
            bank=1
            wn=0
          ENDIF
          bank=1
          wn=0
          qq=0
          kk=k9
          GOSUB presentdisplay
        ENDIF
        IF qq=7  ! Import 7
          GOSUB mergeasci
          bank=1
          wn=0
          qq=0
        ENDIF
        IF qq=3  ! Add Field 3
          aaf%=1
          GOSUB addfield
          aaf%=0
          qq=0
          bank=1
          wn=0
          kk=k9
          GOSUB presentdisplay
        ENDIF
        IF qq=8 ! Search and Replace 9
          GOSUB replace
          bank=1
          wn=0
          kk=k9
          GOSUB presentdisplay
          qq=0
        ENDIF
        IF qq=10
          qe%=@getstring(5,"Enter First Record to Delete",STR$(kk))
          IF qe%=1
            ee=0
          ELSE
            ee=1
          ENDIF
          twt=VAL(rtstring$)
          IF ee=0
            qqe%=@getstring(5,"Enter Last Record to Delete","")
          ENDIF
          IF qqe%=1
            ee=0
          ELSE
            ee=1
          ENDIF
          ggn=VAL(rtstring$)
          IF twt=>ggn
            ee=1
          ENDIF
          IF ee=0
            qqee%=@rteasyrequest("Are you sure you want to go ahead?"+CHR$(10)+"Delete Records From: "+STR$(twt)+" To: "+STR$(ggn),"Ok|Camncel","Delete Range")
            IF qqee%=1
              sit%=1
              startgauge((ggn-twt)+1,"Deleting Range")
              tt1=kk
              FOR kk=ggn TO twt STEP -1
                gauge
                FOR x&=kk TO k
                  w$(x&)=w$(x&+1)
                NEXT x&
                k=k-1
              NEXT kk
              endgauge
              kk=tt1
              IF kk>k
                kk=k
              ENDIF
            ENDIF
            GOSUB presentdisplay
          ENDIF
        ENDIF
        IF qq=11
          GOSUB createfile
        ENDIF
        IF qq=9
          GOSUB stats
          qq=0
        ENDIF
        IF qq=4 AND screenmode%=0  ! Move Field 4
          a%=@rteasyrequest("Reposition Fields","All|Select|Cancel","Reposition Fields")
          IF a%=1
            GOSUB repos
          ENDIF
          IF a%=2
            GOSUB fields
            GOSUB selectfield("Reposition Field",n)
            GOSUB repos2
            a%=2
          ENDIF
          IF a%>0
            qq=0
            wn=0
            bank=1
            clearscreen
            GOSUB redraw
            GOSUB presentdisplay
          ENDIF
        ENDIF
        wn=0
        qq=0
        bank=1
        GOSUB redraw
      ENDIF
    ENDIF
  CASE 15
    IF k>0
      qq=@rteasyrequest("Delete Record "+STR$(kk),"Delete|Cancel","dDbase--Delete..")
      a%=qq
      IF a%=1 AND k>0
        sit%=1
        dsit%=1
        DEFMOUSE (2)
        FOR x&=kk TO k
          w$(x&)=w$(x&+1)
        NEXT x&
        k=k-1
        kk=kk-1
        GOSUB presentdisplay
        DEFMOUSE (msp1%)
      ENDIF
    ENDIF
  CASE 16
    rtitle$="Load Data:   dDbase "
    aa%=1
    IF sit%=1
      aa%=@rteasyrequest("Abandon UnSaved File?","Yes|No",version$)
    ENDIF
    IF aa%=1
      GOSUB filing
      IF ee=0
        IF RIGHT$(UPPER$(file$),4)<>".DDB"
          file$=file$+".ddb"
        ENDIF
        IF RIGHT$(file$,4)=".ddb"
          file2$=LEFT$(file$,LEN(file$)-4)+".dat"
        ELSE
          file2$=file$+".dat"
        ENDIF
        trs$=""
        GOSUB load
      ENDIF
    ENDIF
  CASE 17
    IF n>0
      n1$="Save Database"
      n2$="Save"
      path$=""
      rtitle$="Save Data:   dDbase "
      GOSUB filing
      IF ee=0 AND EXIST(file$) AND file$<>""
        qq%=@rteasyrequest("File Exists!    "+file$,"OverWrite|Cancel",version$)
        IF qq%=0
          ee=1
        ENDIF
      ENDIF
      IF ee=0
        ee%=-1
        GOSUB savit
        IF ee%<>-1
          pref$(4)=""
          GOSUB savit
        ENDIF
      ENDIF
      qq=0
    ENDIF
  CASE 18
    IF k>0
      aa%=@getstring(40,"Search For:","")
      IF aa%=1
        count=0
        counter=0
        wn=0
        lightson
        qs$=rtstring$
        IF LEFT$(qs$,1)="(" AND RIGHT$(qs$,1)=")"
          qs$=CHR$(VAL(MID$(qs$,2,LEN(qs$)-2)))
        ENDIF
        che%=INSTR(qs$,"|")
        IF che%>0
          IF RIGHT$(qs$,1)<>"|"
            qs$=qs$+"|"
          ENDIF
          flag=1
          GOSUB unpackrequired(qs$)
          FOR ttx=1 TO gln
            search$(ttx)=select$(ttx)
          NEXT ttx
          counter=gln
          flag=0
        ELSE
          counter=1
        ENDIF
        recount=0
        IF pr$="y"
          GOSUB startprint
        ENDIF
        IF pr$="y" AND op%=0 AND po%>0 AND fred%=1
          startgauge(k,"Saving Data Please Wait..")
        ENDIF
        IF pr$<>"y"
          TITLEW #0,"Searching For - "+qs$
        ENDIF
        DEFMOUSE (2)
        FOR tr&=1 TO k
          count=0
          IF pr$="y" AND op%=0 AND po%>0 AND fred%=1
            gauge
          ENDIF
          IF che%>0
            count=0
            FOR tyt=1 TO counter
              IF INSTR(UPPER$(w$(tr&)),UPPER$(search$(tyt)))
                count=count+1
              ENDIF
            NEXT tyt
          ELSE
            IF INSTR(UPPER$(w$(tr&)),UPPER$(qs$))>0
              count=1
            ENDIF
          ENDIF
          IF count>0
            INC recount    ! Good
            flag=2
            kk=tr&
            GOSUB unpack
            IF pr$="y"
              IF op%=1 AND fred%=1
                GOSUB presentdisplay
              ENDIF
              flag=0
              IF op%=1
                fred%=1
                GOSUB printit
              ENDIF
              IF op%=0 AND po%>0
                fred%=0
                GOSUB fileprint
              ENDIF
            ENDIF
            IF pr$<>"y"
              OPENW #0
              GOSUB presentdisplay
              GOSUB search1
              flag=0
              IF qq=3
                tr&=k+1
              ENDIF
            ENDIF
            tt=n+1
            qq=0
          ENDIF
        NEXT tr&
        IF fred%=0 AND pr$="y"
          GOSUB labelend
        ENDIF
        IF pr$="y" AND op%=0 AND po%>0
          endgauge
          IF cal%=1
            GOSUB discalc
          ENDIF
          IF op%=0 AND screendis%=1
            PRINT #13,"@endnode"
          ENDIF
          CLOSE #13
          IF op%=0 AND clipit%=1
            clipit%=0
            IF EXIST("c:openclip")
              EXEC "c:openclip ram:clipfile",-1,-1
              KILL "ram:clipfile"
            ENDIF
          ENDIF
          IF op%=0 AND screendis%=1
            screendis%=0
            IF EXIST(op$)
              IF EXIST("progdir:textview")
                external(op$)
              ENDIF
              KILL op$
            ENDIF
          ENDIF
          IF ask%=0
            GOSUB prend
          ENDIF
        ENDIF
        wn=0
        bank=1
        IF recount>0
          IF pr$<>"y"
            CLOSEW #1
          ENDIF
          record$=" Record"
          IF recount>1
            record$=" Records"
          ENDIF
          message("Found "+STR$(recount)+record$)
          DELAY (1)
          moff
        ELSE
          message("Sorry I Couldn't find -ĺ "+UPPER$(qs$))
          beep
          DELAY (2)
          moff
        ENDIF
      ENDIF
      DEFMOUSE (msp1%)
      lightsoff
      GOSUB presentdisplay
    ENDIF
  CASE 19 ! About
    GOSUB info
  CASE 20
    IF k>0
      snap=snap+1
      snap$="snap"+STR$(snap)+".ddb"
      OPEN "o",#1,"t:"+snap$
      GOSUB unpack
      aa$=""
      FOR ttr&=1 TO tf
        tr&=tr(ttr&,1)
        IF VAL(f$(tr&,0))<=3 OR VAL(f$(tr&,0))=7
          PRINT #1,a$(tr&)
        ENDIF
        IF VAL(f$(tr&,0))=8 !MEMO
          vw$=a$(tr&)
          DO
            q=INSTR(vw$,CHR$(174))
            IF q>0
              PRINT #1,LEFT$(vw$,q-1)
              vw$=MID$(vw$,q+1)
            ENDIF
          LOOP UNTIL q=0
        ENDIF
      NEXT ttr&
      CLOSE #1
      FOR kr&=1 TO n
        IF VAL(f$(kr&,0))<=3 OR VAL(f$(kr&,0))=7
          aa$=aa$+LEFT$(f$(kr&,1)+SPACE$(10),10)+"   "+LEFT$(a$(kr&),62)+"   "+CHR$(10)
        ENDIF
      NEXT kr&
      IF EXIST("c:openclip")
        EXEC "c:openclip t:"+snap$,-1,-1
      ENDIF
      a%=@rteasyrequest(aa$,"OK!|Print|OK!","SNAP")
      IF a%=2
        LPRINT aa$
      ENDIF
      wn=0
    ENDIF
  CASE 21
    IF file$<>"" AND sit%=1 AND RIGHT$(UPPER$(file$),4)<>".LIZ"
      GOSUB savit
    ENDIF
    qq=0
  CASE 22
    GOSUB preferences
    presentdisplay
  CASE 23  ! Display database.
    IF kk>0
      GOSUB displayallfields
      wn=0
      bank=1
    ENDIF
    GOSUB presentdisplay
    qq=0
  CASE 24
    GOSUB listfield
  CASE 25   !Pressed 'z'
    IF k>0
      GOSUB fields
      selectfield("View Field",n)
      IF qq<=n
        GOSUB unpack
        pe$=a$(qq)
        IF f$(qq,0)="7"
          external(pe$)
        ENDIF
        IF f$(qq,0)="8"
          tee=qq
          viewmemo(pe$)
        ENDIF
        IF f$(qq,0)="9"
          vw$=f$(qq,5)
          GOSUB attach
        ENDIF
      ELSE
        wn=0
        bank=1
      ENDIF
      wn=0
      bank=1
    ENDIF
  CASE 26 !Unarchive
    EXEC "uarc",-1,-1
  DEFAULT
    VOID @rteasyrequest("Somewhere something has gone Wrong","OK!","One To Many")
  ENDSELECT
  qq=0
LOOP
END
PROCEDURE gerans
  GOSUB fields
  selectfield("Transfer From:",n)
  de=qq
  selectfield("Transfer To:",n)
  err=qq
  qq=0
  wn=0
  bank=1
  IF f$(de,0)=f$(err,0)
    trs$=LEFT$(STR$(de)+"   ",2)+LEFT$(STR$(err)+"   ",2)
  ELSE
    trs$=""
    ~@rteasyrequest("Fields must be of the same type!","Oh!","")
  ENDIF
RETURN
PROCEDURE drawprint
  IF pcode=1   ! Table View
    dprint(3)
    ddprint(4)
    ddprint(8)
  ENDIF
  IF pcode=2  ! Record View
    dprint(4)
    ddprint(3)
    ddprint(8)
  ENDIF
  IF pcode=3 !Form View
    dprint(8)
    ddprint(3)
    ddprint(4)
  ENDIF
  IF pr$="y"
    dprint(1)
  ELSE IF pr$=""
    ddprint(1)
  ENDIF
RETURN
PROCEDURE dprint(st)
  tx$=MID$(box$(st,bank),7)
  gxx=VAL(LEFT$(box$(st,bank),3))
  gyy=VAL(MID$(box$(st,bank),4,3))
  gx1=gxx+LEN(tx$)*8+2
  gy1=gyy+11
  gy1=12
  gx1=LEN(tx$)*8+2
  drawflipbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
  COLOR m3
  TEXT gxx+1,gyy+8,tx$
  GRAPHMODE 3
  TEXT gxx+1,gyy+8,tx$
  GRAPHMODE 1
RETURN
PROCEDURE ddprint(st)
  tx$=MID$(box$(st,bank),7)
  gxx=VAL(LEFT$(box$(st,bank),3))
  gyy=VAL(MID$(box$(st,bank),4,3))
  gx1=gxx+LEN(tx$)*8+2
  gy1=gyy+11
  gy1=12
  gx1=LEN(tx$)*8+2
  drawbevelbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
  COLOR 1
  GRAPHMODE 1
  TEXT gxx+1,gyy+8,tx$
  GRAPHMODE 1
RETURN
PROCEDURE beep
  ~DisplayBeep(0)
RETURN
PROCEDURE fields
  FOR temp&=1 TO n
    select$(temp&)=f$(temp&,1)
  NEXT temp&
RETURN
PROCEDURE info
  chip%=AvailMem(2)
  fast%=AvailMem(4)
  sdd$=DATE$
  mem$=""
  about$(1)="Memory:  CHIP="+STR$(chip%)+" FAST="+STR$(fast%)
  about$(2)="StarDate "+RIGHT$(sdd$,2)+MID$(sdd$,4,2)+"."+LEFT$(sdd$,2)
  stardate$="Time: "+TIME$
  about$(3)="Welcome to dDbase"
  about$(4)="Programmed by Peter Hughes"
  about$(5)=who$
  about$(6)=LEFT$(ul$,37)
  about$(7)="dDbase Has Online Help."
  about$(8)="Press the HELP key for the"
  about$(9)="AmigaGuide Help Function"
  about$(10)=LEFT$(ul$,37)
  about$(11)="OR  F10 For dDbase.GUIDE"
  about$(12)="Or Press `F1' for KeyBoard ShortCuts"
  about$(13)=LEFT$(ul$,37)
  about$(14)=stardate$
  about$(15)="WINDOW: W:"+STR$(winw%)+" H:"+STR$(winh%)
  about$(16)=""
  about$(17)=compile$
  n1=0
  FOR t&=1 TO 17
    IF LEN(about$(t&))>n1
      n1=LEN(about$(t&))
    ENDIF
  NEXT t&
  mess$=""
  FOR t&=1 TO 17
    ll=LEN(about$(t&))
    ii=n1-ll
    sp$=""
    IF ii>0
      ii=INT(ii/2)
      sp$=SPACE$(ii)
    ENDIF
    mess$=mess$+sp$+about$(t&)+CHR$(10)
  NEXT t&
  mess$=LEFT$(mess$,LEN(mess$)-1)
  VOID @rteasyrequest(mess$,"OK!","©MADCAP-SOFTWARE  "+version$)
RETURN
PROCEDURE gfield
  GOSUB form
  fco=0
  FOR ty&=1 TO 59
    l=LEN(form$(ty&))
    FOR tt&=1 TO l
      a$=MID$(form$(ty&),tt&,1)
      IF a$<>" "
        IF MID$(form$(ty&),tt&+1,1)<>" "
          a$=a$+MID$(form$(ty&),tt&+1,1)
          tt&=tt&+2
        ENDIF
        ft=VAL(a$)
        INC fco
        fo(fco)=ft
      ENDIF
    NEXT tt&
  NEXT ty&
RETURN
PROCEDURE cleanstring
  FOR ty&=0 TO n
    a$(ty&)=""
  NEXT ty&
RETURN
PROCEDURE lightson
  COLOR 0
  drawflipbox(LPEEK(WINDOW(wn)+50),84,176+winoff%,26,20)
  COLOR 3
  PBOX 85,177+winoff%,107,194+winoff%
  COLOR 2
  GRAPHMODE 0
  TEXT 90,184+winoff%,"M"
  TEXT 94,192+winoff%,"S"
  GRAPHMODE 1
RETURN
PROCEDURE lightsoff
  COLOR 0
  PBOX 83,177+winoff%,109,196+winoff%
  drawbevelbox(LPEEK(WINDOW(wn)+50),84,176+winoff%,26,20)
  COLOR 0
  text(90,185+winoff%,"M",2,1)
  text(94,193+winoff%,"S",2,1)
RETURN
PROCEDURE checkfont
  ff$="env:sys/font.prefs"
  eex%=0
  IF EXIST(ff$)
    OPEN "i",#15,ff$
    ll%=LOF(#15)
    IF ll%<>518
      eex%=1
    ELSE
      font$=INPUT$(ll%,#15)
      def$=CHAR{V:font$+226}
      def%=PEEK(V:font$+223)
      scr$=CHAR{V:font$+390}
      scr%=PEEK(V:font$+387)
    ENDIF
    CLOSE #15
    IF eex%=0
      IF UPPER$(def$)<>"TOPAZ.FONT" OR def%<>8
        eex%=2
      ELSE IF UPPER$(scr$)<>"TOPAZ.FONT" OR scr%<>8
        eex%=3
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE checkitems
  check$(4,2)=pref$(2)
  FOR tt&=1 TO 6
    check$(tt&,1)=""
  NEXT tt&
  IF EXIST("libs:ilbm.library")
    check$(1,1)="y"
  ELSE
    check$(1,1)="n"
  ENDIF
  IF EXIST("libs:AmigaGuide.library")
    check$(2,1)="y"
  ELSE
    check$(2,1)="n"
  ENDIF
  IF EXIST("c:packit")
    check$(3,1)="y"
  ELSE
    check$(3,1)="n"
  ENDIF
  FOR tt&=1 TO 3
    IF check$(tt&,1)<>"y" AND check$(tt&,1)<>""
      message("Cant find "+check$(tt&,2))
      DELAY 1
      moff
    ENDIF
  NEXT tt&
RETURN
PROCEDURE clrcalc
  FOR t&=1 TO n
    IF f$(t&,0)="10"
      ll=LEN(f$(t&,1))
      x=VAL(f$(t&,2))
      y=VAL(f$(t&,3))
      l=VAL(f$(t&,4))
      PRINT AT(x+LEN(f$(t&,1))+1,y);LEFT$(SPACE$(100),l)
    ENDIF
  NEXT t&
RETURN
PROCEDURE enter
  a$=""
  GOSUB ddisplay
  GOSUB clrcalc
  cleanstring
  temp$=""
  FOR tx&=1 TO n
    t=fo(tx&)
    a$(t)=""
    l=VAL(f$(t,4))
    ll=LEN(f$(t,1))
    x=VAL(f$(t,2))
    y=VAL(f$(t,3))
    IF search%<>1
      TITLEW #0,"Previous Record: "+temp$(t)
    ENDIF
    IF VAL(f$(t,0))=7 AND search%=0   !--------EXTERNAL-------------!
      rtitle$="Select File"
      getfile("")
      nn$=nfile$
      IF ee=0
        a$(t)=nn$
        temp$=CHAR{V:filename$}
        IF LEFT$(pref$(7),1)="y" AND editor$<>""
          a1%=@rteasyrequest("Do you want to edit '<"+a$(t)+">'","Yes|Cancel",version$)
          IF a1%=1
            exec(editor$+" "+a$(t),"Editing Data")
          ENDIF
        ENDIF
      ELSE
        a$(t)=""
      ENDIF
    ENDIF
    IF search%=1 AND f$(t,0)="8"   !----------MEMO-------------!
      rtitle$=f$(t,1)
      ge%=@getstring(79,rtitle$,"")
      IF ge%=1
        a$(t)=rtstring$
      ENDIF
    ENDIF
    IF VAL(f$(t,0))=8 AND search%=0
      GOSUB getmemo
      a$(t)=aa$
      a$=""
      aa$=""
    ENDIF
    IF VAL(f$(t,0))<=3  !------------String/Date/Integer-----------!
      ee=0
      DO
        IF f$(t,0)="3" AND f$(t,5)="6" AND search%=0
          a$=STR$(k+1)
        ENDIF
        ee=0
        PCOLOR filltextpen%,shinepen%
        PRINT AT(x+ll+1,y);SPACE$(VAL(f$(t,4))+1)
        PRINT AT(x+ll+1,y);
        PCOLOR filltextpen%,backgroundpen%
        FORM INPUT l AS a$
        IF a$="<"
          FOR tty&=1 TO n
            tx$(tty&)=a$(tty&)
          NEXT tty&
          t1=t
          ltag%=TRUE
          GOSUB fieldlist(t)
          ltag%=FALSE
          t=t1
          FOR tty&=1 TO n
            a$(tty&)=tx$(tty&)
          NEXT tty&
          a$(t)=at$
          a$=at$
        ENDIF
        IF a$="\\" AND temp$<>""
          a$=temp$
          PRINT AT(x+ll+1,y);SPACE$(l+1)
        ENDIF
        PRINT AT(x+ll+1,y);LEFT$(a$+SPACE$(100),VAL(f$(t,4))+1)
        IF f$(t,5)<>"" AND f$(t,0)="1" AND search%=0  !-----------STRING-----!
          IF f$(t,5)="2"
            a$=UPPER$(a$)  !--------------------------UPPERCASE-----------!
            PRINT AT(x+ll+1,y);a$
          ENDIF
          IF f$(t,5)<>"2"
            paa%=@testrequired(a$,t)  !-----------REQUIRED---------------!
            IF paa%=0
              GOSUB getrequired(t)
              IF qq>gln
                a$=""
                ee=0
              ENDIF
              IF qq<=gln
                a$=select$(qq)
                PRINT AT(x+ll+1,y);LEFT$(a$+SPACE$(80),VAL(f$(t,4)))
                ee=0
              ELSE
                ee=1
              ENDIF
            ENDIF
            bank=1
            wn=0
          ENDIF
        ENDIF
        IF f$(t,0)="3" AND search%=0  !------------------INTEGER---------!
          aa$=a$
          formatnumber(t)
          a$=aa$
          PRINT AT(x+ll+1,y);
          PRINT LEFT$(a$+"              ",VAL(f$(t,4)))
        ENDIF
        IF f$(t,0)="2" AND a$="*" AND search%=0  !-----------DATE----------!
          dd$=DATE$
          IF f$(t,5)="1"
            a$=LEFT$(dd$,2)+"/"+MID$(dd$,4,2)+"/"+RIGHT$(dd$,2)
          ENDIF
          IF f$(t,5)="2" AND search%=0
            a1$=LEFT$(dd$,2)
            a2$=MID$(dd$,4,2)
            a2$=month$(VAL(a2$))
            a3$=RIGHT$(dd$,4)
            a$=a1$+" "+a2$+" "+a3$
          ENDIF
          PRINT AT(x+ll+1,y);
          PRINT a$
        ENDIF
        IF a$=">"
          ee=0
          a$=temp$(t)
          PRINT AT(x+ll+1,y);LEFT$(a$+SPACE$(100),VAL(f$(t,4))+1)
        ENDIF
        a$(t)=a$
        IF f$(t,0)="2" AND search%=0
          ee=0
          aa$=a$
          GOSUB gdate(t)
          a$=aa$
          IF ee=1
            VOID @rteasyrequest("WRONG DATE FORMAT","OK!",version$)
            a$=""
            aa$=""
          ENDIF
          a$=aa$
        ENDIF
      LOOP UNTIL ee=0
      a$=""
    ENDIF
  NEXT tx&
  TITLEW #0,wtitle$
RETURN
PROCEDURE edit
  flag=0
  FOR tx&=1 TO n
    t=fo(tx&)
    fv=VAL(f$(t,0))
    l=VAL(f$(t,4))
    ll=LEN(f$(t,1))
    x=VAL(f$(t,2))
    y=VAL(f$(t,3))
    IF fv<=3    !----String/Date/Integer----!
      PRINT AT(x+ll+1,y);
      IF f$(t,0)="3" AND VAL(f$(t,5))=>4 !---Integer-----!
        PRINT LEFT$(a$(t)+SPACE$(50),l)
        PRINT AT(x+ll+1,y);
      ENDIF
      FORM INPUT l AS a$(t)
    ENDIF
    ee=0
    IF f$(t,5)<>"" AND f$(t,0)="1" !--String/Required----!
      IF f$(t,5)="2"
        a$(t)=UPPER$(a$(t))        !---String/UpperCase----!
        PRINT AT(x+ll+1,y);a$(t)
      ENDIF
      IF f$(t,5)<>"2"
        DO
          paa%=@testrequired(a$(t),t) !---String Required (Check)---!
          IF paa%=0
            GOSUB getrequired(t)
            IF qq<=gln
              a$=select$(qq)
              ll=LEN(f$(t,1))
              PRINT AT(x+ll+1,y);
              PRINT LEFT$(a$+SPACE$(75),VAL(f$(t,4)))
              ee=0
              a$(t)=a$
            ELSE
              ee=1
            ENDIF
          ENDIF
        LOOP UNTIL ee=0
      ENDIF
      bank=1
      wn=0
    ENDIF
    IF f$(t,0)="3"      !----Integer------!
      aa$=a$(t)
      PRINT AT(x+ll+1,y);SPACE$(VAL(f$(t,4)))
      formatnumber(t)
      a$(t)=aa$
      PRINT AT(x+ll+1,y);
      IF VAL(f$(t,5))=>4  !-------Currency----!	
L€ŕ FFLYŕ
        PRINT SPACE$(ll)
        PRINT AT(x+ll+1,y);
      ENDIF
      PRINT LEFT$(a$(t)+SPACE$(80),VAL(f$(t,4)))
    ENDIF
    IF f$(t,0)="2" AND a$(t)="*"   !----Date----!
      a$=a$(t)
      dd$=DATE$
      IF f$(t,5)="1"
        a$=LEFT$(dd$,2)+"/"+MID$(dd$,4,2)+"/"+RIGHT$(dd$,6)
      ENDIF
      IF f$(t,5)="2"
        a1$=LEFT$(dd$,2)
        a2$=MID$(dd$,4,2)
        a2$=month$(VAL(a2$))
        a3$=RIGHT$(dd$,4)
        a$=a1$+" "+a2$+" "+a3$
      ENDIF
      PRINT AT(x+ll+1,y);
      PRINT a$
      a$(t)=a$
    ENDIF
    IF fv=>7     !---------External/Memo----------!
      IF fv=7   !-----External----!
        ee=0
        sss$=a$(t)
        ge%=@getstring(120,"External Field: "+f$(t,1),sss$)
        IF ge%=1
          sss$=rtstring$
        ENDIF
        IF sss$="*"
          rtitle$="Select File"
          getfile("")
          IF ee=0
            sss$=nfile$
          ENDIF
        ENDIF
        a$(t)=sss$
        IF LEFT$(pref$(7),1)="y" AND fv=7 AND editor$<>""
          IF EXIST(a$(t)) AND a$(t)<>""
            checkiff(a$(t))
            eee=1
            IF ee=0
              checkascii(a$(t))
            ENDIF
            IF ee=0 AND eee=0
              a1%=@rteasyrequest("Do you want to Edit '<"+a$(t)+">'","Yes|Cancel",version$)
              IF a1%=1
                exec(editor$+" "+a$(t),"Editing Data")
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      IF fv=8   !-------------Memo------------!
        flag=0
        wind=1
        GOSUB editmemo
        wind=0
      ENDIF
    ENDIF
  NEXT tx&
RETURN
PROCEDURE break
  a%=0
  moff
  IF sit%=1
    a%=1
    aa%=@rteasyrequest("WARNING WIL ROBINSON"+CHR$(10)+"Database Not Saved","Exit|Cancel",version$)
    IF aa%=1
      a%=0
    ENDIF
  ENDIF
  IF a%=0
    qq=@rteasyrequest(" Well Smoke Me A Kipper!!"+CHR$(10)+"Do you really want to quit?","Yes|No",version$)
  ENDIF
  IF qq=1
    message(UPPER$("I'll be back for breakfast!!"))
    GOSUB cleanup
    IF EXIST("t:ddbaseisrunning")
      KILL "t:ddbaseisrunning"
    ENDIF
    CLOSEW #3
    CLOSEW #2
    CLOSEW #1
    CLOSEW #0
    CLOSES 1
    IF EXIST("ram:ALL_FILES")
      KILL "ram:ALL_FILES"
    ENDIF
    IF EXIST("ram:clip")
      KILL "ram:clip"
    ENDIF
    IF EXIST("ram:ddclip")
      KILL "ram:ddclip"
    ENDIF
    IF EXIST("ram:tfile")
      KILL "ram:tfile"
    ENDIF
    IF EXIST("ram:wizard")
      KILL "ram:wizard"
    ENDIF
    IF EXIST("t:lb")
      KILL "t:lb"
    ENDIF
    IF EXIST("ram:unarc")
      KILL "ram:unarc"
    ENDIF
    IF EXIST("t:ddbase_temp")
      KILL "t:ddbase_temp"
    ENDIF
    ff$=prog$
    moff
    EDIT
  ENDIF
RETURN
PROCEDURE helpit
  aa$=""
  mess$=""
  l=LEN(compare$(bank))
  IF bank=1
    box$(25,1)="      View Field"
    box$(26,1)="      UnArchive"
    box$(27,1)="      Transfer"
  ENDIF
  FOR htr&=1 TO l
    hel$=MID$(compare$(bank),htr&,1)
    IF hel$=CHR$(27)
      hel$="Esc"
    ENDIF
    IF hel$=" "
      hel$="Spc"
    ENDIF
    IF hel$=CHR$(8)
      hel$="BackSPC"
    ENDIF
    IF hel$=CHR$(13)
      hel$="Cr"
    ENDIF
    IF bank>1
      mess$=mess$+LEFT$(hel$+"          ",8)+"-------  "+MID$(box$(htr&,bank),7)+CHR$(10)
    ELSE IF bank=1
      mess$=mess$+LEFT$(hel$+"          ",8)+"-------  "+MID$(box$(htr&,bank),7)+"|"
    ENDIF
  NEXT htr&
  IF bank=1
    box$(25,1)=""
    box$(26,1)=""
    box$(27,1)=""
  ENDIF
  title$="SHORTCUT      GADGET"
  IF bank>1
    ~@rteasyrequest(mess$,"Ok",sas$)
  ELSE IF bank=1 !Was pcode=1
    flag=1
    GOSUB unpackrequired(mess$)
    displayit(gln,title$)
  ENDIF
  qq=0
RETURN
PROCEDURE runhelp(help$)
  IF EXIST(help$)
    ex$=guide$+" "+help$
    EXEC ex$,-1,-1
  ELSE
    temp%=29-LEN(help$)
    temp%=temp%/2
    ~@rteasyrequest("HELP UNAVAILABLE: CANT FIND-"+CHR$(10)+CHR$(10)+SPACE$(temp%)+UPPER$(help$),"OK",version$)
  ENDIF
RETURN
PROCEDURE help
  IF bank=10
    IF org%=0 AND EXIST("selector.doc")
      external("selector.doc")
      wn=7
      bank=10
    ELSE IF org%=1
      runhelp("organise.guide")
    ENDIF
  ENDIF
  IF bank=2 AND EXIST("search.doc")
    external("search.doc")
    wn=1
    bank=2
  ENDIF
  IF bank=1 AND k=0
    lightson
    runhelp("ddbase.guide")
    lightsoff
  ENDIF
  IF bank=1 AND k>0
    lightson
    runhelp("main.guide")
    lightsoff
  ENDIF
  IF bank=3
    runhelp("print.guide")
    bank=3
    wn=1
  ENDIF
  IF bank=7
    runhelp("preferences.guide")
    bank=7
    wn=2
  ENDIF
  OPENW #wn
  qq=0
RETURN
FUNCTION displayalert(dis$)
  LOCAL l%
  dis$=SPACE$(2)+dis$
  dis$=LEFT$(dis$+SPACE$(80),77)
  l%=LEN(dis$)
  str%=MALLOC(l%,2)
  FOR t=1 TO l%
    q=ASC(MID$(dis$,t,1))
    POKE str%+t,q
  NEXT t
  re%=DisplayAlert(2,str%,60)
  RETURN re%
  ~MFREE(str%,l%)
ENDFUNC
PROCEDURE errors
  moff
  endgauge
  IF bank=5 AND brain%=7
    RESUME jump10
  ENDIF
  IF brain%=4
    CLOSE #1
    RESUME jump1
  ENDIF
  IF ERR=26 AND brain%=1
    RESUME jump4
  ENDIF
  IF ERR=26 AND brain%=2
    RESUME jump3
  ENDIF
  IF ERR=26 AND brain%=3
    RESUME jump2
  ENDIF
  IF ERR<=250 AND EXIST("progdir:errors")
    OPEN "i",#13,"progdir:errors"
    ee=ERR
    FOR eer=1 TO ee
      LINE INPUT #13,ee$
    NEXT eer
    CLOSE #13
    ee$=UPPER$(ee$)
  ENDIF
  ex$=ERR$(ERR)
  location$="Location: "+STR$(wn)+" , "+STR$(bank)
  a%=@rteasyrequest("MEMORY: "+STR$(FRE(0))+CHR$(10)+"An Error Has Occurred"+CHR$(10)+ex$+CHR$(10)+"Error No."+STR$(ERR)+CHR$(10)+"{"+ee$+"}"+CHR$(10)+location$,"Exit!","dDbase ERROR")
  ~@rteasyrequest(STR$(fl%)+"<FL | LL> "+STR$(ll%),"OK","")
  INC errm
  IF ERR=8
    INC errm
  ENDIF
  wn=0
  bank=1
  DEFMOUSE (msp1%)
  CLOSE #13
  CLOSEW #1
  CLOSEW #2
  CLOSEW #5
  CLOSE #1
  CLOSE #6
  CLOSE #15
  CLOSEW #10
  IF errm>1
    ~@displayalert("       FATAL ERROR:  Sorry Unable to Resume dDbase")
    IF file$<>"" AND sit%=1 AND errm>1
      rtitle$="Save File"
      filing
      IF ee=0
        CHDIR "progdir:"
        GOSUB savit
      ENDIF
    ENDIF
    CHDIR "progdir:"
    OPEN "o",#15,"error-help"
    PRINT #15,ERR,location$
    CLOSE #15
    GOSUB cleanup
    IF EXIST("t:ddbaseisrunning")
      KILL "t:ddbaseisrunning"
    ENDIF
    IF EXIST("ram:wizard")
      KILL "ram:wizard"
    ENDIF
    IF EXIST(destination$+"file.pw")
      KILL destination$+"file.pw"
    ENDIF
    EDIT
  ENDIF
  CLS
  kk=1
  GOSUB display
  GOSUB presentdisplay
  RESUME start
RETURN
PROCEDURE stats
  mess$=""
  mess$="FileName: "+file$+"   WINDOW: W:"+STR$(winw%)+" H:"+STR$(winh%)+CHR$(10)
  mess$=mess$+STR$(k)+" Records  : "+STR$(n)+" Fields  "+STR$(tf)+" Selected Fields"+CHR$(10)
  mess$=mess$+"-----------------------------------------------------------"+CHR$(10)
  FOR t=1 TO n
    me=VAL(f$(t,0))
    me1$="    "
    IF f$(t,0)="2" OR f$(t,0)="3"
      me1$=f$(t,5)
    ENDIF
    IF f$(t,0)="1" AND f$(t,5)>"" AND f$(t,5)<>"2"
      me1$="Req"
    ENDIF
    mess$=mess$+LEFT$(f$(t,1)+SPACE$(40),30)+"|"+LEFT$(dtype$(me)+SPACE$(20),15)+"|"+LEFT$(f$(t,4)+SPACE$(10),7)+me1$+CHR$(10)
  NEXT t
  a%=@rteasyrequest(mess$,"OK!|Print|Selected-Fields|Status|OK!","      Field                      Type          Length   NType")
  IF a%=3 AND tf>0
    mess$=""
    FOR t=1 TO tf
      me=VAL(f$(tr(t,1),0))
      mess$=mess$+LEFT$(f$(tr(t,1),1)+SPACE$(40),35)+"|"+LEFT$(dtype$(me)+SPACE$(20),20)+"|"+STR$(tr(t,2))+CHR$(10)
    NEXT t
    aa%=@rteasyrequest(mess$,"OK!|PRINT|OK!","      Field                           Type               Length")
    IF aa%=2
      LPRINT mess$
    ENDIF
  ENDIF
  IF a%=2
    LPRINT mess$
  ENDIF
  IF a%=4
    GOSUB status
  ENDIF
RETURN
PROCEDURE status
  mess$=""
  chip%=AvailMem(2)
  fast%=AvailMem(4)
  fr%=FRE(4)
  IF k>0
    mm%=0
    FOR mx=1 TO n
      mm%=mm%+VAL(f$(mx,4))
    NEXT mx
    IF mm%>0
      maf%=startmem%/mm%
    ENDIF
    IF maf%>max%
      maf%=max%
    ENDIF
  ENDIF
  mess$="                Status"+CHR$(10)+"                ~~~~~~"+CHR$(10)+CHR$(10)
  mess$=mess$+"Program Memory -"+CHR$(10)+"  Free:"+STR$(fr%)+"    Current Database:"+STR$(startmem%-fr%)+CHR$(10)+CHR$(10)
  mess$=mess$+"System Memory -"+CHR$(10)+"  Chip:"+STR$(chip%)+"     Fast:"+STR$(fast%)+CHR$(10)+CHR$(10)
  mess$=mess$+"Current Files -"+CHR$(10)+CHR$(10)+"  Current: "+STR$(k)+CHR$(10)+"  Maximum Files (Approx) :"+STR$(max%)+CHR$(10)
  mess$=mess$+"  Estimated Max Files="+STR$(maf%)+CHR$(10)+CHR$(10)+"  Each Record ="+STR$(mm%)+" BYTES"
  temp%=@rteasyrequest(mess$,"Ok|Print|Ok",version$)
  IF temp%=2
    LPRINT mess$
  ENDIF
RETURN
PROCEDURE replace
  replace%=0
  wn=2
  ypos%=winh%-100
  ypos%=ypos%/2
  OPENW #2,130,ypos%,380,100,&H80000+&H40000,4096+65536+&H2
  TITLEW #2,version$
  wn=2
  dbbox(10,16,362,80)
  COLOR 1
  text(114,20,"SEARCH AND REPLACE",1,2)
  text(140,38,"Search For",1,2)
  text(134,70,"Replace With",1,2)
  drawflipbox(LPEEK(WINDOW(wn)+50),24,74,329,10)
  drawbevelbox(LPEEK(WINDOW(wn)+50),23,73,331,12)
  drawflipbox(LPEEK(WINDOW(wn)+50),24,42,329,10)
  drawbevelbox(LPEEK(WINDOW(wn)+50),23,41,331,12)
  ee=0
  DO
    ee=0
    find$=""
    change$=""
    PCOLOR 1,m3
    PRINT AT(4,5);SPACE$(40)
    PCOLOR 1,0
    PRINT AT(4,5);
    FORM INPUT 40 AS find$
    IF LEFT$(find$,1)="(" AND RIGHT$(find$,1)=")"
      find$=CHR$(VAL(MID$(find$,2,LEN(find$)-2)))
    ENDIF
    PRINT AT(4,5);LEFT$(find$+SPACE$(40),40)
    PCOLOR 1,m3
    PRINT AT(4,9);SPACE$(40)
    PRINT AT(4,9);
    PCOLOR 1,0
    FORM INPUT 40 AS change$
    PRINT AT(4,9);LEFT$(change$+SPACE$(40),40)
    IF find$=change$
      ~@rteasyrequest(find$+"  "+change$+CHR$(10)+"They both cannot be the same!","Error",version$)
      ee=1
    ENDIF
  LOOP UNTIL ee=0
  CLOSEW #2
  a%=@rteasyrequest("Change `"+find$+"'"+CHR$(10)+"To `"+change$+"'","OK!|Ask!|Cancel","Search+Replace")
  IF a%=>1
    que%=@rteasyrequest("Search All?","All|Select","Search & Replace")
    IF que%=0
      GOSUB fields
      GOSUB selectfield("Select Field",n)
      self%=qq
    ENDIF
    TITLEW #0,"CHANGING: "+find$+" TO: "+change$+"  Please Wait..."
    sit%=1
    dsit%=1
    k1=kk
    startgauge(k,"Replacing...`"+find$+"'")
    OPENW #0
    DEFMOUSE (2)
    ll=LEN(find$)
    FOR kk=1 TO k
      gauge
      GOSUB unpack
      FOR t=1 TO n
        aa%=0
        bb%=0
        IF que%=0
          t=self%
        ENDIF
        DO
          aa%=INSTR(a$(t),find$,bb%)
          IF aa%>0
            abb%=1
            IF a%=2
              prdisplay
              abb%=@rteasyrequest("Change This Record","Ok|Next|Cancel","RECORD:"+STR$(kk))
              CLOSEW #1
              IF abb%=2
                IF LEN(find$)<=bb%+LEN(find$)
                  t=t+1
                ENDIF
                bb%=bb%+LEN(find$)+1
              ENDIF
              IF abb%=0
                kk=k+1
                t=n+1
              ENDIF
            ENDIF
            bb%=aa%+LEN(find$)+1
            IF abb%=1
              replace%=replace%+1
              a$(t)=LEFT$(a$(t),aa%-1)+change$+MID$(a$(t),aa%+ll)
              bb%=bb%+1
            ENDIF
          ENDIF
        LOOP UNTIL aa%=0
        IF que%=0
          t=n+1
        ENDIF
      NEXT t
      w$(kk)=""
      GOSUB pack
    NEXT kk
    endgauge
    DEFMOUSE (msp1%)
    message("Replaced: "+STR$(replace%)+" Items")
    DELAY 2
    moff
    kk=k1
  ENDIF
RETURN
PROCEDURE prdisplay
  LOCAL dislen%
  dislen%=0
  fic%=0
  tot%=0
  tot1%=0
  FOR tty=1 TO n
    IF f$(tty,0)="8"
      tot1%=VAL(f$(tty,4))
      tot%=tot1%/79
    ENDIF
    INC fic%
    IF LEN(a$(tty))>dislen%
      dislen%=LEN(a$(tty))
    ENDIF
  NEXT tty
  IF tot%>0
    fic%=fic%+tot%
  ENDIF
  fic%=fic%*8+40
  IF fic%>winh%
    fic%=winh%
  ENDIF
  INC dislen%
  dislen%=INT(dislen%*8)+20
  IF dislen%>640
    dislen%=640
  ENDIF
  tl%=(640-dislen%)/2
  OPENW #1,tl%,0,dislen%,fic%,0,4096
  TITLEW #1,"Record:"+STR$(kk)
  FOR tty=1 TO n
    IF tty=t
      FOR ytt=1 TO LEN(a$(tty))
        IF ytt=aa%
          PCOLOR 2,3
          PRINT "{";
        ENDIF
        PRINT MID$(a$(tty),ytt,1);
        IF ytt=aa%+LEN(find$)-1
          PRINT "}";
          PCOLOR 1,0
        ENDIF
      NEXT ytt
      PRINT
    ENDIF
    IF tty<>t
      PRINT a$(tty)
    ENDIF
  NEXT tty
RETURN
PROCEDURE msg
  IF MENU(1)=512 AND bank=12
    q$=CHR$(27)
    bbuff%=1
  ENDIF
  IF MENU(1)=512 AND bank=15
    q$=CHR$(27)
  ENDIF
  IF MENU(1)=512 AND bank=9 !Listview
    gxl=3
    ee=1
  ENDIF
  IF MENU(1)=512 AND fredd%=1
    xx=1
  ENDIF
  IF fredd%=0
    IF MENU(1)=512 AND bank=5
      qq=4
    ENDIF
    IF MENU(1)=512 AND bank=0
      filetag%=0
    ENDIF
    IF MENU(1)=512 AND bank=7  !Prefs
      qq=11
      ~MOUSEK=1
    ENDIF
    IF MENU(1)=512 AND bank=5
      qq=4
      ~MOUSEK=1
    ENDIF
    IF MENU(1)=512 AND bank=10 !Select field
      qq=gkn+1
    ENDIF
    IF MENU(1)=512 AND bank=1
      GOSUB break
    ENDIF
  ENDIF
  GOSUB wait_port
RETURN
PROCEDURE wait_port
  userport%=LONG{WINDOW(wn)+86}
  ~WaitPort(userport%)
  ON MESSAGE GOSUB msg
RETURN
PROCEDURE clearscreen
  COLOR 0
  PBOX 12,12,628,157+winoff%
RETURN
PROCEDURE exec(ex$,pee$)
  IF pee$<>""
    message(pee$)
  ENDIF
  ypos%=144+winoff%
  yp$="con:0/"+STR$(ypos%)+"/640/56/dDbase Output"
  OPEN "o",#7,yp$
  EXEC ex$,-1,7
  CLOSE #7
  IF pee$<>""
    moff
  ENDIF
RETURN
' ---------------------------------------Required-----------------------------
FUNCTION testrequired(test$,tt)
  test%=0
  unpackrequired(f$(tt,5))
  FOR temp%=1 TO gln
    IF select$(temp%)=test$
      test%=temp%
    ENDIF
  NEXT temp%
  IF test%=0 AND test$<>""
    question1%=@rteasyrequest(test$+CHR$(10)+"Do you wish to add this file to the List?","Add|Cancel",version$)
    IF question1%=1
      f$(tt,5)=f$(tt,5)+test$+":"
      test%=1
      qu%=@rteasyrequest("Do you want to sort the list?","Sort|Cancel",version$)
      IF qu%=1
        unpackrequired(f$(tt,5))
        GOSUB sortrequired(gln)
        ed$=""
        FOR stb=1 TO gln
          ed$=ed$+select$(stb)+":"
        NEXT stb
      ENDIF
      f$(tt,5)=ed$
    ENDIF
  ENDIF
  RETURN test%
ENDFUNC
PROCEDURE unpackrequired(unpack$)
  ppx=0
  gln=0
  DO
    IF flag=1
      ppx=INSTR(unpack$,"|")
    ENDIF
    IF flag=0
      ppx=INSTR(unpack$,":")
    ENDIF
    IF ppx>0
      INC gln+
      select$(gln)=LEFT$(unpack$,ppx-1)
      unpack$=MID$(unpack$,ppx+1)
    ENDIF
  LOOP UNTIL ppx=0
RETURN
PROCEDURE getrequired(tk)
  unpackrequired(f$(tk,5))
  stx$="Required Text"
  listview(gln,"Required Text")
  qq=m5
  stx$=""
RETURN
PROCEDURE editrequired(rf)
  flag=0
  ed$=f$(rf,5)
  IF ed$<>"2"
    IF tempmax%=0
      tempmax%=30
    ENDIF
    IF tempmax%>55
      message("Field Length to Long: Shortened")
      DELAY 1
      moff
      tempmax%=55
    ENDIF
    twit=tempmax%*8+10
    idiot=(640-(twit+110))/2
    wwn=wn
    wn=10
    unpackrequired(f$(rf,5))
    OPENW #10,idiot,0,twit+110,winh%,0,4096
    tw$=" Blank Line to Exit "+STR$(gln)+" Entries"
    TITLEW #10,tw$
    PRINT
    FOR tt=1 TO gln
      PRINT "      ";LEFT$(select$(tt),tempmax%)
      IF tt=>maxlin1%
        tt=gln+1
      ENDIF
    NEXT tt
    PRINT AT(0,0);
    PRINT
    drawbevelbox(LPEEK(WINDOW(wn)+50),7,14,twit+96,180+winoff%)
    count=1
    tt=0
    DO
      INC tt
      INC count
      IF tt<=gln
        q$=select$(tt)
      ELSE
        q$=""
      ENDIF
      flipbox(2,48,count*8+2,twit+2,9)
      IF tt>gln
        tw$=" Blank Line to Exit "+STR$(tt)+" Entries"
        TITLEW #10,tw$
        PCOLOR 1,clc
        PRINT AT(7,count);SPACE$(tempmax%)
        PCOLOR 1,0
      ENDIF
      PRINT AT(7,count);
      FORM INPUT tempmax% AS q$
      TEXT 36,count*8+10,SPACE$(tempmax%+3)
      TEXT 48,count*8+8,LEFT$(q$+SPACE$(78),tempmax%+4)
      select$(tt)=q$
      IF count=>maxlin1%
        CLS
        PRINT
        tempcount=0
        FOR tx=tt+1 TO gln
          PRINT "      ";LEFT$(select$(tx),tempmax%)
          tempcount=tempcount+1
          IF tempcount=>maxlin1%
            tx=gln+1
          ENDIF
        NEXT tx
        PRINT AT(0,0);
        PRINT
        drawbevelbox(LPEEK(WINDOW(wn)+50),7,14,twit+96,180+winoff%)
        count=1
      ENDIF
      IF tt<=gln
        IF q$=""
          q$="-"
        ENDIF
      ENDIF
    LOOP UNTIL q$="" OR tt=54
    ed$=""
    tt=tt-1
    newcount=0
    FOR t=1 TO tt
      IF select$(t)<>""
        INC newcount
        select$(newcount)=select$(t)
      ENDIF
    NEXT t
    tt=newcount
    qu%=@rteasyrequest("Shall I sort the List?","Sort|Don't",version$)
    IF qu%=1
      GOSUB sortrequired(tt)
    ENDIF
    FOR t=1 TO tt
      ed$=ed$+select$(t)+":"
    NEXT t
    f$(rf,5)=ed$
    CLOSEW #10
    wn=wwn
  ENDIF
RETURN
PROCEDURE sortrequired(ttx)
  QSORT select$(),ttx+1
RETURN
' --------------------------------------System---------------------------------
PROCEDURE displayallfields
  IF tv%>0
    IF dsit%=0 AND EXIST("ram:ALL_FILES")
      EXEC guide$+" ram:ALL_FILES",-1,-1
    ELSE
      dsit%=0
      IF EXIST("ram:ALL_FILES")
        KILL "ram:ALL_FILES"
      ENDIF
      k9=0
      infol=kk
      tempk%=1
      message("Working:")
      aa$=SPACE$(11)
      FOR ttt&=1 TO n
        tt&=fo(ttt&)
        IF VAL(f$(tt&,0))<=3 OR VAL(f$(tt&,0))=7
          aa$=aa$+LEFT$(f$(tt&,1)+SPACE$(500),VAL(f$(tt&,4)))+"|"
        ENDIF
      NEXT ttt&
      IF LEN(aa$)=>78
        OPEN "o",#15,"ram:ALL_FILES"
        PRINT #15,"@database screenoutput"
        PRINT #15,"@node main "+CHR$(34)+filetitl$+" -----------  dDBase ©MadCap-Software"+CHR$(34);""
        PRINT #15;aa$
        PRINT #15;STRING$(LEN(aa$),45)
      ELSE
        select$(tempk%)=aa$
        h$=MID$(aa$,2)
        tempk%=tempk%+1
        select$(tempk%)=STRING$(LEN(aa$),45)
      ENDIF
      FOR kk=1 TO k
        tempk%=tempk%+1
        GOSUB unpack
        aa$="RECORD "+LEFT$(STR$(kk)+SPACE$(5),4)
        FOR ttt&=1 TO n
          tt&=fo(ttt&)
          ff&=VAL(f$(tt&,0))
          tty&=VAL(f$(tt&,4))
          IF ff&<=3 OR ff&=7
            aa$=aa$+LEFT$(a$(tt&)+SPACE$(tty&),tty&)+"|"
          ENDIF
        NEXT ttt&
        IF LEN(aa$)>78
          PRINT #15,aa$
        ELSE
          k9=1
          select$(tempk%)=aa$
        ENDIF
      NEXT kk
      IF k9=0
        PRINT #15,"@endnode"
        CLOSE #15
      ENDIF
      moff
      IF EXIST("ram:ALL_FILES") AND k9=0
        EXEC guide$+" ram:ALL_FILES",-1,-1
        kk=tt1
      ELSE IF k9=1
        GOSUB listview(k+2,h$)
        kk=tag%-2
        wn=0
        bank=1
        GOSUB presentdisplay
      ENDIF
    ENDIF
  ENDIF
  qq=0
  wn=0
  bank=1
RETURN
PROCEDURE createfile
  tt1=kk
  fields
  stx$="Field Selector"
  selectfield("Select Field",n)
  sf=qq
  temp$="ASCII DATA|Final Copy|Protext|WordsWorth|ProWrite|Labels|"
  flag=1
  GOSUB unpackrequired(temp$)
  stx$="OutPut To-"
  selectfield("Mail List",gln)
  eex2=qq
  IF eex2<6
    rtitle$="Create Mail List"
    getfile("")
  ENDIF
  IF eex2=1
    aa%=@getstring(4,"Enter Seperator ($=Value)",",")
    IF aa%=1
      IF LEFT$(rtstring$,1)="$"
        rtstring$=CHR$(VAL(MID$(rtstring$,2)))
      ENDIF
      sep$=rtstring$
    ENDIF
  ENDIF
  flag=0
  FOR kk=1 TO k
    unpack
    IF VAL(f$(sf,0))=8
      i%=INSTR(a$(sf),CHR$(174))
      IF i%>0
        a$(sf)=LEFT$(a$(sf),i%-1)
      ENDIF
    ENDIF
    select$(kk)=a$(sf)+" "
  NEXT kk
  gln=k
  eext=1
  start=1
  m5=0
  eey=0
  IF eex2<6
    eey=@rteasyrequest("Do you want to print Labels as well?","Yes|No",version$)
  ENDIF
  DO UNTIL m5>gln
    GOSUB listview(k,"List Field: "+f$(sf,1))
    ee=0
    IF m5<=gln AND LEFT$(select$(tag%),1)<>"*"
      select$(tag%)="*"+LEFT$(select$(tag%),LEN(select$(tag%))-1)
      PAUSE 5
      ee=1
    ENDIF
    IF m5<=gln AND LEFT$(select$(tag%),1)="*" AND ee=0
      select$(tag%)=MID$(select$(tag%),2)+" "
      PAUSE 5
    ENDIF
    ee=0
  LOOP
  IF eex2<6
    OPEN "o",#13,nfile$
  ENDIF
  IF eex2=2
    GOSUB fcstart
  ENDIF
  IF eex2=6 OR eey=1
    ~@rteasyrequest("Please Make Sure the Printer is ready to Print the Labels","OK",version$)
    GOSUB labelstart
  ENDIF
  FOR county=1 TO k
    IF LEFT$(select$(county),1)="*"
      kk=county
      GOSUB unpack
      IF eex2=1
        GOSUB xpasciiout
      ELSE IF eex2=2
        GOSUB fcout
      ELSE IF eex2=3
        GOSUB prout
      ELSE IF eex2=4
        GOSUB wwout
      ELSE IF eex2=5
        GOSUB pwout
      ELSE IF eex2=6
        GOSUB labelout
      ENDIF
      IF eex2<6 AND eey=1
        GOSUB labelout
      ENDIF
    ENDIF
  NEXT county
  IF eex2<6
    CLOSE #13
  ENDIF
  IF eex2=6 OR eey=1
    GOSUB labelend
  ENDIF
  IF eex2=3
    GOSUB prend
  ENDIF
  eext=0
  kk=tt1
RETURN
PROCEDURE fieldlist(sf)
  ~DisplayBeep(0)
  start1=kk
  FOR kk=1 TO k
    unpack
    IF VAL(f$(sf,0))=8
      i%=INSTR(a$(sf),CHR$(174))
      IF i%>0
        a$(sf)=LEFT$(a$(sf),i%-1)
      ENDIF
    ENDIF
    select$(kk)=a$(sf)
  NEXT kk
  gln=k
  eext=3
  start=start1
  GOSUB listview(k,"List Field: "+f$(sf,1))
  eext=0
  IF tag%>0 AND tag%<=k AND ltag%=FALSE
    kk=tag%
  ELSE
    kk=start1
  ENDIF
  IF ltag%=TRUE
    at$=select$(tag%)
    kk=start1
  ENDIF
RETURN
PROCEDURE listfield
  IF k>0 AND n>0
    start1=kk
    stx$=""
    GOSUB fields
    GOSUB selectfield("List Field",n)
    IF qq>0 AND qq<=n AND VAL(f$(qq,0))<=3 OR VAL(f$(qq,0))=>7
      sf=qq
      FOR kk=1 TO k
        unpack
        IF VAL(f$(sf,0))=8
          i%=INSTR(a$(sf),CHR$(174))
          IF i%>0
            a$(sf)=LEFT$(a$(sf),i%-1)
          ENDIF
        ENDIF
        select$(kk)=a$(sf)
      NEXT kk
      GOSUB listview(k,"List Field: "+f$(sf,1))
      DELAY 1
      IF tag%>0 AND tag%<=k
        kk=tag%
      ELSE
        kk=start1
      ENDIF
      GOSUB presentdisplay
    ENDIF
  ENDIF
RETURN
PROCEDURE mwin
  OPENW #0,0,0,640,200,&H80000+&H40000+512,&H4+4096+65536+&H8+&H2
  TITLEW #0,title$,"dDBase  ©MadCap-SoftWare 27 June 1997"
  FULLW #0
  LPOKE (ADD(FindTask(0),184)),WINDOW(0)
  adr%=WINDOW(0)
  winw%=DPEEK(adr%+8)
  winh%=DPEEK(adr%+10)
  IF winh%<200
    winh%=200
  ENDIF
  IF winw%<640
    ~@displayalert(" Can't Open Window:  "+STR$(winw%)+" X "+STR$(winh%))
    cleanup
    CLOSEW #0
    EDIT
  ENDIF
  IF winw%>640
    winw%=640
    SIZEW #0,winw%,winh%
  ENDIF
  lview%=14
  IF winh%=>400
    lview%=40
  ENDIF
  IF winh%=>512
    lview%=50
  ENDIF
  IF winh%=256
    lview%=20
  ENDIF
  IF lview%=0
    lview%=20
  ENDIF
  maxwh%=winh%
  totline%=winh%/8
  winoff%=winh%-200
  maxlin%=winh%/12.8
  maxlin1%=INT(winh%/10)+1
  maxlin2%=(200+winoff%)-42
  maxlin3%=(maxlin2%/8)-1
  tl=winh%/8
  tl=tl/2
  tl=tl-2
RETURN
PROCEDURE sortit
  y%=1
  n%=k
  DO WHILE y%<n%
    y%=2*y%
  LOOP
  DO
    y%=(y%-1)/2
    IF y%=0
      GOTO 61090   !return
    ENDIF
    it%=n%-y%
    FOR i=1 TO it%
      j%=i
      61040:
      z%=j%+y%
      IF a%=1
        IF UPPER$(TRIM$(MID$(w$(j%),pointer,length)))<UPPER$(TRIM$(MID$(w$(z%),pointer,length)))
          GOSUB changesort
          IF j%>0
            GOTO 61040
          ENDIF
        ENDIF
      ENDIF
      IF a%=2
        IF VAL(MID$(w$(j%),pointer,length))<VAL(MID$(w$(z%),pointer,length))
          GOSUB changesort
          IF j%>0
            GOTO 61040
          ENDIF
        ENDIF
      ENDIF
    NEXT i
  LOOP
  61090:
RETURN
PROCEDURE newsort(sf)
  ~SetTaskPri(FindTask(0),8)
  a%=0
  IF f$(sf,0)="1"
    a%=1
  ENDIF
  IF f$(sf,0)="2" OR f$(sf,0)="3"
    a%=2
  ENDIF
  IF a%>0 AND sf>0
    wn=0
    lightson
    sit%=1
    dsit%=1
    TITLEW #0,"SORTING PLEASE WAIT"
    DEFMOUSE (2)
    GOSUB getpoint
    order%=@rteasyrequest("Sort <"+UPPER$(f$(sf,1))+"> in What Order?","Ascending|Descending",version$)
    message("Sorting Field: ĺ"+f$(sf,1))
    IF order%=0
      GOSUB sortit
    ELSE
      y%=1
      n%=k
      DO WHILE y%<n%
        y%=2*y%
      LOOP
      DO
        y%=(y%-1)/2
        IF y%=0
          GOTO 51090   !return
        ENDIF
        it%=n%-y%
        FOR i=1 TO it%
          j%=i
          51040:
          z%=j%+y%
          IF a%=1
            IF UPPER$(TRIM$(MID$(w$(j%),pointer,length)))>UPPER$(TRIM$(MID$(w$(z%),pointer,length)))
              GOSUB changesort
              IF j%>0
                GOTO 51040
              ENDIF
            ENDIF
          ENDIF
          IF a%=2
            IF VAL(MID$(w$(j%),pointer,length))>VAL(MID$(w$(z%),pointer,length))
              GOSUB changesort
              IF j%>0
                GOTO 51040
              ENDIF
            ENDIF
          ENDIF
        NEXT i
      LOOP
      51090:
    ENDIF
    moff
    wn=0
    bank=1
    ~SetTaskPri(FindTask(0),tskp)
    DEFMOUSE (msp1%)
    lightsoff
    GOSUB presentdisplay
  ENDIF
RETURN
PROCEDURE changesort
  a$=w$(z%)
  w$(z%)=w$(j%)
  w$(j%)=a$
  j%=j%-y%
RETURN
PROCEDURE drawgadgets
  DIM point$(5)
  DIM ppoint$(5)
  OPENW #10,0,0,640,100,0,4096
  FRONTW #0
  OPENW #10
  COLOR 1
  DRAW 20,20 TO 26,18 TO 26,22 TO 20,20  !<
  FILL 24,20
  GET 20,18,28,22,point$(2)
  BOX 18,17,19,23
  GET 18,17,28,24,point$(1)   ! |<
  CLS
  DRAW 20,18 TO 20,22 TO 20,18 TO 26,20 TO 20,22  ! >
  FILL 24,20
  GET 19,17,28,23,point$(3)
  BOX 28,17,29,23
  GET 19,17,29,23,point$(4)  ! >|
  CLS
  DRAW 23,18 TO 26,22 TO 23,18 TO 20,22 TO 20,22 TO 26,22
  FILL 22,21
  BOX 19,24,26,25
  GET 18,17,26,24,point$(5)
  CLS
  COLOR 1
  CIRCLE 50,50,10
  COLOR 0
  PBOX 40,40,60,50
  COLOR 1
  TEXT 39,45,". ."
  TEXT 47,51,"o"
  GET 34,42,72,56,face$
  ' Draw other gadgets
  COLOR m3
  DRAW 262164,20 TO 26,18 TO 26,22 TO 20,20  !<
  FILL 24,20
  GET 20,18,28,22,ppoint$(2)
  BOX 18,17,19,23
  GET 18,17,28,24,ppoint$(1)   ! |<
  CLS
  DRAW 20,18 TO 20,22 TO 20,18 TO 26,20 TO 20,22  ! >
  FILL 24,20
  GET 19,17,28,23,ppoint$(3)
  BOX 28,17,29,23
  GET 19,17,29,23,ppoint$(4)  ! >|
  CLS
  DRAW 23,18 TO 26,22 TO 23,18 TO 20,22 TO 20,22 TO 26,22
  FILL 22,21
  BOX 19,24,26,25
  GET 20,18,26,24,ppoint$(5)
  CLOSEW #10
RETURN
PROCEDURE rendergad(st)
  txx%=VAL(LEFT$(box$(st,1),3))+4
  tyy%=VAL(MID$(box$(st,1),4,3))+2
  IF st=1
    PUT txx%-1,tyy%,point$(1)
    PUT txx%+10,tyy%+1,point$(2)
  ELSE IF st=2
    PUT txx%+4,tyy%+1,point$(2)
  ELSE IF st=3
    PUT txx%+1,tyy%+1,point$(2)
    PUT txx%+9,tyy%,point$(3)
  ELSE IF st=4
    PUT txx%+6,tyy%,point$(3)
  ELSE IF st=5
    PUT txx%+8,tyy%,point$(4)
    PUT txx%-1,tyy%,point$(3)
  ENDIF
RETURN
PROCEDURE rrendergad(st)
  txx%=VAL(LEFT$(box$(st,1),3))+4
  tyy%=VAL(MID$(box$(st,1),4,3))+2
  IF st=1
    PUT txx%-1,tyy%,ppoint$(1)
    PUT txx%+10,tyy%+1,ppoint$(2)
  ELSE IF st=2
    PUT txx%+3,tyy%+1,ppoint$(2)
  ELSE IF st=3
    PUT txx%,tyy%+1,ppoint$(2)
    PUT txx%+10,tyy%,ppoint$(3)
  ELSE IF st=4
    PUT txx%+7,tyy%,ppoint$(3)
  ELSE IF st=5
    PUT txx%+8,tyy%,ppoint$(4)
    PUT txx%-1,tyy%,ppoint$(3)
  ENDIF
RETURN
PROCEDURE functionk
  function:
  DATA "F1:  Shortcut","F2:  Display Filenote","F3:  Create Filenote","F4:  Edit tools","F5:  Format Memo's","F6:  Speak Current Record","F7:  Calculator","F8:  Functionkey Help","F9:  Create Amigaguide Database","F10: dDbase.GUIDE"
  RESTORE function
  FOR t=1 TO 10
    READ select$(t)
  NEXT t
  displayit(10,"FUNCTION KEYS")
RETURN
FUNCTION exist(gf$)
  ret%=0
  IF EXIST(gf$) AND gf$<>""
    RETURN 1
  ELSE
    RETURN 0
  ENDIF
ENDFUNC
PROCEDURE startgauge(fff,title$)
  IF fff<=0
    fff=1
  ENDIF
  c2=(winh%-60)/2
  qq1=0
  range=8*20
  range=range+100
  prefs=range/fff
  IF pcose=1
    c2=0
  ENDIF
  OPENW #15,167,c2,range+45,57,0,4096+&H2+65536+&H4
  TITLEW #15,title$
  gw=range+45
  tgad=gw-56
  tgad=INT(tgad/2)
  flipbox(0,12,19,range+22,31)
  bevelbox(1,14,20,range+18,29)
  COLOR 1
  TEXT tgad-4,23,"PROGRESS"
  bevelbox(1,7,11,gw-12,43)
  flipbox(1,20,31,range+4,8)
  COLOR 3
RETURN
PROCEDURE gauge
  OPENW #15
  IF qq1+prefs<=320
    qq1=qq1+prefs
    PBOX 22,32,22+qq1,37
  ENDIF
RETURN
PROCEDURE endgauge
  CLOSEW #15
RETURN
PROCEDURE saythatagain
  FOR tt=1 TO n
    mode=VAL(f$(tt,0))
    IF mode=<3 OR mode=8
      SAY TRANSLATE$(f$(tt,1)+",")
    ENDIF
    IF mode<=3
      SAY TRANSLATE$(a$(tt))
    ENDIF
    IF mode=8
      tempmemo(a$(tt))
      SAY TRANSLATE$(say$)
    ENDIF
  NEXT tt
RETURN
PROCEDURE tempmemo(vw$)
  say$=""
  gln=0
  q=0
  DO
    q=INSTR(vw$,CHR$(174))
    IF q>0
      INC gln+
      say$=say$+LEFT$(vw$,q-1)
      vw$=MID$(vw$,q+1)
    ENDIF
  LOOP UNTIL q=0
RETURN
PROCEDURE displayit(gln,dtitle$)
  ttab$=SPACE$(ttab%)
  qxl=bank
  gtt=wn
  LOCAL t,ll%,ww%,hh%
  ll%=0
  FOR t=1 TO gln
    i=0
    DO
      i=INSTR(select$(t),CHR$(9))
      IF i>0
        select$(t)=LEFT$(select$(t),i-1)+ttab$+MID$(select$(t),i+1)
      ENDIF
    LOOP UNTIL i=0
    IF LEN(select$(t))>ll%
      ll%=LEN(select$(t))
    ENDIF
  NEXT t
  ww%=ll%*8+30
  hh%=gln*8+30
  ls%=(640-ww%)/2
  IF ww%>winw%
    ww%=winw%
  ENDIF
  wh%=(winh%-hh%)/2
  IF hh%>winh%
    hh%=winh%
  ENDIF
  IF ls%<0
    ls%=0
  ENDIF
  IF wh%<0
    wh%=0
  ENDIF
  wn=4
  OPENW #4,ls%,wh%,ww%,hh%,&H80000+512+&H40000,4096+65536+&H8+&H2
  ON MESSAGE GOSUB msg
  more%=0
  TITLEW #4,dtitle$
  dbbox(8,12,ww%-15,hh%-16)
  PRINT
  ccount%=0
  FOR guagew=1 TO gln
    INC ccount%
    IF ccount%=>maxlin1%+3
      TITLEW #4,"More..."
      dbbox(8,12,ww%-17,hh%-16)
      xx=0
      more%=1
      fredd%=1
      DO UNTIL xx>0
        q$=INKEY$
        IF q$<>""
          xx=1
        ENDIF
        IF xx=0
          xx=MOUSEK
        ENDIF
      LOOP
      fredd%=0
      PRINT AT(0,0);SPACE$(ll%+1)
      TITLEW #4,dtitle$
      ccount%=0
      PAUSE 10
      dbbox(8,12,ww%-17,hh%-16)
    ENDIF
    PRINT AT(2,guagew+1);LEFT$(select$(guagew)+SPACE$(ll%+1),ll%+1)
  NEXT guagew
  xx=0
  idiot=1
  IF more%=1
    PRINT AT(0,1);SPACE$(ll%)
    dbbox(8,12,ww%-17,hh%-16)
  ENDIF
  dbbox(8,12,ww%-17,hh%-16)
  fredd%=1
  DO
    q$=INKEY$
    IF UPPER$(q$)="P" OR UPPER$(q$)="S"
      xx=1
    ENDIF
    ON MENU
  LOOP UNTIL xx>0 OR q$<>""
  fredd%=0
  idiot=0
  IF UPPER$(q$)="S" AND speak%=1
    say$=""
    select$(1)=select$(1)+"."
    FOR guagew=1 TO gln
      say$=say$+select$(guagew)+" "
    NEXT guagew
    SAY TRANSLATE$(say$)
  ENDIF
  IF UPPER$(q$)="P"
    aa%=@rteasyrequest("PRINT DATA!"+CHR$(10)+"Insert Paper","Print|Cancel",version$)
    IF aa%=1
      OPEN "o",#1,"par:"
      FOR t=1 TO gln
        PRINT #1,select$(t)+CHR$(13)
      NEXT t
      CLOSE #1
    ENDIF
  ENDIF
  CLOSEW #4
  bank=qxl
  wn=gtt
  OPENW #wn
RETURN
PROCEDURE unpack
  pointer=1
  ee=0
  FOR ttr&=1 TO n
    aax$=MID$(w$(kk),pointer,VAL(f$(ttr&,4)))
    aax$=TRIM$(aax$)
    IF f$(ttr&,0)="2"   !Date
      GOSUB ddate(ttr&)
    ENDIF
    a$(ttr&)=aax$
    aax$=""
    pointer=pointer+f(ttr&)
  NEXT ttr&
RETURN
PROCEDURE depack
  pointer=1
  ee=0
  FOR ttr&=1 TO n
    ax$=MID$(w$(kk),pointer,VAL(f$(ttr&,4)))
    ax$=TRIM$(ax$)
    a$(ttr&)=ax$
    ax$=""
    pointer=pointer+f(ttr&)
  NEXT ttr&
RETURN
PROCEDURE getpoint
  pointer=1
  FOR tr&=1 TO sf
    pointer=pointer+f(tr&)
  NEXT tr&
  length=f(sf)
  pointer=pointer-length
RETURN
PROCEDURE pack
  ee=0
  FOR tr&=1 TO n
    temp$(tr&)=a$(tr&)
    aa$=""
    IF f$(tr&,0)="2"
      aa$=a$(tr&)
      GOSUB gdate(tr&)
      a$(tr&)=aa$
    ENDIF
    w$(kk)=w$(kk)+LEFT$(a$(tr&)+SPACE$(maxfield%),f(tr&))
  NEXT tr&
RETURN
PROCEDURE disbox
  IF box$(gkk&,bank)<>""
    gxx=VAL(LEFT$(box$(gkk&,bank),3))
    gyy=VAL(MID$(box$(gkk&,bank),4,3))
    tx$=MID$(box$(gkk&,bank),7)
    gx1=gxx+LEN(tx$)*8+2
    gy1=gyy+11
    gy1=12
    gx1=LEN(tx$)*8+2
    COLOR 1
    IF grommet>0
      drawflipbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
      IF bank=1 AND gkk&=>1 AND gkk&<=5
        GOSUB rrendergad(gkk&)
      ELSE
        COLOR m3
        TEXT gxx+2,gyy+8,tx$
        COLOR 1
      ENDIF
      GRAPHMODE 3
      COLOR 1
      TEXT gxx+1,gyy+8,tx$
      GRAPHMODE 1
      IF grommet=1
        qqq=qq
        WHILE MOUSEK<>0
          IF MOUSEX=>gxx AND MOUSEX<=gxx+gx1 AND MOUSEY=>gyy AND MOUSEY<=gyy+12 AND qq=0
            qq=qqq
            COLOR 1
            IF bank=1 AND gkk&=>1 AND gkk&<=5
              rrendergad(gkk&)
            ELSE
              COLOR m3
              TEXT gxx+2,gyy+8,tx$
            ENDIF
            COLOR 2
            GRAPHMODE 3
            TEXT gxx+1,gyy+8,tx$
            GRAPHMODE 1
            drawflipbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
          ENDIF
          IF MOUSEX<gxx OR MOUSEX>gxx+gx1 OR MOUSEY<gyy OR MOUSEY>gyy+12 AND qq>0
            qq=0
            COLOR 1
            TEXT gxx+1,gyy+8,tx$
            drawbevelbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
            IF bank=1 AND gkk&=>1 AND gkk&<=5
              GOSUB rendergad(gkk&)
            ENDIF
          ENDIF
        WEND
      ENDIF
      IF grommet=2
        PAUSE 1
      ENDIF
      grommet=0
    ENDIF
    COLOR 1
    TEXT gxx+1,gyy+7,SPACE$(LEN(tx$))
    TEXT gxx+1,gyy+9,SPACE$(LEN(tx$))
    TEXT gxx+1,gyy+8,tx$
    drawbevelbox(LPEEK(WINDOW(wn)+50),gxx-1,gyy+1,gx1+2,gy1-2)
    IF bank=1
      FOR lvw=1 TO 5
        rendergad(lvw)
      NEXT lvw
    ENDIF
  ENDIF
RETURN
PROCEDURE presentdisplay
  wn=0
  IF kk<=0
    kk=1
  ENDIF
  flag=2
  GOSUB ddisplay
  GOSUB displaybox
  flag=0
RETURN
PROCEDURE ddisplay
  GOSUB unpack
  FOR t&=1 TO n
    IF f$(t&,0)="3" AND VAL(f$(t&,5))=4 OR VAL(f$(t&,5))=5
      fo$=pref$(5)+" "
    ELSE
      fo$=""
    ENDIF
    x=VAL(f$(t&,2))
    y=VAL(f$(t&,3))
    l=VAL(f$(t&,4))
    sel=VAL(f$(t&,0))
    PRINT txfx$(t&,1)
    IF sel=10
      PRINT AT(x+LEN(f$(t&,1))+1,y);LEFT$(SPACE$(100),l)
    ENDIF
    IF sel=<3 OR sel=10
      PRINT AT(x,y);f$(t&,1);txfx$(t&,2);" ";fo$;
    ELSE
      PRINT AT(x,y);f$(t&,1)
    ENDIF
    IF sel=4 OR sel=5
      GOSUB boxit
    ENDIF
    IF VAL(f$(t&,0))<=3
      IF flag=2
        ll=LEN(f$(t&,1))
        aa$=a$(t&)
        IF f$(t&,0)="3"
          formatnumber(t&)
        ENDIF
        PRINT LEFT$(aa$+SPACE$(l),l);
        PRINT " "
      ELSE
        PRINT SPACE$(l);" "
      ENDIF
    ENDIF
    IF VAL(f$(t&,0))<=3 OR VAL(f$(t&,0))=10
      GOSUB beveldo
    ENDIF
    PRINT txfx$(t&,2)
  NEXT t&
  IF ext>0
    GOSUB displayexternal
  ENDIF
  FOR t&=1 TO n
    IF f$(t&,0)="10"
      calc$=f$(t&,5)
      count$=""
      GOSUB calc
      x=VAL(f$(t&,2))
      y=VAL(f$(t&,3))
      l=VAL(f$(t&,4))
      PRINT AT(x+LEN(f$(t&,1))+1,y);LEFT$(count$+SPACE$(100),l)
    ENDIF
  NEXT t&
RETURN
PROCEDURE display
  FOR gkk&=1 TO gk(bank)
    GOSUB disbox
  NEXT gkk&
  GOSUB redraw
RETURN
PROCEDURE redraw
  IF bank=1
    wn=0
    text(200,184+winoff%,"©MADCAP",1,2)
    text(195,193+winoff%,"SOFTWARE",1,2)
    text(551,175+winoff%,"dDbase",2,3)
    drawbevelbox(LONG{ADD(WINDOW(wn),50)},20,160+winoff%,257,38)
    dbbox(274,160+winoff%,352,38)
    drawbevelbox(LPEEK(WINDOW(wn)+50),189,175+winoff%,74,21) !MADCAP
    drawflipbox(LPEEK(WINDOW(wn)+50),547,164+winoff%,60,17)  !DDBASE
    dbbox(8,12,622,147+winoff%) !Screen
    lightsoff
    FOR tt=1 TO 5
      rendergad(tt)
    NEXT tt
  ENDIF
RETURN
PROCEDURE testeditfield
  gyy=MOUSEY
  gxx=MOUSEX
  balance%=FALSE
  FOR t1&=1 TO n
    t&=fo(t1&)
    zy=VAL(f$(t&,2))*8
    qqu=VAL(f$(t&,3))*8
    zx=LEN(f$(t&,1))*8
    IF gxx=>zy AND gxx<=zy+zx AND gyy=>qqu AND gyy<=qqu+10
      balance%=TRUE
      eff%=@rteasyrequest("What do you want to do"+CHR$(10)+"With: "+f$(t&,1),"Edit|Delete|Move|Sort|Fill|Cancel",version$)
      qq=t&
      IF eff%=1  !Edit
        GOSUB editfield
      ENDIF
      IF eff%=2  !Delete
        GOSUB deletefield
      ENDIF
      IF eff%=3  !Move
        GOSUB repos2
      ENDIF
      IF eff%=4 ! Sort
        GOSUB newsort(t&)
        wn=0
        bank=1
        wtitle$=version$+":Record:"+STR$(kk)+" of "+STR$(k)+":Memory: "+STR$(mfr)+"-Kb: File:-"+filetitl$
        TITLEW #0,wtitle$
      ENDIF
      IF eff%=5 !Fill
        tt1=kk
        GOSUB fillfield(t&)
        kk=tt1
        wn=0
        bank=1
      @presentdisplay
      ENDIF
      IF eff%>0
        sit%=1
        dsit%=1
        qq=0
        wn=0
        bank=1
        clearscreen
        GOSUB redraw
        GOSUB presentdisplay
      ENDIF
      t1&=n+1
    ENDIF
  NEXT t1&
  qq=0
  wn=0
  bank=1
RETURN
PROCEDURE testfield
  start1=kk
  gyy=MOUSEY
  gxx=MOUSEX
  gxx=gxx+4
  FOR t1&=1 TO n
    t&=fo(t1&)
    wiz=VAL(f$(t&,2))
    beep=VAL(f$(t&,3))
    wiz=wiz+LEN(f$(t&,1))+1
    at=VAL(f$(t&,2))*8
    cranky=LEN(f$(t&,1))*8
    at=at+cranky
    ex1=VAL(f$(t&,4))
    crankey=ex1*8
    crankey=crankey+at
    handcuffs=VAL(f$(t&,3))*8
    handcuffs=handcuffs
    en=handcuffs+10
    IF gxx=>at AND gxx<=crankey+16 AND gyy=>handcuffs AND gyy<=en AND VAL(f$(t&,0))<=3
      PAUSE 20
      IF MOUSEK=1
        GOSUB fieldlist(t&)
        GOSUB presentdisplay
        wtitle$=version$+":Record:"+STR$(kk)+" of "+STR$(k)+":Memory: "+STR$(mfr)+"-Kb: File:-"+filetitl$
        TITLEW #0,wtitle$
      ELSE
        PCOLOR filltextpen%,shinepen%
        PRINT AT(wiz,beep);SPACE$(ex1+1)
        PCOLOR filltextpen%,backgroundpen%
        PRINT AT(wiz,beep);
        FORM INPUT ex1 AS a$(t&)
        IF a$(t&)=">"
          a$(t&)=temp$(t&)
        ENDIF
        IF f$(t&,5)="2"
          a$(t&)=UPPER$(a$(t&))
        ENDIF
        IF f$(t&,5)<>"" AND f$(t&,0)="1" AND f$(t&,5)<>"2"
          paa%=@testrequired(a$(t&),t&)  !-----------REQUIRED---------------!
          IF paa%=0
            GOSUB getrequired(t&)
            IF qq<=gln
              a$(t&)=select$(qq)
              ee=0
            ELSE
              ee=1
            ENDIF
          ENDIF
        ENDIF
        sitt%=1
        sit%=1
        dsit%=1
      ENDIF
    ENDIF
  NEXT t1&
  IF sitt%=1
    kk=start1
    w$(kk)=""
    GOSUB pack
    GOSUB presentdisplay
    sitt%=0
  ENDIF
  wn=0
  bank=1
RETURN
FUNCTION test
  sitt%=0
  qqq$=""
  qq=0
  ON MESSAGE GOSUB msg
  ON MENU
  gyy=MOUSEY
  gxx=MOUSEX
  IF qq$=""
    cleanup
    EDIT
  ENDIF
  IF qqq$=""
    qqq$=INKEY$
  ENDIF
  cc=CVI(qqq$)
  cc=cc-39700
  IF cc=45 AND bank=9
    qqq$="u"
  ENDIF
  IF cc=46 AND bank=9
    qqq$="d"
  ENDIF
  IF cc=37
    IF bank=1
      lightson
    ENDIF
    runhelp("ddbase.guide")
    lightsoff
  ENDIF
  IF cc=36 AND k>0
    amigaguide
  ENDIF
  IF cc=35
    GOSUB functionk
  ENDIF
  IF cc=31 AND bank=1
    GOSUB edittool
  ENDIF
  IF cc=32
    GOSUB formatmemo
  ENDIF
  IF cc=34 AND EXIST("sys:tools/calculator")
    ex$="run >NIL: sys:tools/calculator"
    EXEC ex$,-1,-1
  ENDIF
  IF cc=33 AND speak%=1 AND bank=1 AND kk>0
    GOSUB saythatagain
  ENDIF
  IF MOUSEK=2 AND bank=1 AND n>0
    GOSUB testeditfield
    IF balance%=FALSE AND popup%=TRUE
      qq=14
    ENDIF
  ENDIF
  IF MOUSEK=1 AND bank=1 AND k>0
    xllx=MOUSEX
    tx=MOUSEY
    GOSUB unpack
    GOSUB testfield
    IF ext>0
      GOSUB testexternal
    ENDIF
    a=@getbox(xllx,tx)
    IF a>0
      que%=@rteasyrequest("Do you want to: ","Move|Delete|Change Type|Cancel",version$)
      IF que%=1
      @movebox(a)
      ELSE IF que%=2
      @deletebox(a)
      ELSE IF que%=3
      @changebox(a)
      ENDIF
      qq=0
      wn=0
      bank=1
      clearscreen
      GOSUB redraw
      GOSUB presentdisplay
    ENDIF
    qqq$=""
    wn=0
    bank=1
    qq=0
  ENDIF
  IF cc=43
    GOSUB help
  ENDIF
  IF cc=45
    qqq$=">"
  ENDIF
  IF cc=47
    qqq$="."
  ENDIF
  IF cc=46
    qqq$="<"
  ENDIF
  IF cc=48
    qqq$=","
  ENDIF
  IF cc=28
    GOSUB helpit
    qqq$=""
    qq=0
  ENDIF
  IF qqq$<>""
    qq=INSTR(compare$(bank),qqq$)
    IF qq>0
      gxx=VAL(LEFT$(box$(qq,bank),3))
      gyy=VAL(MID$(box$(qq,bank),4,3))
      grommet=2
      gkk&=qq
      GOSUB disbox
    ENDIF
  ENDIF
  IF MOUSEK=1 AND qq=0 AND sitt%=0
    qq=0
    GOSUB testit
    IF qq>0
      grommet=1
      GOSUB disbox
      grommet=0
    ENDIF
  ENDIF
  RETURN qq
ENDFUNC
PROCEDURE testit
  qq=0
  FOR gt=1 TO gk(bank)
    gx=VAL(LEFT$(box$(gt,bank),3))
    gy=VAL(MID$(box$(gt,bank),4,3))
    tx$=MID$(box$(gt,bank),7)
    l=LEN(tx$)*8+6
    IF gxx=>gx AND gxx=<gx+l AND gyy=>gy AND gyy<=gy+12
      qq=gt
      gt=gk(bank)+1
      gkk&=qq
    ENDIF
  NEXT gt
RETURN
FUNCTION center(center$)
  ll%=LEN(center$)
  ll%=80-ll%
  ll%=ll%/2
  RETURN ll%
ENDFUNC
PROCEDURE changebox(a)
  getlist("BEVEL|FLIP|BOX|DOUBLE-BEVEL|DELETE|MOVE|")
  selectfield("DRAW BOX",gln)
  IF qq>0 AND qq<=gln
    box(a,0)=qq
  ENDIF
RETURN
' -------------------------------------GetTools------------------------------
PROCEDURE readprefs
  tool%=FALSE
  IF EXIST("ddbase.tools")
    ERASE ttool$()
    DIM ttool$(50)
    tool%=TRUE
    OPEN "i",#12,"ddbase.tools"
    tools=0
    DO
      LINE INPUT #12,a$
      a$=TRIM$(a$)
      tools=tools+1
      ttool$(tools)=a$
    LOOP UNTIL EOF(#12) OR LEFT$(a$,2)="##"
    CLOSE #12
  ENDIF
RETURN
FUNCTION tool(tool$)
  xx$=""
  xx=0
  boing%=FALSE
  FOR tt=1 TO tools
    IF tool$=LEFT$(ttool$(tt),LEN(tool$))
      xx$=ttool$(tt)
      tt=tools+1
    ENDIF
  NEXT tt
  IF xx$<>""
    i=INSTR(xx$,"=")
    IF i>0
      t$=MID$(xx$,i+1)
      boing%=TRUE
    ENDIF
  ENDIF
  IF boing%=TRUE
    t$=t$+CHR$(0)
    RETURN V:t$
  ELSE
    RETURN 0
  ENDIF
ENDFUNC
PROCEDURE geticon
  GOSUB readprefs
  IF tool%=TRUE
    dta2:
    DATA ILBM-READER,SAMPLEPLAYER,ANIMPLAYER,GIF,TIF,JPEG,MEDPLAYER,DOC_READER,TRACKERPLAYER
    DATA -,-,WAV,BMP,AVI,-,EMODULE,HTML,MIDI,WMF,QT
    DATA 1,"PAGELENGTH",2,"SEPERATOR",5,"CURRENCY",6,"TASKPRI"
    RESTORE dta2
    FOR t&=1 TO 20
      READ gg$
      tool$(t&)=CHAR{@tool(gg$)}
    NEXT t&
    FOR t&=1 TO 4
      READ nn&,tool$
      pref$(nn&)=CHAR{@tool(tool$)}
    NEXT t&
    tool$="TAB"+CHR$(0)
    ttab%=VAL(CHAR{@tool(tool$)})
    IF ttab%=0
      ttab%=3
    ENDIF
    fdl$=CHAR{@tool("FIELDLENGTH")}
    IF fdl$<>""
      maxfield%=VAL(fdl$)
    ENDIF
    guide$=CHAR{@tool("AMIGAGUIDE")}
    height$=CHAR{@tool("HEIGHT")}
    editor$=CHAR{@tool("TEXT_EDITOR")}
    entry1$=CHAR{@tool("LOAD")}
    ddb$=CHAR{@tool("FIELDS")}
    IF UPPER$(ddb$)="BOTH" OR ddb$=""
      ddbb%=0
    ELSE IF UPPER$(ddb$)="FLIP"
      ddbb%=1
    ELSE IF UPPER$(ddb$)="BEVEL"
      ddbb%=2
    ELSE IF UPPER$(ddb$)="DOUBLE"
      ddbb%=3
    ENDIF
    lfeed$=CHAR{@tool("FORMFEED")}
    lfeed$=UPPER$(lfeed$)
    destination$=CHAR{@tool("DESTINATION")}
    dscreen$=CHAR{@tool("SCREEN")}
    vw$=CHAR{@tool("VIEW")}
    IF vw$="FORM"
      pcode=3
    ELSE IF vw$="TABLE"
      pcode=1
    ELSE IF vw$="RECORD"
      pcode=2
    ENDIF
    popup%=FALSE
    backup%=FALSE
    pd$=CHAR{@tool("POPUP")}
    IF pd$="Y"
      popup%=TRUE
    ENDIF
    pd$=CHAR{@tool("BACKUP")}
    IF pd$="Y"
      backup%=TRUE
    ENDIF
    IF entry1$<>""
      entry$=entry1$
    ENDIF
    IF destination$=""
      destination$="Ram:"
    ENDIF
    IF EXIST("c:showmodule")
      tool$(16)="c:showmodule"
    ENDIF
    tool$(15)=guide$
    GOSUB getprefs
  ENDIF
RETURN
PROCEDURE getmax
  GOSUB readprefs
  IF tool%=TRUE
    max$=CHAR{@tool("MAX")}
    maxi%=VAL(max$)
    IF maxi%>3000
      maxi%=3000
    ENDIF
    reserve%=maxi%*250
  ENDIF
RETURN
' -------------------------------------Date-----------------------------------
PROCEDURE gdate(gt)
  ee=0
  IF aa$>""
    aa$=TRIM$(aa$)
    IF f$(gt,5)="1"  !DD/MM/YY
      a1$=RIGHT$(aa$,2)
      a2$=MID$(aa$,4,2)
      a3$=LEFT$(aa$,2)
      ee=0
      IF VAL(a3$)<1 OR VAL(a3$)>31 OR VAL(a2$)<0 OR VAL(a2$)>12
        ee=1
      ENDIF
      IF ee=0
        aa$=a1$+a2$+a3$
      ENDIF
    ENDIF
    IF f$(gt,5)="2"  !DD MMM YYYY
      DO
        q=INSTR(aa$,"  ")
        IF q>0
          aa$=LEFT$(aa$,q-1)+MID$(aa$,q+1)
        ENDIF
      LOOP UNTIL q=0
      q=INSTR(aa$," ")
      IF q>0
        a1$=RIGHT$(aa$,4)
        a2$=MID$(aa$,q+1,3)
        a3$=LEFT$(aa$,q-1)
      ENDIF
      IF LEN(a3$)=1
        a3$="0"+a3$
      ENDIF
      output=0
      mon=0
      DO
        output=output+1
        IF UPPER$(a2$)=UPPER$(month$(output))
          mon=output
        ENDIF
      LOOP UNTIL mon>0 OR output=12
      a2$=STR$(mon)
      IF LEN(a2$)<2
        a2$="0"+a2$
      ENDIF
      ee=0
      IF mon<1 OR mon>12 OR VAL(a3$)<1 OR VAL(a3$)>31
        ee=1
      ENDIF
      IF ee=0
        aa$=a1$+a2$+a3$
      ELSE
        aa$="E"+aa$+"E"
        ee=0
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE ddate(gt) !Display date
  ax$=TRIM$(aax$)
  IF ax$<>""
    IF f$(gt,5)="1"
      a1$=LEFT$(ax$,2)
      a2$=MID$(ax$,3,2)
      a3$=RIGHT$("  "+ax$,2)
      ax$=a3$+"/"+a2$+"/"+a1$
    ENDIF
    IF f$(gt,5)="2"
      IF LEFT$(ax$,1)<>"E" AND RIGHT$(ax$,1)<>"E"
        IF LEN(ax$)=7
          ax$=LEFT$(ax$,4)+"0"+MID$(ax$,5)
        ENDIF
        a1$=LEFT$(ax$,4)
        a2$=MID$(ax$,5,2)
        a3$=RIGHT$(ax$,2)
        IF icon=1
          a3$=RIGHT$("  "+a3$,2)
        ENDIF
        IF LEFT$(a3$,1)="0"
          a3$=RIGHT$(a3$,1)
        ENDIF
        mon=VAL(a2$)
        a2$=month$(mon)
        ax$=a3$+" "+a2$+" "+a1$
      ENDIF
    ENDIF
    IF LEFT$(ax$,1)="0"
      ax$=MID$(ax$,2)
    ENDIF
  ENDIF
  aax$=ax$
RETURN
PROCEDURE dodate
  FOR t=1 TO n
    IF f$(t,0)="2" AND f$(t,5)=""
      fd%=t
      aa%=@findate
      IF ee=1
        f$(t,5)=STR$(aa%)
      ENDIF
    ENDIF
  NEXT t
RETURN
FUNCTION findate
  k1=kk
  ee=0
  kk=1
  DO UNTIL kk=>k OR ee=1
    INC kk
    depack
    ax$=TRIM$(a$(fd%))
    IF LEN(ax$)>0
      ee=1
      IF LEN(ax$)=<6
        aa%=1
      ELSE
        aa%=2
      ENDIF
    ENDIF
  LOOP
  kk=k1
  RETURN aa%
ENDFUNC
' ----------------------------------Search------------------------------------
PROCEDURE inputrange
  wn=2
  ypos%=winh%-100
  ypos%=ypos%/2
  OPENW #2,120,ypos%,400,100,&H80000+&H40000,4096+65536+&H2
  TITLEW #2,version$
  wn=2
  dbbox(6,12,390,84)
  COLOR 1
  text(20,30,"RANGE",1,2)
  drawbevelbox(LPEEK(WINDOW(wn)+50),15,19,50,16)
  text(135,37,"RANGE FROM",1,2)
  text(140,68,"RANGE TO",1,2)
  text(180,22,"dDbase ©MADCAP-SOFTWARE",1,3)
  drawflipbox(LPEEK(WINDOW(wn)+50),24,74,329,10)
  drawbevelbox(LPEEK(WINDOW(wn)+50),23,73,331,12)
  drawflipbox(LPEEK(WINDOW(wn)+50),24,42,329,10)
  drawbevelbox(LPEEK(WINDOW(wn)+50),23,41,331,12)
  find$=""
  change$=""
  PCOLOR 1,m3
  PRINT AT(4,5);SPACE$(40)
  PCOLOR 1,0
  PRINT AT(4,5);
  FORM INPUT 40 AS find$
  PRINT AT(4,5);LEFT$(find$+SPACE$(40),40)
  PCOLOR 1,m3
  PRINT AT(4,9);SPACE$(40)
  PRINT AT(4,9);
  PCOLOR 1,0
  FORM INPUT 40 AS change$
  PRINT AT(4,9);LEFT$(change$+SPACE$(40),40)
  CLOSEW #2
  rtstring$=find$+"|"+change$
RETURN
PROCEDURE search1
  bank=2
  OPENW #1,3,158+winoff%,634,40,&H80000+&H40000,65536+&H800+4096
  wtitle$="Search Database    Record No."+STR$(kk)+"  Found: "+STR$(recount)+" From "+STR$(k)+"  Records        "
  wn=1
  dbbox(8,2,620,37)
  text(12,11,SPACE$(75),1,2)
  text(20,12,wtitle$,1,2)
  text(260,30,"dDbase  ©MADCAP-SOFTWARE",2,3)
  DEFLINE &X1111000011110000
  COLOR 1
  LINE 260,31,452,31
  DEFLINE 1
  qq=0
  DEFMOUSE (msp1%)
  DO
    wn=1
    bank=2
    OPENW #1
    GOSUB display
    DO UNTIL qq<>0
      bank=2
      qq=@test
    LOOP
    IF qq=2
      IF pcode=2
        aa%=@getstring(79,"Left Margin",STR$(lmargin%))
        tab%=VAL(rtstring$)
        qq=0
      ELSE
        tab%=0
      ENDIF
      GOSUB printit
    ENDIF
    IF qq=4
      GOSUB fields
      GOSUB selectfield("View Field",n)
      wn=1
      IF qq<=n
        IF f$(qq,0)="8"
          vw$=a$(qq)
          aaa%=aa%
          tee=qq
          GOSUB viewmemo(vw$)
          aa%=aaa%
        ENDIF
        IF f$(qq,0)="7"
          pe$=a$(qq)
          qq=0
          GOSUB external(pe$)
          wn=1
        ENDIF
        qq=0
      ENDIF
      bank=1
      wn=1
      qq=0
    ENDIF
  LOOP UNTIL qq=1 OR qq=3
  bank=1
  wn=0
  OPENW #0
  DEFMOUSE 2
RETURN
PROCEDURE range
  ss=INSTR(a$,"|")
  IF ss>0
    range2$=MID$(a$,ss+1)
    range1$=LEFT$(a$,ss-1)
  ENDIF
RETURN
PROCEDURE searchit
  TITLEW #0,"'=' Exact  '^' In string  '|' LeftS Search '<>' Less/Greater '*' Range"
  search%=1
  GOSUB enter
  search%=0
  recount=0
  counter=0
  FOR tr&=1 TO n
    IF a$(tr&)="*"
      GOSUB inputrange
      wn=0
      IF rtstring$<>""
        a$(tr&)="*"+rtstring$
      ENDIF
    ENDIF
    search$(tr&)=a$(tr&)
  NEXT tr&
  GOSUB ddisplay
  lightson
  IF pr$="y"
    GOSUB startprint
  ENDIF
  FOR tr&=1 TO n
    IF search$(tr&)<>""
      counter=counter+1
    ENDIF
  NEXT tr&
  DEFMOUSE (2)
  TITLEW #0,"Searching Please Wait....."
  IF pr$="y" AND op%=0
    startgauge(k,"Saving Records Please Wait..")
  ENDIF
  exi$=""
  FOR tr&=1 TO k
    exi$=INKEY$
    IF exi$=CHR$(27)
      tr&=k
    ENDIF
    count=0
    kk=tr&
    GOSUB unpack
    FOR x&=1 TO n
      IF search$(x&)<>""
        tad$=""
        a$=MID$(search$(x&),2)
        IF LEFT$(search$(x&),1)="*"
          aa$=search$(x&)
          GOSUB range
          tad$=""
          IF f$(x&,0)="2"
            tad$=a$(x&)
            aa$=range1$
            GOSUB gdate(x&)
            range1$=aa$
            aa$=range2$
            GOSUB gdate(x&)
            range2$=aa$
          ENDIF
          temp%=0
          IF VAL(f$(x&,0))=2 OR VAL(f$(x&,0))=3
            temp%=1
          ENDIF
          IF VAL(f$(x&,0))=2
            aa$=a$(x&)
            GOSUB gdate(x&)
            a$(x&)=aa$
          ENDIF
          IF LEFT$(a$(x&),LEN(range1$))=>range1$ AND LEFT$(a$(x&),LEN(range2$))<=range2$ AND temp%=0
            count=count+1
          ENDIF
          IF VAL(a$(x&))=>VAL(range1$) AND VAL(a$(x&))<=VAL(range2$) AND temp%=1
            count=count+1
          ENDIF
        ENDIF
        IF LEFT$(search$(x&),1)="=" AND UPPER$(a$)=UPPER$(a$(x&))
          count=count+1
        ENDIF
        IF LEFT$(search$(x&),1)="|" AND UPPER$(a$)=UPPER$(LEFT$(a$(x&),LEN(a$)))
          count=count+1
        ENDIF
        IF LEFT$(search$(x&),1)="^" AND INSTR(UPPER$(a$(x&)),UPPER$(a$))>0
          count=count+1
        ENDIF
        IF LEFT$(search$(x&),1)=">" AND VAL(a$)<VAL(a$(x&))
          count=count+1
        ENDIF
        IF LEFT$(search$(x&),1)="<" AND VAL(a$)>VAL(a$(x&))
          count=count+1
        ENDIF
      ENDIF
      IF tad$<>""
        a$(x&)=tad$
        tad$=""
      ENDIF
    NEXT x&
    IF pr$="y" AND op%=0
      gauge
    ENDIF
    IF count=counter
      INC recount  ! Leave
      k9=kk
      kk=tr&
      IF pr$<>"y"
        presentdisplay
        GOSUB search1
      ENDIF
      IF pr$="y"
        IF op%=1
          GOSUB printit
        ENDIF
        IF op%=0 AND po%>0
          GOSUB fileprint
        ENDIF
      ENDIF
      IF qq=3
        tr&=k+1
      ENDIF
    ENDIF
  NEXT tr&
  moff
  IF pr$="y" AND op%=1 AND fred%=0
    GOSUB labelend
  ENDIF
  IF pr$="y"
    endgauge
    IF ask%=0 AND op%=0
      GOSUB prend
    ENDIF
    IF cal%=1
      GOSUB discalc
    ENDIF
    IF op%=0 AND screendis%=1
      PRINT #13,"@endnode"
    ENDIF
    CLOSE #13
    IF op%=0 AND clipit%=1
      clipit%=0
      IF EXIST("c:openclip")
        EXEC "c:openclip ram:clipfile",-1,-1
        KILL "ram:clipfile"
      ENDIF
    ENDIF
    IF op%=0 AND screendis%=1
      screendis%=0
      IF EXIST(op$)
        external(op$)
        KILL op$
      ENDIF
    ENDIF
  ENDIF
  clipit%=0
  TITLEW #0,title$
RETURN
' -------------------------Import/Export Data---------------------------
PROCEDURE amigaguide
  IF tf>0
    rtitle$="CREATE AMIGAGUIDE DATABASE"
    GOSUB getfile("")
    eee=@exist(nfile$)
    IF eee=1 AND ee=0
      qu%=@rteasyrequest(nfile$+CHR$(10)+"File Exists!!","Overwrite|Cancel",version$)
      IF qu%=0
        ee=1
      ELSE
        ee=0
      ENDIF
    ENDIF
    IF ee=0
      tabu%=5
      que%=@getstring(5,"Enter Tabulation:","5")
      IF que%=1
        tabu%=VAL(rtstring$)
      ENDIF
		que%=@getstring(5,"Top margin","0")
		IF que%=1
			topm%=VAL(rtstring$)
		ENDIF
      IF ee=0
        GOSUB fields
        selectfield("SELECT GADGET FIELD",n)
        ff=qq
      ENDIF
      ge%=@getstring(40,"Enter Title",filetitl$)
      title$=UPPER$(rtstring$)
      eel%=0
      lenny%=0
      FOR tt=1 TO tf  !Check to see if there is an external field
        IF LEN(f$(tr(tt,1),1))>lenny%
          lenny%=LEN(f$(tr(tt,1),1))
        ENDIF
        IF f$(tr(tt,1),0)="7"
          eel%=1
        ENDIF
      NEXT tt
      text%=0
      IF eel%=1 ! If there is an external field
        text%=@rteasyrequest("Do you want to Insert any External Text Files?","Insert|Cancel",version$)
        IF text%=1
          ~@getstring(12,"Enter Buffer Size","8000")
          fbuffer%=VAL(rtstring$)
        ENDIF
      ENDIF
      IF ee=0 AND ff<=n AND ge%=1
        lightson
        break=0
        startgauge(k*3,"Creating AmigaGuide Database!")
        IF eel%=1
          OPEN "o",#16,"con:0/"+STR$(winh%-50)+"/640/50/OUTPUT/CLOSE"
        ENDIF
        FOR kk=1 TO k
          gauge
          unpack
          IF LEN(a$(ff))>break
            break=LEN(a$(ff))
          ENDIF
        NEXT kk
        IF break>20
          break=20
        ENDIF
        col=INT(80/(break+4))
        OPEN "o",#12,nfile$
        messgae=0
        PRINT #12,"@database dDbase_MADCAP-SOFTWARE"
        PRINT #12,"@height 20"
        PRINT #12
        PRINT #12,"@node Main "+CHR$(34)+title$+"        "+"dDbase..©MADCAP-SOFTWARE"+CHR$(34)
        PRINT #12
        PRINT #12,"  Created using ";version$;"  ON: ";DATE$;"  ";TIME$
        PRINT #12
        FOR t=1 TO k    ! Main Gadgets
          kk=t
          GOSUB unpack
          GOSUB gauge
          temp$=TRIM$(UPPER$(a$(ff)))
          dd=LEN(temp$)
          IF break>dd
            dd=(break-dd)\2
            temp$=SPACE$(dd)+temp$
          ENDIF
          temp$=LEFT$(temp$+SPACE$(40),break)
          ss$="@{"+CHR$(34)+temp$+CHR$(34)+" link gui"+STR$(t)+"}"
          PRINT #12,ss$;"   ";
          messgae=messgae+1
          IF messgae=col
            PRINT #12
            messgae=0
          ENDIF
        NEXT t
        PRINT #12
        PRINT #12,"@endnode"
        dbx3=0
        FOR t=1 TO n
          IF LEN(f$(t,1))>dbx3 AND VAL(f$(t,o))<=3
            dbx3=LEN(f$(t,1))
          ENDIF
        NEXT t
        FOR t=1 TO k     ! Body
          GOSUB gauge
          kk=t
          GOSUB unpack
          PRINT #12,"@node gui"+STR$(t)+" "+CHR$(34)+UPPER$(a$(ff))+CHR$(34)
          FOR ytt=1 TO tf
          	FOR top = 1 to topm%
          		PRINT #12, ""
          	NEXT top
            tt=tr(ytt,1)
            xllx=tt
            gww=VAL(f$(tt,0))
            f$=f$(tt,1)
            IF f$(tt,0)="10"
              calc$=f$(tt,5)
              GOSUB calc
              a$(tt)=count$
            ENDIF
            IF gww<=3 OR gww=10
              PRINT #12,SPACE$(tabu%);LEFT$(f$+SPACE$(40),dbx3);":  ";
              PRINT #12,a$(tt)
              PRINT #12
            ENDIF
            IF gww=8  ! Memo
              vw$=a$(tt)
              i=0
              PRINT #12,SPACE$(tabu%);f$
              PRINT #12,SPACE$(tabu%);LEFT$("---------------------------------------",LEN(f$))
              PRINT #12
              DO
                i=INSTR(vw$,CHR$(174))
                IF i>0
                  PRINT #12,SPACE$(tabu%);LEFT$(vw$,i-1)
                  vw$=MID$(vw$,i+1)
                ENDIF
              LOOP UNTIL i=0
              PRINT #12
              PRINT #12,TAB(30);STRING$(20,"_")
              PRINT #12
            ENDIF
            IF gww=9   ! Attach
              aag%=1
              vw$=f$(tt,5)
              GOSUB attach
              PRINT #12,SPACE$(tabu%);"@{"+CHR$(34)+f$(tt,1)+CHR$(34)+" SYSTEM "+CHR$(34)+vw$+CHR$(34)+"}"
              aag%=0
            ENDIF
            IF gww=7 AND a$(tt)<>""       !External
              PRINT #12,TAB(tabu%);LEFT$(f$+SPACE$(20),dbx3);": ";a$(tt)
              PRINT #12
              eee=0
              di$=DIR$(0)
              eex$=""
              ee=0
              clc=1
              external(a$(tt))
              clc=0
              IF eee=16 AND EXIST("c:showmodule") !Emodule
                ee=-1
                EXEC "c:showmodule "+a$(tt)+" > ram:tfile",-1,16
                eof("ram:tfile")
                OPEN "i",#5,"ram:tfile"
                DO
                  LINE INPUT #5,mo$
                  PRINT #12,mo$
                LOOP UNTIL EOF(#5)
                CLOSE #5
                ee=-1
              ENDIF
              IF ee=11 AND UPPER$(RIGHT$(a$(tt),4))=".LZX"
                arc$="@{"+CHR$(34)+"READ"+CHR$(34)+"  SYSTEM "+CHR$(34)+"lzx v "+a$(tt)+" > t:gu"+CHR$(34)+"}"
                ree$="@{"+CHR$(34)+"VIEW"+CHR$(34)+" link  t:gu/MAIN}"
                PRINT #12,SPACE$(tabu%);arc$;"      ";ree$;"  VIEW ARCHIVE: READ FIRST"
                PRINT #12
                unarc$="@{"+CHR$(34)+"UNARCHIVE TO RAM"+CHR$(34)+"  SYSTEM "+CHR$(34)+"lzx x "+a$(tt)+" ram:"+CHR$(34)+"}"
                PRINT #12,SPACE$(tabu%);unarc$
                ee=-1
              ELSE IF ee=11 AND UPPER$(RIGHT$(a$(tt),4))=".LHA"
                arc$="@{"+CHR$(34)+"READ"+CHR$(34)+"  SYSTEM "+CHR$(34)+"lha v "+a$(tt)+" > t:gu "+CHR$(34)+"}"
                ree$="@{"+CHR$(34)+"VIEW"+CHR$(34)+" link  t:gu/MAIN}"
                PRINT #12,SPACE$(tabu%);arc$;"     ";ree$;"  VIEW ARCHIVE: READ FIRST"
                PRINT #12
                unarc$="@{"+CHR$(34)+"UNARCHIVE TO RAM:"+CHR$(34)+"  SYSTEM "+CHR$(34)+"lha x "+a$(tt)+" ram:"+CHR$(34)+"}"
                PRINT #12,SPACE$(tabu%);unarc$
                ee=-1
              ENDIF
              i%=INSTR(a$(tt),":")
              IF i%=0
                i%=INSTR(a$(tt),"/")
              ENDIF
              IF i%=0
                a$(tt)=di$+a$(tt)
              ENDIF
              IF ee=0  ! Text File
                IF text%=0 !OR UPPER$(RIGHT$(a$(tt),6))=".GUIDE"
                  PRINT #12
                  PRINT #12,SPACE$(tabu%);"@{";CHR$(34);f$;CHR$(34);" link ";a$(tt);"/MAIN}"
                  PRINT #12
                ELSE
                  IF EXIST(a$(tt)) !AND UPPER$(RIGHT$(a$(tt),6))<>".GUIDE"
                    GOSUB eof(a$(tt))  ! Ensure EOF
                    OPEN "i",#5,a$(tt)
                    fl%=LOF(#5)
                    IF fl%<=fbuffer%
                      DO
                        IF ll%<fl%
                          LINE INPUT #5,select$
                        ENDIF
                        PRINT #12,select$
                        select$=""
                        ll%=LOC(#5)
                        EXIT IF ERR=26
                      LOOP UNTIL EOF(#5) OR ll%=>fl% OR ERR=26 OR gnu=max%
                    ELSE
                      PRINT #12
                      PRINT #12,SPACE$(tabu%);"@{";CHR$(34);f$;CHR$(34);" link ";a$(tt);"/MAIN}"
                      PRINT #12
                    ENDIF
                    CLOSE #5
                  ELSE
                    PRINT #12,a$(tt)
                  ENDIF
                ENDIF
              ENDIF
              eex$=""
              IF ee=>1 AND ee<=7 OR ee=9 OR ee=>12 AND ee<=14 OR ee=>16 AND ee<=20 AND tool$(ee)<>""
                eex$=tool$(ee)
              ENDIF
              IF eex$=""
                eex$=guide$
              ENDIF
              IF eex$<>"" AND ee<>11
                IF RIGHT$(eex$,1)="*"
                  eex$=LEFT$(eex$,LEN(eex$)-1)
                ENDIF
                PRINT #12
                PRINT #12,SPACE$(tabu%);"@{";CHR$(34);f$;CHR$(34);" SYSTEM ";CHR$(34);eex$;" ";a$(xllx);CHR$(34);"}"
                PRINT #12
              ENDIF
            ENDIF
          NEXT ytt
          PRINT #12,"@endnode"
        NEXT t
        GOSUB endgauge
        IF m4=1
          tool$(8)=""
          m4=0
        ENDIF
        CLOSE #12
        IF eel%=1
          CLOSE #16
        ENDIF
        qq=0
        ee=0
        IF EXIST("progdir:Guide.info")
          CHDIR "progdir:"
          EXEC "copy Guide.info to "+nfile$+".info",-1,-1
        ENDIF
        aa%=@rteasyrequest("Do you wish to View "+CHR$(10)+nfile$,"VIEW|CANCEL",version$)
        qq=0
        IF aa%=1
          EXEC guide$+" "+nfile$,-1,-1
        ENDIF
        lightsoff
      ENDIF
      presentdisplay
      qq=0
    ENDIF
  ELSE
    ~@rteasyrequest("You Have to Select Some fields first","OK",version$)
  ENDIF
RETURN
PROCEDURE eof(ff$)
  OPEN "u",#15,ff$
  lof%=LOF(#15)
  IF lof%>0
    SEEK #15,lof%-1
    t%=INP(#15)
    IF t%<>10
      PRINT #15,CHR$(10)
      ~DisplayBeep(0)
    ENDIF
  ENDIF
  CLOSE #15
RETURN
PROCEDURE mergeasci
  rtitle$="Merge Data: dDbase"
  temp1$=filename1$
  GOSUB getfile("")
  IF ee=0
    select$(1)="ASCII"
    select$(2)="SUPERBASE"
    select$(3)="BBASE"
    select$(4)="FinalData"
    select$(5)="Twist Database"
    selectfield("MERGE",5)
    aa%=qq
    IF aa%=2
      GOSUB import_sb
    ENDIF
    IF aa%=3
      GOSUB impbbase
    ENDIF
    IF aa%=4
    @importfd("FinalData Database")
    ENDIF
    IF aa%=5
    @importfd("Twist Database")
    ENDIF
    IF aa%=1
      IF ee=0 AND EXIST(nfile$)
        sit%=1
        dsit%=1
        DEFMOUSE (2)
        qq$=""
        brain%=3
        OPEN "i",#1,nfile$
        lf%=LOF(#1)
        startgauge(lf%,"MERGE ASCII")
        qq$=""
        DO UNTIL EOF(#1) OR qq$=CHR$(27)
          k=k+1
          FOR rt&=1 TO n
            a$(rt&)=""
          NEXT rt&
          FOR rt&=1 TO tf
            t=tr(rt&,1)
            a$=""
            q=0
            DO UNTIL q=10
              qq$=INKEY$
              q=INP(#1)
              IF q<>10
                qq1=qq1+prefs
                a$=a$+CHR$(q)
              ENDIF
            LOOP
            fp%=LOC(#1)
            gauge
            a$(t)=TRIM$(a$)
          NEXT rt&
          EXIT IF k=>1299
          kk=k
          GOSUB pack
          TITLEW #15,"Importing Data..Record: "+STR$(kk)
        LOOP
        fin1:
        jump2:
        brain%=0
        CLOSE #1
        endgauge
        DEFMOUSE (msp1%)
      ELSE
        message("CANT FIND "+nfile$)
        DELAY 3
        moff
      ENDIF
    ENDIF
  ENDIF
  wn=0
  bank=1
  GOSUB presentdisplay
RETURN
PROCEDURE expbbase
  rtitle$="Export bBase"
  GOSUB getfile("")
  IF RIGHT$(nfile$,6)<>".bbase"
    nfile$=nfile$+".bbase"
  ENDIF
  tt%=@exist(nfile$)
  IF tt%=1 AND ee=0
    aa%=@rteasyrequest(nfile$+" File Exists","OverWrite|Cancel",version$)
    IF aa%=0
      ee=1
    ENDIF
  ENDIF
  IF ee=0
    OPEN "o",#1,nfile$
    ccount=0
    FOR t&=1 TO n
      IF VAL(f$(t&,0))=<3
        INC ccount
      ENDIF
    NEXT t&
    PRINT #1,ccount
    FOR t&=1 TO n
      IF VAL(f$(t&,0))<=3
        PRINT #1,CHR$(34)+LEFT$(f$(t&,1)+STRING$(20,"."),20)+CHR$(34)
      ENDIF
    NEXT t&
    PRINT #1,k
    startgauge(k,"Export to bBaseII Format")
    FOR kk=1 TO k
      unpack
      gauge
      FOR tt&=1 TO n
        IF VAL(f$(tt&,0))<=3
          PRINT #1,CHR$(34)+a$(tt&)+CHR$(34)
        ENDIF
      NEXT tt&
    NEXT kk
    CLOSE #1
    endgauge
  ENDIF
RETURN
PROCEDURE prout
  ccc$=CHR$(34)
  temp$=""
  FOR tt&=1 TO tf
    IF f$(tr(tt&,1),0)="10"
      calc$=f$(tr(tt&,1),5)
      GOSUB calc
      a$(tr(tt&,1))=count$
    ENDIF
    temp$=temp$+ccc$+a$(tr(tt&,1))+ccc$+","
  NEXT tt&
  temp$=LEFT$(temp$,LEN(temp$)-1)
  PRINT #13,temp$
RETURN
PROCEDURE prend
  IF po%<>2
    ff$=nfile$+".mrg"
    OPEN "o",#12,ff$
    PRINT #12,">CO Created by: "+version$+" On :"+DATE$+"  AT:  "+TIME$
    PRINT #12,">DF "+nfile$
    PRINT #12,">RU ";
    temp$=""
    FOR tt&=1 TO tf
      temp$=f$(tr(tt&,1),1)
      DO
        i%=INSTR(temp$," ")
        IF i%>0
          temp$=LEFT$(temp$,i%-1)+"_"+MID$(temp$,i%+1)
        ENDIF
      LOOP UNTIL i%=0
      PRINT #12,temp$+" ";
    NEXT tt&
    PRINT #12
    FOR tt&=1 TO tf
      temp$=f$(tr(tt&,1),1)
      DO
        i%=INSTR(temp$," ")
        IF i%>0
          temp$=LEFT$(temp$,i%-1)+"_"+MID$(temp$,i%+1)
        ENDIF
      LOOP UNTIL i%=0
      PRINT #12,"&"+temp$+"&"
    NEXT tt&
    CLOSE #12
    ~@rteasyrequest("A File Called-"+ff$+CHR$(10)+"Has just been saved. Use Merge"+CHR$(10)+"From Protext to use","Ok",version$)
  ENDIF
RETURN
PROCEDURE fcstart
  ccc$=CHR$(10)
  temp$=""
  FOR t&=1 TO tf
    temp$=temp$+f$(tr(t&,1),1)+","
  NEXT t&
  PRINT #13,LEFT$(temp$,LEN(temp$)-1)
  PRINT #13;CHR$(10)
RETURN
PROCEDURE fcout
  temp$=""
  FOR tt&=1 TO tf
    IF f$(tr(tt&,1),0)="10"
      calc$=f$(tr(tt&,1),5)
      GOSUB calc
      a$(tr(tt&,1))=count$
    ENDIF
    temp$=temp$+a$(tr(tt&,1))+"  ,"
  NEXT tt&
  PRINT #13,LEFT$(temp$,LEN(temp$)-1)
  PRINT #13;ccc$
RETURN
PROCEDURE wwout
  temp$=""
  FOR tt&=1 TO tf
    IF f$(tr(tt&,1),0)="10"
      calc$=f$(tr(tt&,1),5)
      GOSUB calc
      a$(tr(tt&,1))=count$
    ENDIF
    temp$=temp$+a$(tr(tt&,1))+CHR$(9)
  NEXT tt&
  PRINT #13,LEFT$(temp$,LEN(temp$)-1)
RETURN
PROCEDURE pwout
  temp$=""
  FOR tt&=1 TO tf
    IF f$(tr(tt&,1),0)="10"
      calc$=f$(tr(tt&,1),5)
      GOSUB calc
      a$(tr(tt&,1))=count$
    ENDIF
    temp$=temp$+CHR$(34)+a$(tr(tt&,1))+CHR$(34)+CHR$(9)
  NEXT tt&
  PRINT #13,LEFT$(temp$,LEN(temp$)-1)
RETURN
PROCEDURE export(rtitle$,exp%)
  GOSUB getfile("")
  tt%=@exist(nfile$)
  IF tt%=1 AND ee=0
    aa%=@rteasyrequest(nfile$+" File Exists","Overwrite|Cancel",rtitle$)
    IF aa%=0
      ee=1
    ENDIF
  ENDIF
  IF ee=0
    IF exp%=1
      ccc$=CHR$(34)
    ENDIF
    IF exp%=2
      ccc$=CHR$(10)
    ENDIF
    OPEN "o",#13,nfile$
    ccount=0
    IF exp%=2
      GOSUB fcstart
    ENDIF
    startgauge(k,"Exporting: "+rtitle$)
    FOR kk=1 TO k
      unpack
      gauge
      temp$=""
      IF exp%=1
        GOSUB prout
      ENDIF
      IF exp%=2
        GOSUB fcout
      ENDIF
      IF exp%=3
        GOSUB wwout
      ENDIF
      IF exp%=4
        GOSUB pwout
      ENDIF
    NEXT kk
    CLOSE #13
    endgauge
    IF exp%=1
      GOSUB prend
    ENDIF
  ENDIF
RETURN
PROCEDURE importfd(fdtex$)
  IF EXIST(nfile$) AND ee=0
    message("Importing "+fdtex$)
    OPEN "i",#2,nfile$
    DO UNTIL EOF(#2)
      LINE INPUT #2,tx$
      FOR t=1 TO 20
        a$(t)=""
      NEXT t
      tk=0
      DO UNTIL tk=>tf OR tx$=""
        IF LEFT$(tx$,1)=CHR$(34)
          i=INSTR(tx$,CHR$(34),2)
          IF i>0
            tk=tk+1
            a$(tr(tk,1))=MID$(tx$,2,i-2)
            tx$=MID$(tx$,i+2)
          ENDIF
        ENDIF
        IF LEFT$(tx$,1)<>CHR$(34) AND tx$<>""
          i=INSTR(tx$,",")
          IF i>0
            tk=tk+1
            a$(tr(tk,1))=LEFT$(tx$,i-1)
            tx$=MID$(tx$,i+1)
          ELSE
            tk=tk+1
            a$(tr(tk,1))=tx$
          ENDIF
        ENDIF
      LOOP
      k=k+1
      kk=k
      pack
    LOOP
    CLOSE #2
    moff
  ENDIF
RETURN
PROCEDURE impbbase
  OPEN "i",#1,nfile$
  LINE INPUT #1,d$
  d=VAL(d$)
  IF d<>tf
    ~@rteasyrequest("FILE NOT COMPATIBLE WITH SELECTED FIELDS","So?",version$)
    CLOSE #1
  ENDIF
  IF d=tf
    FOR t&=1 TO tf
      LINE INPUT #1,d$
    NEXT t&
    LINE INPUT #1,d$
    dd=VAL(d$)
    startgauge(dd,"Import BBASE File...")
    kk=k
    FOR tt&=1 TO dd
      gauge
      INC k
      FOR rt&=1 TO tf
        t=tr(rt&,1)
        LINE INPUT #1,a$
        a$=MID$(a$,2,LEN(a$)-2)
        a$(t)=a$
      NEXT rt&
      kk=k
      pack
    NEXT tt&
    CLOSE #1
    endgauge
  ENDIF
RETURN
PROCEDURE xpasciistart
  ~@getstring(10,"Please Enter Seperator ($<NO>)",",")
  IF LEFT$(rtstring$,1)="$"
    rtstring$=CHR$(VAL(MID$(rtstring$,2)))
  ENDIF
  sep$=rtstring$
  aq%=@rteasyrequest("Do you want each field enclosed in Quotations?","Yes|No",version$)
  IF aq%=1
    ccc$=CHR$(34)
  ELSE
    ccc$=""
  ENDIF
RETURN
PROCEDURE xpasciiout
  temp$=""
  FOR tt&=1 TO tf
    IF f$(tr(tt&,1),0)="10"
      calc$=f$(tr(tt&,1),5)
      GOSUB calc
      a$(tr(tt&,1))=count$
    ENDIF
    temp$=temp$+ccc$+a$(tr(tt&,1))+ccc$+sep$
  NEXT tt&
  temp$=LEFT$(temp$,LEN(temp$)-1)
  PRINT #13,temp$
RETURN
PROCEDURE xpascii
  IF tf>0
    IF fdflag%=FALSE
      GOSUB xpasciistart
    ENDIF
    rtitle$="Export ASCII DATA"
    GOSUB getfile("")
    tt%=@exist(nfile$)
    IF tt%=1 AND ee=0
      aa%=@rteasyrequest(nfile$+" File Exists","OverWrite|Cancel",version$)
      IF aa%=0
        ee=1
      ENDIF
    ENDIF
    IF ee=0
      OPEN "o",#13,nfile$
      IF fdflag%=TRUE
        ax$=""
        ccc$=CHR$(34)
        sep$=CHR$(9)
        FOR tty&=1 TO tf
          ax$=ax$+f$(tr(tty&,1),1)+" "+sep$
        NEXT tty&
        PRINT #13,LEFT$(ax$,LEN(ax$)-1)
      ENDIF
      ccount=0
      startgauge(k,"Export ASCI DATA..")
      FOR kk=1 TO k
        unpack
        gauge
        GOSUB xpasciiout
      NEXT kk
      CLOSE #13
      endgauge
    ENDIF
  ELSE
    message("You have to select some fields first!")
    DELAY 5
    moff
  ENDIF
RETURN
PROCEDURE exportfd
  fdflag%=TRUE
  GOSUB xpascii
  fdflag%=FALSE
RETURN
PROCEDURE xpddbase
  acr%=@rteasyrequest("Add a Line Feed?","Ok Then|No Thank you",version$)
  tax=kk
  OPEN "o",#13,nfile$
  startgauge(k,"Exporting Data..")
  FOR kk=1 TO k
    unpack
    gauge
    FOR rt&=1 TO tf
      t=tr(rt&,1)
      a$=""
      q=0
      IF acr%=1
        IF a$(t)=""
          a$(t)="#"
        ENDIF
        PRINT #13,a$(t);CHR$(13)
      ELSE
        PRINT #13,a$(t)
      ENDIF
    NEXT rt&
  NEXT kk
  kk=tax
  endgauge
  CLOSE #13
RETURN
PROCEDURE exportasci
  ffile$=file$
  temp1$=filename1$
  rtitle$="Export ASCII:  dDbase"
  GOSUB getfile("")
  file$=nfile$
  tt%=@exist(nfile$)
  IF tt%=1 AND ee=0
    aa%=@rteasyrequest(nfile$+" File Exists","OverWrite|Cancel",version$)
    IF aa%=0
      ee=1
      file$=ffile$
    ENDIF
  ENDIF
  IF ee=0
    question%=@rteasyrequest("Export in dDbase Format?","Yes|No",version$)
    IF question%=0
      ask%=1
      startgauge(k,"Exporting Data")
      DEFMOUSE (2)
      OPEN "o",#13,file$
      IF tf=0
        tf=n
        FOR t&=1 TO n
          tr(t&,1)=t&
          tr(t&,2)=VAL(f$(t&,4))
        NEXT t&
      ENDIF
      FOR tx&=1 TO k
        gauge
        kk=tx&
        GOSUB fileprint
      NEXT tx&
      acr%=0
      CLOSE #13
      endgauge
      DEFMOUSE (msp1%)
      file$=ffile$
      filename1$=temp1$
    ELSE
      GOSUB xpddbase
    ENDIF
  ENDIF
RETURN
PROCEDURE import_sb
  c$=pref$(2)
  IF VAL(c$)=<0
    cc=ASC(c$)
  ELSE
    cc=VAL(c$)
  ENDIF
  qq$=CHR$(cc)
  IF EXIST(nfile$)
    brain%=2
    sit%=1
    dsit%=1
    DEFMOUSE (2)
    OPEN "i",#1,nfile$
    lf%=LOF(#1)
    startgauge(lf%,"MERGING SUPERBASE")
    qq$=""
    DO UNTIL EOF(#1) OR ERR=26 OR qq$=CHR$(27)
      qq$=INKEY$
      qqq=0
      a$=""
      DO UNTIL qqq=10 OR qqq=13
        qqq=INP(#1)
        IF qqq<>10 AND qqq<>13
          qq1=qq1+prefs
          a$=a$+CHR$(qqq)
        ENDIF
      LOOP
      INC k
      sl=LEN(a$)
      aa$=""
      i%=0
      FOR t&=1 TO sl
        flag=0
        q$=MID$(a$,t&,1)
        IF q$<>qq$
          aa$=aa$+q$
        ENDIF
        IF q$="*" OR t&=>sl
          INC i%
          a$(tr(i%,1))=aa$
          aa$=""
        ENDIF
      NEXT t&
      gauge
      kk=k
      GOSUB pack
    LOOP
    jump3:
    endgauge
    brain%=0
    CLOSE #1
    DEFMOUSE (msp1%)
  ENDIF
RETURN
PROCEDURE exportsbase
  tfilename$=filename1$
  rtitle$="Export SuperBase:  dDbase"
  GOSUB getfile("")
  tt%=@exist(nfile$)
  IF tt%=1 AND ee=0
    aa%=@rteasyrequest(nfile$+" File Exists","OverWrite|Cancel",version$)
    IF aa%=0
      ee=1
    ENDIF
  ENDIF
  IF ee=0
    startgauge(k,"EXPORT SUPERBASE")
    DEFMOUSE (2)
    IF tf=0
      tf=n
      FOR t&=1 TO n
        tr(t&,1)=t&
        tr(t&,2)=VAL(f$(t&,4))
      NEXT t&
    ENDIF
    OPEN "o",#1,nfile$
    FOR t&=1 TO k
      kk=t&
      GOSUB unpack
      gauge
      FOR tt&=1 TO tf
        PRINT #1,LEFT$(a$(tr(tt&,1))+SPACE$(tr(tt&,2)),tr(tt&,2));pref$(2);
      NEXT tt&
      PRINT #1
    NEXT t&
    endgauge
    CLOSE #1
    nfile$=nfile$+".hlp"
    OPEN "o",#1,nfile$
    FOR t&=1 TO tf
      PRINT #1,LEFT$(f$(tr(t&,1),1)+SPACE$(20),20);tr(t&,2)
    NEXT t&
    CLOSE #1
    DEFMOUSE (msp1%)
  ENDIF
  filename1$=tfilename$
RETURN
' --------------------------------Calculations------------------------------
PROCEDURE checkcalc
  FOR tty&=1 TO n
    IF f$(tty&,0)="3" OR f$(tty&,0)="10"
      calc%=TRUE
    ENDIF
  NEXT tty&
RETURN
PROCEDURE parsley
  LOCAL i,k99,ii,cc$
  i=0
  DO
    i=INSTR(calc$,"F")
    IF i>0
      k99=i
      d$=MID$(calc$,k99+1)
      ii=INSTR(d$,"+")
      IF ii=0
        ii=INSTR(d$,"-")
      ENDIF
      IF ii=0
        ii=INSTR(d$,"/")
      ENDIF
      IF ii=0
        ii=INSTR(d$,"*")
      ENDIF
      IF ii>0
        cc$=LEFT$(d$,ii-1)
        calc$=LEFT$(calc$,i-1)+a$(VAL(cc$))+MID$(d$,ii)
      ELSE IF ii=0
        cc$=MID$(d$,1)
        calc$=LEFT$(calc$,i-1)+a$(VAL(cc$))
      ENDIF
    ENDIF
  LOOP UNTIL i=0
RETURN
PROCEDURE calc
  LOCAL ttt&,c,cc,i,ii,x
  FOR ttt&=1 TO 30
    calc$(ttt&,0)=""
  NEXT ttt&
  unpack
  c=0
  cc=0
  i=0
  DO
    i=INSTR(calc$," ")
    IF i>0
      calc$=LEFT$(calc$,i-1)+MID$(calc$,i+1)
    ENDIF
  LOOP UNTIL i=0
  i=0
  GOSUB parsley
  DO
    cc=cc+1
    x=ASC(MID$(calc$,cc,1))
    IF x<48 OR x>57 AND x<>46
      c=c+1
      calc$(c,0)=LEFT$(calc$,cc-1)
      calc$(c,1)=CHR$(x)
      calc$=MID$(calc$,cc+1)
      cc=0
    ENDIF
  LOOP UNTIL calc$=""
  cc=0
  to=VAL(calc$(1,0))
  DO
    cc=cc+1
    IF calc$(cc,1)="+" !AND VAL(calc$(cc+1,0))>0
      to=to+VAL(calc$(cc+1,0))
    ELSE IF calc$(cc,1)="-" !AND VAL(calc$(cc+1,0))>0
      to=to-VAL(calc$(cc+1,0))
    ELSE IF calc$(cc,1)="/" AND VAL(calc$(cc+1,0))>0
      to=to/VAL(calc$(cc+1,0))
    ELSE IF calc$(cc,1)="*" AND VAL(calc$(cc+1,0))>0
      to=to*VAL(calc$(cc+1,0))
    ENDIF
  LOOP UNTIL cc=c
  count$=STR$(to)
  calc$=""
RETURN
PROCEDURE clearcalc
  LOCAL tty&
  FOR tty&=1 TO 20
    calc(tty&)=0
  NEXT tty&
  to=0
RETURN
PROCEDURE calcit
  LOCAL ttty&,tty&
  GOSUB unpack
  IF cal%=1
    FOR ttty&=1 TO tf
      tty&=tr(ttty&,1)
      IF f$(tty&,0)="10"
        calc$=f$(tty&,5)
        GOSUB calc
        a$(tty&)=count$
      ENDIF
      IF f$(tty&,0)="3" OR f$(tty&,0)="10"
        calc(tty&)=calc(tty&)+VAL(a$(tty&))
      ENDIF
    NEXT ttty&
  ENDIF
RETURN
PROCEDURE discalc
  LOCAL tty,guagew,tty&,ttty&
  eex$=""
  FOR tty=1 TO tf
    guagew=tr(tty,1)
    IF f$(guagew,0)="3" OR f$(guagew,0)="10"
      eex$=eex$+LEFT$(f$(guagew,1)+SPACE$(100),tr(tty,2))+STR$(calc(guagew))+CHR$(10)
    ENDIF
  NEXT tty
  print%=@rteasyrequest(eex$,"OK|Print|Cancel",version$)
  temp$=""
  IF print%=2 AND pcode=1 AND question%=1
    LPRINT STRING$(78,ASC("-"))
    FOR tty&=1 TO tf
      temp$=temp$+LEFT$(STR$(calc(tr(tty&,1)))+SPACE$(100),tr(tty&,2))+"   "
    NEXT tty&
    LPRINT lfm$+temp$
  ELSE IF pcode>1 AND question%=1
    LPRINT " "
    FOR ttty&=1 TO tf
      tty=tr(ttty&,1)
      IF f$(tty,0)="3" OR f$(tty,0)="10"
        LPRINT LEFT$(f$(tty,1)+SPACE$(100),20);STR$(calc(tty))
      ENDIF
    NEXT ttty&
  ENDIF
  IF print%=2 AND pcode=1 AND question%=2
    FOR tty&=1 TO tf
      temp$=temp$+LEFT$(STR$(calc(tr(tty&,1)))+SPACE$(100),tr(tty&,2))+"   "
    NEXT tty&
    PRINT #13,STRING$(78,ASC("-"))
    PRINT #13,temp$
  ELSE IF pcode>1 AND question%=2
    FOR ttty&=1 TO tf
      tty=tr(ttty&,1)
      IF f$(tty,0)="3" OR f$(tty,0)="10"
        PRINT #13,LEFT$(f$(tty,1)+SPACE$(100),20);STR$(calc(tty))
      ENDIF
    NEXT ttty&
  ENDIF
RETURN
' -------------------------------Filing Routines--------------------------
PROCEDURE filewizard
  IF EXIST("progdir:help/")
    FILES "progdir:help/" TO "ram:wizard"
    IF EXIST("ram:wizard")
      OPEN "i",#1,"ram:wizard"
      path=0
      DO UNTIL EOF(#1)
        LINE INPUT #1,aa$
        aa$=TRIM$(aa$)
        ii=INSTR(aa$," ")
        IF ii>0
          aa$=LEFT$(aa$,ii-1)
        ENDIF
        IF UPPER$(RIGHT$(aa$,4))=".LIZ"
          path=path+1
          select$(path)=UPPER$(aa$)
        ENDIF
      LOOP
      CLOSE #1
      IF path>0
        QSORT select$(),path+1
      @listview(path,"Select Daemon")
        IF tag%>0 AND tag%<=path
          nna$=select$(tag%)
          fff$=file$
          file$="progdir:help/"+nna$
          wizard%=TRUE
          GOSUB load
          wizard%=FALSE
        ENDIF
      ENDIF
    ENDIF
  ENDIF
RETURN
FUNCTION checkconfig
  check%=TRUE
  testmax%=200+winoff%-30
  IF bbx>0
    FOR chk&=1 TO bbx
      IF box(chk&,4)>testmax%
        ee=1
        check%=FALSE
      ENDIF
    NEXT chk&
  ENDIF
  RETURN check%
ENDFUNC
FUNCTION checkfile
  check%=TRUE
  FOR chk&=1 TO n
    IF VAL(f$(chk&,3))>maxlin1%
      ee=1
      check%=FALSE
    ENDIF
  NEXT chk&
  RETURN check%
ENDFUNC
PROCEDURE savit
  IF EXIST("ram:ALL_FILES")
    KILL "ram:ALL_FILES"
  ENDIF
  lightson
  k1=kk
  DEFMOUSE (2)
  IF RIGHT$(file$,4)<>".ddb" AND RIGHT$(file$,4)<>".DDB"
    file$=file$+".ddb"
  ENDIF
  file1$=file$+".cfg"
  file2$=LEFT$(file$,LEN(file$)-4)+".dat"
  IF EXIST(file$) AND backup%=TRUE
    IF EXIST(file$+".BAK")
      KILL file$+".BAK"
    ENDIF
    IF EXIST(file1$+".BAK")
      KILL file1$+".BAK"
    ENDIF
    IF EXIST(file2$+".BAK")
      KILL file2$+".BAK"
    ENDIF
    RENAME file$ AS file$+".BAK"
    IF EXIST(file1$)
      RENAME file1$ AS file1$+".BAK"
    ENDIF
    IF EXIST(file2$)
      RENAME file2$ AS file2$+".BAK"
    ENDIF
  ENDIF
  OPEN "o",#1,file$
  PRINT #1,"ddbase.file170790"  !Save definition
  PRINT #1,n                    !Field No
  PRINT #1,k                    !Record no
  FOR t&=1 TO n                 !Save Fields
    FOR nn&=0 TO 5
      PRINT #1,f$(t&,nn&)
    NEXT nn&
  NEXT t&
  CLOSE #1
  IF LEFT$(pref$(4),1)="y" AND EXIST("c:packit")
    file4$=file2$
    file2$=MID$(pref$(4),3)+"ddtemp"
  ENDIF
  OPEN "o",#1,file2$            !Save data
  startgauge(k,"SAVING.."+filetitl$)
  FOR t&=1 TO k
    gauge
    PRINT #1,w$(t&)
  NEXT t&
  endgauge
  CLOSE #1
  IF LEFT$(pref$(4),1)="y" AND EXIST("c:packit")
    moff
    message("Crunching File Please Wait...")
    ex$="c:packit "+file2$+" "+file4$+" C=CRUNCH EFF="+MID$(pref$(4),2,1)
    ypos%=144+winoff%
    yp$="con:0/"+STR$(ypos%)+"/640/56/dDbase Output"
    OPEN "o",#2,yp$
    ee%=EXEC(ex$,0,2)
    WRITE #2,ee%
    DELAY (3)
    CLOSE #2
    KILL file2$
    moff
    lightsoff
    DEFMOUSE (msp1%)
  ENDIF
  IF bbx>0 OR tf>0  !Save boxes and selected fields
    OPEN "o",#1,file1$
    PRINT #1,tf
    FOR t&=1 TO tf  !Selected fields
      PRINT #1,tr(t&,1) ! Field
      PRINT #1,tr(t&,2) ! Field Length
    NEXT t&
    PRINT #1,bbx
    FOR t&=1 TO bbx !Boxes
      FOR tt&=0 TO 4
        PRINT #1,box(t&,tt&)
      NEXT tt&
    NEXT t&
    CLOSE #1
    OPEN "o",#3,LEFT$(file$,LEN(file$)-4)+".txfx"
    FOR tt&=1 TO n
      PRINT #3,CHR$(34)+txfx$(tt&,1)+CHR$(34)
      PRINT #3,CHR$(34)+txfx$(tt&,2)+CHR$(34)
    NEXT tt&
    CLOSE #3
    sit%=0
  ENDIF
  kk=k1
  GOSUB presentdisplay
  sit%=0
  DEFMOUSE (msp1%)
  lightsoff
RETURN
PROCEDURE loadconfig
  IF wizard%=FALSE
    file1$=file$+".cfg"
  ELSE IF wizard%=TRUE
    file1$=LEFT$(file$,LEN(file$)-4)+".ddb.cfg"
  ENDIF
  IF EXIST(file1$)
    OPEN "i",#1,file1$
    INPUT #1,tf
    FOR t&=1 TO tf
      INPUT #1,tr(t&,1) ! Field
      INPUT #1,tr(t&,2) ! Field Length
    NEXT t&
    INPUT #1,bbx
    FOR t&=1 TO bbx
      FOR tt&=0 TO 4
        INPUT #1,box(t&,tt&)
      NEXT tt&
    NEXT t&
    CLOSE #1
  ENDIF
  checkit%=@checkconfig
  IF checkit%=FALSE
    ~@rteasyrequest("Wrong Screen Mode for Config File","Ok",version$)
    filename1$=""
    n=0
    bbx=0
    k=0
    kk=0
    ERASE w$()
    DIM w$(max%)
    ext=0
  ENDIF
  checkitt%=@checkfile
  IF checkitt%=FALSE AND checkit%=TRUE
    ~@rteasyrequest("Wrong Screen Mode For "+file$,"Ok",version$)
    n=0
    bbx=0
    k=0
    kk=0
    ERASE w$()
    DIM w$(max%)
    filename1$=""
  ENDIF
  bank=1
  wn=0
  IF checkit%=TRUE
    GOSUB getext
  ENDIF
  moff
  DEFMOUSE (msp1%)
  kk=1
  wn=0
  bank=1
  GOSUB clearscreen
  IF ee=0
    GOSUB gfield
  ENDIF
RETURN
PROCEDURE clear
  bbx=0
  gr=0
  IF calcf>0
    FOR t&=1 TO calcf
      calcf(t&)=0
    NEXT t&
    calcf=0
  ENDIF
  sit%=0
  ERASE w$()
  ERASE section$()
  FOR t&=1 TO calcf
    calcf(t&)=0
  NEXT t&
  calcf=0
  FOR t&=1 TO n
    FOR tt&=1 TO 4
      f$(t&,tt&)=""
    NEXT tt&
  NEXT t&
  DIM w$(max%)
  DIM section$(20)
  k=0
  kk=0
  n=0
  bbx=0
  nn$=""
  tf=0
RETURN
PROCEDURE load
  IF EXIST(file$)
    ee=0
  ELSE
    ~@rteasyrequest(file$+" IS NOT A dDbase DATABASE","Ok",version$)
    ee=1
  ENDIF
  IF ee=0
    IF EXIST("ram:ALL_FILES")
      KILL "ram:ALL_FILES"
    ENDIF
    lightson
    GOSUB clear
    filenote$=LEFT$(file$,LEN(file$)-4)+".fln"
    message("Loading --ĺ"+LEFT$(file$,LEN(file$)-4))
    DEFMOUSE (2)
    OPEN "i",#1,file$
    INPUT #1,nn$                !Field No
    IF nn$="ddbase.file170790"
      INPUT #1,n
      INPUT #1,k                !Record No
      IF k>1299 OR n>20
        GOTO finish
      ENDIF
      FOR t&=1 TO n             !Load Fields
        FOR nn&=0 TO 4
          LINE INPUT #1,f$(t&,nn&)
        NEXT nn&
        IF f$(t&,0)="3" OR f$(t&,0)="10"
          calc%=TRUE
        ENDIF
        IF VAL(f$(t&,4))>maxfield%
          gu%=@rteasyrequest("Shall I Expand the Field Size:"+CHR$(10)+"     From: "+STR$(maxfield%)+" To: "+f$(t&,4),"GO AHEAD|CANCEL",version$)
          IF gu%=1
            maxfield%=VAL(f$(t&,4))+100
          ENDIF
        ENDIF
        IF f$(t&,0)="1"
          qq=0
          af$=""
          DO UNTIL qq=10 OR qq=13
            qq=INP(#1)
            IF qq<>10 AND qq<>13
              af$=af$+CHR$(qq)
            ENDIF
          LOOP
        ENDIF
        IF f$(t&,0)<>"1"
          LINE INPUT #1,af$
        ENDIF
        f$(t&,5)=af$
        f(t&)=VAL(f$(t&,4))
      NEXT t&
    ELSE
      ~@rteasyrequest("NOT A dDbase DATABASE","OK",version$)
      moff
      clearscreen
      ee=1
    ENDIF
    CLOSE #1
    IF EXIST(file2$) AND k>0 AND ee=0
      OPEN "i",#1,file2$
      aba$=INPUT$(4,#1)
      CLOSE #1
      IF aba$="PP20" AND EXIST("c:packit")
        temp$=destination$+"file.pw"
        ex$="c:packit "+file2$+" "+temp$+" D=DECRUNCH >NIL:"
        moff
        message("DeCrunching File")
        EXEC ex$,-1,-1
        moff
        file2$=temp$
        ee=0
      ENDIF
      IF aba$="PP20" AND NOT EXIST("c:packit")
        file2$=""
        ~@rteasyrequest("Cannot Decrunch Requested File Cannot find Packit in your C directory","Shame",version$)
        ee=1
        k=0
        kk=0
        n=0
      ENDIF
      IF k>0 AND EXIST(file2$) AND ee=0
        free%=FRE()
        OPEN "i",#1,file2$
        lof%=LOF(#1)
        IF lof%<free%
          RECALL #1,w$(),1 TO k,x
          kk=k
          GOSUB unpack
          FOR county=1 TO n
            temp$(county)=a$(county)
          NEXT county
          kk=1
        ELSE
          moff
          message("NOT ENOUGH MEMORY TO LOAD FILE")
          DELAY 4
          filename1$=""
          filetitl$=""
          moff
          ee=1
          GOSUB clear
        ENDIF
        finish:
        CLOSE #1
      ENDIF
    ENDIF
    IF EXIST(destination$+"file.pw")
      KILL destination$+"file.pw"
    ENDIF
    IF ee=0
      GOSUB loadconfig
      IF EXIST(LEFT$(file$,LEN(file$)-4)+".txfx")
        OPEN "i",#3,LEFT$(file$,LEN(file$)-4)+".txfx"
        FOR tt&=1 TO n
          INPUT #3,txfx$(tt&,1)
          INPUT #3,txfx$(tt&,2)
        NEXT tt&
        CLOSE #3
      ELSE
        FOR tt&=1 TO 20
          txfx$(tt&,1)=""
          txfx$(tt&,2)=""
        NEXT tt&
      ENDIF
    ENDIF
    IF ee=1
      bank=1
      wn=0
      DEFMOUSE (msp1%)
      moff
    ENDIF
    dodate
    donum
    lightsoff
    GOSUB presentdisplay
    GOSUB redraw
  ENDIF
RETURN
PROCEDURE filing
  ee=1
  match_pat$="#?.DDB"+CHR$(0)
  changereqtags%(1)=VARPTR(match_pat$)
  rtchangereqattra(filereqptr%,VARPTR(changereqtags%(0)))
  IF @rtselectfile(filereqptr%,rtitle$+CHR$(0),rtpath$)=1
    ee=0
    file$=path$
    IF LEFT$(file$,9)="Ram Disk:"
      file$="Ram:"+MID$(file$,10)
    ENDIF
    IF filename1$<>""
      IF RIGHT$(UPPER$(filename1$),4)=".DDB"
        filetitl$=LEFT$(filename1$,LEN(filename1$)-4)
      ELSE
        filetitl$=filename1$
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE getpath(rtitle$)
  ee=1
  tempfile$=filename1$
  IF @rtselectdir(pathptr%,rtitle$+CHR$(0),rtpath$)=1
    ee=0
    nfile$=path$
    IF RIGHT$(nfile$,1)<>":" AND nfile$<>""
      nfile$=nfile$+"/"
    ENDIF
    IF LEFT$(nfile$,9)="Ram Disk:"
      nfile$="Ram:"+MID$(nfile$,10)
    ENDIF
  ENDIF
  filename1$=tempfile$
RETURN
PROCEDURE getfile(match$)
  rtitle$="Select File"
  ee=1
  tempfile$=filename1$
  match_pat$=match$+CHR$(0)
  changereqtags%(1)=VARPTR(match_pat$)
  rtchangereqattra(globalptr%,VARPTR(changereqtags%(0)))
  IF @rtselectfile(globalptr%,rtitle$+CHR$(0),rtpath$)=1
    ee=0
    nfile$=path$
    IF LEFT$(nfile$,9)="Ram Disk:"
      nfile$="Ram:"+MID$(nfile$,10)
    ENDIF
  ENDIF
  filename1$=tempfile$
RETURN
' -------------------------------Field Manipulation-----------------------
PROCEDURE fillfield(print)
@startgauge(k,"Fill Field..."+STR$(print))
  phil$=""
  FOR kk=1 TO k
  @gauge
    unpack
    IF a$(print)<>""
      phil$=a$(print)
    ENDIF
    IF a$(print)=""
      a$(print)=phil$
      TITLEW #15,phil$
    ENDIF
    w$(kk)=""
    pack
  NEXT kk
@endgauge
RETURN
PROCEDURE capturewindow
  FOR ty=0 TO 20
    section$(ty)=""
  NEXT ty
  mereq%=(winh%-42)*237
  IF FRE(0)=>mereq%
    ymax%=winh%-42
    ymax1%=ymax%/20+1
    xmax%=0
    GET 10,10,640,ymax1%,section$(1)
    GET 10,ymax1%+1,640,ymax1%*2,section$(2)
    GET 10,ymax1%*2+1,640,ymax1%*3,section$(3)
    GET 10,ymax1%*3+1,640,ymax1%*4,section$(4)
    GET 10,ymax1%*4+1,640,ymax1%*5,section$(5)
    GET 10,ymax1%*5+1,640,ymax1%*6,section$(6)
    GET 10,ymax1%*6+1,640,ymax1%*7,section$(7)
    GET 10,ymax1%*7+1,640,ymax1%*8,section$(8)
    GET 10,ymax1%*8+1,640,ymax1%*9,section$(9)
    GET 10,ymax1%*9+1,640,ymax1%*10,section$(10)
    GET 10,ymax1%*10+1,640,ymax1%*11,section$(11)
    GET 10,ymax1%*11+1,640,ymax1%*12,section$(12)
    GET 10,ymax1%*12+1,640,ymax1%*13,section$(13)
    GET 10,ymax1%*13+1,640,ymax1%*14,section$(14)
    GET 10,ymax1%*14+1,640,ymax1%*15,section$(15)
    GET 10,ymax1%*15+1,640,ymax1%*16,section$(16)
    GET 10,ymax1%*16+1,640,ymax1%*17,section$(17)
    GET 10,ymax1%*17+1,640,ymax1%*18,section$(18)
    GET 10,ymax1%*18+1,640,ymax1%*19,section$(19)
    GET 10,ymax1%*19+1,640,ymax1%*20,section$(20)
    eer=0
  ELSE
    ~@rteasyrequest("Not enough memory for required function","OK",version$)
    eer=1
  ENDIF
RETURN
PROCEDURE releasewindow
  ymax%=winh%-42
  ymax1%=ymax%/20+1
  xmax%=0
  PUT 10,10,section$(1)
  PUT 10,ymax1%+1,section$(2)
  PUT 10,ymax1%*2+1,section$(3)
  PUT 10,ymax1%*3+1,section$(4)
  PUT 10,ymax1%*4+1,section$(5)
  PUT 10,ymax1%*5+1,section$(6)
  PUT 10,ymax1%*6+1,section$(7)
  PUT 10,ymax1%*7+1,section$(8)
  PUT 10,ymax1%*8+1,section$(9)
  PUT 10,ymax1%*9+1,section$(10)
  PUT 10,ymax1%*10+1,section$(11)
  PUT 10,ymax1%*11+1,section$(12)
  PUT 10,ymax1%*12+1,section$(13)
  PUT 10,ymax1%*13+1,section$(14)
  PUT 10,ymax1%*14+1,section$(15)
  PUT 10,ymax1%*15+1,section$(16)
  PUT 10,ymax1%*16+1,section$(17)
  PUT 10,ymax1%*17+1,section$(18)
  PUT 10,ymax1%*18+1,section$(19)
  PUT 10,ymax1%*19+1,section$(20)
RETURN
PROCEDURE place
  OPENW #1,0,0,640,winh%,&H80000,4096+&H4+65536
  tit$="Place Fields:   Press Left Mouse Button to Position Field "
  TITLEW #1,tit$
  wn=1
  CLS
  GOSUB displaybox
  drawbevelbox(LPEEK(WINDOW(wn)+50),4,11,630,197+winoff%) !Screen
  drawflipbox(LPEEK(WINDOW(wn)+50),10,14,618,160+winoff%) !Screen
  FOR t=1 TO n
    TITLEW #1,tit$+STR$(t)
    drawbevelbox(LPEEK(WINDOW(wn)+50),7,14,627,182+winoff%)
    capturewindow
    IF eer=0
      sel$=f$(t,0)
      IF VAL(f$(t,0))<=3
        aa$=f$(t,1)
      ELSE
        aa$=f$(t,1)
      ENDIF
      bb$=SPACE$(LEN(aa$))
      DO UNTIL MOUSEK=1
        x=INT(MOUSEX/8)+1
        y=INT(MOUSEY/8)
        IF y<0
          y=0
        ENDIF
        IF y=>maxlin3%
          y=maxlin3%
        ENDIF
        IF VAL(f$(t,0))<=3 OR VAL(f$(t,0))=10
          ltot=LEN(f$(t,1))*8
          ltot=ltot+9
          totl=VAL(f$(t,4))*8
          flipbox(1,x*8+ltot,y*8+3,totl,8)
          PRINT AT(x,y);aa$
        ELSE
          ltot=LEN(f$(t,1))*8
          ltot=ltot+7
          PRINT AT(x,y);f$(t,1)
          IF VAL(f$(t,0))<>6
            bevelbox(1,x*8-8,y*8-1,ltot,14)
          ENDIF
        ENDIF
        releasewindow
      LOOP
      IF VAL(f$(t,0))<=3 OR VAL(f$(t,0))=10
        ltot=LEN(f$(t,1))*8
        ltot=ltot+9
        totl=VAL(f$(t,4))*8
        flipbox(1,x*8+ltot,y*8+3,totl,8)
        PRINT AT(x,y);aa$
      ELSE
        ltot=LEN(f$(t,1))*8
        ltot=ltot+7
        PRINT AT(x,y);f$(t,1)
        IF VAL(f$(t,0))<>6
          bevelbox(1,x*8-8,y*8-1,ltot,14)
        ENDIF
      ENDIF
      f$(t,2)=STR$(x)
      f$(t,3)=STR$(y)
      DELAY 1
    ENDIF
  NEXT t
@clearsection
  CLOSEW #1
RETURN
PROCEDURE clearsection
  ERASE section$()
  DIM section$(20)
RETURN
PROCEDURE placeit
  ll%=0
  FOR t&=1 TO n
    IF LEN(f$(t&,1))>ll%
      ll%=LEN(f$(t&,1))
    ENDIF
  NEXT t&
  FOR t&=1 TO n
    f$(t&,1)=LEFT$(f$(t&,1)+SPACE$(ll%),ll%)+" |"
  NEXT t&
  FOR t&=1 TO n
    f$(t&,2)=STR$(5)
    f$(t&,3)=STR$(t&+2)
  NEXT t&
RETURN
PROCEDURE create
  ask%=@rteasyrequest("Create a File or use a Daemon?","Create|Daemon",title$)
  IF ask%=0
    GOSUB filewizard
  ELSE
    ge%=@getstring(5,"How Many Fields","")
    IF ge%=1
      start=1
      xn=VAL(rtstring$)
      IF xn>0 AND xn<20
        GOSUB getfields
        IF a%>0
          n=xn
          IF screenmode%=0
            GOSUB place
          ELSE
            GOSUB placeit
          ENDIF
          bank=1
          wn=0
          clearscreen
          GOSUB getext
          GOSUB getfieldlength
          GOSUB gfield
          GOSUB redraw
          GOSUB checkcalc
          filename1$="UnTitled.ddb"
        ENDIF
      ELSE
        ~@rteasyrequest("     Wrong Input     "+CHR$(10)+"       (1-19)"+CHR$(10),"Ok",version$)
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE getfieldlength
  FOR ty&=1 TO n
    f(ty&)=VAL(f$(ty&,4))
  NEXT ty&
RETURN
PROCEDURE getfields
  ' Field Definitions are:
  ' 0- Field Definition
  ' 1- Name
  ' 2- X Pos
  ' 3- Y Pos
  ' 4- Length
  ' 5- Type (String UpperC=2 ow <>"" Req)
  '       Date 1-2
  '       Integer 1-6
  sit%=1
  dsit%=1
  ypos%=winh%-60
  OPENW #3,103,0,450,winh%,0,4096
  TITLEW #3,"  No      Field                                Length"
  wn=3
  drawbevelbox(LPEEK(WINDOW(wn)+50),12,12,424,184+winoff%)
  IF n>0
    FOR t=1 TO n
      PRINT AT(3,t+1);LEFT$(STR$(t)+SPACE$(4),4);LEFT$(f$(t,1)+STRING$(45,"-"),43);RIGHT$(SPACE$(4)+f$(t,4),4)
    NEXT t
  ENDIF
  OPENW #2,50,ypos%,556,60,&H40000,4096+65536+&H2
  TITLEW #2,version$
  bank=8
  wn=2
  dbbox(7,12,540,44)
  GOSUB display
  drawflipbox(LPEEK(WINDOW(wn)+50),448,18,42,10)  ! Len
  drawbevelbox(LPEEK(WINDOW(wn)+50),447,17,44,12) ! Len
  drawflipbox(LPEEK(WINDOW(wn)+50),24,18,329,10)
  drawbevelbox(LPEEK(WINDOW(wn)+50),23,17,331,12)
  FOR xx=start TO xn
    a%=0
    OPENW #2
    ~ActivateWindow(WINDOW(2))
    DO UNTIL a%>0
      TITLEW #2,"Field Definitions  Field-"+STR$(xx)+"  Of-"+STR$(xn)
      text(418,38,"Field Length",1,2)
      text(140,38,"Field Name",1,2)
      COLOR 0
      COLOR 1
      field$=""
      change$=""
      reclen%=0
      PRINT AT(57,2);SPACE$(4)
      PCOLOR 1,m3
      PRINT AT(4,2);SPACE$(40)
      PRINT AT(4,2);
      PCOLOR 1,0
      FORM INPUT 40 AS field$
      reclen%=LEN(fields$)+2
      PRINT AT(4,2);LEFT$(field$+SPACE$(40),40)
      DO
        change$=""
        PCOLOR 1,m3
        PRINT AT(57,2);SPACE$(4)
        PCOLOR 1,0
        PRINT AT(57,2);
        FORM INPUT 4 AS change$
      LOOP UNTIL VAL(change$)>0
      IF VAL(change$)>maxfield%
        ~@rteasyrequest("Field Too Long","Ok","")
        change$=STR$(maxfield%)
      ENDIF
      reclen%=reclen%+VAL(change$)
      PRINT AT(57,2);LEFT$(change$+SPACE$(10),4)
      qqq=0
      TITLEW #2,"ENTER FIELD TYPE"
      WHILE qqq=0
        qqq=@test
      WEND
      txtype%=@rteasyrequest("What sort of text effect do you want?","Bold|Underlined|Italic|Cancel","Text Effect")
      q2=xx
      IF txtype%=1
        txfx$(q2,1)=txfx$(q2,1)+b1$
        txfx$(q2,2)=txfx$(q2,2)+b2$
      ELSE IF txtype%=2
        txfx$(q2,1)=txfx$(q2,1)+ul1$
        txfx$(q2,2)=txfx$(q2,2)+ul2$
      ELSE IF txtype%=3
        txfx$(q2,1)=txfx$(q2,1)+it$
        txfx$(q2,2)=txfx$(q2,2)+it1$
      ELSE IF txtype%=0
        txfx$(q2,1)=""
        txfx$(q2,2)=""
      ENDIF
      IF qqq=1
        IF reclen%>74
          lenn%=70-LEN(field$)
          change$=STR$(lenn%)
        ENDIF
        select$(1)="Required"
        select$(2)="UPPERCASE"
        select$(3)="Normal"
        aa%=0
        WHILE aa%=0
          selectfield("STRING",3)
          ~ActivateWindow(WINDOW(2))
          OPENW #2
          aa%=qq
          IF aa%>3
            aa%=0
          ENDIF
        WEND
        IF aa%=1
          tempmax%=VAL(change$)
          editrequired(xx)
          wn=2
          OPENW #2
        ENDIF
        IF aa%=2
          f$(xx,5)="2"
        ENDIF
        qqq=1
      ENDIF
      IF qqq=2
        aa%=0
        IF VAL(f$(xx,4))<12
          f$(xx,4)=STR$(12)
        ENDIF
        DO UNTIL aa%>0
          aa%=@datefield
          f$(xx,5)=STR$(aa%)
          IF aa%=0
            message("YOU ARE REQUIRED TO ENTER A DATE FORMAT")
            DELAY 2
            moff
            bank=10
            GOSUB helpit
            bank=8
            wn=2
          ENDIF
        LOOP
        qqq=2
      ENDIF
      IF qqq=3
        gxl=q
        aa%=@getnumeric
        IF aa%=7
          aa%=0
        ENDIF
        IF aa%>0
          f$(xx,5)=STR$(aa%)
          xlen%=VAL(change$)
          IF aa%=1 AND xlen%<4
            xlen%=6
          ELSE IF aa%=2 AND xlen%<8
            xlen%=10
          ELSE IF aa%=3 AND xlen%<4
            xlen%=7
          ELSE IF aa%=4 AND xlen%<6
            xlen%=8
          ELSE IF aa%=5 AND xlen%<8
            xlen%=11
          ENDIF
          change$=STR$(xlen%)
        ENDIF
        qqq=3
      ENDIF
      IF qqq=9  ! Attach
        temp$=rtstring$
        ~@getstring(70,"Enter Formula","")
        formula$=rtstring$
        rtstring$=temp$
      ENDIF
      IF qqq=10 !Calc
        temp$=rtstring$
        ~@getstring(70,"Enter Calculation","")
        calculation$=UPPER$(rtstring$)
        rtstring$=temp$
      ENDIF
      mess$=""
      FOR tem=1 TO xx-1
        me1$="   "
        IF f$(tem,0)="2" OR f$(tem,0)="3"
          me1$=f$(tem,5)
        ENDIF
        IF f$(tem,0)="1" AND f$(tem,5)<>""
          me1$="Req"
        ENDIF
        mess$=mess$+LEFT$(f$(tem,1)+SPACE$(30),25)+LEFT$(f$(tem,4)+SPACE$(10),5)+LEFT$(dtype$(VAL(f$(tem,0)))+SPACE$(10),10)+me1$+CHR$(10)
      NEXT tem
      me1$="   "
      IF LEN(f$(xx,5))>2
        me1$="Req"
      ELSE
        me1$=f$(xx,5)
      ENDIF
      mess$=mess$+"------------------------------------------"+CHR$(10)
      mess$=mess$+LEFT$(field$+SPACE$(30),25)+LEFT$(change$+SPACE$(10),5)+LEFT$(dtype$(qqq)+SPACE$(10),10)+me1$+CHR$(10)
      mess$=mess$+"------------------------------------------"+CHR$(10)
      mess$=mess$+"Field No."+STR$(xx)+"  Is This Correct:"+CHR$(10)
      a%=@rteasyrequest(mess$,"Accept|Restart|Cancel","Field Name               Length   Type   NType")
      IF a%=1
        f$(xx,1)=field$
        f$(xx,4)=change$
        f$(xx,0)=STR$(qqq)
        IF f$(xx,0)="9"
          f$(xx,5)=formula$
        ENDIF
        IF f$(xx,0)="10"
          f$(xx,5)=calculation$
        ENDIF
        qqq=0
        OPENW #3
        PRINT AT(3,xx+1);LEFT$(STR$(xx)+SPACE$(4),4);LEFT$(field$+STRING$(45,"-"),43);RIGHT$(SPACE$(4)+change$,4)
        OPENW #2
      ENDIF
      IF a%=2
        xx=start-1
        IF aaf%=0
          OPENW #3
          CLS
          wn=3
          drawbevelbox(LPEEK(WINDOW(wn)+50),12,12,424,184+winoff%)
          wn=2
        ENDIF
      ENDIF
      IF a%=0
        xx=xn+1
        sit%=0
      ENDIF
      EXIT IF a%=0
    LOOP
  NEXT xx
  CLOSEW #2
  CLOSEW #3
RETURN
PROCEDURE fielddef
  ypos%=winh%-140
  ypos%=ypos%/2
  OPENW #2,70,ypos%,500,140,&H40000+&H80000,4096+65536
  TITLEW #2,version$
  bank=8
  wn=2
  dbbox(6,18,485,116)
  drawflipbox(LPEEK(WINDOW(wn)+50),60,40,380,55)
  FOR tt=1 TO 10
    tx$(tt)=box$(tt,8)
    box$(tt,8)=LEFT$(box$(tt,8),3)+"117"+MID$(box$(tt,8),7)
  NEXT tt
  GOSUB display
  text(204,22,"Field Data",1,2)
  text(12,50,"No ",2,1)
  text(12,63,"Type- ",2,1)
  text(12,76,"Name- ",2,1)
  text(12,89,"Length",2,1)
  text(74,50,STR$(qq),1,2)
  temp$=""
  temp$=f$(qq,5)
  IF LEN(temp$)>1 AND f$(qq,0)="1"
    q2=qq
    temp$="Required"
  ENDIF
  text(74,63,dtype$(VAL(f$(qq,0)))+"  :"+temp$,1,2)
  text(74,76,LEFT$(f$(qq,1),30),1,2)
  text(74,89,f$(qq,4),1,2)
  text(100,110,"Please Select Field Type",1,2)
  qq=0
  DO
    qqq=@test
  LOOP UNTIL qq>0
  txtype%=@rteasyrequest("What sort of text effect do you want?","Bold|Underlined|Italic|Cancel","Text Effect")
  IF txtype%=1
    txfx$(q2,1)=txfx$(q2,1)+b1$
    txfx$(q2,2)=txfx$(q2,2)+b2$
  ELSE IF txtype%=2
    txfx$(q2,1)=txfx$(q2,1)+ul1$
    txfx$(q2,2)=txfx$(q2,2)+ul2$
  ELSE IF txtype%=3
    txfx$(q2,1)=txfx$(q2,1)+it$
    txfx$(q2,2)=txfx$(q2,2)+it1$
  ELSE IF txtype%=0
    txfx$(q2,1)=""
    txfx$(q2,2)=""
  ENDIF
  IF qqq=9
    temp$=rtstring$
    ~@getstring(70,"Enter Formula",f$(q2,5))
    formula$=rtstring$
    f$(q2,5)=rtstring$
    rtstring$=temp$
  ENDIF
  IF qqq=10 !Calc
    temp$=rtstring$
    ~@getstring(70,"Enter Calculation",f$(q2,5))
    f$(q2,5)=UPPER$(rtstring$)
    rtstring$=temp$
  ENDIF
  FOR tt=1 TO 10
    box$(tt,8)=tx$(tt)
  NEXT tt
  a%=qqq
  IF qqq=1
    IF reclen%>74
      lenn%=70-field%
      pointer=lenn%
      rtstring$=STR$(lenn%)
    ENDIF
    select$(1)="Required"
    select$(2)="UPPERCASE"
    select$(3)=" Normal"
    aaa%=0
    qqq=0
    WHILE aaa%=0
      selectfield("STRING",3)
      aaa%=qq
      qqq=0
      IF aaa%>3
        aaa%=0
      ENDIF
    WEND
    a%=1
    IF aaa%=3
      aaa%=0
    ENDIF
    IF aaa%=1
      a%=1
      GOSUB editrequired(q2)
    ENDIF
    IF aaa%=2
      f$(q2,5)="2"
    ENDIF
    IF aaa%=0
      f$(q2,5)=""
    ENDIF
  ENDIF
  IF qqq=3
    a%=3
    f$(q2,5)=STR$(@getnumeric)
  ENDIF
  CLOSEW #2
  bank=1
  wn=0
RETURN
PROCEDURE selectfield(title3$,gkn)
  mmaxlin%=(winh%-14)/10
  wwn=wn
  qxl=bank
  IF gkn<=maxlin1%*3
    col=1
    IF title3$=""
      title3$=version$
    ENDIF
    tw=0
    gl=0
    fw=0
    select$(gkn+1)=""
    FOR fl&=1 TO gkn
      select$(fl&)=TRIM$(select$(fl&))
      IF LEN(select$(fl&))>fw
        fw=LEN(select$(fl&))
      ENDIF
    NEXT fl&
    IF LEN(title3$)<fw
      ffw=fw-LEN(title3$)-5
      ffw=INT(ffw/2)
      title3$=SPACE$(ffw+2)+title3$
    ENDIF
    gl=fw
    fw=fw+10
    tw=fw*8
    tw=tw-36
    chk=tw
    fx=0
    IF tw>0
      fx=INT(tw/2)
    ENDIF
    ls=220-fx
    ls=ls+95
    wn=7
    gk(10)=gkn
    compare$(10)=LEFT$(alpha$,gkn)
    bank=10
    bx$="20 "
    winh=0
    itr=0
    FOR rit&=1 TO gkn
      INC itr
      l=LEN(select$(rit&))
      IF itr=mmaxlin%  ! Was -1
        INC col
        itr=1
        bx$=STR$(20+tw)
        bx$=LEFT$(bx$+"   ",3)
        winh=gy
        gy=1
        tw=tw+chk+6!!!!!!!
      ENDIF
      IF gl>l
        gll=INT(gl-l)
        gll=INT(gll/2)
        gls$=LEFT$(SPACE$(gll)+select$(rit&)+SPACE$(gl),gl)
      ELSE
        gls$=select$(rit&)
      ENDIF
      gy=itr*10!!--
      gy=gy+4 ! Was 3
      a$=LEFT$(STR$(gy)+"   ",3)
      box$(rit&,bank)=bx$+a$+gls$
    NEXT rit&
    gy=gy+11
    l=4
    gll=INT(gl-l)
    gll=INT(gll/2)
    IF gll<0
      gll=1
    ENDIF
    a$=LEFT$(STR$(gy)+"   ",3)
    IF gkn>maxlin%
      bx=VAL(bx$)
      bx=bx-12!!!!!!
      bx$=LEFT$(STR$(bx)+"   ",3)
    ENDIF
    IF gl<4
      gls$=gls$
    ELSE
      gls$=LEFT$(gls$+SPACE$(gl),gl)
    ENDIF
    a$=LEFT$(STR$(gy)+"     ",3)
    a$=a$+gls$
    gll=INT(gl-13)
    gll=INT(gl/2)
    txd=gll
    IF winh>0
      gy=winh
    ENDIF
    td=gy+20
    fg=winh%-td
    fg=INT(fg/2)-2
    IF tw>640
      tw=640
    ENDIF
    IF td>winh%
      td=winh%
      fg=0
    ENDIF
    IF fg<0
      fg=0
    ENDIF
    IF gkn>maxlin%
      filel=INT(chk/2)
      ls=ls-filel
    ENDIF
    IF col=3
      templ=640-tw
      ls=INT(templ/2)
    ENDIF
    IF ls<0
      ls=0
    ENDIF
    IF tw<=140
      td=td-12
    ENDIF
    IF col<=3
      ls%=(640-tw)/2
      IF ls%<0
        ls%=0
      ENDIF
      IF flaget%=1
        ls%=640-tw
      ENDIF
      OPENW #7,ls%,fg,tw,td,&H80000+512+&H40000,4096+65536+&H8+&H4
      TITLEW #7,title3$
      wn=7
      IF flaget%=1
        ~ActivateWindow(WINDOW(7))
      ENDIF
      drawflipbox(LPEEK(WINDOW(wn)+50),8,12,tw-16,td-16)
      drawbevelbox(LPEEK(WINDOW(wn)+50),10,14,tw-21,td-20)
      IF tw>140 AND gkn<maxlin%-1
        IF stx$=""
          stx$="Field Selector"
        ENDIF
        txd=txd-4
        txd=txd*8
        text(txd,td-LEN(stx$)+2,stx$,1,2)
      ENDIF
      GOSUB display
      qq=0
      DO UNTIL qq<>0
        qq=@test
      LOOP
      IF qq>gkn
        qq=gkn+1
      ENDIF
      IF flaget%=0
        CLOSEW #7
      ENDIF
    ENDIF
  ELSE
    ~@rteasyrequest("To Many Entries "+STR$(gkn),"OK",version$)
  ENDIF
  wn=wwn
  bank=qxl
RETURN
PROCEDURE selfield
  qq%=@rteasyrequest(STR$(tf)+" Fields Selected "+CHR$(10)+"Select All Fields- or Select Some Fields","All!|Select!|No Fields|Cancel!"+CHR$(0),"dDbase--Select Fields...")
  IF qq%=3
    tf=0
  ENDIF
  IF qq%=1
    sit%=1
    tf=n
    FOR t=1 TO n
      tr(t,1)=t
      tr(t,2)=VAL(f$(t,4))
    NEXT t
  ENDIF
  IF qq%=2
    sit%=1
    tf=0
    mm$=""
    GOSUB fields
    flaget%=1
    OPENW #1,10,10,280,190,0,4096+&H2
    bevelbox(1,8,12,264,174)
    TITLEW #1,"SelectField"
    DO
      GOSUB selectfield("Select Fields",n)
      OPENW #1
      IF qq=>1 AND qq<=n
        INC tf
        tr(tf,1)=qq
        ~ActivateWindow(WINDOW(1))
        TITLEW #1,"  Field                Length"
        PRINT AT(3,tf+1);LEFT$(f$(qq,1)+SPACE$(20),20);"  ";
        sss$=f$(qq,4)
        FORM INPUT 5 AS sss$
        tr(tf,2)=VAL(sss$)
        TITLEW #1,"Select Field"
      ENDIF
    LOOP UNTIL qq>n
    flaget%=0
    CLOSEW #1
    CLOSEW #7
    bank=1
    wn=0
  ENDIF
  qq=0
  wn=0
  bank=1
RETURN
PROCEDURE editfield
  reclen%=0
  wwn=wn
  rtstring$=f$(qq,1)
  nn=30
  IF f$(qq,0)="2"
    ~@rteasyrequest("Sorry. With this version of dDbase"+CHR$(10)+"You are unable to edit a Date Field","Sorry",version$)
  ENDIF
  IF qq=>1 AND qq<=n AND f$(qq,0)<>"2"
    sit%=1
    ge%=@getstring(120,"Edit Field :"+f$(qq,1),rtstring$)
    IF ge%=1
      f$(qq,1)=rtstring$
    ENDIF
    reclen%=LEN(f$(qq,1))+2
    rtstring$=f$(qq,4)
    bx=VAL(rtstring$)
    ge%=@getstring(4,f$(qq,1)+" Field length",rtstring$)
    pointer=VAL(rtstring$)
    IF pointer>maxfield%
      ge%=0
      ~@rteasyrequest("Field Too Long","OK","")
    ENDIF
    IF ge%=0
      pointer=bx
    ENDIF
    field%=reclen%
    reclen%=reclen%+pointer
    tempmax%=VAL(f$(qq,4))
    q2=qq
    GOSUB fielddef
    qq=q2
    startgauge(k,"Reformating Database")
    DEFMOUSE (2)
    f$(qq,0)=STR$(a%)
    count=0
    FOR ty=1 TO qq-1
      count=count+VAL(f$(ty,4))
    NEXT ty
    aa%=1
    IF pointer<bx
      aa%=@rteasyrequest("WARNING YOU MAY LOSE DATA","Continue!|Cancel!","What Shall I Do")
    ENDIF
    IF aa%=1 OR pointer>bx
      f$(qq,4)=rtstring$
      temp$=""
      IF count<1
        count=1
      ENDIF
      FOR ty=1 TO k
        gauge
        temp$=MID$(w$(ty),count,bx)!+1
        a1$=LEFT$(w$(ty),count-1)
        a2$=MID$(w$(ty),count+bx)!+1
        IF f$(qq,5)="2"
          temp$=UPPER$(temp$)
        ENDIF
        temp$=LEFT$(temp$+SPACE$(1500),pointer)
        w$(ty)=a1$+temp$+a2$
      NEXT ty
      bank=1
      CLS
      bank=1
      FOR ttr=1 TO n
        f(ttr)=VAL(f$(ttr,4))
      NEXT ttr
      wn=0
    ENDIF
    GOSUB getext
    GOSUB checkcalc
  ENDIF
  DEFMOUSE (msp1%)
  endgauge
RETURN
PROCEDURE deletefield
  IF qq>0 AND qq<=n
    sf=qq
    qq=@rteasyrequest("Delete Field "+CHR$(34)+f$(qq,1)+CHR$(34),"Are You Sure!|Cancel!","dDbase--Delete Field..")
    IF qq=1
      sit%=1
      dsit%=1
      GOSUB getpoint
      pointer=pointer-1
      startgauge(k,"Deleting Field <"+f$(sf,1)+">")
      ' Data
      FOR t=1 TO k
        gauge
        w$(t)=LEFT$(w$(t),pointer)+MID$(w$(t),pointer+length+1)
      NEXT t
      endgauge
      DEFMOUSE 2
      ' Field
      FOR t=sf TO n
        FOR tt=0 TO 5
          f$(t,tt)=f$(t+1,tt)
        NEXT tt
      NEXT t
      ' Text effects
      FOR t=sf TO n
        FOR tt=1 TO 2
          txfx$(t,tt)=txfx$(t+1,tt)
        NEXT tt
      NEXT t
      n=n-1
      FOR ttr=1 TO n
        f(ttr)=VAL(f$(ttr,4))
      NEXT ttr
    ENDIF
    IF screenmode%=1
      FOR t&=1 TO n
        f$(t&,1)=LEFT$(f$(t&,1),LEN(f$(t&,1))-2)
      NEXT t&
      GOSUB placeit
    ENDIF
    GOSUB gfield
    GOSUB getext
    DEFMOUSE 8
  ENDIF
  qq=0
  bank=1
RETURN
PROCEDURE addfield
  IF n<19
    sit%=1
    dsit%=1
    start=n+1
    xn=n+1
    GOSUB getfields
    IF a%>0
      a%=VAL(f$(xn,0))
      fi$=f$(xn,1)
      sss$=f$(xn,4)
      IF a%<4
        gi$=fi$+" ["+SPACE$(VAL(sss$)-1)+"]"
      ELSE
        gi$=fi$
      ENDIF
      OPENW #1,0,0,640,winh%,&H40000+&H80000,4096+65536
      TITLEW #1,"ADD FIELD:  Position New Field then Press Left Mouse Buttone"
      wn=1
      drawbevelbox(LPEEK(WINDOW(wn)+50),4,11,630,189+winoff%) !Screen
      drawbevelbox(LPEEK(WINDOW(wn)+50),22,161+winoff%,595,45)  !|< << >> >| =?
      drawflipbox(LPEEK(WINDOW(wn)+50),10,14,618,145+winoff%) !Screen
      flag=4
      IF fi$<>""
        bb$=LEFT$(SPACE$(80),LEN(fi$))
        wn=1
        GOSUB ddisplay
        GOSUB displaybox
        capturewindow
        IF eer=0
          DO UNTIL MOUSEK=1
            xx=MOUSEX
            yy=MOUSEY
            xx=INT(xx/8)
            yy=INT(yy/8)
            aa$=f$(xn,1)
            IF yy<=maxlin3%
              IF VAL(f$(xn,0))<=3 OR f$(xn,0)="10"
                ltot=LEN(f$(xn,1))*8
                ltot=ltot+9
                totl=VAL(f$(xn,4))*8
                bevelbox(1,xx*8+ltot,yy*8+3,totl,8)
                PRINT AT(xx,yy);aa$
                releasewindow
              ELSE
                ltot=LEN(f$(xn,1))*8
                ltot=ltot+7
                PRINT AT(xx,yy);f$(xn,1)
                bevelbox(1,xx*8-8,yy*8-1,ltot,14)
                releasewindow
              ENDIF
            ENDIF
          LOOP
          n=n+1
          f$(n,0)=STR$(a%)
          f$(n,1)=fi$
          f$(n,2)=STR$(xx)
          f$(n,3)=STR$(yy)
          f$(n,4)=sss$
          IF VAL(f$(n,0))=2
            f$(n,5)=STR$(aa%)
          ENDIF
          FOR ttr=1 TO n
            f(ttr)=VAL(f$(ttr,4))
          NEXT ttr
        ENDIF
      @clearsection
      ENDIF
      bank=1
      wn=0
      qq=0
      GOSUB gfield
      GOSUB getext
      CLOSEW #1
    ENDIF
    GOSUB checkcalc
  ELSE
    ~@rteasyrequest("You already have the Maximum Amount of Fields","Ok",version$)
  ENDIF
RETURN
PROCEDURE repos
  dsit%=1
  sit%=1
  OPENW #1,0,0,640,winh%,&H80000,&H4+4096+65536
  wn=1
  drawflipbox(LPEEK(WINDOW(wn)+50),14,12,620,194+winoff%)
  FOR tr=1 TO n
    f$(tr,2)=""
    f$(tr,3)=""
  NEXT tr
  GOSUB place
  CLOSEW #1
  GOSUB gfield
  clearscreen
RETURN
PROCEDURE repos2
  dsit%=1
  sit%=1
  kk=qq
  IF kk=>1 AND kk<=n
    OPENW #1,0,0,640,winh%,&H80000,&H4+4096+65536
    wn=1
    drawbevelbox(LPEEK(WINDOW(wn)+50),4,11,630,197+winoff%) !Screen
    drawbevelbox(LPEEK(WINDOW(wn)+50),22,161+winoff%,595,45)  !|< << >> >| =?
    TITLEW #1,"MOVE FIELD:  Position  Field then Press Left Mouse Buttone"
    drawflipbox(LPEEK(WINDOW(wn)+50),14,12,620,186+winoff%)
    GOSUB displaybox
    FOR tr=1 TO n
      IF tr<>kk
        ltot=LEN(f$(tr,1))*8
        xx2=VAL(f$(tr,2))
        yy2=VAL(f$(tr,3))
        ll1=VAL(f$(tr,4))
        IF VAL(f$(tr,0))<=3 OR VAL(f$(tr,0))=10
          PRINT AT(xx2,yy2);f$(tr,1)
          flipbox(1,xx2*8+ltot,yy2*8+3,ll1*8,8)
        ELSE
          PRINT AT(xx2,yy2);f$(tr,1)
          IF VAL(f$(tr,0))<>6
            bevelbox(1,xx2*8-8,yy2*8-1,ltot+7,14)
          ENDIF
        ENDIF
      ENDIF
    NEXT tr
    ffa$=f$(kk,1)
    capturewindow
    IF eer=0
      DO UNTIL MOUSEK=1
        bb$=SPACE$(LEN(f$(kk,1)))+SPACE$(VAL(f$(kk,4)))+"  "
        IF f$(kk,0)="7"
          bb$=SPACE$(LEN(ffa$))
        ENDIF
        COLOR 1
        xx2=INT(MOUSEX/8)+1
        yy2=INT(MOUSEY/8)
        ltot=LEN(ffa$)*8
        ll1=VAL(f$(kk,4))
        releasewindow
        IF yy2=>maxlin3%
          yy2=maxlin3%
        ENDIF
        IF VAL(f$(kk,0))<=3 OR f$(kk,0)="10"
          PRINT AT(xx2,yy2);ffa$
          flipbox(1,xx2*8+ltot,yy2*8+3,ll1*8,8)
        ELSE
          flen=LEN(f$(kk,1))
          flen=flen*8+7
          PRINT AT(xx2,yy2);ffa$
          IF VAL(f$(kk,0))<>6
            bevelbox(1,xx2*8-8,yy2*8-1,flen,14)
          ENDIF
        ENDIF
      LOOP
      f$(kk,2)=STR$(xx2)
      f$(kk,3)=STR$(yy2)
    ENDIF
  @clearsection
    CLOSEW #1
    kk=1
    clearscreen
    GOSUB gfield
  ENDIF
RETURN
PROCEDURE getlist(temp$)
  ppx=0
  gln=0
  DO
    ppx=INSTR(temp$,"|")
    IF ppx>0
      INC gln+
      select$(gln)=LEFT$(temp$,ppx-1)
      temp$=MID$(temp$,ppx+1)
    ENDIF
  LOOP UNTIL ppx=0
  aaa$=temp$
RETURN
FUNCTION datefield
  aaa$="DD/MM/YY|DD MON YYYY|"
  getlist(aaa$)
  selectfield("DATES",gln)
  IF qq>gln
    qq=0
  ENDIF
  RETURN qq
ENDFUNC
FUNCTION getnumeric
  aaa$="99.9|9999.99|9999|Ł99.99|Ł9999.99|Auto|"
  getlist(aaa$)
  selectfield("NUMBERS",gln)
  IF qq>gln
    qq=0
  ENDIF
  RETURN qq
ENDFUNC
PROCEDURE formatnumber(gt)
  ' 1- 99,0
  ' 2- 9999.99
  ' 3- 9999
  ' 4- Ł99.99
  ' 5- Ł9999.99
  ' 6- Auto
  tnum=VAL(f$(gt,5))
  i=RINSTR(aa$,".")
  ii=INSTR(aa$,pref$(5))  ! Currency
  IF tnum=2 OR tnum=5 OR tnum=4 AND i>0
    a1$=MID$(aa$+"00",i,3)
    aa$=LEFT$(aa$,i-1)+a1$
  ENDIF
  IF tnum=1 AND i=0 AND VAL(aa$)>0
    aa$=aa$+".0"
  ENDIF
  IF tnum=2 OR tnum=4 OR tnum=5 AND i>0 AND VAL(aa$)>0
    a1$=MID$(aa$+"0000",i,3)
    aa$=LEFT$(aa$,i-1)+a1$
  ENDIF
  IF tnum=2 OR tnum=5 OR tnum=4 AND i=0 AND VAL(aa$)>0
    aa$=aa$+".00"
  ENDIF
  IF tnum=4 OR tnum=5 AND VAL(aa$)>0
    i=INSTR(aa$,".")
    aa$=LEFT$(aa$,i-1)+MID$(aa$+"00",i,3)
  ENDIF
  IF tnum=3 AND i>0 AND VAL(aa$)>0
    aa$=LEFT$(aa$,i-1)
  ENDIF
  IF tnum=4 OR tnum=5 OR tnum=2 AND aa$<>""
    IF tnum=4
      switch=3
    ELSE
      switch=5
    ENDIF
    i=INSTR(aa$,".")
    a1$=LEFT$(aa$,i-1)
    a2$=RIGHT$(aa$,3)
    aa$=RIGHT$("    "+a1$,switch)+a2$
  ENDIF
  IF tnum=0
  ENDIF
RETURN
PROCEDURE donum
  FOR t=1 TO n
    IF f$(t,0)="3" AND f$(t,5)=""
      fle%=LEN(f$(t,1))+6
      fle%=fle%*8+10
      IF fle%<154
        fle%=154
      ENDIF
      lw%=640-fle%
      lw%=lw%/2
      OPENW #15,lw%,20,fle%,30,0,4096
      TITLEW #15,"GET NUMERIC FORMAT"
      PRINT "FIELD:";f$(t,1)
      f$(t,5)=STR$(@getnumeric)
      CLOSEW #15
    ENDIF
  NEXT t
RETURN
' -------------------------------Print Routines-----------------------------
PROCEDURE getprinter
  pref%=MALLOC(232,1)
  ~GetDefPrefs(pref%,232)
  ss$="-"
  prit$=CHAR{pref%+128}
  ~MFREE(pref%,232)
RETURN
PROCEDURE heading
  LOCAL tr
  head$=""
  FOR tr=1 TO tf
    head$=head$+LEFT$(f$(tr(tr,1),1)+SPACE$(80),tr(tr,2))+" | "
  NEXT tr
RETURN
PROCEDURE makehead
  LOCAL tr
  ~@getstring(5,"Enter Left Margin",STR$(lmargin%))
  lfm=VAL(rtstring$)
  lfm$=SPACE$(lfm)
  pcount=0
  pnumber=1
  head$=""
  CLOSE #15
  IF filename1$=""
    filename1$="UnNamed"
  ENDIF
  OPEN "o",#15,"prt:"
  PRINT #15,CHR$(27);"#1";CHR$(27);"[1m";
  PRINT #15,lfm$;version$;" ";LEFT$(filename1$,LEN(filename1$)-4);"       Page 1"
  FOR tr=1 TO tf
    head$=head$+LEFT$(f$(tr(tr,1),1)+SPACE$(80),tr(tr,2))+" | "
  NEXT tr
  PRINT #15,lfm$;head$
  PRINT #15,lfm$;LEFT$(ul$+ul$,LEN(head$));
  PRINT #15,CHR$(27);"[22m"
  CLOSE #15
RETURN
PROCEDURE printrecord
  GOSUB unpack
  tab$=SPACE$(tab%)
  pcount=pcount+tf
  IF pcount+n+12=>VAL(pref$(1))
    qa%=@rteasyrequest("Please Insert New Sheet of Paper","OK!|FormFeed",version$)
    IF qa%=0
      LPRINT CHR$(12)
    ENDIF
    GOSUB recordhead
  ENDIF
  OPEN "o",#1,"prt:"
  PRINT #1,CHR$(27);"#1";"   RECORD   ";kk
  FOR tt=1 TO tf
    t=tr(tt,1)
    IF f$(t,0)="10"
      calc$=f$(t,5)
      GOSUB calc
      a$(t)=count$
    ENDIF
    IF VAL(f$(t,0))<=3 OR VAL(f$(t,0))=7 OR f$(t,0)="10"
      PRINT #1,tab$;LEFT$(f$(t,1)+SPACE$(25),20);LEFT$(a$(t),59)
    ELSE IF VAL(f$(t,0))=7 AND EXIST(a$(t)) AND text%=1
      clc=1
      external(a$(t))
      clc=0
      IF ee=0
        GOSUB eof(a$(t))
        OPEN "i",#5,a$(t)
        fl%=LOF(#5)
        IF fl%<=fbuffer%
          DO
            LINE INPUT #5,select$
            ll%=LOC(#5)
            PRINT #1,select$
            select$=""
          LOOP UNTIL EOF(#5) OR ll%=>fl% OR ERR=26 OR gnu=max%
        ENDIF
        CLOSE #5
      ELSE
        PRINT #1,tab$;LEFT$(f$(t,1)+SPACE$(25),20);LEFT$(a$(t),59)
      ENDIF
    ELSE
      PRINT #1,tab$;f$(t,1)
    ENDIF
    IF VAL(f$(t,0))=8  !Memo
      vw$=a$(t)
      q=0
      PRINT #1
      DO
        INC pcount
        q=INSTR(vw$,CHR$(174))
        IF q>0
          INC gln+
          PRINT #1,tab$;LEFT$(vw$,q-1)
          vw$=MID$(vw$,q+1)
        ENDIF
      LOOP UNTIL q=0
      PRINT #1
      pcount=pcount+2
    ENDIF
  NEXT tt
  PRINT #1,"          ------------------------------------------------------------"
  CLOSE #1
RETURN
PROCEDURE recordhead
  pnumber=pnumber+1
  temp$="    "+version$+" "+"FILE: "+TRIM$(filename$)+" PAGE: "+STR$(pnumber)
  LPRINT CHR$(27)+"#1"+SPACE$(@center(temp$));temp$
  LPRINT STRING$(78,"-")
  pcount=3
RETURN
PROCEDURE startprint
  CLOSE #13
  screendis%=0
  op%=@rteasyrequest("OutPut TO:","Printer|ClipBoard|Screen|File",version$)
  IF op%=1
    fred%=@rteasyrequest("Printer Output To:","Paper|Labels",version$)
    ask%=1
  ENDIF
  IF calc%=TRUE
    cal%=@rteasyrequest("Do you want running totals?","Yes|Cancel",version$)
    GOSUB clearcalc
    IF op%=0
      question%=2
    ENDIF
  ENDIF
  IF op%=0 OR op%=2 OR op%=3
    IF op%=0
      rtitle$="OUTPUT FILE"
      getfile("")
      op$=nfile$
    ENDIF
    po%=1
    IF op%=2
      op$="ram:clipfile"
      clipit%=1
      op%=0
    ENDIF
    IF op%=3
      aa$=SPACE$(11)
      FOR ttt&=1 TO tf
        tt&=tr(ttt&,1)
        lle%=tr(tt&,2)
        aa$=aa$+LEFT$(f$(tt&,1)+SPACE$(500),lle%)
      NEXT ttt&
      op$="ram:screendisplay"
      screendis%=1
    ENDIF
    IF EXIST(op$)
      po%=@rteasyrequest("File Exists: Do you want to-","Overwrite|Append|Cancel",version$)
    ENDIF
    ask%=1
    IF op%=2 OR op%=0
      ask%=@rteasyrequest("OutPut:","ASCII|FinalCopy|ASCII-MERGE|WordsWorth|ProWrite|Protext",version$)
    ENDIF
    IF po%=1
      OPEN "o",#13,op$
    ENDIF
    IF po%=2
      OPEN "a",#13,op$
    ENDIF
    IF op%=0 AND ask%=1 AND pcode=1
      qwe%=@rteasyrequest("Do you wish to have filenames at top?","Yes|Cancel",version$)
      IF qwe%=1
        GOSUB heading
        PRINT #13,head$
        PRINT #13,STRING$(LEN(head$),"-")
      ENDIF
    ENDIF
    IF op%=3
      PRINT #13,"@database screenoutput"
      PRINT #13,"@node main "+CHR$(34)+filetitl$+" -----------  dDBase ©MadCap-Software"+CHR$(34);""
    ENDIF
    IF op%=3 AND pcode=1  !table
      PRINT #13,aa$
      PRINT #13,STRING$(LEN(aa$),"-")
      op%=0
    ELSE IF op%=3 AND pcode<>1
      op%=0
    ENDIF
    IF pcode=1 AND cal%=1 AND ask%=1
      GOSUB heading
      PRINT #13,head$
      PRINT #13,LEFT$("---------------------------------------------------------------------------",LEN(head$))
    ENDIF
  ENDIF
  IF ask%=3 AND po%<>2
    GOSUB xpasciistart
  ENDIF
  IF ask%=2 AND po%<>2
    GOSUB fcstart
  ENDIF
  IF op%=1 AND pcode=1 AND ask%=1 AND fred%=1
    GOSUB makehead
  ENDIF
  IF op%=1 AND pcode=2 AND ask%=1 AND fred%=1
    GOSUB recordhead
  ENDIF
  IF op%=1 AND fred%=0
    GOSUB labelstart
  ENDIF
  pcount=0
  pnumber=1
RETURN
PROCEDURE fileprint
  IF cal%=1
    GOSUB calcit
  ENDIF
  IF sep$=""
    sep$="|"
  ENDIF
  IF tf>0
    unpack
    IF ask%=0 !Protext
      GOSUB prout
    ELSE IF ask%=2
      GOSUB fcout
    ELSE IF ask%=3
      GOSUB xpasciiout
    ELSE IF ask%=4
      GOSUB wwout
    ELSE IF ask%=5
      GOSUB pwout
    ENDIF
    IF ask%=1
      IF pcode=1
        GOSUB table
        PRINT #13,aa$
      ELSE
        PRINT #13
        PRINT #13,"Record    ";kk
        PRINT #13
        FOR tt=1 TO tf
          t=tr(tt,1)
          IF f$(t,0)="10"
            calc$=f$(t,5)
            GOSUB calc
            a$(t)=count$
          ENDIF
          IF VAL(f$(t,0))<=3 OR VAL(f$(t,0))=7 OR VAL(f$(t,0))=10
            IF bold%=1
              PRINT #13,CHR$(27)+"[1m"+LEFT$(f$(t,1)+CHR$(27)+"[22m"+SPACE$(25),20);LEFT$(a$(t),59)
            ELSE IF bold%=0
              PRINT #13,LEFT$(f$(t,1)+SPACE$(25),20);LEFT$(a$(t),59)
            ENDIF
          ELSE
            PRINT #13
            IF bold%=1
              PRINT #13,CHR$(27)+"[1m";
            ENDIF
            PRINT #13,f$(t,1)
            IF bold%=1
              PRINT #13,CHR$(27)+"[22m";
            ENDIF
          ENDIF
          IF VAL(f$(t,0))=7 AND EXIST(a$(t))
            clc=1
            GOSUB external(a$(t))
            clc=0
            IF ee=0 AND text%=1 AND UPPER$(aba$)<>"@DATABASE"
              GOSUB eof(a$(t))
              OPEN "i",#5,a$(t)
              gnu=0
              fl%=LOF(#5)
              IF fl%<=fbuffer%
                DO
                  LINE INPUT #5,select$
                  ll%=LOC(#5)
                  PRINT #13,select$
                LOOP UNTIL EOF(#5) OR ll%=>fl% OR ERR=26 OR gnu=max%
              ELSE IF ee>0
                PRINT #13,a$(t)
              ENDIF
              CLOSE #5
            ENDIF
            IF ee=0 AND text%=0
              PRINT #13
              PRINT #13,a$(t)
            ENDIF
            IF ee>0
              PRINT #13
              PRINT #13,a$(t)
            ENDIF
          ENDIF
          IF VAL(f$(t,0))=8  !Memo
            vw$=a$(t)
            q=0
            PRINT #13
            DO
              q=INSTR(vw$,CHR$(174))
              IF q>0
                PRINT #13,LEFT$(vw$,q-1)
                vw$=MID$(vw$,q+1)
              ENDIF
            LOOP UNTIL q=0
            PRINT #13
          ENDIF
        NEXT tt
        PRINT #13,"          ------------------------------------------------------------"
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE table
  LOCAL table,taa
  aa$=""
  FOR table=1 TO tf
    IF f$(tr(table,1),0)="10"
      calc$=f$(tr(table,1),5)
      GOSUB calc
      a$(tr(table,1))=count$
    ENDIF
    taa=tr(table,2)
    aa$=aa$+LEFT$(a$(tr(table,1))+SPACE$(80),taa)+" : "
  NEXT table
RETURN
PROCEDURE printtable
  aa$=""
  GOSUB unpack
  GOSUB table
  LPRINT lfm$;aa$
  INC pcount
  IF pcount=>VAL(pref$(1))-3
    qa%=@rteasyrequest("Please Insert a New Sheet Of Paper"+CHR$(10)+"And then Select OK! to Continue","OK!|FormFeed","PRINT")
    IF qa%=0
      LPRINT CHR$(12)
    ENDIF
    pnumber=pnumber+1
    LPRINT CHR$(27);"#1";CHR$(27);"[1m";
    LPRINT lfm$;version$;" ";LEFT$(filename1$,LEN(filename1$)-4);"       Page ";pnumber
    LPRINT lfm$;head$
    LPRINT lfm$;LEFT$(ul$+ul$,LEN(head$))
    pcount=0
  ENDIF
RETURN
PROCEDURE envelope
  a%=1
  IF tf=0
    a%=@rteasyrequest("No Selected Fields"+CHR$(10),"Cancel",version$)
  ENDIF
  IF a%=1
    aa%=@getstring(5,"Enter The Left Margin",STR$(lmargin%))
    tb=VAL(rtstring$)
    ~@rteasyrequest("Please Set Envelope / Label and Then press Return","RETURN","PRINT ENVELOPE")
    OPEN "o",#5,"par:"
    startgauge(tf,"PRINING ENVELOPE")
    FOR tt=1 TO tf
      gauge
      PRINT #5,SPACE$(tb)+LEFT$(a$(tr(tt,1))+SPACE$(tr(tt,2)),tr(tt,2))+CHR$(13)
    NEXT tt
    endgauge
    CLOSE #5
  ENDIF
RETURN
PROCEDURE printit
  GOSUB calcit
  IF fred%=1
    IF pcode=1
      GOSUB printtable
    ENDIF
    IF pcode=2
      GOSUB printrecord
    ENDIF
    IF pcode=3
      GOSUB form
      GOSUB formprint
    ENDIF
  ENDIF
  IF fred%=0
    GOSUB labelout
  ENDIF
RETURN
PROCEDURE formprint
  a%=@rteasyrequest("Please Ensure the Printer Is Ready","ok!",version$)
  FOR ty=1 TO 24
    form$(ty)=SPACE$(79)
  NEXT ty
  FOR ty=1 TO n
    fx=VAL(f$(ty,2))
    fy=VAL(f$(ty,3))
    vf=VAL(f$(ty,0))
    ff$=f$(ty,1)
    fll=VAL(f$(ty,4))
    fl=LEN(ff$)
    IF f$(ty,0)="10"
      calc$=f$(ty,5)
      GOSUB calc
      a$(ty)=count$
    ENDIF
    IF VAL(f$(ty,0))<=3 OR f$(ty,0)="10"
      form$(fy)=LEFT$(form$(fy),fx)+ff$+"[ "+LEFT$(a$(ty)+SPACE$(70),fll)+"]"+MID$(form$(fy),fx+fl+fll)
    ENDIF
    IF VAL(f$(ty,0))=>4 AND VAL(f$(ty,0))<=6
      form$(fy)=LEFT$(form$(fy),fx)+ff$+MID$(form$(fy),fx+fl+fll)
    ENDIF
    IF VAL(f$(ty,0))=>7 AND VAL(f$(ty,0))<=8
      form$(fy)=LEFT$(form$(fy),fx)+"[ "+ff$+" ]"+SPACE$(LEN(a$(ty)))+MID$(form$(fy),fx+fl+fll)
    ENDIF
    form$(fy)=LEFT$(form$(fy),78)
  NEXT ty
  OPEN "o",#2,"prt:"
  PRINT #2,CHR$(27);"#1"
  FOR ty=1 TO 24
    PRINT #2,LEFT$(form$(ty),78)
    INC pcount
  NEXT ty
  CLOSE #2
RETURN
PROCEDURE form
  FOR ty=1 TO 59
    form$(ty)=SPACE$(79)
  NEXT ty
  FOR ty=1 TO n
    x1=VAL(f$(ty,2))
    y1=VAL(f$(ty,3))
    form$(y1)=LEFT$(form$(y1),x1-1)+STR$(ty)+MID$(form$(y1),x1+LEN(STR$(ty)))
  NEXT ty
RETURN
' ---------------------------------Labels---------------------------------
PROCEDURE labelout
  GOSUB unpack
  label%=label%+1
  FOR start2=1 TO tf
    label$(start2,label%)=a$(tr(start2,1))
  NEXT start2
  IF label%=lbw%
    FOR start2=1 TO doit
      PRINT #15;SPACE$(char);LEFT$(label$(start2,1)+SPACE$(floggit),floggit);
      IF lbw%=1
        PRINT #15
      ELSE
        PRINT #15;SPACE$(def);LEFT$(label$(start2,2),floggit)
      ENDIF
    NEXT start2
    FOR start2=1 TO ty1
      PRINT #15
    NEXT start2
    label%=0
  ENDIF
RETURN
PROCEDURE labelstart
  OPEN "o",#15,"prt:"
  label%=0
  IF tf<>xf
    doit=xf
  ELSE
    doit=tf
  ENDIF
RETURN
PROCEDURE labelend
  ~DisplayBeep(0)
  IF label%>0
    FOR start2=1 TO 6
      PRINT #15;SPACE$(char);label$(start2,label%)
    NEXT start2
  ENDIF
  CLOSE #15
RETURN
PROCEDURE labelsetup
  top%=(winh%-175)/2
  wwn=wn
  wn=5
  OPENW #5,90,top%,460,175,0,4096+&H2+&H400
  TITLEW #5,"LABEL SETUP : "+version$
  bevelbox(1,6,3,440,156-woffset%)
  bevelbox(1,76,9,120,45)
  bevelbox(1,266,9,120,45)
  bevelbox(1,76,99,120,45)
  PRINT AT(3,4);"<-M1->"
  PRINT AT(27,4);"<-M2->"
  TEXT 137,79,"M3"
  TEXT 141,61,"|"
  TEXT 141,68,"|"
  TEXT 141,89,"|"
  TEXT 141,96,"|"
  PCOLOR 2,3
  PRINT AT(3,4);"<-M1->"
  PCOLOR 1,0
  flipbox(1,230,99,168,45)
  bevelbox(1,6,3,440,156-woffset%)
  PRINT AT(30,14);"Enter Margin 1->";
  n$=STR$(char)
  GOSUB lform
  PRINT AT(3,4);"<-M1->"
  char=VAL(n$)
  PCOLOR 2,3
  PRINT AT(27,4);"<-M2->"
  PCOLOR 1,0
  PRINT AT(30,15);"Enter Margin 2->";
  n$=STR$(def)
  GOSUB lform
  PRINT AT(27,4);"<-M2->"
  def=VAL(n$)
  PCOLOR 2,3
  PRINT AT(18,10);"M3"
  PCOLOR 1,0
  PRINT AT(30,16);"Enter Margin 3->";
  n$=STR$(ty1)
  GOSUB lform
  PRINT AT(18,10);"M3"
  ty1=VAL(n$)
  PCOLOR 2,3
  PRINT AT(11,4);"<            >"
  PCOLOR 1,0
  PRINT AT(30,17);"Enter Text Width->";
  n$=STR$(floggit)
  GOSUB lform
  PRINT AT(11,4);"              "
  floggit=VAL(n$)
  IF floggit>50
    floggit=50
  ENDIF
  IF floggit<10
    floggit=10
  ENDIF
  qq%=@rteasyrequest("How Many Labels Wide?","One|Two",version$)
  IF qq%=1
    lbw%=1
  ENDIF
  IF qq%=0
    lbw%=2
  ENDIF
  qq%=@getstring(5,"How Many Lines?","6")
  IF qq%=1
    xf=VAL(rtstring$)
  ENDIF
  q=0
  OPEN "o",#4,"dlabel.lbs"
  PRINT #4,char
  PRINT #4,def
  PRINT #4,ty1
  PRINT #4,xf
  PRINT #4,floggit
  PRINT #4,lbw%
  CLOSE #4
  CLOSEW #5
  wn=wwn
RETURN
PROCEDURE lform
  FORM INPUT 10 AS n$
  bevelbox(1,6,3,440,156-woffset%)
RETURN
' ------------------------------GetText Draw Box Input --------------------
PROCEDURE displaybox
  IF bbx>0
    FOR bb=1 TO bbx
      IF box(bb,0)=3
        COLOR 1
        BOX box(bb,1),box(bb,2),box(bb,3),box(bb,4)
      ENDIF
      IF box(bb,0)=4
        COLOR 1
        dbbox(box(bb,1),box(bb,2),box(bb,3)-box(bb,1),box(bb,4)-box(bb,2))
      ENDIF
      IF box(bb,0)=2
        drawflipbox(LPEEK(WINDOW(wn)+50),box(bb,1),box(bb,2),box(bb,3)-box(bb,1),box(bb,4)-box(bb,2))
      ENDIF
      IF box(bb,0)=1
        drawbevelbox(LPEEK(WINDOW(wn)+50),box(bb,1),box(bb,2),box(bb,3)-box(bb,1),box(bb,4)-box(bb,2))
      ENDIF
    NEXT bb
  ENDIF
RETURN
PROCEDURE dbbox(dbx1,nkk,tim,ta)
  drawflipbox(LPEEK(WINDOW(wn)+50),dbx1,nkk,tim+1,ta)
  drawbevelbox(LPEEK(WINDOW(wn)+50),dbx1+2,nkk+1,tim-3,ta-2)
RETURN
PROCEDURE boxit
  bx=x*8-20
  by=y*8-2
  IF l<LEN(f$(t&,1))
    l=LEN(f$(t&,1))+2
  ENDIF
  bl=l*8
  IF f$(t&,0)="5"
    drawflipbox(LPEEK(WINDOW(wn)+50),bx,by,bl+20,16)
  ENDIF
  IF f$(t&,0)="4"
    drawbevelbox(LPEEK(WINDOW(wn)+50),bx,by,bl+20,16)
  ENDIF
RETURN
PROCEDURE movebox(deb)
  capturewindow
  IF eer=0
    GRAPHMODE 1
    COLOR 3
    dbx=box(deb,3)-box(deb,1)
    dby=box(deb,4)-box(deb,2)
    dby1=dby
    dbx1=dbx
    DELAY (1)
    DO UNTIL MOUSEK>0
      IF MOUSEX>10 AND MOUSEY>10 AND MOUSEY+dby<200+winoff%-42 AND MOUSEX+dbx<640
        BOX MOUSEX,MOUSEY,MOUSEX+dbx,MOUSEY+dby
        releasewindow
      ENDIF
    LOOP
    IF MOUSEK=1
      box(deb,1)=MOUSEX
      box(deb,2)=MOUSEY
      box(deb,3)=box(deb,1)+dbx
      box(deb,4)=box(deb,2)+dby
    ENDIF
  ENDIF
@clearsection
RETURN
FUNCTION getbox(mx,my)
  deb=0
  FOR xx=1 TO bbx
    IF box(xx,1)=>mx-3 AND box(xx,1)<=mx+3 AND box(xx,2)=>my-3 AND box(xx,2)<=my+3
      deb=xx
      xx=bbx+1
    ENDIF
  NEXT xx
  RETURN deb
ENDFUNC
PROCEDURE deletebox(deb)
  startgauge(bbx-deb,"Deleting Box")
  FOR xx=deb TO bbx
    gauge
    FOR county=0 TO 4
      box(xx,county)=box(xx+1,county)
    NEXT county
  NEXT xx
  endgauge
  bbx=bbx-1
RETURN
PROCEDURE dbox
  temptitle$="Left Mousekey to Postion: Right Mousekey to Cancel"
  getlist("BEVEL|FLIP|BOX|DOUBLE-BEVEL|DELETE|MOVE|")
  selectfield("DRAW BOX",gln)
  IF qq>gln
    qq=0
  ENDIF
  aa%=qq
  qq=0
  IF aa%=>1 AND aa%<=4
    capturewindow
  ENDIF
  IF aa%=5 AND bbx>0
    mx=0
    my=0
    TITLEW #0,"Click On Top Left Of Box  To Delete"
    DO UNTIL MOUSEK=1
      mx=MOUSEX
      my=MOUSEY
    LOOP
    deb=0
    FOR xx=1 TO bbx
      IF box(xx,1)=>mx-3 AND box(xx,1)<=mx+3 AND box(xx,2)=>my-3 AND box(xx,2)<=my+3
        deb=xx
        xx=bbx+1
      ENDIF
    NEXT xx
    a%=0
    IF deb<>0
      COLOR 3
      IF box(deb,0)<=4
        BOX box(deb,1),box(deb,2),box(deb,3),box(deb,4)
      ENDIF
      bbox$="Box"
      a%=@rteasyrequest("Do You want to Delete "+bbox$+" "+STR$(deb),"Delete|Cancel",version$)
      DEFLINE 1
    ENDIF
    IF a%=1
      startgauge(bbx-deb,"Deleting Box")
      FOR xx=deb TO bbx
        gauge
        FOR tt=0 TO 4
          box(xx,tt)=box(xx+1,tt)
        NEXT tt
      NEXT xx
      endgauge
      bbx=bbx-1
    ENDIF
  ENDIF
  IF aa%>0
    sit%=1
  ENDIF
  IF bbx+1>10 AND aa%<>6
    qq%=@displayalert("                           Sorry To Many Boxes")
    aa%=5
  ENDIF
  IF aa%=6
    mx=0
    my=0
    TITLEW #0,"Click Once On the Top Left Of Box  To Move"
    DO UNTIL MOUSEK=1
      mx=MOUSEX
      my=MOUSEY
    LOOP
    TITLEW #0,temptitle$
    deb=@getbox(mx,my)
    wn=0
    IF deb>0
    @movebox(deb)
    ENDIF
  ENDIF
  IF aa%>0 AND aa%<5 AND eer=0
    GRAPHMODE 1
    COLOR 3
    wn=0
    temp1$="Click the Left Mouse Button Once on top Left Corner"
    msk%=0
    DO UNTIL msk%>0
      TITLEW #0,temp1$+" X:"+STR$(MOUSEX)+" Y:"+STR$(MOUSEY)
      msk%=MOUSEK
    LOOP
    TITLEW #0,temptitle$
    IF msk%=1
      dbx=MOUSEX
      dby=MOUSEY
      ~MOUSEK=0
      DELAY (1)
      DO UNTIL MOUSEK>0
        TITLEW #0,temptitle$+" X:"+STR$(MOUSEX)+" Y:"+STR$(MOUSEY)
        IF MOUSEX>dbx AND MOUSEY>dby AND MOUSEY<200+winoff%-42 AND aa%<=4
          BOX dbx,dby,MOUSEX,MOUSEY
          releasewindow
        ENDIF
      LOOP
      IF MOUSEK=1
        bbx=bbx+1
        box(bbx,3)=MOUSEX
        box(bbx,4)=MOUSEY
        box(bbx,1)=(dbx)
        box(bbx,2)=(dby)
        box(bbx,0)=aa%
      ENDIF
    ENDIF
  ENDIF
  COLOR 1,0
@clearsection
  DEFLINE 1
RETURN
FUNCTION getstring(numchars%,title$,temp$)
  tagq%(0)=-2147483628
  tagq%(1)=VARPTR(rteztitle$)
  tagq%(2)=rt_reqpos%
  tagq%(3)=reqpos_centerwin%
  tagq%(4)=0
  IF temp$=""
    temp$=SPACE$(80)
    POKE V:temp$,0
  ELSE
    temp$=temp$+CHR$(0)
  ENDIF
  rtstring$=""
  title$=title$+CHR$(0)
  as%=0
  tg%=V:tagq%(0)
  IF @rtgetstringa(VARPTR(temp$),numchars%,VARPTR(title$),0,tg%)
    rtstring$=TRIM$(CHAR{V:temp$})
    as%=1
  ENDIF
  RETURN as%
ENDFUNC
PROCEDURE text(tx,ty,text$,fcol,col)
  COLOR fcol
  GRAPHMODE 1
  TEXT tx,ty,text$
  COLOR col
  GRAPHMODE 0
  TEXT tx,ty-1,text$
  GRAPHMODE 1
RETURN
PROCEDURE beveldo
  x1(1)=LEN(f$(t&,1))
  x1(2)=VAL(f$(t&,2))
  x1(3)=VAL(f$(t&,3))
  x1(4)=VAL(f$(t&,4))
  FOR tt&=1 TO 4
    x1(tt&)=x1(tt&)*8
  NEXT tt&
  ' IF screenmode%=0 !
  IF ddbb%=0 OR ddbb%=1
    drawflipbox(LPEEK(WINDOW(wn)+50),x1(1)+x1(2),x1(3)+2,x1(4)+16,10)
  ENDIF
  IF ddbb%=2 OR ddbb%=3
    drawbevelbox(LPEEK(WINDOW(wn)+50),x1(1)+x1(2),x1(3)+2,x1(4)+16,10)
  ENDIF
  IF ddbb%=3
    drawflipbox(LPEEK(WINDOW(wn)+50),x1(1)+x1(2)-2,x1(3)+1,x1(4)+20,12)
  ENDIF
  IF ddbb%=0
    drawbevelbox(LPEEK(WINDOW(wn)+50),x1(1)+x1(2)-1,x1(3)+1,x1(4)+18,12)  !+2
  ENDIF
  ' ENDIF
RETURN
PROCEDURE flipbox(wn,gx,gy,gx1,gy1)
  gx1=gx1+gx
  gy1=gy1+gy
  COLOR 1  !Black
  LINE gx,gy,gx1,gy  !Top
  LINE gx,gy,gx,gy1   !Left
  COLOR 2  !White
  LINE gx1,gy,gx1,gy1
  LINE gx1,gy1,gx,gy1
RETURN
PROCEDURE bevelbox(wn,gx,gy,gx1,gy1)
  gx1=gx1+gx
  gy1=gy1+gy
  COLOR 2  !Black
  LINE gx,gy,gx1,gy  !Top
  LINE gx,gy,gx,gy1   !Left
  COLOR 1  !White
  LINE gx1,gy,gx1,gy1
  LINE gx1,gy1,gx,gy1
RETURN
PROCEDURE message(message$)
  IF LEN(message$)<=77
    CLOSEW #12
    x1(1)=LEN(message$)
    x1(2)=x1(1)*8
    x1(3)=INT(640-x1(2))
    x1(4)=INT(x1(3)/2)
    mm=x1(2)+50
    mm=640-mm
    mm=INT(mm/2)
    ypos%=winh%-60
    ypos%=ypos%/2
    OPENW #12,mm,ypos%,x1(2)+50,60,&H80000,4096+65536+&H2+&H4
    TITLEW #12,version$
    bbv=x1(1)*8
    bbv=bbv+4
    flipbox(2,22,28,bbv,11)
    qx=INSTR(message$,"ĺ")
    IF qx>0
      COLOR 1
      mess$=MID$(message$,qx+1)
      message$=LEFT$(message$,qx-1)
      j=LEN(message$)
      j=j*8
      TEXT 25,36,message$
      COLOR 2
      text(25+j,37,mess$,1,2)
      COLOR 1
    ELSE
      COLOR 1
      text(25,37,message$,1,2)
    ENDIF
    flipbox(2,8,13,x1(2)+34,42)
    bevelbox(2,10,15,x1(2)+28,38)
    bevelbox(4,3,10,x1(2)+45,54)
    message$=""
    message1$=""
  ENDIF
RETURN
PROCEDURE moff
  CLOSEW #12
RETURN
' ------------------------------Memo Files-----------------------------
PROCEDURE inclip
  IF EXIST("c:saveclip")
    IF EXIST("ram:ddclip")
      KILL "ram:ddclip"
    ENDIF
    EXEC "c:saveclip ram:ddclip",-1,-1
    IF EXIST("ram:ddclip")
      OPEN "i",#15,"ram:ddclip"
      lo%=LOF(#15)
      CLOSE #15
      IF lo%>0
        eof("ram:ddclip")
        memcount=0
        memo$=""
        OPEN "i",#1,"ram:ddclip"
        DO UNTIL EOF(#1)
          LINE INPUT #1,a$
          INC memcount
          tex$(memcount)=a$
        LOOP
        CLOSE #1
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE dippy
  FOR county=1 TO maxl%
    PRINT AT(1,county);tx$(county)
  NEXT county
RETURN
PROCEDURE textedit
  wwn=wn
  qxl=bank
  bank=15
  wn=1
  maxl%=maxlin1%+4
  FOR county=k9+1 TO maxl%
    tx$(county)=""
  NEXT county
  OPENW #1,0,0,winw%,winh%,&H40000+512+&H80000,4096+&H8
  TITLEW #1,"Press Escape to Quit"
  GOSUB killtab
  char%=0
  CLS
  FOR county=1 TO maxl%
    tx$(county)=LEFT$(tx$(county)+SPACE$(79),79)
    PRINT AT(1,county);tx$(county)
  NEXT county
  FOR county=maxl%+1 TO 150
    tx$(county)=""
  NEXT county
  s=1
  cc=1
  x=1
  y=1
  DO
    q$=""
    eel=cc*79-79+x
    TITLEW #1,"Press Esc to Exit: F1:Insert Line  F2:Delete Line   Characters: "+STR$(eel)
    cc$=MID$(tx$(cc),x,1)
    DO
      PCOLOR 1,3
      PRINT AT(x,cc);cc$
      q$=INKEY$
      IF MOUSEK=1
        PCOLOR 1,0
        PRINT AT(x,cc);cc$
        cc=INT((MOUSEY-11)/8)+1
        x=INT(MOUSEX/8)+1
        q$=CHR$(9)
        IF cc>maxl%
          cc=maxl%
        ENDIF
        IF cc<1
          cc=1
        ENDIF
      ENDIF
      ON MENU
      IF q$="" AND MOUSEK<>1
        PAUSE 2
        PCOLOR 1,0
        PRINT AT(x,cc);cc$
        PAUSE 2
      ENDIF
    LOOP UNTIL q$<>""
    PCOLOR 1,0
    PRINT AT(x,cc);cc$
    qq=CVI(q$)
    IF qq>0
      qq=qq-39700
      IF qq=28 AND k9+1<=maxl% !Insert
        FOR county=maxl%+1 TO cc STEP -1
          tx$(county)=tx$(county-1)
        NEXT county
        tx$(cc)=SPACE$(79)
        k9=k9+1
        GOSUB dippy
      ENDIF
      IF qq=29  !Delete
        FOR county=cc TO maxl%
          tx$(county)=tx$(county+1)
        NEXT county
        tx$(maxl%)=SPACE$(79)
        k9=k9-1
        GOSUB dippy
      ENDIF
      IF qq=47
        x=x+1
      ELSE IF qq=48
        x=x-1
      ELSE IF qq=46
        cc=cc+1
      ELSE IF qq=45
        cc=cc-1
      ENDIF
    ENDIF
    IF q$=CHR$(127)
      tx$(cc)=LEFT$(tx$(cc),x-1)+MID$(tx$(cc),x+1)+" "
      PRINT AT(1,cc);tx$(cc)
    ENDIF
    IF q$=CHR$(13)
      cc=cc+1
      x=1
    ENDIF
    IF cc<1
      cc=1
    ENDIF
    IF cc>maxl%
      cc=maxl%
    ENDIF
    IF x<1
      x=1
    ENDIF
    IF x>79
      x=79
    ENDIF
    IF qq=0 AND q$<>CHR$(13) AND q$<>CHR$(9) AND q$<>CHR$(8) AND q$<>CHR$(127) AND q$<>CHR$(27)
      PCOLOR 1,0
      tx$(cc)=LEFT$(tx$(cc),x-1)+q$+MID$(tx$(cc),x)
      tx$(cc)=LEFT$(tx$(cc)+SPACE$(79),79)
      PRINT AT(1,cc);tx$(cc)
      x=x+1
    ENDIF
    IF cc>s
      s=cc
    ENDIF
  LOOP UNTIL q$=CHR$(27)
  IF k9>s
    s=k9
  ENDIF
  IF s>k9
    k9=s
  ENDIF
  CLOSEW #1
@clipit
  bank=qxl
  wn=wwn
RETURN
PROCEDURE geteditor
  qqq%=@getstring(79,"Enter Text Editor:","c:ed")
  IF qqq%=1
    editor$=rtstring$
  ENDIF
RETURN
PROCEDURE cex
  FOR county=1 TO maxlin1%
    tx$(county)=""
  NEXT county
RETURN
PROCEDURE creatememo(memo$)
  memo$=""
  wh=30
  llen%=0
  flagy=1
  IF eex=0
    FOR county=1 TO maxlin1%+4
      tx$(county)=""
    NEXT county
    GOSUB textedit
    memo$=""
    FOR county=1 TO k9
      memo$=memo$+tx$(county)+CHR$(174)
    NEXT county
    aa$=memo$
    GOSUB cex
  ENDIF
  IF editor$="" AND eex=1
    GOSUB geteditor
  ENDIF
  IF editor$<>"" AND eex=1
    eex=0
    ba$=""
    bba$=""
    ex$=editor$+" t:ddbase-temp"
    IF k9>0
      IF EXIST("t:ddbase-temp")
        KILL "t:ddbase-temp"
      ENDIF
      OPEN "o",#2,"t:ddbase-temp"
      FOR tt=1 TO k9
        PRINT #2,tx$(tt)
      NEXT tt
      CLOSE #2
    ENDIF
    EXEC ex$,-1,-1
    ' Read it back
    k9=0
    IF EXIST("t:ddbase-temp")
    @eof("t:ddbase-temp")
      OPEN "i",#2,"t:ddbase-temp"
      fl%=LOF(#2)
      IF fl%>0
        memo$=""
        k9=0
        DO
          INC k9
          LINE INPUT #2,ax$
          memo$=memo$+ax$+CHR$(174)
          ff%=LOC(#2)
        LOOP UNTIL ERR=26 OR ff%=>fl% OR EOF(#2)
      ENDIF
      CLOSE #2
      KILL "t:ddbase-temp"
      a1%=@rteasyrequest("Do you want to Justify the Text?","Yes|Cancel",version$)
      IF a1%=1
        aa$=memo$
      @undothing
      @inquisitor
        memo$=""
        FOR county=1 TO k9
          memo$=memo$+tx$(county)+CHR$(174)
        NEXT county
      ENDIF
      aa$=memo$
    ENDIF
  ENDIF
RETURN
PROCEDURE viewmemo(vw$)
  q=0
  k9=0
  fred$=" : "+f$(ext(tee),1)
  gln=0
  DO
    q=INSTR(vw$,CHR$(174))
    IF q>0
      INC gln+
      select$(gln)=LEFT$(vw$,q-1)
      vw$=MID$(vw$,q+1)
    ENDIF
  LOOP UNTIL q=0
  v%=V:fred$
  DEFMOUSE 2
  IF gln>maxlin1%+3
    start=1
    eext=2
  @listview(gln,fred$)
    eext=0
  ELSE
    displayit(gln,"P=Print"+fred$)
  ENDIF
  DEFMOUSE msp1%
RETURN
PROCEDURE undothing
  GOSUB cex
  k9=0
  q=0
  aa$=TRIM$(aa$)
  DO
    q=0
    q=INSTR(aa$,CHR$(174))
    IF q>0
      INC k9
      tx$(k9)=LEFT$(aa$,q-1)
      aa$=MID$(aa$,q+1)
    ENDIF
  LOOP UNTIL q=0 OR LEN(aa$)=0
RETURN
PROCEDURE inquisitor
  ww%=0
  FOR county=1 TO k9
    IF LEN(tx$(county))>ww%
      ww%=LEN(tx$(county))
    ENDIF
  NEXT county
  ii%=1
  FOR county=1 TO k9
    w1%=ww%-LEN(tx$(county))
    FOR tt=1 TO w1%
      i%=INSTR(tx$(county)," ",ii%)
      IF i%>0
        tx$(county)=LEFT$(tx$(county),i%)+" "+MID$(tx$(county),i%+1)
        ii%=i%+2
      ENDIF
    NEXT tt
    ii%=1
  NEXT county
RETURN
PROCEDURE editmemo
  getlist("Edit|Add|Redo|")
  selectfield("Memo",3)
  aa%=qq
  IF qq>3
    aa%=0
  ENDIF
  IF aa%=1 AND a$(t)<>""
    aa$=a$(t)
    GOSUB undothing
    IF k9>0 AND k9<=maxlin1%+4
      GOSUB textedit
      aa%=@rteasyrequest("Do you want to Justify the text?","Yes|Cancel",version$)
      IF aa%=1
      @inquisitor
      ENDIF
    ENDIF
    IF k9>maxlin1%+4 AND aa%=1
      IF editor$<>"" AND k9>maxlin1%+4
        xtl%=VAL(f$(t,4))
        ex$=editor$+" t:ddbase-temp"
        IF EXIST("t:ddbase-temp")
          KILL "t:ddbase-temp"
        ENDIF
        OPEN "o",#2,"t:ddbase-temp"
        FOR tt=1 TO k9
          PRINT #2,tx$(tt)
        NEXT tt
        CLOSE #2
        EXEC ex$,-1,-1
        ' Read it back
        k9=0
      @eof("t:ddbase-temp")
        OPEN "i",#2,"t:ddbase-temp"
        fl%=LOF(#2)
        aa$=""
        eer=0
        DO
          INC k9
          LINE INPUT #2,tx$(k9)
          IF LEFT$(tx$(k9),1)=CHR$(12)
            tx$(k9)=""
          ENDIF
          aa$=aa$+tx$(k9)+CHR$(174)
          ff%=LOC(#2)
        LOOP UNTIL ERR=26 OR ff%=>fl% OR EOF(#2)
        CLOSE #2
        KILL "t:ddbase-temp"
      ELSE
        ~@rteasyrequest("I am Sorry that I am unable to comply"+CHR$(10)+"As you have not defined a Text Editor!","Shame",version$)
      ENDIF
    ENDIF
    aa$=""
    newcount=0
    GOSUB clipit  !Was killtab
    FOR tt=1 TO k9
      aa$=aa$+tx$(tt)+CHR$(174)
    NEXT tt
    a$(t)=aa$
  ENDIF
  IF aa%=3
    wind=1
    a$(t)=""
    aa%=2
    k9=0
  ENDIF
  IF aa%=2
    bba$=a$(t)
    IF bba$=""
      k9=0
    ENDIF
    flag=2
    aa$=a$(t)
    IF aa$<>""
      GOSUB undothing
    ENDIF
    eex=1
    GOSUB getmemo
    eex=0
    ba$=aa$
    IF ba$<>""
      ba$=bba$+aa$
    ELSE
      ba$=aa$
    ENDIF
    aa$=ba$ !Was deleted
    undothing
    baa$=""
  @clipit
    FOR tt=1 TO k9
      baa$=baa$+tx$(tt)+CHR$(174)
    NEXT tt
    GOSUB cex
    flag=0
    wind=0
    a$(t)=baa$
  ENDIF
RETURN
PROCEDURE getdir
  ee=0
  memo$=""
  IF flag=0 OR wind=1
    gedir%=1
    GOSUB getpath("Select Device")
    gedir%=0
    dev$=nfile$
  ENDIF
  IF ee=0
    IF EXIST("t:ddb")
      KILL "t:ddb"
    ENDIF
    message("Scanning Device "+dev$)
    FILES dev$ TO "t:ddb"
    IF NOT EXIST("t:ddb")
      ~@rteasyrequest("Error File Not Created!!","Ok","ERROR")
      ee=1
    ENDIF
    moff
    IF EXIST("t:ddb")
      message("Loading Directory Please Wait...")
      FOR era=1 TO max1%-1
        tex$(era)=""
      NEXT era
      OPEN "i",#1,"t:ddb"
      ff%=0
      fl%=LOF(#1)
      count=0
      memcount=0
      DO UNTIL EOF(#1) OR ff%=>fl% OR memcount=>max1%-1
        LINE INPUT #1,xx$
        xx$=TRIM$(xx$)
        xx=INSTR(xx$," ")
        IF xx>0
          xx$=LEFT$(xx$,xx-1)
        ENDIF
        ee=0
        xx$=UPPER$(xx$)
        IF RIGHT$(xx$,5)<>".INFO" AND xx$<>"*C" AND xx$<>"*LIBS" AND xx$<>"*DEVS" AND xx$<>"*L" AND xx$<>"*S" AND xx$<>"*FONTS" AND xx$<>"*T" AND xx$<>"*SYSTEM"
          INC memcount
          tex$(memcount)=xx$
          xx$=""
        ENDIF
        ff%=LOC(#1)
      LOOP
      CLOSE #1
      KILL "t:ddb"
      GOSUB moff
      sor%=@rteasyrequest("Shall I Sort the List? ","Sort|Cancel",version$)
      IF sor%=1
        QSORT tex$(),memcount+1
      ENDIF
      le=0
      bl=0
      FOR tt=1 TO memcount
        IF LEFT$(tex$(tt),1)="*"
          le=LEN(tex$(tt))
          IF le>bl
            bl=le
          ENDIF
        ENDIF
      NEXT tt
      FOR tt=1 TO memcount
        IF LEFT$(tex$(tt),1)="*"
          tex$(tt)=LEFT$(MID$(tex$(tt),2)+SPACE$(bl),bl)+"<Dir>"
        ENDIF
      NEXT tt
      newcount=0
      FOR tt=1 TO memcount
        IF tex$(tt)<>"" AND tex$(tt)<>CHR$(174)
          INC newcount
          tex$(newcount)=tex$(tt)
        ENDIF
      NEXT tt
      memcount=newcount
    ENDIF
    moff
  ENDIF
RETURN
PROCEDURE getmemo
  aa$=""
  PCOLOR 1,0
  start=0
  fin=0
  q$=""
  select$(1)="Use Existing"
  select$(2)="Load New"
  select$(3)="Keyboard"
  select$(4)="Directory"
  select$(5)="ClipBoard"
  selectfield("MEMO",5)
  gmem%=qq
  ee=0
  IF gmem%<6
    IF gmem%=5
      count=0
      GOSUB inclip
    ENDIF
    IF gmem%=4
      GOSUB getdir
    ENDIF
    IF gmem%=3
      flag=2
      creatememo(memo$)
      flag=0
      gmem%=0
    ENDIF
    IF gmem%=2
      temp$=file$
      temp1$=filename1$
      rtitle$="Load New:"
      GOSUB getfile("")
      file$=nfile$
      IF ee=1
        gmem%=0
      ENDIF
      nn$=file$
      file$=temp$
      filename1$=temp1$
      text$=""
      memcount=0
      IF EXIST(nn$) AND gmem%>0
        OPEN "i",#1,nn$
        test$=INPUT$(4,#1)
        CLOSE #1
        IF test$="PP20"
          ex$="packit "+nn$+"  ram:ddfile.di D=DECRUNCH >NIL:"
          message("DeCrunching Please Wait")
          EXEC ex$,-1,-1
          moff
          nn1$=nn$
          nn$="ram:ddfile.di"
        ENDIF
        FOR era=1 TO max1%-1
          tex$(era)=""
        NEXT era
        GOSUB eof(nn$)
        OPEN "i",#1,nn$
        ff%=0
        fl%=LOF(#1)
        count=0
        memcount=0
        DO UNTIL EOF(#1) OR ff%=>fl% OR memcount=>max1%-1
          brain%=1
          INC memcount
          qqq=0
          aaa$=""
          LINE INPUT #1,aaa$
          IF LEFT$(aaa$,1)=CHR$(12)
            aaa$=""
          ENDIF
          tex$(memcount)=aaa$
          ff%=LOC(#1)
          EXIT IF ff%=>fl% OR ERR=26
        LOOP
        jump4:
        brain%=0
        CLOSE #1
        IF EXIST("ram:ddfile.di")
          KILL "ram:ddfile.di"
          IF nn$="ram:ddfile.di"
            nn$=nn1$
          ENDIF
        ENDIF
      ELSE
        ~@rteasyrequest("File Does Not Exist","Ok",version$)
      ENDIF
    ENDIF
    IF gmem%>0 AND memcount>0
    @getit
      aa$=""
      PCOLOR 1,0
      FOR xtr=start TO fin
        a$=tex$(xtr)
        q=0
        tem$=""
        FOR rrt=1 TO LEN(a$)
          a1$=MID$(a$,rrt,1)
          IF a1$=CHR$(27) OR a1$=CHR$(12)! OR a1$=CHR$(13) OR a1$=CHR$(10)
            a1$=" "
          ENDIF
          IF a1$=CHR$(9)
            a1$=SPACE$(ttab%)
          ENDIF
          IF a1$=CHR$(34)
            a1$="'"
          ENDIF
          tem$=tem$+a1$
        NEXT rrt
        IF LEN(tem$)>77
          tem$=LEFT$(tem$,77)
        ENDIF
        aa$=aa$+tem$+CHR$(174) !try aa$=left$(aa$,len(aa$)-1) take off 10
      NEXT xtr
      CLOSEW #5
      q$=""
    ENDIF
  ENDIF
RETURN
PROCEDURE getit
  GOSUB killtab2(memcount)
  FOR t&=1 TO memcount
    select$(t&)=tex$(t&)
  NEXT t&
  start=1
  eext=1
@listview(memcount,"Select Start")
  sta%=tag%
  select$(tag%)="*"+select$(tag%)
  PAUSE 50
@listview(memcount,"Select End")
  eext=0
  CLOSEW #8
  fin=tag%
  start=sta%
  IF start>fin
    SWAP start,fin
  ENDIF
RETURN
PROCEDURE killtab
  FOR county=1 TO k9
    ll%=0
    DO
      ll%=INSTR(tx$(county),CHR$(9))
      IF ll%>0
        tx$(county)=LEFT$(tx$(county),ll%-1)+SPACE$(ttab%)+MID$(tx$(county),ll%+1)
      ENDIF
    LOOP UNTIL ll%=0
    DO
      IF RIGHT$(tx$(county),1)=" "
        tx$(county)=LEFT$(tx$(county),LEN(tx$(county))-1)
      ENDIF
      EXIT IF tx$(county)=" " AND county<k9
    LOOP UNTIL RIGHT$(tx$(county),1)<>" "
    IF tx$(county)=" "
      k9=county-1
      county=k9+1
    ENDIF
  NEXT county
RETURN
PROCEDURE killtab2(k8)
  FOR county=1 TO k8
    ll%=0
    DO
      ll%=INSTR(tex$(county),CHR$(9))
      IF ll%>0
        tex$(county)=LEFT$(tex$(county),ll%-1)+SPACE$(ttab%)+MID$(tex$(county),ll%+1)
      ENDIF
    LOOP UNTIL ll%=0
    DO
      IF RIGHT$(tex$(county),1)=" "
        tex$(county)=LEFT$(tex$(county),LEN(tex$(county))-1)
      ENDIF
      EXIT IF tex$(county)=" " AND county<k8
    LOOP UNTIL RIGHT$(tex$(county),1)<>" "
    IF tex$(county)=" "
      k8=county-1
      county=k8+1
    ENDIF
  NEXT county
RETURN
PROCEDURE formatmemo
  IF n>0 AND k>0
    fields
    selectfield("SELECT MEMO FIELD",n)
    IF qq>0 AND f$(qq,0)="8"
      sit%=1
      m1=qq
      tt1=kk
      aa%=@getstring(5,"Enter Text Width","75")
      width%=VAL(rtstring$)
      startgauge(k,"Formatting Memo's")
      FOR kk=1 TO k
        unpack
        TITLEW #15,"Formatting Record: "+STR$(kk)
        aa$=a$(m1)
        undothing
        GOSUB clipit  !Was killtab
        GOSUB justify
        ba$=""
        w$(kk)=""
        FOR tt=1 TO k9
          IF tx$(tt)<>""
            ba$=ba$+TRIM$(tx$(tt))+CHR$(174)
          ENDIF
          tx$(tt)=""
        NEXT tt
        a$(m1)=ba$
        pack
        gauge
      NEXT kk
      endgauge
      kk=tt1
    ENDIF
  ENDIF
  qq=0
RETURN
PROCEDURE justify
  s$=""
  i%=0
  FOR county=1 TO k9
    ii%=1
    DO
      i%=INSTR(tx$(county),"  ")
      IF i%>0
        tx$(county)=LEFT$(tx$(county),i%)+MID$(tx$(county),i%+2)
      ENDIF
    LOOP UNTIL i%=0
    s$=s$+TRIM$(tx$(county))+" "
  NEXT county
  count=0
  DO
    p=0
    IF LEN(s$)>width%
      p=0
      FOR county=width% TO 1 STEP -1
        a$=MID$(s$,county,1)
        IF a$=" " OR a$="." OR a$=","
          p=county
          county=0
        ENDIF
      NEXT county
      IF p>0
        count=count+1
        tx$(count)=LEFT$(s$,p)
        s$=TRIM$(MID$(s$,p+1))
      ENDIF
    ENDIF
  LOOP UNTIL p=0
  count=count+1
  tx$(count)=s$
  ii%=1
  FOR county=1 TO count
    pee=width%-LEN(tx$(county))
    FOR tt=1 TO pee
      i%=INSTR(tx$(county)," ",ii%)
      IF i%>0
        tx$(county)=LEFT$(tx$(county),i%)+" "+MID$(tx$(county),i%+1)
        ii%=i%+2
      ENDIF
    NEXT tt
    ii%=1
  NEXT county
  k9=count
RETURN
PROCEDURE clipit
  FOR t&=1 TO k9
    DO UNTIL RIGHT$(tx$(t&),1)<>" " OR tx$(t&)=" "
      IF RIGHT$(tx$(t&),1)=" "
        tx$(t&)=LEFT$(tx$(t&),LEN(tx$(t&))-1)
      ENDIF
      EXIT IF tx$(t&)=" "
    LOOP
    IF tx$(t&)=" "
      tx$(t&)=""
    ENDIF
    DO
      ll%=INSTR(tx$(t&),CHR$(9))
      IF ll%>0
        tx$(t&)=LEFT$(tx$(t&),ll%-1)+SPACE$(ttab%)+MID$(tx$(t&),ll%+1)
      ENDIF
    LOOP UNTIL ll%=0
  NEXT t&
  sl=0
  FOR t&=k9 TO 1 STEP -1
    IF tx$(t&)<>""
      sl=t&
      t&=1
    ENDIF
  NEXT t&
  IF sl>0
    k9=sl
  ENDIF
RETURN
' -----------------------------External Files--------------------------
PROCEDURE checkcg(cg$)
  ii=INSTR(cg$,".")
  cg%=FALSE
  eee=0
  IF ii>0
    ccg$=LEFT$(cg$,ii-1)
    eee=0
    IF EXIST(ccg$+".lib")
      eee=eee+1
    ENDIF
    IF eee>0 AND EXIST(ccg$+".dat")
      eee=eee+1
    ENDIF
    IF eee>0 AND EXIST(ccg$+".metric")
      eee=eee+1
    ENDIF
    IF eee=3
      cg%=TRUE
    ELSE
      cg%=FALSE
    ENDIF
  ENDIF
RETURN
PROCEDURE getext
  ext=0
  FOR ty=1 TO n
    IF VAL(f$(ty,0))=>7 AND VAL(f$(ty,0))<10
      INC ext
      ext(ext)=ty
    ENDIF
  NEXT ty
RETURN
PROCEDURE displayexternal
  FOR tee=1 TO ext
    exx=VAL(f$(ext(tee),2))
    exy=VAL(f$(ext(tee),3))
    exl=LEN(f$(ext(tee),1))
    exx=INT(exx*8)-8
    exy=INT(exy*8)
    exl=INT(exl*8)+8
    IF f$(ext(tee),0)="8"
      COLOR 3
    ELSE IF f$(ext(tee),0)="7"
      COLOR 3
      DEFLINE &X1111000011110000
    ELSE IF f$(ext(tee),0)="9"
      COLOR 2
      DEFLINE &X1110001110001111
    ENDIF
    BOX exx-1,exy-1,exx+exl+1,exy+14
    DEFLINE 1
    COLOR 1
    drawbevelbox(LPEEK(WINDOW(0)+50),exx,exy,exl,14)
  NEXT tee
RETURN
PROCEDURE testexternal
  IF ext>0 AND k>0
    FOR tee=1 TO ext
      exx=INT(VAL(f$(ext(tee),2))*8)-8
      exy=INT(VAL(f$(ext(tee),3))*8)
      exl=INT(LEN(f$(ext(tee),1))*8)+8
      tx$=f$(ext(tee),1)
      IF MOUSEX=>exx AND MOUSEX=<exx+exl AND MOUSEY=>exy AND MOUSEY<=exy+12
        drawflipbox(LPEEK(WINDOW(0)+50),exx,exy,exl,14)
        COLOR 3
        PBOX exx+3,exy+1,exx+exl-3,exy+12
        GRAPHMODE 0
        COLOR 2
        TEXT exx+4,exy+9,tx$
        GRAPHMODE 1
        WHILE MOUSEK<>0
        WEND
        COLOR 0
        PBOX exx+3,exy+1,exx+exl-3,exy+12
        COLOR 1
        drawbevelbox(LPEEK(WINDOW(0)+50),exx,exy,exl,14)
        TEXT exx+4,exy+9,tx$
        pe$=a$(ext(tee))
        IF f$(ext(tee),0)="9"
          vw$=f$(ext(tee),5)
          GOSUB attach
        ENDIF
        IF pe$<>""
          IF f$(ext(tee),0)="7"
            GOSUB external(pe$)
            wn=0
            bank=1
          ENDIF
          IF f$(ext(tee),0)="8"
            vw$=a$(ext(tee))
            GOSUB viewmemo(vw$)
          ENDIF
        ENDIF
      ENDIF
    NEXT tee
  ENDIF
RETURN
PROCEDURE attach
  unpack
  dd$=""
  DO
    i%=INSTR(vw$,";")
    IF i%>0
      d%=VAL(MID$(vw$,i%+2))
      vw$=LEFT$(vw$,i%-1)
    ENDIF
  LOOP UNTIL i%=0
  DO
    i%=INSTR(vw$,"s%")
    IF i%>0
      vw$=LEFT$(vw$,i%-1)+a$(d%)+MID$(vw$,i%+2)
    ENDIF
  LOOP UNTIL i%=0
  IF aag%=0
    EXEC vw$,-1,-1
  ENDIF
RETURN
PROCEDURE checkascii(pee$)
  OPEN "i",#1,pee$
  fll%=LOF(#1)
  asc=0
  q=0
  eee=0
  IF fll%>25
    DO UNTIL asc=>200 OR EOF(#1) OR ff%=fll% OR eee=1
      q=INP(#1)
      INC asc
      IF q<9 OR q>174
        eee=1
        asc=200
      ENDIF
    LOOP
  ENDIF
  CLOSE #1
RETURN
PROCEDURE printexternal(pe$)
  IF EXIST(pe$) AND pe$<>""
    temp%=0
    pc%=0
    sss$=""
    excount=0
    count=0
    CLOSE #6
    OPEN "i",#6,pe$
    fl%=LOF(#6)
    aa%=1
    IF fl%=<600  !<=
      ccount=0
      mess$=""
      DO UNTIL EOF(#6) OR ERR=26
        qqqq%=0
        a$=""
        DO UNTIL qqqq%=10 OR qqqq%=13
          qqqq%=INP(#6)
          IF qqqq%<>10 AND qqqq%<>13
            a$=a$+CHR$(qqqq%)
          ENDIF
        LOOP
        INC ccount
        select$(ccount)=a$
        IF LEN(select$(ccount))>76
          select$(ccount)=LEFT$(select$(ccount),76)
        ENDIF
        EXIT IF ccount>maxlin1%
      LOOP
      IF ccount=<maxlin1%
        displayit(ccount,ptitle$)
        aa%=0
      ENDIF
    ENDIF
    CLOSE #6
    IF UPPER$(RIGHT$(pe$,6))=UPPER$(".guide") OR aba$="@database" AND ee<>10 AND guide$<>""
      win=wn
      message("Viewing:ĺ "+pe$)
      ex$=guide$+" "+pe$
      EXEC ex$,-1,-1
      moff
      aa%=0
    ENDIF
    IF aa%=1
      aia%=1
      plen=LEN(pe$)
      IF plen>15
        plen=plen-15
      ELSE
        plen=0
      ENDIF
      IF plen>1
        plen=INT(plen/2)
      ENDIF
      IF LEN(pe$)<15
        lenp=15-LEN(pe$)
        lenp=INT(lenp\2)
      ELSE
        lenp=0
      ENDIF
      IF eee=1
        aia%=0
        ex$=guide$+" "+pe$
        exec(ex$,"Viewing File")
      ENDIF
      IF aia%=2
        tempk%=@getstring(100,"Run "+pe$,pe$)
        IF tempk%=1
          pe$=TRIM$(rtstring$)
        ENDIF
        exec(pe$,"Running:"+pe$)
      ENDIF
      IF aia%=1 AND tool$(7)<>"" AND tool$(7)<>"-"
        OPEN "o",#12,"con:220/80/180/10/Viewing-File/"
        EXEC tool$(7)+" "+pe$,-1,12
        CLOSE #12
      ELSE IF aia%=1
        eof(pe$)
        OPENW #12,0,0,winw%,winh%,512+&H40000+&H80000,4096+&H8+65536
        TITLEW #12,"Viewing: "+pe$+"  Esc to Exit: P to Print"
        q$=""
        wn=12
        bank=12
        OPEN "i",#2,pe$
        llof%=LOF(#2)
        bbuff%=0
        count=0
        DO UNTIL EOF(#2) OR q$=CHR$(27)
          LINE INPUT #2,a$
          IF LEFT$(a$,1)=CHR$(12)
            a$=""
            count=maxlin1%
          ENDIF
          PRINT LEFT$(a$,79)
          '   IF LEN(a$)>79
          '          INC count
          '        ENDIF
          INC count
          IF count=>maxlin1%
            lloc%=LOC(#2)
            per%=lloc%/llof%*100
            PRINT CHR$(27)+"[1m"+"PRESS ANY KEY  "+CHR$(27)+"[22m";
            PCOLOR 2,3
            PRINT STR$(per%)+"%"
            PCOLOR 1,0
            DO
              q$=INKEY$
              ON MENU
            LOOP UNTIL q$<>"" OR MOUSEK=2
            IF q$="p" AND EXIST("c:printit")
              pri%=@rteasyrequest("Ensure Printer is ready","Print|Cancel",version$)
              IF pri%=1
                exec("c:printit "+pe$,"")
              ENDIF
            ENDIF
            xx=CRSLIN
            PRINT AT(0,xx-1);SPACE$(78)
            xx=xx-1
            PRINT AT(0,xx);SPACE$(78);
            PRINT AT(0,xx);
            count=0
          ENDIF
        LOOP
        PRINT
        IF bbuff%=0
          PRINT CHR$(27)+"[1m"+"END OF FILE: PRESS ANY KEY"+CHR$(27)+"[22m"
          DO
            q$=INKEY$
          LOOP UNTIL q$<>"" OR MOUSEK<>0
          IF q$="p" AND EXIST("c:printit")
            pri%=@rteasyrequest("Ensure Printer is ready","Print|Cancel",version$)
            IF pri%=1
              exec("copy "+pe$+" to prt:","PRINTING")
            ENDIF
          ENDIF
        ENDIF
        CLOSE #2
        CLOSEW #12
      ENDIF
    ENDIF
  ENDIF
  qq=0
  wn=0
  bank=1
RETURN
PROCEDURE iff(pe$)
  IF EXIST(pe$) AND check$(1,1)="y"
    IF pr$="y" AND EXIST(graphic$)
      pr%=@rteasyrequest("Do you wish to Print:"+CHR$(10)+pe$,"Print|Cancel","dDbase")
    ENDIF
    LPOKE frame%+156,0  !
    LPOKE frame%+160,0  !
    POKE frame%+1,0
    pe$=pe$+CHR$(0)
    ldifftowindow(V:pe$,frame%)
    ~ScreenToFront(LPEEK(ADD(frame%,160)))
    IF dela$=""
      DO
      LOOP UNTIL MOUSEK>0
      IF pr$="y" AND pr%=1 AND EXIST(graphic$)
        EXEC graphic$,-1,-1
      ENDIF
      ~CloseWindow(LPEEK(frame%+156))
      ~CloseScreen(LPEEK(frame%+160))
    ENDIF
  ELSE
    ~@rteasyrequest(pe$+" Not Found","Ok",version$)
    IF check$(1,1)<>"y"
      ~@rteasyrequest("Cannot find ILBM.LIBRARY","Ok",version$)
    ENDIF
  ENDIF
  wn=0
  ~ActivateWindow(WINDOW(wn))
RETURN
PROCEDURE checkiff(pe$)
  ii%=RINSTR(pe$,"/")
  IF ii%=0
    ii%=RINSTR(pe$,":")
  ENDIF
  IF ii%>0
    pee$=MID$(pe$,ii%+1)
  ELSE
    pee$=pe$
  ENDIF
  IF EXIST(pe$)
    OPEN "i",#15,pe$
    lof%=LOF(#15)
    IF lof%>60
      a$=INPUT$(60,#15)
      aa$=LEFT$(a$,12)
    ENDIF
    CLOSE #15
  ENDIF
  ee=0
  r$=UPPER$(RIGHT$(pe$,4))
  IF r$=".IFF" OR LEFT$(a$,4)="FORM" AND RIGHT$(aa$,4)="ILBM"
    ee=1
  ELSE IF r$=".SVX" OR LEFT$(a$,4)="FORM" AND RIGHT$(aa$,3)="SVX"
    ee=2
  ELSE IF r$=".GIF" OR LEFT$(a$,3)="GIF"
    ee=4
  ELSE IF r$=".TIF" OR LEFT$(a$,2)="MM" AND MID$(a$,4,1)="*"
    ee=5
  ELSE IF r$=".JPG" OR MID$(a$,7,4)="JFIF"
    ee=6
  ELSE IF r$=".MED" OR LEFT$(a$,3)="MED" OR LEFT$(a$,3)="MMD"
    ee=7
  ELSE IF UPPER$(LEFT$(pee$,4))="MOD." OR r$=".MOD" OR UPPER$(MID$(a$,21,3))="ST-"
    ee=9
  ELSE IF r$=".LHA" OR r$=".LZX" OR r$=".DMS"
    ee=11
  ELSE IF r$=".WAV" OR MID$(a$,9,7)="WAVfmt" AND LEFT$(a$,3)="RIF"
    ee=12
  ELSE IF r$=".BMP"
    ee=13
  ELSE IF r$=".AVI"
    ee=14
  ELSE IF r$=".GUIDE"
    ee=15
  ELSE IF UPPER$(RIGHT$(pe$,2))=".M" OR LEFT$(a$,4)="EMOD"
    ee=16
  ELSE IF r$=".MID"
    ee=18
  ELSE IF r$=".WMF"
    ee=19
  ELSE IF r$=".MOV"
    ee=20
  ENDIF
RETURN
PROCEDURE external(pe$)
  ee=0
  GOSUB checkiff(pe$)
  IF ee=0
    ee=15
  ENDIF
  IF ee=16 AND tool$(16)<>""
    exec(tool$(16)+" "+pe$+" > ram:tfile","")
    pe$="ram:tfile"
    ee=15
  ENDIF
  IF ee=11 AND clc=0
    GOSUB lha
  ENDIF
  IF ee<>11 AND clc=0
    ex$=tool$(ee)+" "+pe$
    EXEC ex$,-1,-1
  ENDIF
RETURN
PROCEDURE anim(pe$)
  IF EXIST(pe$) AND anim$<>""
    IF RIGHT$(anim$,1)="*"
      ex$=LEFT$(anim$,LEN(anim$)-1)+" "+pe$
      GOSUB exec(ex$,"Viewing:"+pe$)
    ELSE
      message("Viewing:ĺ"+pe$)
      ex$=pref$(1)+" "+pe$
      EXEC ex$,-1,-1
      moff
    ENDIF
  ENDIF
RETURN
PROCEDURE sample(pe$)
  IF sound$="" OR sound$="-"
    qqq%=@getstring(80,"Enter Sample Player","c:dsound")
    sound$=rtstring$
    tool$(5)=sound$
  ENDIF
  IF EXIST(pe$) AND sound$<>""
    IF RIGHT$(sound$,1)="*"
      ex$=LEFT$(sound$,LEN(sound$)-1)+" "+pe$
      GOSUB exec(ex$,"Playing - "+pe$)
    ELSE
      message("Playing -ĺ "+pe$)
      ex$=sound$+" "+pe$
      EXEC ex$,-1,-1
      moff
    ENDIF
  ENDIF
RETURN
' -----------------------------Preferences------------------------------
PROCEDURE showprefs
  OPENW #2
  IF LEFT$(pref$(7),1)="y"
    drawflipbox(LPEEK(WINDOW(wn)+50),130,112,12,8)
    COLOR 3
    PBOX 132,113,139,118
    COLOR 1
  ELSE
    TEXT 130,119,"  "
    drawbevelbox(LPEEK(WINDOW(wn)+50),130,112,12,8)
  ENDIF
  IF LEFT$(pref$(4),1)="y"
    drawflipbox(LPEEK(WINDOW(wn)+50),76,81,12,8)
    COLOR 3
    PBOX 78,82,85,87
    COLOR 1
  ELSE
    TEXT 76,88,"  "
    drawbevelbox(LPEEK(WINDOW(wn)+50),76,81,12,8)
  ENDIF
  IF LEFT$(pref$(9),1)="Y"
    drawflipbox(LPEEK(WINDOW(wn)+50),295,112,12,8)
    COLOR 3
    PBOX 298,113,303,118
    COLOR 1
  ELSE
    TEXT 295,119,"  "
    drawbevelbox(LPEEK(WINDOW(wn)+50),295,112,12,8)
  ENDIF
RETURN
PROCEDURE preferences
  oscreen%=FALSE
  ypos%=winh%-133
  ypos%=ypos%/2
  OPENW #2,85,ypos%,470,133,&H80000+512,4096+65536+&H8+&H2+&H4
  ON MESSAGE GOSUB msg
  TITLEW #2,""
  TITLEW #2," "+version$
  bank=7
  wn=2
  GOSUB display
  drawflipbox(LPEEK(WINDOW(wn)+50),355,43,100,45) !Gadgets
  dbbox(7,12,342,118)  !Screen
  drawflipbox(LPEEK(WINDOW(wn)+50),290,95,40,11)   !TaskPriority
  drawflipbox(LPEEK(WINDOW(wn)+50),90,95,35,11)  !Currency
  text(295,103,STR$(tskp),4,3)
  text(138,73,"Printer Preferences",1,2)
  drawflipbox(LPEEK(WINDOW(wn)+50),73,34,45,11)   !Print
  drawflipbox(LPEEK(WINDOW(wn)+50),103,50,24,11)  ! Superbase
  text(107,58,pref$(2),4,3)
  text(131,58,"Import/Export Superbase",1,2)
  text(94,89,"PowerPack Datafiles",1,2)
  COLOR 1
  text(125,43,"Page Length",1,2)
  text(75,42,pref$(1),4,3)
  text(100,103,pref$(5),4,3)
  text(119,24,"PREFERENCES",1,2)
  text(280,24,"dDbase",1,3)
  qq=0
  WHILE qq<12
    qq=0
    GOSUB showprefs
    DO UNTIL qq<>0
      qq=@test
    LOOP
    IF qq=1
      PRINT AT(10,4);
      FORM INPUT 10 AS pref$(1)
      text(75,42,pref$(1),4,3)
    ENDIF
    IF qq=2
      PRINT AT(14,6);
      FORM INPUT 4 AS pref$(2)
      text(107,58,pref$(2),4,3)
    ENDIF
    IF qq=3 ! Label Setup
      GOSUB labelsetup
      wn=2
      bank=7
      qq=10
    ENDIF
    IF qq=4 ! Crunch DataFiles
      IF LEFT$(pref$(4),1)="y"
        pref$(4)=""
      ELSE
        ~@getstring(5,"Enter Efficiency 1-5 (5=Best)","5")
        eff$=rtstring$
        pp$=MID$(pref$(4),3)
        sss$="ram:"
        GOSUB getpath("Select Temporary File Path")
        sss$=nfile$
        wn=2
        pref$(4)="y"+eff$+sss$
      ENDIF
    ENDIF
    IF qq=5 ! Currency
      ~@getstring(5,"Enter Currency",pref$(5))
      pref$(5)=rtstring$
      text(100,103,pref$(5),4,3)
    ENDIF
    IF qq=6
      temp=tskp
      sss$=STR$(tskp)
      ~@getstring(5,"Task Pri (-10 to 20)",sss$)
      OPENW #2
      tskp=VAL(rtstring$)
      IF tskp>20
        message("Wrong Input -10 to 20")
        DELAY 2
        moff
        OPENW #2
        tskp=temp
      ENDIF
      IF tskp<-10
        message("Wrong Input -10 to 20")
        DELAY 2
        tskp=temp
        moff
        OPENW #2
        tskp=-10
      ENDIF
      pref$(6)=STR$(tskp)
      ~SetTaskPri(FindTask(0),tskp)
      text(295,102,"    ",1,2)
      text(295,103,STR$(tskp),4,3)
    ENDIF
    IF qq=7
      IF LEFT$(pref$(7),1)="y"
        pref$(7)=""
      ELSE
        IF editor$=""
          ~@getstring(79,"Enter Text Editor","c:ed")
          editor$=rtstring$
        ENDIF
        pref$(7)="y"
      ENDIF
    ENDIF
    IF qq=8 !Printer
      mess$=""
      pref%=MALLOC(232,1)
      ~GetDefPrefs(pref%,232)
      ss$="-"
      prit$=CHAR{ADD(pref%,128)}
      mess$=LEFT$("PRINTER"+STRING$(20,ss$),20)+prit$+CHR$(10)+CHR$(10)+STRING$(16,ss$)+"TEXT"+STRING$(16,ss$)+CHR$(10)+CHR$(10)+CHR$(10)
      mess$=mess$+LEFT$("Page Length"+STRING$(20,ss$),20)+STR$(WORD{ADD(pref%,178)})+CHR$(10)
      mess$=mess$+LEFT$("Left Margin"+STRING$(20,ss$),20)+STR$(WORD{ADD(pref%,164)})+CHR$(10)
      mess$=mess$+LEFT$("Right Margin"+STRING$(20,ss$),20)+STR$(WORD{ADD(pref%,166)})+CHR$(10)
      port%=WORD{ADD(pref%,180)}
      port$=""
      IF port%=0
        port$="Continuous"
      ELSE
        port$="Single"
      ENDIF
      mess$=mess$+LEFT$("Paper Type"+STRING$(20,ss$),20)+port$+CHR$(10)
      pitch%=BYTE{ADD(pref%,158)}
      port$=""
      IF pitch%=0
        port$="10"
      ELSE IF pitch%=4
        port$="12"
      ELSE IF pitch%=8
        port$="15/17"
      ENDIF
      mess$=mess$+LEFT$("Pitch "+STRING$(20,ss$),20)+port$+CHR$(10)
      ptype%=WORD{ADD(pref%,176)}
      port$=""
      ppp%=BYTE{ADD(pref%,162)}
      IF ppp%=0
        port$="6 Lines Per Inch"
      ELSE
        port$="8 Lines Per Inch"
      ENDIF
      mess$=mess$+LEFT$("Spacing"+STRING$(20,ss$),20)+port$+CHR$(10)
      port$=""
      IF ptype%=0
        port$="US LETTER"
      ELSE IF ptype%=16
        port$="US LEGAL"
      ELSE IF ptype%=32
        port$="NARROW TRACTOR"
      ELSE IF ptype%=48
        port$="WIDE TRACTOR"
      ELSE IF ptype%=64
        port$="CUSTOM"
      ELSE IF ptype%=144
        port$="DIN A4"
      ENDIF
      mess$=mess$+LEFT$("Page Size"+STRING$(20,ss$),20)+port$+CHR$(10)
      ppp%=BYTE{ADD(pref%,160)}
      port$=""
      IF ppp%=1
        port$="Letter Quality"
      ELSE IF ppp%=0
        port$="Draft"
      ENDIF
      mess$=mess$+LEFT$("Print Quality"+STRING$(20,ss$),20)+port$+CHR$(10)+CHR$(10)
      port%=BYTE{ADD(pref%,1)}
      port$=""
      IF port%=1
        port$="Serial"
      ELSE
        port$="Parallel"
      ENDIF
      mess$=mess$+STRING$(16,"-")+"PORT"+STRING$(16,"-")+CHR$(10)+CHR$(10)+LEFT$("Port"+STRING$(20,ss$),20)+port$+CHR$(10)
      ~MFREE(pref%,232)
      aa%=@rteasyrequest(mess$,"Ok|Printer|PrinterGFX|OK","Printer Data      "+version$)
      IF aa%=3 AND EXIST("sys:prefs/printergfx")
        EXEC "sys:prefs/printergfx",-1,-1
      ENDIF
      IF aa%=2 AND EXIST("sys:prefs/printer")
        EXEC "sys:prefs/printer",-1,-1
      ENDIF
    ENDIF
    IF qq=10
      GOSUB putprefs
      qq=11
    ENDIF
    IF qq=9  ! Screen
      IF LEFT$(pref$(9),1)="Y"
        pref$(9)=""
      ELSE
        select$(1)="NTSC-HIRES"
        select$(2)="NTSC-HIRES-LACED"
        select$(3)="PAL-HIRES"
        select$(4)="PAL-HIRES-LACED"
        listview(4,"SELECT SCREENMODE")
        IF tag%>0
          pref$(9)="Y"+TRIM$(select$(tag%))
          oscreen%=TRUE
        ENDIF
        qq=9
        wn=2
        bank=7
      ENDIF
    ENDIF
    EXIT IF qq=11
    qq=0
    PAUSE (5)
  WEND
  bank=1
  wn=0
  CLOSEW #2
  IF oscreen%=TRUE
    oscreen%=FALSE
    CLOSEW #0
    EXEC "run >NIL: "+MID$(pref$(9),2),-1,-1
    DELAY 2
    GOSUB mwin
    IF gadtoolsbase%<>0
      freevisualinfo(vi%)
      ~CloseLibrary(gadtoolsbase%)
    ENDIF
    IF gadtoolsbase%<>0
      vi%=@getvisualinfoa(LPEEK(WINDOW(wn)+46),0)
    ENDIF
    totline%=winh%/8
    winoff%=winh%-200
    maxlin%=winh%/12.8
    maxlin1%=INT(winh%/10)+1
    maxlin2%=(200+winoff%)-42
    maxlin3%=(maxlin2%/8)-1
    tl=winh%/8
    tl=tl/2
    tl=tl-2
  @getgadgets
    bank=1
    wn=0
    GOSUB display
    IF @checkconfig=TRUE
      GOSUB presentdisplay
    ELSE
      ~@rteasyrequest("Wrong Screen Mode for Config File","Ok",version$)
      filename1$=""
      n=0
      bbx=0
      k=0
      kk=0
      ext=0
      ERASE w$()
      DIM w$(max%)
    ENDIF
  ENDIF
  bank=1
  qq$=""
RETURN
PROCEDURE putprefs
  temp$="progdir:ddbase.prefs"
  OPEN "o",#1,temp$
  PRINT #1,"DDBASE.PREFS"
  RESTORE dta4
  FOR t&=1 TO 5
    READ tt&
    PRINT #1,pref$(tt&)
  NEXT t&
  CLOSE #1
RETURN
PROCEDURE getprefs
  temp$="progdir:ddbase.prefs"
  IF EXIST(temp$)
    OPEN "i",#1,temp$
    INPUT #1,dd$
    IF dd$="DDBASE.PREFS"
      dta4:
      DATA 1,2,5,6,9
      RESTORE dta4
      FOR t=1 TO 5
        READ tt&
        LINE INPUT #1,pref$(tt&)
      NEXT t
      tskp=VAL(pref$(6))
      CLOSE #1
      mess$=""
    ELSE
      beep
    ENDIF
  ENDIF
RETURN
' --------------------------Start and Finnish----------------------------
PROCEDURE init
  DIM box$(60,20),gk(20),x1(8),tr(20,2),search$(20),form$(60),f(20),dte$(5),fo(25),month$(12)
  DIM f$(20,5),a$(20),w$(max%),m68%(20),tagq%(5),dtype$(20),ext(20),calc(20)
  DIM compare$(12),help$(5),filetags%(5),changereqtags%(3),box(10,4),tex$(max1%),tx$(150),temp$(20)
  DIM check$(6,2),group$(5),group(20),tool$(50),select$(max%+2),section$(20),label$(10,2),calc$(30,1)
  DIM dtags%(5),about$(20),txfx$(20,2),month(12)
  ltag%=FALSE
  wizard%=FALSE
  char=6
  def=6
  ty1=3
  xf=6
  floggit=30
  lbw%=1
  trsf$=""
  compile$="dDbase Was Compiled on  29 April 1998"+CHR$(10)
  graphic$="sys:tools/GraphicDump"
  flaget%=0
  ul$="__________________________________________________________________________________"
  ext=0
  msp1%=8
  DEFMOUSE (msp1%)
  cumfy_armchair%=0
  IF DPEEK((LPEEK(4))+20)<37
    ~@displayalert("ERROR: You Need OS2.04 or Higher to Run")
    CLOSEW #0
    GOSUB cleanup
    EDIT
  ENDIF
  CHDIR "progdir:"
  a$=SPACE$(346)
  ~GetScreenData(V:a$,346,1,0)
  r&=PEEK(V:a$+189)
  a$=""
  screenmode%=0
  IF r&>7 AND winh%>256 AND LEFT$(pref$(9),1)<>"Y"
    ~@displayalert("NOTE: dDbase  works best with 4-128 Colors. For More Colors Use Hires ")
    screenmode%=1
  ENDIF
  GOSUB checkfont
  IF eex%>1 AND LEFT$(pref$(9),1)<>"Y"
    CLOSEW #0
    mw$="PAL-HIRES"
    IF winh%=>200 AND winh%<=256
      lview%=20
      mw$="NTSC-HIRES"
    ENDIF
    IF winh%=>400 AND winh%<=512
      lview%=40
      mw$="NTSC-HIRES-LACED"
    ENDIF
    IF winh%=>512
      mw$="PAL-HIRES-LACED"
      lview%=50
    ENDIF
    IF EXIST(mw$)
      screenmode%=0
      exec("run "+mw$,"")
      DELAY 2
    ELSE
      IF r&>7
        ~@displayalert("ERROR: Unable to open screen")
      ENDIF
    ENDIF
    GOSUB mwin
  ENDIF
  m3=2
  IF r&>2
    m3=6
  ENDIF
  IF r&>3
    m3=14
  ENDIF
  version$="dDBase  7.66"
  startmem%=FRE(0)
  IF NOT EXIST("libs:reqtools.library")
    ~@displayalert("                 CAN'T RUN dDbase - NO REQTOOLS.LIBRARY")
    CLOSEW #0
    GOSUB cleanup
    EDIT
  ENDIF
  sit%=0
  GOSUB setupgadtools
  bbx=0
  dtype$(1)="String"
  dtype$(2)="Date"
  dtype$(3)="Integer"
  dtype$(4)="Bevel Box"
  dtype$(5)="Flip Box"
  dtype$(6)="Text"
  dtype$(7)="External"
  dtype$(0)="Unknown"
  dtype$(8)="Memo"
  dtype$(9)="Attach"
  dtype$(10)="Calc"
  dte$(1)="DD/MM/YY"
  dte$(2)="DD Mon YYYY"
  help$(1)="Main Buttons"
  help$(2)="Search Buttons"
  help$(3)="Print Buttons"
  help$(4)="Organise Buttons"
  alpha$="abcdefghijklmnopqrstuvwxyzABCEDFGHIJKLMNOPQRSTUVWXYZ"
  GOSUB setup
  compare$(1)="<, .>="+CHR$(13)+"n"+CHR$(27)+"pcSeoDls?APvxyrzu"  !Main
  compare$(2)=CHR$(13)+"p"+CHR$(27)+"v"
  compare$(3)="pctr"+CHR$(27)+"eafl"
  compare$(5)=" t="+CHR$(27)+"P"+CHR$(8)
  compare$(7)="pelgdtEaSs"+CHR$(27)
  compare$(8)="sdibftemac"
  wn=0
  gk=0
  bank=1
  maxfield%=1000
  pr$="n"
  pcode=1
  IF EXIST("ddbase.info")
    dscreen%=0
    GOSUB geticon
  ENDIF
  IF editor$="" AND EXIST("c:ed")
    editor$="c:ed"
  ENDIF
  IF editor$="-"
    editor$=""
  ENDIF
  IF height$<>""
    winh%=VAL(height$)
    IF winh%<200
      winh%=200
    ENDIF
    IF winh%>maxwh%
      winh%=maxwh%
    ENDIF
    SIZEW #0,winw%,winh%
    totline%=winh%/8
    winoff%=winh%-200
    maxlin%=winh%/12.8
    maxlin1%=INT(winh%/10)+1
    maxlin2%=(200+winoff%)-42
    maxlin3%=(maxlin2%/8)-1
    tl=winh%/8
    tl=tl/2
    tl=tl-2
    lview%=14
    IF winh%=>400
      lview%=40
    ENDIF
    IF winh%=>512
      lview%=50
    ENDIF
    IF winh%=256
      lview%=20
    ENDIF
    IF lview%=0
      lview%=20
    ENDIF
  ENDIF
  IF guide$=""
    ee=0
    IF EXIST("sys:utilities/amigaguide")
      guide$="amigaguide"
    ENDIF
    IF guide$="" AND EXIST("sys:utilities/multiview")
      guide$="multiview"
    ENDIF
    IF guide$=""
      message("Cannot find Amigaguide/Multiview")
      DELAY 3
    ENDIF
  ENDIF
  RESTORE
  FOR t&=1 TO 12
    READ month$(t&)
  NEXT t&
@getgadgets
  RESTORE month
  FOR m=1 TO 12
    READ month(m)
  NEXT m
  d$=DATE$
  rr=VAL(RIGHT$(d$,4))
  IF INT(rr/4)=rr/4
    month(2)=29
  ENDIF
  pref%=MALLOC(232,1)
  pp%=GetDefPrefs(pref%,232)
  prin%=DPEEK(pref%+178)
  prit$=CHAR{pref%+128}
  iconh%=PEEK(ADD(pref%,0))
  IF iconh%<>8
    ~@displayalert("             FONT Incompatible with dDbase")
    CLOSEW #0
    GOSUB cleanup
    EDIT
  ENDIF
  lmargin%=DPEEK(ADD(pref%,164))
  ~MFREE(pref%,232)  !BUG?
  IF VAL(pref$(1))=0
    pref$(1)=STR$(prin%-3)
  ENDIF
  GOSUB checkitems
  speak%=0
  IF EXIST("devs:narrator.device") AND EXIST("libs:translator.library")
    speak%=1
  ENDIF
  IF EXIST("dlabel.lbs")
    OPEN "i",#4,"dlabel.lbs"
    INPUT #4,char
    INPUT #4,def
    INPUT #4,ty1
    INPUT #4,xf
    INPUT #4,floggit
    INPUT #4,lbw%
    CLOSE #4
  ENDIF
RETURN
PROCEDURE getgadgets
  ' Main Gadgets
  RESTORE maing
  gk=0
  DO UNTIL a$="end"
    READ a$
    IF a$<>"end"
      INC gk
      a1$=MID$(a$,4,3)
      a1=VAL(a1$)
      a1=a1-56
      a1=a1+winoff%
      a$=LEFT$(a$,3)+LEFT$(STR$(a1)+"   ",3)+MID$(a$,7)
      box$(gk,bank)=a$
    ENDIF
  LOOP
  ' 1==Main 2=Search 3=Print 4=Organise 5=External 7=Prefs 8=Field Def 10=Select fiels
  gk(1)=gk
  FOR t&=1 TO 4         !Search
    READ box$(t&,2)
  NEXT t&
  gk(2)=4
  FOR t&=1 TO 9         !Print
    READ box$(t&,3)
  NEXT t&
  gk(3)=9
  gk(6)=5
  FOR t=1 TO 6          !Read External
    READ box$(t,5)
    a$=box$(t,5)
    a1$=MID$(a$,4,3)
    a1=VAL(a1$)
    a1=a1+winoff%
    a$=LEFT$(a$,3)+LEFT$(STR$(a1)+"   ",3)+MID$(a$,7)
    box$(t,5)=a$
  NEXT t
  gk(5)=6
  FOR t=1 TO 11         !Preference
    READ box$(t,7)
  NEXT t
  gk(7)=11
  gk(8)=10
  FOR t=1 TO 10          !Field Definition
    READ box$(t,8)
  NEXT t
  bank=1
  FOR tt=1 TO 3
    READ check$(tt,2)
  NEXT tt
RETURN
PROCEDURE setup
  ' ----------------------ReqTools-----------------------------
  reqtoolsname$="reqtools.library"+CHR$(0)
  reqtoolsbase%=OpenLibrary(VARPTR(reqtoolsname$),0)
  IF reqtoolsbase%=0
    GOSUB cleanup
  ENDIF
  rt_filereq%=0
  globalptr%=@rtallocrequesta(rt_filereq%,0)
  IF globalptr%=0
    GOSUB cleanup
  ENDIF
  pathptr%=@rtallocrequesta(rt_filereq%,0)
  IF pathptr%=0
    GOSUB cleanup
  ENDIF
  filereqptr%=@rtallocrequesta(rt_filereq%,0)
  IF filereqptr%=0
    GOSUB cleanup
  ENDIF
  rtchangereqattra(filereqptr%,VARPTR(changereqtags%(0)))
  rtfi_flags%=-2147483608
  rt_reqpos%=-2147483645
  reqpos_centerwin%=1
  freqf_nofiles%=8
  freqf_patgad%=16
  filetags%(0)=rtfi_flags%
  filetags%(1)=freqf_patgad%
  filetags%(2)=rt_reqpos%
  filetags%(3)=reqpos_centerwin%
  filetags%(4)=0
  dtags%(0)=rtfi_flags%
  dtags%(1)=freqf_patgad%+freqf_nofiles%
  dtags%(2)=rt_reqpos%
  dtags%(3)=reqpos_centerwin%
  dtags%(4)=0
  match_pat$="#?.DDB"+CHR$(0)
  rtfi_matchpat%=-2147483597
  changereqtags%(0)=rtfi_matchpat%
  changereqtags%(1)=VARPTR(match_pat$)
  changereqtags%(2)=0
  ' ------------------------ILBM + MISC---------------------------
  libname$="ilbm.library"+CHR$(0)
  ilbmbase%=OpenLibrary(V:libname$,0)
  frame%=MALLOC(174,2)
  view%=ViewAddress()
  viewport%=LONG{view%}
  colmap%=LONG{viewport%+4}
  GOSUB getpens(0)
  tv%=0
  IF EXIST("c:textview")
    tv%=1
  ENDIF
  IF tv%=0 AND EXIST("progdir:textview")
    tv%=1
  ENDIF
  ' -----------------------Text Effects---------------------------
  b1$=CHR$(27)+"[1m"
  b2$=CHR$(27)+"[22m"
  ul1$=CHR$(27)+"[4m"
  ul2$=CHR$(27)+"[24m"
  it$=CHR$(27)+"[3m"
  it1$=CHR$(27)+"[23m"
RETURN
PROCEDURE setupgadtools
  ' -----------------------GadTools---------------------------------
  DIM fliptags%(5),bevtags%(5)
  gt_visualinfo%=-2146959308
  wn=0
  gadname$="gadtools.library"+CHR$(0)
  gadtoolsbase%=OpenLibrary(VARPTR(gadname$),0)
  IF gadtoolsbase%<>0
    vi%=@getvisualinfoa(LPEEK(WINDOW(wn)+46),0)
  ENDIF
  bevtags%(0)=gt_visualinfo%
  bevtags%(1)=vi%
  bevtags%(2)=0
  gtbb_recessed%=-2146959309
  rtitle$="Select A File"
  title%=VARPTR(rtitle$)
  fliptags%(0)=gtbb_recessed%
  fliptags%(1)=123
  fliptags%(2)=gt_visualinfo%
  fliptags%(3)=vi%
  fliptags%(4)=0
RETURN
PROCEDURE cleanup
  IF dscreen%<>0
  ENDIF
  IF filereqptr%<>0
    GOSUB rtfreerequest(filereqptr%)
  ENDIF
  IF globalptr%<>0
    GOSUB rtfreerequest(globalptr%)
  ENDIF
  IF reqtoolsbase%<>0
    ~CloseLibrary(reqtoolsbase%)
  ENDIF
  IF EXIST("ram:ddt")
    KILL "ram:ddt"
  ENDIF
  IF EXIST("ram:temp.dc")
    KILL "ram:temp.dc"
  ENDIF
  GOSUB cleanup1
RETURN
PROCEDURE cleanup1
  IF gadtoolsbase%<>0
    freevisualinfo(vi%)
    ~CloseLibrary(gadtoolsbase%)
  ENDIF
  IF ilbmbase%<>0
    ~MFREE(frame%,174)
    ~CloseLibrary(ilbmbase%)
  ENDIF
RETURN
' --------------------------Reqtools Functions-----------------------
FUNCTION rtselectfile(req%,heading$,rtpath$)
  filename$=SPACE$(60)
  POKE VARPTR(filename$),0
  IF @rtfilerequesta(req%,V:filename$,V:heading$,V:filetags%(0))<>0
    path$=CHAR{LPEEK(req%+16)}
    IF path$<>""
      IF RIGHT$(path$,1)<>":"
        path$=path$+"/"
      ENDIF
    ENDIF
    filename1$=CHAR{V:filename$}
    rtpath$=path$+CHAR{V:filename$}
    path$=rtpath$
    RETURN 1
  ELSE
    RETURN 0
  ENDIF
ENDFUNC
FUNCTION rtselectdir(req%,heading$,rtpath$)
  filename$=SPACE$(60)
  POKE VARPTR(filename$),0
  IF @rtfilerequesta(req%,V:filename$,V:heading$,V:dtags%(0))<>0
    path$=CHAR{LPEEK(req%+16)}
    RETURN 1
  ELSE
    RETURN 0
  ENDIF
ENDFUNC
FUNCTION rtallocrequesta(type%,taglist%)
  m68%(0)=type%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-30,m68%()
  RETURN m68%(0)
ENDFUNC
PROCEDURE rtfreerequest(req%)
  m68%(9)=req%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-36,m68%()
RETURN
PROCEDURE rtchangereqattra(req%,taglist%)
  m68%(9)=req%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-48,m68%()
RETURN
FUNCTION rtfilerequesta(filereq%,file%,title%,taglist%)
  m68%(9)=filereq%
  m68%(10)=file%
  m68%(11)=title%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-54,m68%()
  RETURN m68%(0)
ENDFUNC
FUNCTION rtezrequesta(bodyfmt%,gadfmt%,reqinfo%,argarray%,taglist%)
  m68%(9)=bodyfmt%
  m68%(10)=gadfmt%
  m68%(11)=reqinfo%
  m68%(12)=argarray%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-66,m68%()
  RETURN m68%(0)
ENDFUNC
FUNCTION rtgetstringa(buffer%,maxchars%,title%,reqinfo%,taglist%)
  m68%(9)=buffer%
  m68%(0)=maxchars%
  m68%(10)=title%
  m68%(11)=reqinfo%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-72,m68%()
  RETURN m68%(0)
ENDFUNC
FUNCTION rtgetlonga(longptr%,title%,reqinfo%,taglist%)
  m68%(9)=longptr%
  m68%(10)=title%
  m68%(11)=reqinfo%
  m68%(8)=taglist%
  m68%(14)=reqtoolsbase%
  RCALL reqtoolsbase%-78,m68%()
  RETURN m68%(0)
ENDFUNC
FUNCTION rteasyrequest(body$,gad$,rteztitle$)
  body$=body$+CHR$(0)
  rteztitle$=rteztitle$+CHR$(0)
  gad$=gad$+CHR$(0)
  tagq%(0)=-2147483628
  tagq%(1)=VARPTR(rteztitle$)
  tagq%(2)=rt_reqpos%
  tagq%(3)=reqpos_centerwin%
  tagq%(4)=0
  RETURN @rtezrequesta(VARPTR(body$),VARPTR(gad$),0,0,VARPTR(tagq%(0)))
ENDFUNC
FUNCTION rtgetnum(numptr%,title$)
  RETURN @rtgetlonga(numptr%,VARPTR(title$),0,0)
ENDFUNC
' --------------------------GadTools Functions---------------------------
PROCEDURE drawbevelbox(rport%,left%,top%,width%,height%)
  m68%(14)=gadtoolsbase%
  m68%(8)=rport%
  m68%(9)=VARPTR(bevtags%(0))
  m68%(0)=left%
  m68%(1)=top%
  m68%(2)=width%
  m68%(3)=height%
  RCALL gadtoolsbase%-120,m68%()
RETURN
FUNCTION getvisualinfoa(screen%,taglist%)
  m68%(14)=gadtoolsbase%
  m68%(8)=screen%
  m68%(9)=taglist%
  RCALL gadtoolsbase%-126,m68%()
  RETURN m68%(0)
ENDFUNC
PROCEDURE drawflipbox(rport%,left%,top%,width%,height%)
  m68%(14)=gadtoolsbase%
  m68%(8)=rport%
  m68%(9)=VARPTR(fliptags%(0))
  m68%(0)=left%
  m68%(1)=top%
  m68%(2)=width%
  m68%(3)=height%
  RCALL gadtoolsbase%-120,m68%()
RETURN
PROCEDURE freevisualinfo(vi%)
  m68%(14)=gadtoolsbase%
  m68%(8)=vi%
  RCALL gadtoolsbase%-132,m68%()
RETURN
' ----------------------------ILBM----------------------------------------
PROCEDURE ldifftowindow(filename%,ilbmframe%)
  m68%(1)=filename%
  m68%(9)=ilbmframe%
  m68%(14)=ilbmbase%
  RCALL ilbmbase%-30,m68%()
RETURN
' ----------------------------Pen Colours---------------------------------
PROCEDURE getpens(window%)
  LOCAL screen%,pens%,drawinfo%
  screen%=LONG{WINDOW(0)+46}
  drawinfo%=@getscreendrawinfo(screen%)
  pens%=LONG{drawinfo%+4}
  ' -- Assign the pen colours
  detailpen%=CARD{pens%}
  blockpen%=CARD{pens%+2}
  textpen%=CARD{pens%+4}
  shinepen%=CARD{pens%+6}
  shadowpen%=CARD{pens%+8}
  fillpen%=CARD{pens%+10}
  filltextpen%=CARD{pens%+12}
  backgroundpen%=CARD{pens%+14}
  highlighttextpen%=CARD{pens%+16}
  freescreendrawinfo(screen%,drawinfo%)
RETURN
FUNCTION getscreendrawinfo(screen%)
  m68%(8)=screen%
  m68%(14)=_IntBase
  RCALL _IntBase-690,m68%()
  RETURN m68%(0)
ENDFUNC
PROCEDURE freescreendrawinfo(screen%,drawinfo%)
  m68%(8)=screen%
  m68%(9)=drawinfo%
  m68%(14)=_IntBase
  RCALL _IntBase-696,m68%()
RETURN
' ------------------------List View?????----------------
PROCEDURE listview(gln,wtitle$)
  ee=0
  GOSUB width
  IF star1>75
    star1=75
  ENDIF
  star2=star1*8+36
  IF star2<150
    star2=160
  ENDIF
  IF star2>winw%
    star2=winw%
  ENDIF
  ck=(star2-140)/2
  stb$=LEFT$(STR$(ck)+"   ",3)
  box$(1,9)=LEFT$(STR$(ck)+"   ",3)+"150 UP "
  box$(2,9)=LEFT$(STR$(ck+36)+"   ",3)+"150 DOWN "
  box$(3,9)=LEFT$(STR$(ck+88)+"   ",3)+"150 DONE "
  lvbh%=132
  lvh%=170
  IF lview%=20
    box$(1,9)=LEFT$(STR$(ck)+"   ",3)+"198 UP "
    box$(2,9)=LEFT$(STR$(ck+36)+"   ",3)+"198 DOWN "
    box$(3,9)=LEFT$(STR$(ck+88)+"   ",3)+"198 DONE "
    lvh%=218
    lvbh%=180
  ENDIF
  IF lview%=50
    box$(1,9)=LEFT$(STR$(ck)+"   ",3)+"438 UP "
    box$(2,9)=LEFT$(STR$(ck+36)+"   ",3)+"438 DOWN "
    box$(3,9)=LEFT$(STR$(ck+88)+"   ",3)+"438 DONE "
    lvh%=455
    lvbh%=417
  ENDIF
  IF lview%=40
    box$(1,9)=LEFT$(STR$(ck)+"   ",3)+"358 UP "
    box$(2,9)=LEFT$(STR$(ck+36)+"   ",3)+"358 DOWN "
    box$(3,9)=LEFT$(STR$(ck+88)+"   ",3)+"358 DONE "
    lvh%=375
    lvbh%=257+80
  ENDIF
  gk(9)=3
  compare$(9)="><"+CHR$(27)
  qxl=bank
  wwn=wn
  OPENW #8,(winw%-star2)/2,(winh%-lvh%)/2,star2,lvh%,512+&H40000+&H80000,4096+&H2+&H8+&H4
  TITLEW #8,wtitle$
  wn=8
  bank=9
  IF ddbb%=1 OR ddbb%=0
    drawflipbox(LPEEK(WINDOW(wn)+50),7,13,star2-15,lvbh%)
  ENDIF
  IF ddbb%=2
    drawbevelbox(LPEEK(WINDOW(wn)+50),7,13,star2-15,lvbh%)
  ENDIF
  IF ddbb%=3
    dbbox(7,13,star2-15,lvbh%)
  ENDIF
  IF ddbb%=0
    drawbevelbox(LPEEK(WINDOW(wn)+50),6,12,star2-13,lvbh%+2)
  ENDIF
  GOSUB display
  tag%=0
  IF eext=0
    start=1
  ENDIF
  GOSUB draw
  DO
    DO
      gxl=@test
      ON MENU
      IF gxl=3
        q$=CHR$(27)
        m5=gln+1
        eext=0
      ENDIF
      my=MOUSEY
      IF MOUSEK=1 AND eext<>2
        my=my-8
        qq=INT(my-0.5)
        qq=INT(qq/8)
        IF qq=>1 AND qq<=lview%+1
          m5=start+qq-1
          PCOLOR 1,3
          PRINT AT(3,qq+1);LEFT$(select$(m5),star1)
          PCOLOR 1,0
          PAUSE 5
          tag%=m5
        ENDIF
      ENDIF
    LOOP UNTIL gxl<>0 OR MOUSEK<>0 OR tag%<>0
    EXIT IF gxl=3 OR tag%<>0
    IF gxl=2 AND gln>lview%
      start=start-lview%
      IF start<1
        start=1
      ENDIF
      GOSUB draw
    ENDIF
    IF gxl=1 AND gln>lview%
      start=start+lview%
      IF start+lview%>gln
        start=gln-lview%
      ENDIF
      GOSUB draw
    ENDIF
  LOOP UNTIL tag%<>0
  IF eext=0 OR eext=3
    CLOSEW #8
  ENDIF
  bank=1
  wn=0
RETURN
PROCEDURE draw
  ttf=0
  FOR ttx=start TO start+lview%
    ttf=ttf+1
    IF LEFT$(select$(ttx),1)="*" AND eext=1
      PCOLOR 1,3
      PRINT AT(3,ttf+1);MID$(LEFT$(select$(ttx)+SPACE$(80),star1),2)
      PCOLOR 1,0
    ELSE
      PRINT AT(3,ttf+1);LEFT$(select$(ttx)+SPACE$(80),star1)
    ENDIF
  NEXT ttx
RETURN
PROCEDURE width
  star1=0
  FOR ttx&=1 TO gln
    IF LEN(select$(ttx&))>star1
      star1=LEN(select$(ttx&))
    ENDIF
  NEXT ttx&
  FOR ttx&=gln+1 TO max%
    select$(ttx&)=""
  NEXT ttx&
RETURN
PROCEDURE adddate(da$,am)
  dd=VAL(LEFT$(da$,2))
  mm=VAL(MID$(da$,4,2))
  yy=VAL(RIGHT$(da$,4))
  FOR tyt=1 TO am
    IF dd<month(mm)
      INC dd
    ELSE
      dd=1
      INC mm<=
      IF mm>12
        mm=1
        INC yy
      ENDIF
    ENDIF
  NEXT tyt
  ny$=RIGHT$("0"+STR$(dd),2)+"/"+RIGHT$("0"+STR$(mm),2)+"/"+STR$(yy)
RETURN
' -----------------------------Under process
PROCEDURE up
  ~@rteasyrequest("Procedure under Development","Oh","")
RETURN
PROCEDURE unarchive
@up
RETURN
PROCEDURE extract
@up
RETURN
PROCEDURE edittool
  ' @up
  IF editor$<>"" AND EXIST("ddbase.tools")
    EXEC editor$+" "+"ddbase.tools",-1,-1
    GOSUB geticon
  ENDIF
RETURN
PROCEDURE lha
  EXEC "uarc "+pe$,-1,-1
RETURN
DATA $VER: dDbase 7.68  ©MadCap-Software  (5 October 1998),0