home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / qbasic / qbtree42.arc / MAILAB.BAS < prev    next >
BASIC Source File  |  1989-10-19  |  42KB  |  1,532 lines
  1. DECLARE FUNCTION ConvertLFpts$ (pts%)
  2. DECLARE FUNCTION Convert2ASCII$ (strg$)
  3. DECLARE SUB PrintLabel ()
  4. DECLARE SUB ParsePC ()
  5. DECLARE SUB ShowEsc (onoff%)
  6. DECLARE SUB ShowLabelInches ()
  7. DECLARE SUB GetMoveKey (NumberOpts%, ulr%, ulc%, lrr%, lrc%, code%, lastkey%, lastptr%, ptr%)
  8. DECLARE SUB ClearMsgArea ()
  9. DECLARE SUB DropPrintWindow (lastkey%)
  10. DECLARE SUB DropEditWindow (lastkey%)
  11. DECLARE SUB SaveWindow (WindowSave%(), ulr%, ulc%, lrr%, lrc%)
  12. DECLARE SUB BackWindow (WindowSave%(), ulr%, ulc%, lrr%, lrc%)
  13. DECLARE SUB ShowTitleScreen ()
  14. DECLARE FUNCTION GetKeyCode% (xcode%)
  15. DECLARE SUB DropFileWindow (lastkey%)
  16. DECLARE SUB ChangeAttr (ulr%, ulc%, lrr%, lrc%, fg%, bg%)
  17. DECLARE SUB XPrint (strg$, row%, col%, fg%, bg%)
  18. DECLARE FUNCTION Edit% (lb%, ub%, prompt$(), fg%, bg%, exitkey%, flag%)
  19. DECLARE SUB WEdit (lb%, ub%, prompt$(), fg%, bg%, xitkey%, flag%)
  20. DECLARE SUB WPrint (lb%, ub%, prompt$(), fg%, bg%)
  21. DECLARE SUB DropTypeWindow (lastkey%)
  22. DECLARE SUB DropPitchWindow (lastkey%)
  23. DECLARE SUB MoveRec2Prompt (rec$)
  24. DECLARE SUB GetCommandLineFile ()
  25.  
  26. DECLARE FUNCTION FileExists% (filename$)  '{must be a ready drive}
  27.  
  28. CONST BackSpace = 8, TabRight = 9, EnterKey = 13, TabLeft = 15
  29. CONST EscKey = 27, HomeKey = 71, PgUpKey = 73, CursorLeft = 75
  30. CONST CursorRight = 77, EndKey = 79, PgDnKey = 81, InsertKey = 82
  31. CONST DeleteKe = 83, DeleteToEOLKey = 25
  32. CONST CursorUp = 72, CursorDown = 80
  33. CONST DropFile = 33, DropEdit = 18, DropPrint = 25
  34. CONST DropPitch = 25, DropType = 20
  35.                                    
  36. CONST TRUE = -1, FALSE = NOT TRUE
  37.  
  38. DEFINT A-Z
  39. '{10/19/89 by Cornel Huth}
  40. '{A useful label generating program using QBTREE42}
  41. '{the system is self-contained (with QBTREE42)}
  42. '{for speedier screens, use optimized SAVE/BACKWINDOW() & XPRINT()}
  43. '{the printer codes have been set for an IBM PC Graphics Printer}
  44. '{others will most probably have a different LFn/72 setup}
  45.  
  46. REM $INCLUDE: 'qbtree42.bi'
  47.                
  48. REDIM SHARED StatError$(200 TO 232)
  49. StatError$(200) = "Key not found"
  50. StatError$(201) = "Key already exists"
  51. StatError$(202) = "End of file"
  52. StatError$(203) = "Top of file"
  53. StatError$(204) = "Empty file"
  54. StatError$(205) = "Disk full"
  55. StatError$(206) = "Data pointer invalid"
  56. StatError$(207) = "Key pointer invalid"
  57. StatError$(208) = "File not QBTREE40"
  58. StatError$(210) = "Stack overflow"
  59. StatError$(211) = "Function not implemented"
  60. StatError$(220) = "Record length invalid"
  61. StatError$(221) = "Key length invalid"
  62. StatError$(222) = "File not open"
  63. StatError$(223) = "Invalid null key assignment"
  64. StatError$(224) = "Invalid record number"
  65. StatError$(225) = "No more handles"
  66. StatError$(226) = "File not found"
  67. StatError$(227) = "File needs to be converted"
  68. StatError$(228) = "File not QBTREE"
  69. StatError$(229) = "Lock already in force"
  70. StatError$(230) = "File already exists"
  71. StatError$(231) = "File not found"
  72. StatError$(232) = "General lock failure"
  73.  
  74. REDIM SHARED prompt$(1 TO 50, 1 TO 3)
  75. prompt$(1, 1) = "10/01/60/a/L0:"
  76. prompt$(2, 1) = "10/65/03/n/"
  77. prompt$(3, 1) = "10/69/03/n/"
  78. prompt$(4, 1) = "10/73/03/n/"
  79. prompt$(5, 1) = "10/77/03/n/"
  80. prompt$(6, 1) = "11/01/60/a/L1:"
  81. prompt$(7, 1) = "11/65/03/n/"
  82. prompt$(8, 1) = "11/69/03/n/"
  83. prompt$(9, 1) = "11/73/03/n/"
  84. prompt$(10, 1) = "11/77/03/n/"
  85. prompt$(11, 1) = "12/01/60/a/L2:"
  86. prompt$(12, 1) = "12/65/03/n/"
  87. prompt$(13, 1) = "12/69/03/n/"
  88. prompt$(14, 1) = "12/73/03/n/"
  89. prompt$(15, 1) = "12/77/03/n/"
  90. prompt$(16, 1) = "13/01/60/a/L3:"
  91. prompt$(17, 1) = "13/65/03/n/"
  92. prompt$(18, 1) = "13/69/03/n/"
  93. prompt$(19, 1) = "13/73/03/n/"
  94. prompt$(20, 1) = "13/77/03/n/"
  95. prompt$(21, 1) = "14/01/60/a/L4:"
  96. prompt$(22, 1) = "14/65/03/n/"
  97. prompt$(23, 1) = "14/69/03/n/"
  98. prompt$(24, 1) = "14/73/03/n/"
  99. prompt$(25, 1) = "14/77/03/n/"
  100. prompt$(26, 1) = "15/01/60/a/L5:"
  101. prompt$(27, 1) = "15/65/03/n/"
  102. prompt$(28, 1) = "15/69/03/n/"
  103. prompt$(29, 1) = "15/73/03/n/"
  104. prompt$(30, 1) = "15/77/03/n/"
  105. prompt$(31, 1) = "16/01/60/a/L6:"
  106. prompt$(32, 1) = "16/65/03/n/"
  107. prompt$(33, 1) = "16/69/03/n/"
  108. prompt$(34, 1) = "16/73/03/n/"
  109. prompt$(35, 1) = "16/77/03/n/"
  110. prompt$(36, 1) = "17/01/60/a/L7:"
  111. prompt$(37, 1) = "17/65/03/n/"
  112. prompt$(38, 1) = "17/69/03/n/"
  113. prompt$(39, 1) = "17/73/03/n/"
  114. prompt$(40, 1) = "17/77/03/n/"
  115. prompt$(41, 1) = "18/01/60/a/L8:"
  116. prompt$(42, 1) = "18/65/03/n/"
  117. prompt$(43, 1) = "18/69/03/n/"
  118. prompt$(44, 1) = "18/73/03/n/"
  119. prompt$(45, 1) = "18/77/03/n/"
  120. prompt$(46, 1) = "19/01/60/a/L9:"
  121. prompt$(47, 1) = "19/65/03/n/"
  122. prompt$(48, 1) = "19/69/03/n/"
  123. prompt$(49, 1) = "19/73/03/n/"
  124. prompt$(50, 1) = "19/77/03/n/"
  125.  
  126. NumberFileOpts = 4
  127. REDIM FileOpts$(1 TO NumberFileOpts)
  128. FileOpts$(1) = " Select data file  "
  129. FileOpts$(2) = " Select index file "
  130. FileOpts$(3) = " Show files        "
  131. FileOpts$(4) = " Exit to DOS       "
  132.  
  133. NumberEditOpts = 6
  134. REDIM EditOpts$(1 TO NumberEditOpts)
  135. EditOpts$(1) = " Select key     "
  136. EditOpts$(2) = " Add key/record "
  137. EditOpts$(3) = " Update record  "
  138. EditOpts$(4) = " Next key       "
  139. EditOpts$(5) = " Previous key   "
  140. EditOpts$(6) = " Delete key/rec "
  141.  
  142. NumberPrintOpts = 2
  143. REDIM PrintOpts$(1 TO NumberPrintOpts)
  144. PrintOpts$(1) = " Print label        "
  145. PrintOpts$(2) = " Edit printer codes "
  146.  
  147. NumberPitchOpts = 7
  148. REDIM PitchOpts$(1 TO NumberPitchOpts)
  149. PitchOpts$(1) = "     Reset      1 "
  150. PitchOpts$(2) = "     Normal     2 "
  151. PitchOpts$(3) = "     Compressed 4 "
  152. PitchOpts$(4) = "     Expanded   8 "
  153. PitchOpts$(5) = "     Pitch 4   16 "
  154. PitchOpts$(6) = "     Pitch 5   32 "
  155. PitchOpts$(7) = "     Pitch 6   64 "
  156.  
  157. NumberTypeOpts = 8
  158. REDIM TypeOpts$(1 TO NumberTypeOpts)
  159. TypeOpts$(1) = "     Emphasized  1 "
  160. TypeOpts$(2) = "     Bold        2 "
  161. TypeOpts$(3) = "     Superscript 4 "
  162. TypeOpts$(4) = "     Subscript   8 "
  163. TypeOpts$(5) = "     Type 5     16 "
  164. TypeOpts$(6) = "     Type 6     32 "
  165. TypeOpts$(7) = "     Type 7     64 "
  166. TypeOpts$(8) = "     Type 8    128 "
  167.  
  168. REDIM prePC$(1 TO 16)
  169. REDIM postPC$(1 TO 16)
  170. REDIM PC$(1 TO 16, 1 TO 3)
  171. PC$(1, 1) = "03/40/30/a/  RESET:"
  172. PC$(2, 1) = "04/40/30/a/ NORMAL:"
  173. PC$(3, 1) = "05/40/30/a/ COMPRE:"
  174. PC$(4, 1) = "06/40/30/a/ EXPAND:"
  175. PC$(5, 1) = "07/40/30/a/ PITCH4:"
  176. PC$(6, 1) = "08/40/30/a/ PITCH5:"
  177. PC$(7, 1) = "09/40/30/a/ PITCH6:"
  178. PC$(8, 1) = "10/40/30/a/ LFn/72:"
  179. PC$(1, 2) = ""                    '{reset printer}
  180. PC$(2, 2) = "27,16"               '{normal pitch}
  181. PC$(3, 2) = "15\18"               '{compressed\undo}
  182. PC$(4, 2) = "14\19"               '{expanded\undo}
  183. PC$(5, 2) = ""                    '{pitch4}
  184. PC$(6, 2) = ""                    '{pitch5}
  185. PC$(7, 2) = "0"                   '{pitch6}
  186. PC$(8, 2) = "27,65,n,27,50"       '{variable line feed (n/72)}
  187.                                   '{ n above will be taken from LFpt}
  188.  
  189. PC$(9, 1) = "11/40/30/a/ EMPHAS:"
  190. PC$(10, 1) = "12/40/30/a/   BOLD:"
  191. PC$(11, 1) = "13/40/30/a/  SUPER:"
  192. PC$(12, 1) = "14/40/30/a/    SUB:"
  193. PC$(13, 1) = "15/40/30/a/  TYPE5:"
  194. PC$(14, 1) = "16/40/30/a/  TYPE6:"
  195. PC$(15, 1) = "17/40/30/a/  TYPE7:"
  196. PC$(16, 1) = "18/40/30/a/  TYPE8:"
  197.  
  198. PC$(9, 2) = "27,69\27,70"         '{emphasized\undo}
  199. PC$(10, 2) = "27,71\27,72"        '{bold\undo}
  200. PC$(11, 2) = "27,83,0\27,84"      '{superscript\undo}
  201. PC$(12, 2) = "27,83,1\27,84"      '{subscript\undo}
  202. PC$(13, 2) = ""                   '{type5}
  203. PC$(14, 2) = ""                   '{type6}
  204. PC$(15, 2) = ""                   '{type7}
  205. PC$(16, 2) = ""                   '{type8}
  206.  
  207. DIM SHARED sysfg
  208. DIM SHARED sysbg
  209. DIM SHARED sysdata$
  210. DIM SHARED sysindex$
  211.  
  212. CLS
  213. sysfg = 7
  214. sysbg = 0
  215. ShowTitleScreen
  216.  
  217. GetCommandLineFile
  218.  
  219. code = 0
  220. lptfile = FREEFILE
  221. OPEN "LPT1:BIN" FOR OUTPUT AS #lptfile
  222. DO
  223.    IF code = 0 THEN code = GetKeyCode(xcode)
  224.  
  225.    SELECT CASE code
  226.    CASE DropFile
  227.       IF xcode THEN
  228.          ShowEsc 1
  229.          DropFileWindow lastkey
  230.          IF lastkey = CursorLeft THEN
  231.             code = DropPrint
  232.          ELSEIF lastkey = CursorRight THEN
  233.             code = DropEdit
  234.          END IF
  235.      END IF
  236.  
  237.    CASE DropEdit
  238.       IF xcode THEN
  239.          ShowEsc 1
  240.          DropEditWindow lastkey
  241.          IF lastkey = CursorLeft THEN
  242.             code = DropFile
  243.          ELSEIF lastkey = CursorRight THEN
  244.             code = DropPrint
  245.          END IF
  246.       END IF
  247.  
  248.    CASE DropPrint
  249.       IF xcode THEN
  250.          ShowEsc 1
  251.          DropPrintWindow lastkey
  252.          IF lastkey = CursorLeft THEN
  253.             code = DropEdit
  254.          ELSEIF lastkey = CursorRight THEN
  255.             code = DropFile
  256.          END IF
  257.       END IF
  258.  
  259.    CASE ELSE
  260.       code = 0
  261.  
  262.    END SELECT
  263.    ShowEsc 0
  264.    IF lastkey = EscKey THEN code = 0
  265. LOOP
  266.  
  267. '{exit to system in DropFileWindow}
  268.  
  269. SUB BackWindow (WindowSave(), ulr, ulc, lrr, lrc)
  270.  
  271. '{restore the window}
  272. LOCATE , , 0
  273. ptr = 0
  274. FOR row = ulr TO lrr
  275.    LOCATE row, ulc
  276.    FOR col = ulc TO lrc
  277.       ptr = ptr + 1
  278.       char$ = CHR$(WindowSave(ptr) AND 255)
  279.       attr = WindowSave(ptr) \ 255
  280.       fg = attr AND 15
  281.       bg = attr \ 16
  282.       COLOR fg, bg
  283.       PRINT char$;
  284.    NEXT
  285.    PRINT
  286. NEXT
  287.  
  288. END SUB
  289.  
  290. SUB ChangeAttr (ulr, ulc, lrr, lrc, fg, bg)
  291.  
  292. oldrow = CSRLIN
  293. oldcol = POS(0)
  294. COLOR fg, bg
  295. LOCATE , , 0
  296. FOR row = ulr TO lrr
  297.    FOR col = ulc TO lrc
  298.       CurrentChar = SCREEN(row, col)
  299.       LOCATE row, col
  300.       PRINT CHR$(CurrentChar);
  301.    NEXT
  302. NEXT
  303. COLOR sysfg, sysbg
  304. LOCATE oldrow, oldcol
  305.  
  306. END SUB
  307.  
  308. SUB ClearMsgArea
  309.  
  310. LOCATE 25, 1
  311. PRINT SPACE$(80);
  312. LOCATE 25, 1
  313.  
  314. END SUB
  315.  
  316. FUNCTION Convert2ASCII$ (strg$)
  317.  
  318. t$ = ""
  319. IF strg$ = "" THEN
  320.    '{it's got no numbers}
  321. ELSE
  322.    ptr = 1
  323.    t$ = strg$
  324.    flag = FALSE
  325.    DO
  326.       DO WHILE LEFT$(t$, 1) = ","
  327.          t$ = MID$(t$, 2)
  328.       LOOP                              '{remove leading commas}
  329.       commaptr = INSTR(ptr, t$, ",")    '{find the next comma}
  330.       IF commaptr = 0 THEN              '{no more commas, must be at last}
  331.          commaptr = LEN(t$) + 1
  332.          flag = TRUE
  333.       END IF
  334.       t2$ = t2$ + CHR$(VAL(t$))
  335.       t$ = MID$(t$, commaptr + 1)
  336.    LOOP UNTIL flag
  337.    Convert2ASCII$ = t2$
  338. END IF
  339.       
  340. END FUNCTION
  341.  
  342. FUNCTION ConvertLFpts$ (pts)
  343.  
  344. SHARED PC$()
  345.  
  346. strg$ = PC$(8, 2)
  347. t$ = ""
  348. nptr = INSTR(strg$, "n")
  349. IF strg$ = "" OR ASC(strg$) = 44 THEN
  350.    '{it's got no numbers}
  351. ELSE
  352.    ptr = 1
  353.    DO
  354.       commaptr = INSTR(ptr, strg$, ",")
  355.       IF commaptr = 0 THEN commaptr = LEN(strg$) + 1
  356.       t$ = t$ + CHR$(VAL(MID$(strg$, ptr, commaptr - ptr)))
  357.       ptr = commaptr + 1
  358.       IF ptr = nptr THEN
  359.          t$ = t$ + CHR$(pts)
  360.          commaptr = INSTR(ptr, strg$, ",")
  361.          ptr = commaptr + 1
  362.       END IF
  363.    LOOP UNTIL ptr >= LEN(strg$)
  364.    ConvertLFpts$ = t$
  365. END IF
  366.  
  367. END FUNCTION
  368.  
  369. SUB DropEditWindow (lastkey)
  370.  
  371. SHARED NumberEditOpts
  372. SHARED EditOpts$()
  373.  
  374. STATIC ke$
  375.  
  376. lastkey = 0
  377. ulr = 1
  378. ulc = 10
  379. lrr = ulr + NumberEditOpts
  380. lrc = ulc + LEN(EditOpts$(1)) - 1
  381. REDIM WindowSave(1 TO (lrc - ulc + 1) * (lrr - ulr + 1)) AS INTEGER
  382. REDIM MiscSave(1 TO (80 * 25)) AS INTEGER
  383.  
  384. SaveWindow WindowSave(), ulr, ulc, lrr, lrc
  385.  
  386. '{show the selections}
  387. ChangeAttr ulr, ulc + 1, ulr, ulc + 4, sysfg, sysbg
  388. LOCATE ulr + 1, ulc
  389. COLOR sysbg, sysfg
  390. FOR i = 1 TO NumberEditOpts
  391.    LOCATE , ulc
  392.    PRINT EditOpts$(i)
  393. NEXT
  394.  
  395. ptr = 0
  396. lastptr = ptr
  397. DO
  398.    COLOR sysbg, sysfg
  399.    ShowLabelInches
  400.    COLOR sysfg, sysbg
  401.    GetMoveKey NumberEditOpts, ulr, ulc, lrr, lrc, code, lastkey, lastptr, ptr
  402.    IF sysdata$ = "" OR sysindex$ = "" THEN ptr = 0: code = -1
  403.   
  404.    SELECT CASE ptr
  405.    CASE 0
  406.    '{must have hit Esc}
  407.  
  408.    CASE 1  '{select a key}
  409.       ClearMsgArea
  410.       SaveWindow MiscSave(), 2, 28, 2, 70
  411.       LOCATE 2, 28
  412.       COLOR sysbg, sysfg
  413.       PRINT SPACE$(28);
  414.       LOCATE 2, 28
  415.       INPUT ; "key:", ke$
  416.       ke$ = RTRIM$(LTRIM$(ke$))
  417.       BackWindow MiscSave(), 2, 28, 2, 70
  418.       IF ke$ <> "" THEN
  419.         COLOR sysfg, sysbg
  420.         ke$ = UCASE$(ke$)
  421.         stat = GetEqual(0, 0, ke$, rec$)
  422.         ClearMsgArea
  423.         SELECT CASE stat
  424.         CASE 0
  425.            PRINT "Key='"; RTRIM$(ke$); "'";
  426.            MoveRec2Prompt rec$
  427.            WPrint 1, 50, prompt$(), sysfg, sysbg
  428.         CASE 200
  429.            PRINT "'"; RTRIM$(ke$); "' not found.  Get next (y/n)? ";
  430.            yn$ = ""
  431.            INPUT ; "", yn$
  432.            IF UCASE$(yn$) = "Y" THEN
  433.               stat = GetNext(0, 0, ke$, rec$)
  434.               IF stat THEN
  435.                  ClearMsgArea
  436.                  PRINT StatError$(stat); " <ERROR:"; stat;
  437.               ELSE
  438.                  ClearMsgArea
  439.                  PRINT "Key="; RTRIM$(ke$);
  440.                  MoveRec2Prompt rec$
  441.                  WPrint 1, 50, prompt$(), sysfg, sysbg
  442.               END IF
  443.            END IF
  444.         CASE ELSE
  445.            PRINT StatError$(stat); " <ERROR:"; stat;
  446.         END SELECT
  447.       ELSE
  448.          '{just an Enter key}
  449.       END IF
  450.       
  451.    CASE 2  '{add key and data to index and data files}
  452.       ClearMsgArea
  453.       SaveWindow MiscSave(), 3, 28, 3, 70
  454.       FOR i = 1 TO 50
  455.          prompt$(i, 2) = ""
  456.       NEXT
  457.       LOCATE 3, 28
  458.       COLOR sysbg, sysfg
  459.       PRINT SPACE$(28)
  460.       LOCATE 3, 28
  461.       INPUT ; "key:", ke$
  462.       ke$ = RTRIM$(LTRIM$(ke$))
  463.       IF ke$ <> "" THEN
  464.          COLOR sysfg, sysbg
  465.          ke$ = UCASE$(ke$)
  466.          stat = GetEqual(0, 0, ke$, rec$)
  467.          ClearMsgArea
  468.          IF stat = 200 OR stat = 204 THEN
  469.             lastkey = Edit(1, 50, prompt$(), sysfg, sysbg, 27, -1)
  470.             rec$ = ""
  471.             FOR i = 1 TO 50
  472.                rec$ = rec$ + prompt$(i, 2)
  473.             NEXT
  474.             stat = AddRecord(0, 0, ke$, rec$)
  475.             SELECT CASE stat
  476.             CASE 0
  477.                PRINT "Added '"; RTRIM$(ke$); "'";
  478.             CASE ELSE
  479.                PRINT StatError$(stat); " <ERROR:"; stat;
  480.             END SELECT
  481.          ELSEIF stat = 0 THEN
  482.             PRINT StatError$(201); " <ERROR:"; 201;
  483.          END IF
  484.       ELSE
  485.          '{just an Enter key}
  486.       END IF
  487.       BackWindow MiscSave(), 3, 28, 3, 70
  488.     
  489.    CASE 3  '{update the current data record}
  490.       ClearMsgArea
  491.       stat = GetEqual(0, 0, ke$, rec$)
  492.       IF stat = 0 THEN
  493.          PRINT "Key="; RTRIM$(ke$);
  494.          lastkey = Edit(1, 50, prompt$(), sysfg, sysbg, EscKey, -1)
  495.          ClearMsgArea
  496.          PRINT "Update key '"; RTRIM$(ke$); "' with this data (y/n)? ";
  497.          yn$ = ""
  498.          INPUT ; "", yn$
  499.          IF UCASE$(yn$) = "Y" THEN
  500.             rec$ = ""
  501.             FOR i = 1 TO 50
  502.                rec$ = rec$ + prompt$(i, 2)
  503.             NEXT
  504.             stat = UpdateRecord(0, rec$)
  505.             ClearMsgArea
  506.             IF stat THEN
  507.                PRINT StatError$(stat); " <ERROR:"; stat;
  508.             ELSE
  509.                PRINT "Updated '"; RTRIM$(ke$); "'";
  510.             END IF
  511.          ELSE
  512.             ClearMsgArea
  513.          END IF
  514.       ELSE
  515.          ClearMsgArea
  516.          PRINT StatError$(stat); " <ERROR:"; stat;
  517.       END IF
  518.  
  519.    CASE 4  '{next key and data}
  520.       ClearMsgArea
  521.       stat = GetNext(0, 0, ke$, rec$)
  522.       IF stat = 0 THEN
  523.          PRINT "Key='"; RTRIM$(ke$); "'";
  524.          MoveRec2Prompt rec$
  525.          WPrint 1, 50, prompt$(), sysfg, sysbg
  526.       ELSE
  527.          PRINT StatError$(stat); " <ERROR:"; stat;
  528.       END IF
  529.  
  530.    CASE 5  '{prev key and data}
  531.       ClearMsgArea
  532.       stat = GetPrev(0, 0, ke$, rec$)
  533.       IF stat = 0 THEN
  534.          PRINT "Key='"; RTRIM$(ke$); "'";
  535.          MoveRec2Prompt rec$
  536.          WPrint 1, 50, prompt$(), sysfg, sysbg
  537.       ELSE
  538.          PRINT StatError$(stat); " <ERROR:"; stat;
  539.       END IF
  540.  
  541.    CASE 6  '{delete key/rec}
  542.       ClearMsgArea
  543.       PRINT "Delete '"; RTRIM$(ke$); "' (y/n)? ";
  544.       yn$ = ""
  545.       INPUT ; "", yn$
  546.       ClearMsgArea
  547.       IF UCASE$(yn$) = "Y" THEN
  548.          stat = DeleteRecord(0, 0, ke$)
  549.          IF stat THEN
  550.             PRINT StatError$(stat); " <ERROR:"; stat;
  551.          ELSE
  552.             PRINT "Deleted '"; RTRIM$(ke$); "'";
  553.          END IF
  554.       END IF
  555.  
  556.    CASE ELSE
  557.    END SELECT
  558.  
  559. LOOP UNTIL code = EscKey OR code = -1
  560. ClearMsgArea
  561. BackWindow WindowSave(), ulr, ulc, lrr, lrc
  562. ERASE WindowSave
  563. ERASE MiscSave
  564.  
  565. END SUB
  566.  
  567. SUB DropFileWindow (lastkey)
  568.  
  569. SHARED NumberFileOpts
  570. SHARED FileOpts$()
  571. SHARED lptfile          '{LPT1 BASIC handle}
  572.  
  573. lastkey = 0
  574.  
  575. ulr = 1
  576. ulc = 2
  577. lrr = ulr + NumberFileOpts
  578. lrc = ulc + LEN(FileOpts$(1)) - 1
  579. REDIM WindowSave(1 TO (lrc - ulc + 1) * (lrr - ulr + 1)) AS INTEGER
  580. REDIM MiscSave(1 TO (80 * 25)) AS INTEGER
  581.  
  582. SaveWindow WindowSave(), ulr, ulc, lrr, lrc
  583.  
  584. '{show the selections}
  585. ChangeAttr ulr, ulc + 1, ulr, ulc + 4, sysfg, sysbg
  586. LOCATE ulr + 1, ulc
  587. COLOR sysbg, sysfg
  588. FOR i = 1 TO NumberFileOpts
  589.    LOCATE , ulc
  590.    PRINT FileOpts$(i)
  591. NEXT
  592.  
  593. ptr = 0
  594. lastptr = ptr
  595. DO
  596.    GetMoveKey NumberFileOpts, ulr, ulc, lrr, lrc, code, lastkey, lastptr, ptr
  597.   
  598.    SELECT CASE ptr
  599.    CASE 0
  600.    '{must have hit Esc}
  601.  
  602.    CASE 1  '{select the data file}
  603.       ok = FALSE
  604.       SaveWindow MiscSave(), 10, 10, 10, 70
  605.       DO
  606.          LOCATE 10, 10
  607.          COLOR sysbg, sysfg
  608.          PRINT SPACE$(60);
  609.          LOCATE 10, 10
  610.          INPUT ; "Data file:", sysd$
  611.          sysd$ = UCASE$(sysd$)
  612.          stat = OpenDataFile(sysd$, 0)
  613.          IF stat = 0 THEN
  614.             ok = TRUE
  615.             sysdata$ = sysd$
  616.             ClearMsgArea
  617.          ELSEIF stat = 231 AND sysd$ <> "" THEN
  618.             ClearMsgArea
  619.             PRINT "'"; sysd$; "' does not exists.  Create (y/n)? ";
  620.             yn$ = ""
  621.             INPUT ; " ", yn$
  622.             IF UCASE$(yn$) = "Y" THEN
  623.                stat = CreateDataFile(sysd$, 720)
  624.                IF stat THEN
  625.                   ClearMsgArea
  626.                   PRINT StatError$(stat); " <ERROR:"; stat; "creating data file '"; sysd$; "'";
  627.                ELSE
  628.                   stat = OpenDataFile(sysd$, 0)
  629.                   IF stat = 0 THEN
  630.                      ok = TRUE
  631.                      sysdata$ = sysd$
  632.                      ClearMsgArea
  633.                   ELSE
  634.                      ClearMsgArea
  635.                      PRINT StatError$(stat); " <ERROR:"; stat; "opening data file '"; sysd$; "'";
  636.                   END IF
  637.                END IF
  638.             END IF
  639.          ELSEIF sysd$ <> "" THEN
  640.             ClearMsgArea
  641.             PRINT StatError$(stat); " with '"; sysd$; "' <ERROR:"; stat;
  642.          END IF
  643.          COLOR sysfg, sysbg
  644.          BackWindow MiscSave(), 10, 10, 10, 70
  645.       LOOP UNTIL ok OR sysd$ = ""
  646.       ClearMsgArea
  647.      
  648.    CASE 2  '{select the index file}
  649.       ok = FALSE
  650.       SaveWindow MiscSave(), 10, 10, 10, 70
  651.       DO
  652.          LOCATE 10, 10
  653.          COLOR sysbg, sysfg
  654.          PRINT SPACE$(60);
  655.          LOCATE 10, 10
  656.          INPUT ; "Index file:", sysi$
  657.          sysi$ = UCASE$(sysi$)
  658.          stat = OpenKeyFile(sysi$, 0)
  659.          IF stat = 0 THEN
  660.             ok = TRUE
  661.             sysindex$ = sysi$
  662.             ClearMsgArea
  663.          ELSEIF stat = 231 AND sysi$ <> "" THEN
  664.             ClearMsgArea
  665.             PRINT "'"; sysi$; "' does not exists.  Create (y/n)? ";
  666.             INPUT ; " ", yn$
  667.             IF UCASE$(yn$) = "Y" THEN
  668.                stat = CreateKeyFile(sysi$, 24)
  669.                IF stat THEN
  670.                   ClearMsgArea
  671.                   PRINT StatError$(stat); " <ERROR:"; stat; "creating key file '"; sysi$; "'";
  672.                ELSE
  673.                   stat = OpenKeyFile(sysi$, 0)
  674.                   IF stat = 0 THEN
  675.                      ok = TRUE
  676.                      sysindex$ = sysi$
  677.                      ClearMsgArea
  678.                   ELSE
  679.                      ClearMsgArea
  680.                      PRINT StatError$(stat); " <ERROR:"; stat; "opening key file '"; sysi$; "'";
  681.                   END IF
  682.                END IF
  683.             END IF
  684.          ELSEIF sysi$ <> "" THEN
  685.             ClearMsgArea
  686.             PRINT StatError$(stat); " with '"; sysi$; "' <ERROR:"; stat;
  687.          END IF
  688.          COLOR sysfg, sysbg
  689.          BackWindow MiscSave(), 10, 10, 10, 70
  690.       LOOP UNTIL ok OR sysi$ = ""
  691.       ClearMsgArea
  692.      
  693.    CASE 3  '{show the data and index files being used}
  694.       SaveWindow MiscSave(), 8, 5, 11, 75
  695.       LOCATE 8, 10
  696.       COLOR sysbg, sysfg
  697.       FOR row = 8 TO 11
  698.          LOCATE row, 5
  699.          PRINT SPACE$(70)
  700.       NEXT
  701.       stat = StatDataFile(0, reclen, recs&, bf)
  702.       LOCATE 9, 8
  703.       IF stat = 0 THEN PRINT "data: "; RIGHT$(sysdata$, 28);
  704.       LOCATE , 42
  705.       PRINT " reclen:"; reclen, " records:"; recs&;
  706.       stat = StatKeyFile(0, keylen, keys&, bf)
  707.       LOCATE 10, 7
  708.       IF stat = 0 THEN PRINT "index: "; RIGHT$(sysindex$, 28);
  709.       LOCATE , 42
  710.       PRINT " keylen:"; keylen, "    keys:"; keys&
  711.       SLEEP 5
  712.       BackWindow MiscSave(), 8, 5, 11, 75
  713.  
  714.    CASE 4  '{exit to DOS}
  715.      stat = StatDataFile(0, reclen, recs&, bf)
  716.      IF bf THEN stat = CloseDataFile(0)
  717.      stat = StatKeyFile(0, keylen, keys&, bf)
  718.      IF bf THEN stat = CloseKeyFile(0)
  719.      CLOSE #lptfile                     '{close LPT1}
  720.      LOCATE 24, 1
  721.      SYSTEM
  722.  
  723.    CASE ELSE
  724.    END SELECT
  725. LOOP UNTIL code = EscKey OR code = -1
  726.  
  727. BackWindow WindowSave(), ulr, ulc, lrr, lrc
  728. ERASE WindowSave
  729. ERASE MiscSave
  730.  
  731. END SUB
  732.  
  733. SUB DropPitchWindow (lastkey)
  734.  
  735. SHARED NumberPitchOpts
  736. SHARED PitchOpts$()
  737.  
  738. STATIC pp()
  739. REDIM pp(1 TO 7)
  740.  
  741. lastkey = 0
  742.  
  743. ulr = 1
  744. ulc = 29
  745. lrr = ulr + NumberPitchOpts + 1         '{total line}
  746. lrc = ulc + LEN(PitchOpts$(1)) - 1
  747.  
  748. REDIM WindowSave(1 TO (lrc - ulc + 1) * (lrr - ulr + 1)) AS INTEGER
  749. SaveWindow WindowSave(), ulr, ulc, lrr, lrc
  750.  
  751. '{show the selections}
  752. ChangeAttr ulr, ulc + 1, ulr, ulc + 6, sysfg, sysbg
  753. LOCATE ulr + 1, ulc
  754. COLOR sysbg, sysfg
  755. FOR i = 1 TO NumberPitchOpts
  756.    LOCATE , ulc
  757.    PRINT PitchOpts$(i);
  758.    LOCATE , ulc
  759.    IF pp(i) THEN PRINT "  ON" ELSE PRINT " OFF"
  760. NEXT
  761. LOCATE , ulc
  762. t$ = "VALUE:     "
  763. t$ = SPACE$((LEN(PitchOpts$(1)) - LEN(t$))) + t$
  764. PRINT t$
  765. value = 0
  766. FOR i = 1 TO 7
  767.    value = value + (2 ^ (i - 1) * pp(i) * -1)
  768. NEXT
  769. LOCATE ulr + NumberPitchOpts + 1, ulc + LEN(PitchOpts$(1)) - 5
  770. PRINT value;
  771. COLOR sysfg, sysbg
  772.  
  773. ptr = 0
  774. lastptr = ptr
  775. DO
  776.    GetMoveKey NumberPitchOpts, ulr, ulc + 4, lrr, lrc, code, lastkey, lastptr, ptr
  777.    IF ptr > 0 AND ptr <= NumberPitchOpts THEN
  778.       pp(ptr) = NOT pp(ptr)
  779.       LOCATE ulr + 1, ulc
  780.       COLOR sysbg, sysfg
  781.       LOCATE ulr + ptr, ulc
  782.       IF pp(ptr) THEN PRINT "  ON" ELSE PRINT " OFF"
  783.       LOCATE ulr + NumberPitchOpts + 1, ulc + LEN(PitchOpts$(1)) - 5
  784.       value = 0
  785.       FOR i = 1 TO 7
  786.          value = value + (2 ^ (i - 1) * pp(i) * -1)
  787.       NEXT
  788.       PRINT value;
  789.       COLOR sysfg, sysbg
  790.    END IF
  791. LOOP UNTIL code = EscKey OR code = -1
  792.                                 
  793. BackWindow WindowSave(), ulr, ulc, lrr, lrc
  794. ERASE WindowSave
  795.  
  796. END SUB
  797.  
  798. SUB DropPrintWindow (lastkey)
  799.  
  800. SHARED NumberPrintOpts
  801. SHARED PrintOpts$()
  802. SHARED PC$()
  803.  
  804. lastkey = 0
  805.  
  806. ulr = 1
  807. ulc = 19
  808. lrr = ulr + NumberPrintOpts
  809. lrc = ulc + LEN(PrintOpts$(1)) - 1
  810. REDIM WindowSave(1 TO (lrc - ulc + 1) * (lrr - ulr + 1)) AS INTEGER
  811. REDIM MiscSave(1 TO (80 * 25)) AS INTEGER
  812.  
  813. SaveWindow WindowSave(), ulr, ulc, lrr, lrc
  814.  
  815. '{show the selections}
  816. ChangeAttr ulr, ulc + 1, ulr, ulc + 5, sysfg, sysbg
  817. LOCATE ulr + 1, ulc
  818. COLOR sysbg, sysfg
  819. FOR i = 1 TO NumberPrintOpts
  820.    LOCATE , ulc
  821.    PRINT PrintOpts$(i)
  822. NEXT
  823.  
  824. ptr = 0
  825. lastptr = ptr
  826. DO
  827.    GetMoveKey NumberPrintOpts, ulr, ulc, lrr, lrc, code, lastkey, lastptr, ptr
  828.   
  829.    SELECT CASE ptr
  830.    CASE 0
  831.    '{must have hit Esc}
  832.    
  833.    CASE 1  '{print label}
  834.       ClearMsgArea
  835.       PRINT "Printing label";
  836.       PrintLabel
  837.       ClearMsgArea
  838.  
  839.    CASE 2  '{edit printer codes}
  840.       ClearMsgArea
  841.       ulr2 = 3
  842.       ulc2 = 40
  843.       lrr2 = ulr2 + 15
  844.       lrc2 = ulc2 + 37
  845.       SaveWindow MiscSave(), ulr2, ulc2, lrr2, lrc2
  846.       COLOR sysbg, sysfg
  847.       lastkey = Edit(1, 16, PC$(), sysbg, sysfg, 27, 0)
  848.       BackWindow MiscSave(), ulr2, ulc2, lrr2, lrc2
  849.   
  850.    CASE ELSE
  851.    END SELECT
  852.  
  853. LOOP UNTIL code = EscKey OR code = -1
  854.                                  
  855. BackWindow WindowSave(), ulr, ulc, lrr, lrc
  856. ERASE WindowSave
  857. ERASE MiscSave
  858.  
  859. END SUB
  860.  
  861. SUB DropTypeWindow (lastkey)
  862.  
  863. SHARED NumberTypeOpts
  864. SHARED TypeOpts$()
  865.  
  866. STATIC pt()
  867. REDIM pt(1 TO 8)
  868.  
  869. lastkey = 0
  870.  
  871. ulr = 1
  872. ulc = 39
  873. lrr = ulr + NumberTypeOpts + 1         '{total line}
  874. lrc = ulc + LEN(TypeOpts$(1)) - 1
  875.  
  876. REDIM WindowSave(1 TO (lrc - ulc + 1) * (lrr - ulr + 1)) AS INTEGER
  877. SaveWindow WindowSave(), ulr, ulc, lrr, lrc
  878.  
  879. '{show the selections}
  880. ChangeAttr ulr, ulc + 1, ulr, ulc + 4, sysfg, sysbg
  881. LOCATE ulr + 1, ulc
  882. COLOR sysbg, sysfg
  883. FOR i = 1 TO NumberTypeOpts
  884.    LOCATE , ulc
  885.    PRINT TypeOpts$(i);
  886.    LOCATE , ulc
  887.    IF pt(i) THEN PRINT "  ON" ELSE PRINT " OFF"
  888. NEXT
  889. LOCATE , ulc
  890. t$ = "VALUE:     "
  891. t$ = SPACE$((LEN(TypeOpts$(1)) - LEN(t$))) + t$
  892. PRINT t$
  893. value = 0
  894. FOR i = 1 TO 8
  895.    value = value + (2 ^ (i - 1) * pt(i) * -1)
  896. NEXT
  897. LOCATE ulr + NumberTypeOpts + 1, ulc + LEN(TypeOpts$(1)) - 5
  898. PRINT value
  899. COLOR sysfg, sysbg
  900.  
  901. ptr = 0
  902. lastptr = ptr
  903. DO
  904.    GetMoveKey NumberTypeOpts, ulr, ulc + 4, lrr, lrc, code, lastkey, lastptr, ptr
  905.    IF ptr > 0 AND ptr <= NumberTypeOpts THEN
  906.       pt(ptr) = NOT pt(ptr)
  907.       LOCATE ulr + 1, ulc
  908.       COLOR sysbg, sysfg
  909.       LOCATE ulr + ptr, ulc
  910.       IF pt(ptr) THEN PRINT "  ON" ELSE PRINT " OFF"
  911.       LOCATE ulr + NumberTypeOpts + 1, ulc + LEN(TypeOpts$(1)) - 5
  912.       value = 0
  913.       FOR i = 1 TO 8
  914.          value = value + (2 ^ (i - 1) * pt(i) * -1)
  915.       NEXT
  916.       PRINT value
  917.       COLOR sysfg, sysbg
  918.    END IF
  919. LOOP UNTIL code = EscKey OR code = -1
  920.                                
  921. BackWindow WindowSave(), ulr, ulc, lrr, lrc
  922. ERASE WindowSave
  923.  
  924. END SUB
  925.  
  926. FUNCTION Edit (lb, ub, prompt$(), fg, bg, exitkey, flag)
  927.  
  928. xitkey = exitkey
  929. cr = CSRLIN
  930. cl = POS(0)
  931.  
  932. WPrint lb, ub, prompt$(), fg, bg
  933. WEdit lb, ub, prompt$(), fg, bg, xitkey, flag '{xitkey = last key in Wedit}
  934.  
  935. LOCATE cr, cl
  936. Edit = xitkey
  937.  
  938. END FUNCTION
  939.  
  940. SUB GetCommandLineFile
  941.  
  942. c$ = COMMAND$
  943. IF c$ <> "" THEN
  944.    sysd$ = c$ + ".DAT"
  945.    sysi$ = c$ + ".IND"
  946.    stat = OpenDataFile(sysd$, 0)
  947.    IF stat = 0 THEN
  948.       sysdata$ = sysd$
  949.    ELSE
  950.       ClearMsgArea
  951.       PRINT StatError$(stat); " with '"; sysd$; "' <ERROR:"; stat;
  952.       SLEEP 2
  953.       ClearMsgArea
  954.       SLEEP 1
  955.    END IF
  956.    stat = OpenKeyFile(sysi$, 0)
  957.    IF stat = 0 THEN
  958.       sysindex$ = sysi$
  959.    ELSE
  960.       ClearMsgArea
  961.       PRINT StatError$(stat); " with '"; sysi$; "' <ERROR:"; stat;
  962.       SLEEP 2
  963.    END IF
  964. END IF
  965.  
  966. END SUB
  967.  
  968. FUNCTION GetKeyCode (xcode)
  969.  
  970. DO
  971.    i$ = INKEY$
  972. LOOP WHILE i$ = ""
  973. code = ASC(i$)
  974. xcode = FALSE
  975. IF code = 0 THEN code = ASC(RIGHT$(i$, 1)): xcode = TRUE
  976. GetKeyCode = code
  977.  
  978. END FUNCTION
  979.  
  980. SUB GetMoveKey (NumberOpts, ulr, ulc, lrr, lrc, code, lastkey, lastptr, ptr)
  981.  
  982. sel = FALSE
  983. DO
  984.    code = GetKeyCode(xcode)
  985.    SELECT CASE code
  986.    CASE CursorDown
  987.       IF xcode THEN
  988.          lastptr = ptr
  989.          ptr = ptr + 1
  990.          IF ptr > NumberOpts THEN ptr = 1
  991.       END IF
  992.  
  993.    CASE CursorUp
  994.       IF xcode THEN
  995.          lastptr = ptr
  996.          ptr = ptr - 1
  997.          IF ptr < 1 THEN ptr = NumberOpts
  998.       END IF
  999.  
  1000.    CASE CursorRight
  1001.       lastkey = CursorRight
  1002.       ptr = 0
  1003.       code = -1
  1004.  
  1005.    CASE CursorLeft
  1006.       lastkey = CursorLeft
  1007.       ptr = 0
  1008.       code = -1
  1009.  
  1010.    CASE EnterKey
  1011.       IF ptr <> 0 THEN sel = TRUE
  1012.  
  1013.    CASE EscKey
  1014.       ptr = 0
  1015.       lastkey = EscKey
  1016.  
  1017.    CASE ELSE
  1018.    END SELECT
  1019.  
  1020.    IF ptr <> lastptr THEN
  1021.       IF lastptr <> 0 THEN ChangeAttr ulr + lastptr, ulc + 1, ulr + lastptr, lrc - 1, sysbg, sysfg
  1022.       ChangeAttr ulr + ptr, ulc + 1, ulr + ptr, lrc - 1, sysfg, sysbg
  1023.       lastptr = ptr
  1024.    END IF
  1025. LOOP UNTIL sel = TRUE OR code = EscKey OR code = -1
  1026.  
  1027. END SUB
  1028.  
  1029. SUB MoveRec2Prompt (rec$)
  1030.  
  1031. SHARED prompt$()
  1032.  
  1033. sp = 1
  1034. FOR i = 1 TO 50 STEP 5
  1035.    prompt$(i, 2) = MID$(rec$, sp, 60)
  1036.    sp = sp + 60
  1037.    prompt$(i + 1, 2) = MID$(rec$, sp, 3)
  1038.    sp = sp + 3
  1039.    prompt$(i + 2, 2) = MID$(rec$, sp, 3)
  1040.    sp = sp + 3
  1041.    prompt$(i + 3, 2) = MID$(rec$, sp, 3)
  1042.    sp = sp + 3
  1043.    prompt$(i + 4, 2) = MID$(rec$, sp, 3)
  1044.    sp = sp + 3
  1045. NEXT
  1046.  
  1047. END SUB
  1048.  
  1049. SUB ParsePC
  1050.  
  1051. SHARED PC$()
  1052. SHARED prePC$()
  1053. SHARED postPC$()
  1054.  
  1055. FOR i = 1 TO 16
  1056.    t$ = PC$(i, 2)
  1057.    IF RTRIM$(t$) <> "" THEN
  1058.       backslash = INSTR(t$, "\")
  1059.       IF backslash THEN
  1060.          prePC$(i) = LEFT$(t$, backslash - 1)
  1061.          postPC$(i) = MID$(t$, backslash + 1)
  1062.       ELSE
  1063.          prePC$(i) = t$
  1064.          postPC$(i) = ""
  1065.       END IF
  1066.    END IF
  1067. NEXT
  1068.  
  1069. END SUB
  1070.  
  1071. SUB PrintLabel
  1072.  
  1073. SHARED prompt$()
  1074. SHARED prePC$()
  1075. SHARED postPC$()
  1076. SHARED PC$()
  1077. SHARED lptfile
  1078.  
  1079. ParsePC
  1080.  
  1081. FOR i = 1 TO 50 STEP 5
  1082.    ln$ = prompt$(i, 2)
  1083.    cnt = 0
  1084.    ln$ = LTRIM$(RTRIM$(ln$))
  1085.    IF LEN(ln$) THEN
  1086.       prepitch$ = ""
  1087.       postpitch$ = ""
  1088.       pretype$ = ""
  1089.       posttype$ = ""
  1090.       of = VAL(prompt$(i + 1, 2))
  1091.       pp = VAL(prompt$(i + 2, 2))
  1092.       pt = VAL(prompt$(i + 3, 2))
  1093.       pf = VAL(prompt$(i + 4, 2))
  1094.     
  1095.       IF pp AND 1 THEN prepitch$ = prepitch$ + prePC$(1) + ","
  1096.       IF pp AND 2 THEN prepitch$ = prepitch$ + prePC$(2) + ","
  1097.       IF pp AND 4 THEN prepitch$ = prepitch$ + prePC$(3) + ","
  1098.       IF pp AND 8 THEN prepitch$ = prepitch$ + prePC$(4) + ","
  1099.       IF pp AND 16 THEN prepitch$ = prepitch$ + prePC$(5) + ","
  1100.       IF pp AND 32 THEN prepitch$ = prepitch$ + prePC$(6) + ","
  1101.       IF pp AND 64 THEN prepitch$ = prepitch$ + prePC$(7)
  1102.    
  1103.       IF pp AND 1 THEN postpitch$ = postpitch$ + postPC$(1) + ","
  1104.       IF pp AND 2 THEN postpitch$ = postpitch$ + postPC$(2) + ","
  1105.       IF pp AND 4 THEN postpitch$ = postpitch$ + postPC$(3) + ","
  1106.       IF pp AND 8 THEN postpitch$ = postpitch$ + postPC$(4) + ","
  1107.       IF pp AND 16 THEN postpitch$ = postpitch$ + postPC$(5) + ","
  1108.       IF pp AND 32 THEN postpitch$ = postpitch$ + postPC$(6) + ","
  1109.       IF pp AND 64 THEN postpitch$ = postpitch$ + postPC$(7)
  1110.  
  1111.       IF pt AND 1 THEN pretype$ = pretype$ + prePC$(9) + ","
  1112.       IF pt AND 2 THEN pretype$ = pretype$ + prePC$(10) + ","
  1113.       IF pt AND 4 THEN pretype$ = pretype$ + prePC$(11) + ","
  1114.       IF pt AND 8 THEN pretype$ = pretype$ + prePC$(12) + ","
  1115.       IF pt AND 16 THEN pretype$ = pretype$ + prePC$(13) + ","
  1116.       IF pt AND 32 THEN pretype$ = pretype$ + prePC$(14) + ","
  1117.       IF pt AND 64 THEN pretype$ = pretype$ + prePC$(15) + ","
  1118.       IF pt AND 128 THEN pretype$ = pretype$ + prePC$(16)
  1119.  
  1120.       IF pt AND 1 THEN posttype$ = posttype$ + postPC$(9) + ","
  1121.       IF pt AND 2 THEN posttype$ = posttype$ + postPC$(10) + ","
  1122.       IF pt AND 4 THEN posttype$ = posttype$ + postPC$(11) + ","
  1123.       IF pt AND 8 THEN posttype$ = posttype$ + postPC$(12) + ","
  1124.       IF pt AND 16 THEN posttype$ = posttype$ + postPC$(13) + ","
  1125.       IF pt AND 32 THEN posttype$ = posttype$ + postPC$(14) + ","
  1126.       IF pt AND 64 THEN posttype$ = posttype$ + postPC$(15) + ","
  1127.       IF pt AND 128 THEN posttype$ = posttype$ + postPC$(16)
  1128.  
  1129.       pprec$ = Convert2ASCII$(prepitch$)
  1130.       ppostc$ = Convert2ASCII$(postpitch$)
  1131.       tprec$ = Convert2ASCII$(pretype$)
  1132.       tpostc$ = Convert2ASCII$(posttype$)
  1133.       offsetc$ = Convert2ASCII$(PC$(2, 2))
  1134.       ffc$ = ConvertLFpts$(pf)
  1135.       t$ = pprec$ + tprec$ + ffc$ + ln$ + ppostc$ + tpostc$
  1136.       IF of THEN PRINT #lptfile, offsetc$; SPACE$(of);
  1137.       PRINT #lptfile, t$
  1138.    END IF
  1139. NEXT
  1140.  
  1141. END SUB
  1142.  
  1143. SUB SaveWindow (WindowSave(), ulr, ulc, lrr, lrc)
  1144.  
  1145. '{save current window contents}
  1146. LOCATE , , 0                    '{cursor off}
  1147. ptr = 0
  1148. FOR row = ulr TO lrr
  1149.    FOR col = ulc TO lrc
  1150.       ptr = ptr + 1
  1151.       WindowSave(ptr) = SCREEN(row, col, 0) + SCREEN(row, col, 1) * 256
  1152.    NEXT
  1153. NEXT
  1154.  
  1155.  
  1156. END SUB
  1157.  
  1158. SUB ShowEsc (onoff)
  1159.  
  1160. COLOR sysbg, sysfg
  1161. LOCATE 1, 72
  1162. IF onoff THEN
  1163.    PRINT "Esc=back";
  1164. ELSE
  1165.    PRINT "        ";
  1166. END IF
  1167. COLOR sysfg, sysbg
  1168.  
  1169. END SUB
  1170.  
  1171. SUB ShowLabelInches
  1172.  
  1173. totalpts = 0
  1174. FOR i = 5 TO 50 STEP 5
  1175.    totalpts = totalpts + VAL(prompt$(i, 2))
  1176. NEXT
  1177. LOCATE 1, 60
  1178. PRINT USING "###.###"; totalpts / 72
  1179.  
  1180. END SUB
  1181.  
  1182. SUB ShowTitleScreen
  1183.  
  1184. CLS
  1185. COLOR sysbg, sysfg
  1186. t1$ = "  File    Edit     Print  "
  1187. t1$ = t1$ + SPACE$(80 - LEN(t1$))
  1188. PRINT t1$
  1189. LOCATE 1, 53
  1190. PRINT "Inches:"
  1191. ShowLabelInches
  1192. t1$ = "use <Alt><first letter>    MAILAB  Mail Label Generator "
  1193. '{make sure that t1$ is even in len}
  1194. pad$ = SPACE$((80 - LEN(t1$)) \ 2)
  1195. t1$ = pad$ + t1$ + pad$
  1196. LOCATE 25, 1
  1197. PRINT t1$;
  1198. COLOR sysfg, sysbg
  1199. t1$ = " Contents "
  1200. pad$ = STRING$(((60 - LEN(t1$)) \ 2), 196)
  1201. t1$ = pad$ + t1$ + pad$
  1202. LOCATE 9, 4
  1203. PRINT t1$;
  1204.  
  1205. LOCATE 9, 65
  1206. PRINT "Ofs"
  1207. LOCATE 9, 69
  1208. PRINT "Pit"
  1209. LOCATE 9, 73
  1210. PRINT "Typ"
  1211. LOCATE 9, 77
  1212. PRINT "LFpt";
  1213. WPrint 1, 50, prompt$(), sysfg, sysbg
  1214.  
  1215. END SUB
  1216.  
  1217. SUB WEdit (lb, ub, prompt$(), fg, bg, xitkey, flag)
  1218.    
  1219. REDIM LineSave(1 TO 80 * 2)
  1220. REDIM MiscSave(1 TO 80 * 25)
  1221.  
  1222. IF flag THEN                            'flag=TRUE if in editwindow
  1223.    SaveWindow LineSave(), 1, 1, 1, 80
  1224.    COLOR sysbg, sysfg
  1225.    LOCATE 1, 1
  1226.    PRINT SPACE$(50);
  1227.    LOCATE 1, 30
  1228.    PRINT "Pitch"
  1229.    LOCATE 1, 40
  1230.    PRINT "Type"
  1231.    COLOR sysfg, sysbg
  1232. END IF
  1233.  
  1234. done = FALSE
  1235. fld = lb
  1236. LastField = fld - 1   'must be unequal to fld at first
  1237. r = VAL(MID$(prompt$(fld, 1), 1))
  1238. c = VAL(MID$(prompt$(fld, 1), 4)) + LEN(prompt$(fld, 1)) - 11
  1239. col = c
  1240. DO
  1241.    GOSUB RevField
  1242.    r = VAL(MID$(prompt$(fld, 1), 1))
  1243.    XPrint prompt$(fld, 2), r, col, bg, fg
  1244.    IF prompt$(fld, 3) <> "" THEN        '{print help info}
  1245.       XPrint prompt$(fld, 3) + SPACE$(80 - LEN(prompt$(fld, 3))), 25, 1, bg, fg
  1246.    END IF
  1247.    LOCATE r, c, 1
  1248.    DO
  1249.       i$ = INKEY$
  1250.    LOOP WHILE i$ = ""
  1251.    code = ASC(i$)
  1252.    xcode = 0
  1253.    IF code > 31 AND code < 127 THEN
  1254.       GOSUB CheckFormat
  1255.       IF ValidKey THEN
  1256.          MID$(prompt$(fld, 2), c - col + 1, 1) = i$
  1257.          XPrint i$, r, c, bg, fg
  1258.          GOSUB RIGHT
  1259.       ELSE
  1260.          SOUND 999, 1
  1261.       END IF
  1262.    ELSE
  1263.       IF code = EnterKey THEN
  1264.          IF EndOfFld THEN
  1265.             'all characters valid
  1266.          ELSEIF c > col THEN
  1267.             IF typ$ = "N" OR typ$ = "M" OR typ$ = "D" THEN
  1268.                prompt$(fld, 2) = LEFT$(prompt$(fld, 2), c - col)
  1269.             END IF
  1270.          ELSE
  1271.             prompt$(fld, 2) = prompt$(fld, 2)
  1272.          END IF
  1273.          WPrint fld, fld, prompt$(), fg, bg
  1274.          
  1275.          IF flag THEN
  1276.             COLOR sysbg, sysfg
  1277.             ShowLabelInches
  1278.             COLOR sysfg, sysbg
  1279.          END IF
  1280.  
  1281.          IF fld < ub THEN
  1282.             fld = fld + 1
  1283.             r = VAL(MID$(prompt$(fld, 1), 1))
  1284.             c = VAL(MID$(prompt$(fld, 1), 4)) + LEN(prompt$(fld, 1)) - 11
  1285.             col = c
  1286.          ELSE
  1287.             done = TRUE
  1288.          END IF
  1289.          GOSUB NormField
  1290.       END IF
  1291.          
  1292.       xcode = FALSE
  1293.       IF code = 0 THEN code = ASC(RIGHT$(i$, 1)): xcode = TRUE
  1294.       IF xcode AND code = DropPitch THEN
  1295.          DropPitchWindow lastkey
  1296.       ELSEIF xcode AND code = DropType THEN
  1297.          DropTypeWindow lastkey
  1298.       ELSE
  1299.          SELECT CASE code
  1300.             CASE BackSpace
  1301.                IF c > col THEN c = c - 1: GOSUB ZapChar: EndOfFld = FALSE
  1302.             CASE CursorRight
  1303.                IF xcode THEN GOSUB RIGHT
  1304.             CASE CursorLeft
  1305.                IF xcode THEN IF c > col THEN c = c - 1: EndOfFld = FALSE
  1306.             CASE EndKey
  1307.                IF xcode THEN c = col + VAL(MID$(prompt$(fld, 1), 7)) - 1: EndOfFld = TRUE
  1308.             CASE HomeKey
  1309.                IF xcode THEN c = col: EndOfFld = FALSE
  1310.             CASE TabRight
  1311.                IF fld < ub THEN fld = fld + 1 ELSE fld = lb
  1312.                GOSUB NormField: GOSUB CheckRC
  1313.             CASE CursorDown
  1314.                IF xcode THEN
  1315.                   IF fld < ub THEN fld = fld + 1 ELSE fld = lb
  1316.                   GOSUB NormField: GOSUB CheckRC
  1317.                   EndOfFld = FALSE
  1318.                END IF
  1319.             CASE TabLeft
  1320.                IF xcode THEN
  1321.                   IF fld > lb THEN fld = fld - 1 ELSE fld = ub
  1322.                   GOSUB NormField: GOSUB CheckRC
  1323.                   EndOfFld = FALSE
  1324.                END IF
  1325.             CASE CursorUp
  1326.                IF xcode THEN
  1327.                   IF fld > lb THEN fld = fld - 1 ELSE fld = ub
  1328.                   GOSUB NormField: GOSUB CheckRC
  1329.                   EndOfFld = FALSE
  1330.                END IF
  1331.             CASE DeleteKe          '...ke so we don't clash with DeleteKey()
  1332.                IF xcode THEN GOSUB ZapChar
  1333.             CASE InsertKey
  1334.                IF xcode THEN GOSUB Insert
  1335.             CASE PgUpKey
  1336.                IF xcode THEN GOSUB NormField: GOSUB FirstFld
  1337.             CASE PgDnKey
  1338.                IF xcode THEN GOSUB NormField: GOSUB LastFld
  1339.             CASE DeleteToEOLKey
  1340.                GOSUB DeleteToEOL
  1341.             CASE EscKey
  1342.                GOSUB NormField
  1343.                done = TRUE
  1344.             CASE HelpKey
  1345.                IF xcode THEN
  1346.                END IF
  1347.  
  1348.             CASE ELSE
  1349.          END SELECT
  1350.       END IF
  1351.    END IF
  1352. LOOP UNTIL done
  1353. LOCATE , , 0
  1354. '{return last key code to caller}
  1355. xitkey = code
  1356. IF flag THEN BackWindow LineSave(), 1, 1, 1, 80
  1357. COLOR sysfg, sysbg
  1358.  
  1359. EXIT SUB
  1360.  
  1361. '* local SR to FSEDIT
  1362.  
  1363. RIGHT:
  1364.       IF c < col + VAL(MID$(prompt$(fld, 1), 7)) - 1 THEN
  1365.          c = c + 1
  1366.          EndOfFld = FALSE
  1367.       ELSE
  1368.          EndOfFld = TRUE
  1369.       END IF
  1370.       RETURN
  1371.  
  1372. ZapChar:
  1373.       prompt$(fld, 2) = LEFT$(prompt$(fld, 2), c - col) + MID$(prompt$(fld, 2), c - col + 2, VAL(MID$(prompt$(fld, 1), 7)) - c + col - 1) + " "
  1374.       r = VAL(MID$(prompt$(fld, 1), 1))
  1375.       XPrint prompt$(fld, 2), r, col, bg, fg
  1376.       EndOfFld = FALSE
  1377.       RETURN
  1378.  
  1379. Insert:
  1380.       prompt$(fld, 2) = LEFT$(LEFT$(prompt$(fld, 2), c - col) + " " + MID$(prompt$(fld, 2), c - col + 1), VAL(MID$(prompt$(fld, 1), 7)))
  1381.       r = VAL(MID$(prompt$(fld, 1), 1))
  1382.       XPrint prompt$(fld, 2), r, col, bg, fg
  1383.       EndOfFld = FALSE
  1384.       RETURN
  1385.  
  1386. FirstFld:
  1387.       fld = lb
  1388.       r = VAL(MID$(prompt$(fld, 1), 1))
  1389.       c = VAL(MID$(prompt$(fld, 1), 4)) + LEN(prompt$(fld, 1)) - 11
  1390.       col = c
  1391.       EndOfFld = FALSE
  1392.       RETURN
  1393.  
  1394. LastFld:
  1395.       fld = ub
  1396.       r = VAL(MID$(prompt$(fld, 1), 1))
  1397.       c = VAL(MID$(prompt$(fld, 1), 4)) + LEN(prompt$(fld, 1)) - 11
  1398.       col = c
  1399.       EndOfFld = FALSE
  1400.       RETURN
  1401.  
  1402. DeleteToEOL:
  1403.       XPrint STRING$(VAL(MID$(prompt$(fld, 1), 7)) - (c - col), " "), CSRLIN, c, bg, fg
  1404.       FOR i = (c - col + 1) TO VAL(MID$(prompt$(fld, 1), 7))
  1405.          MID$(prompt$(fld, 2), i, 1) = " "
  1406.       NEXT
  1407.       EndOfFld = FALSE
  1408.       WPrint fld, fld, prompt$(), fg, bg
  1409.       RETURN
  1410.  
  1411. CheckFormat:
  1412.       typ$ = UCASE$(MID$(prompt$(fld, 1), 10, 1))
  1413.       ValidKey = TRUE
  1414.       SELECT CASE typ$
  1415.          CASE "A"
  1416.             '{nothing}
  1417.          CASE "U"
  1418.             i$ = UCASE$(i$)
  1419.          CASE "L"
  1420.             i$ = UCASE$(i$)
  1421.             IF i$ <> "T" AND i$ <> "F" AND i$ <> "Y" AND i$ <> "N" THEN ValidKey = FALSE
  1422.          CASE "N", "M"
  1423.             IF INSTR("0123456789.-+ ", i$) = 0 THEN ValidKey = FALSE
  1424.          CASE "D"
  1425.             IF INSTR("0123456789 ", i$) = 0 THEN ValidKey = FALSE
  1426.          CASE ELSE
  1427.       END SELECT
  1428.       RETURN
  1429.  
  1430. RevField:
  1431.       LastField = fld
  1432.       LastRow = r
  1433.       LastCol = col
  1434.       LenField = VAL(MID$(prompt$(fld, 1), 7))
  1435.       LastLength = LenField
  1436.       'ChangeAttr is too slow in QB, just print the field in reverse
  1437.       'ChangeAttr r, col, r, (col + LenField - 1), bg, fg
  1438.       RETURN
  1439.  
  1440. CheckRC:
  1441.       r = VAL(MID$(prompt$(fld, 1), 1))
  1442.       c = VAL(MID$(prompt$(fld, 1), 4)) + LEN(prompt$(fld, 1)) - 11
  1443.       col = c
  1444.       RETURN
  1445.  
  1446. NormField:
  1447.       ChangeAttr LastRow, LastCol, LastRow, (LastCol + LastLength - 1), fg, bg
  1448.       RETURN
  1449.  
  1450. END SUB
  1451.  
  1452. 'PROMPT$() FORMAT ----------------------------------------------------
  1453. '
  1454. '2-dimensional variable-length string array
  1455. '  for each data entry variable:
  1456. '     prompt$(i,1) = "rr/cc/al/t/prompt string"
  1457. '     - rr,cc = start of prompt string's screen position (1-25,1-80)
  1458. '     - al    = maximum length of answer response (into prompt$(i,2))
  1459. '     - t     = type of edit mask:
  1460. '               - a = alphanumeric
  1461. '               - m = decimal value (.00 minimum)
  1462. '               - n = number
  1463. '               - d = only 0-9 keys (use separate prompt for mo/da/yr)
  1464. '               - l = logical (1-character Y N T F)
  1465. '
  1466. 'responses are formatted into prompt$(i,2)
  1467. 'help line data is in prompt$(i,3)
  1468. 'current QB cursor position preserved
  1469. 'last key pressed (i.e. the Esc or ENTER) is returned by Edit()
  1470. '
  1471. SUB WPrint (lb, ub, prompt$(), fg, bg)
  1472.  
  1473. FOR i = lb TO ub
  1474.    CurrStr$ = prompt$(i, 1)
  1475.    row = VAL(CurrStr$)
  1476.    col = VAL(MID$(CurrStr$, 4))
  1477.    length = VAL(MID$(CurrStr$, 7))
  1478.    typ$ = UCASE$(MID$(CurrStr$, 10, 1))
  1479.       
  1480.    SELECT CASE typ$
  1481.    CASE "M"
  1482.       Number = TRUE
  1483.       temp$ = RTRIM$(LTRIM$(prompt$(i, 2)))
  1484.       xsp = INSTR(temp$, " ")
  1485.       IF xsp = 0 THEN xsp = LEN(prompt$(i, 2)) ELSE xsp = xsp - 1
  1486.       prompt$(i, 2) = LEFT$(temp$, xsp)
  1487.       temp# = VAL(prompt$(i, 2))
  1488.       prompt$(i, 2) = LTRIM$(STR$(temp#))
  1489.       DecPos = INSTR(prompt$(i, 2), ".")
  1490.       IF DecPos = 0 THEN
  1491.          prompt$(i, 2) = prompt$(i, 2) + ".00"
  1492.       ELSEIF LEN(prompt$(i, 2)) - DecPos = 1 THEN
  1493.          prompt$(i, 2) = prompt$(i, 2) + "0"
  1494.       END IF
  1495.    CASE "N"
  1496.       Number = TRUE
  1497.       temp$ = LTRIM$(prompt$(i, 2))
  1498.       xsp = INSTR(temp$, " ")
  1499.       IF xsp = 0 THEN xsp = LEN(prompt$(i, 2)) ELSE xsp = xsp - 1
  1500.       prompt$(i, 2) = LEFT$(temp$, xsp)
  1501.       temp# = VAL(prompt$(i, 2))
  1502.       prompt$(i, 2) = LTRIM$(STR$(temp#))
  1503.    CASE ELSE
  1504.       Number = FALSE
  1505.    END SELECT
  1506.  
  1507.    IF Number THEN
  1508.       prompt$(i, 2) = RIGHT$(prompt$(i, 2), length)     'the decimal
  1509.       prompt$(i, 2) = STRING$(length - LEN(prompt$(i, 2)), " ") + prompt$(i, 2)
  1510.    ELSE
  1511.       prompt$(i, 2) = prompt$(i, 2) + STRING$(length - LEN(prompt$(i, 2)), " ")
  1512.    END IF
  1513.  
  1514.    XPrint MID$(prompt$(i, 1), 12) + prompt$(i, 2), row, col, fg, bg
  1515.       
  1516. NEXT
  1517.  
  1518. END SUB
  1519.  
  1520. SUB XPrint (strg$, row, col, fg, bg)
  1521.  
  1522. oldrow = CSRLIN
  1523. oldcol = POS(0)
  1524. COLOR fg, bg
  1525. LOCATE row, col, 0      '{leave the cursor off}
  1526. PRINT strg$;
  1527. COLOR sysfg, sysbg
  1528. LOCATE oldrow, oldcol
  1529.  
  1530. END SUB
  1531.  
  1532.