home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / dbase / proc.prg < prev    next >
Encoding:
Text File  |  1989-09-26  |  7.1 KB  |  269 lines
  1. *********************************************************
  2. *    Prozeduren für UTILITY
  3. *********************************************************
  4. *    CLOCKHandler
  5. *    Funktion 0
  6. *     SETCLOCK
  7. *    p ist vom Typ C und enthält entweder
  8. *    "0" :    Uhr aussschalten
  9. *    "1" :    Uhr einschalten
  10. *    " 10,10,15" : (Beispiel) wenn die erste Stelle
  11. *              anders als 0 oder 1 ist, müssen
  12. *              die folgenden Zeichen eine Folge
  13. *              von drei Zahlen darstellen, wo-
  14. *              die erste die Zeile, die zweite
  15. *              die Spalte und die dritte den
  16. *              Farbcode angibt. Das Beispiel
  17. *              positioniert also die Uhr in Zei-
  18. *              le 10, Spalte 10 in hellweiß.
  19. *********************************************************
  20. procedure setclock        
  21. parameters p                           
  22. privat out
  23.  do case
  24.   case p="0"
  25.    call utility with "00:"
  26.   case p="1"
  27.    call utility with "01:"
  28.   otherwise
  29.    out=stuff(p,1,1,"02:")
  30.    call utility with out
  31.  endcase
  32. return
  33. **********************************************************
  34. **********************************************************
  35. *     SCREENHandler
  36. *    Funktion 1
  37. *    Unterfunktionen
  38. *    1 :    SCROLL
  39. *    2 :    WCLEAR
  40. *    3 :    WSTR
  41. *    4 :    WSTRC
  42. *    5 :    WPUSH
  43. *    6 :    WGET
  44. *    7 :    WPOP
  45. **********************************************************
  46. *    SCROLL
  47. *    scrolled das aktive window (falls noch keins
  48. *    geöffnet wurde das gesamte Fenster) um lines
  49. *    nach oben oder unten
  50. *
  51. procedure scroll
  52. parameters lines
  53.  call utility with "11:"+str(lines,2)
  54. return
  55. **********************************************************
  56. *    WCLEAR
  57. *    löscht das aktive Window (oder den ganzen
  58. *    Bildschirm)
  59. *
  60. procedure wclear
  61.  call utility with "12:"
  62. return
  63. **********************************************************
  64. *    WSTR
  65. *    direktes Schreiben, absolute Koordianten
  66. *    Form:    13:<y>,<x>,<col>;<string>
  67. *        mit     <y>    Zeile [0..24]
  68. *            <x>    Spalte [0..79]
  69. *            <col>    Farbe [0..255]
  70. *            <string> Text
  71. *    Wirklich schnell ist diese Zeichenausgabe
  72. *    natürlich nur, wenn  nicht diese Prozedur
  73. *    aufgerufen wird, sondern direkt ein CALL-
  74. *    Befehl mit den entsprechenden Parametern
  75. *    angegeben wird. Auf die Variable out könnte
  76. *    hier verzichtet werden, wenn die Zeilenlänge
  77. *    größer als 60 sein dürfte; sagt das der TOOL-
  78. *    BOX-Redaktion.
  79. *
  80. procedure wstr
  81. parameters y,x,col,str
  82. privat out
  83.  out="13:"+str(y,2)+","+str(x,2)+","
  84.  out=out+str(col,3)+";"+str
  85.  call utility with out
  86. return
  87. **********************************************************
  88. *     WSTRC
  89. *    mit Zeichenkontrolle und window relativer
  90. *    Cursorpositionierung
  91. *    Form:    14:<y>,<x>,<col>;<string>
  92. *        Erläuterung siehe oben
  93. *
  94. procedure wstrc
  95. parameters y,x,col,str
  96. privat out
  97.  out="14:"+str(y,2)+","+str(x,2)+","
  98.  out=out+str(col,3)+";"+str
  99.  call utility with out
  100. return
  101. **********************************************************
  102. *     WRITE
  103. *    mit Zeichenkontrolle ab window relativer
  104. *    Cursorposition
  105. *    Form:    14:<col>;<string>
  106. *        Erläuterung siehe oben
  107. *
  108. procedure write
  109. parameters col,str
  110. privat out
  111.  out="14:"+str(col,3)+";"+str
  112.  call utility with out
  113. return
  114. **********************************************************
  115. *    WPUSH
  116. *    öffnet ein neues Fenster mit den Koordinaten
  117. *    uly,ulx,lry,lrx, die falls kein Rahmen (fr_type=0)
  118. *    definiert wurde den freien Textbereich definieren,
  119. *    andernfalls liegt der Textbereich innerhalb der
  120. *    Koordinaten. Als Rahmentypen gibt es 5 Arten:
  121. *        ┌────┐
  122. *    1 :    │    │
  123. *        └────┘
  124. *        ╔════╗
  125. *    2 :    ║    ║
  126. *        ╚════╝
  127. *        ╓────╖
  128. *    3 :    ║    ║
  129. *        ╙────╜
  130. *        ╒════╕
  131. *    4 :    │    │    
  132. *        ╘════╛
  133. *        ██████
  134. *    5 :    █    █
  135. *        ██████
  136. *    Die Farben für Rahmen und Textbereich werden in
  137. *    der SET-COLOR Notation angegeben.
  138. *    Die letzte Cursorposition und -form wird
  139. *    gesichert.
  140. *
  141. procedure wpush 
  142. parameters uly,ulx,lry,lrx,fr_color,fr_type,t_color,bheader
  143. privat out
  144.  out="15:"+str(uly,2)+","+str(ulx,2)+","+str(lry,2)+","
  145.  out=out+str(lrx,2)+","+fr_color+","+str(fr_type,2)+","
  146.  out=out+t_color+";"+bheader
  147.  call utility with out
  148.  if substr(out,4,1)="1"
  149.   ? "wpush : Kein Speicher mehr frei"
  150.   cancel
  151.  endif
  152.  if substr(out,4,1)="2"
  153.   ? "wpush : Stack ist voll"
  154.   cancel
  155.  endif
  156.  if substr(out,4,1)="3"
  157.   ? "wpush : Ungültige Parameter"
  158.   cancel
  159.  endif
  160.  set color to &t_color
  161. return
  162. **********************************************************
  163. *    WGET
  164. *    holt den gesicherten Inhalt des Windowbereichs
  165. *    zurück ohne das Window zu desaktivieren und vom
  166. *    Stack zu holen. Ein eventuell definierter Rahmen
  167. *    wird dabei gelöscht.
  168. *
  169. procedure wget
  170. privat out
  171.  out="16:   "
  172.  call utility with out
  173.  if substr(out,4,1)="2"
  174.   ? "wget : Stack ist leer"
  175.   cancel
  176.  endif
  177.  if substr(out,4,1)="3"
  178.   ? "wget : Ungültige Parameter"
  179.  endif
  180. return
  181. **********************************************************
  182. *    WPOP
  183. *    holt den gesicherten Inhalt des Windowbereichs
  184. *    zurück und "popped" das Window vom Stack. Die
  185. *    Kontrolle wird vom untergeordneten Window über-
  186. *    nommen. Cursorposition und -form werden restau-
  187. *    riert.
  188. *
  189. procedure wpop
  190. privat out
  191.  out="17:   "
  192.  call utility with out
  193.  if substr(out,4,1)="2"
  194.   ? "wpop : Stack ist leer"
  195.  endif
  196.  if substr(out,4,1)="3"
  197.   ? "wpop : Ungültige Parameter"
  198.  endif
  199. return
  200. **********************************************************
  201. *    WAITING
  202. *    öffnet ein Fenster mit den oberen Koordinaten
  203. *    (uly,ulx), gibt eine Wartemeldung aus und
  204. *    wartet auf einen Tastendruck.
  205. *
  206. procedure waiting
  207. parameters uly,ulx
  208.  do wpush with uly,ulx,uly+2,ulx+38,'+w',1,'',""
  209.  @ uly+1,ulx+2 say "Bitte eine Taste drücken ..."
  210.  wait ""
  211.  do wpop 
  212. return
  213. **********************************************************
  214. **********************************************************
  215. *    PRINTHandler
  216. *    Funktion 2
  217. *    SETPRINT
  218. *    übergibt einen String an den Handler und löst
  219. *    die vordefinierte Funktion aus. Implementiert
  220. *    sind folgende Funktionen (für einen NEC P9 XL),
  221. *    d.h. die folgenden Zeichenketten sind im LOADER 
  222. *    definiert: 
  223. *        RESET         :  Reset des Druckers
  224. *        ELITE_HS     :  Elite Highspeed
  225. *        PICA_DRAFT     :  Pica Normalschrift
  226. *        PICA_NAR     :  Pica Eng 18 dpi
  227. *        NAR_OFF     :  Engschrift aus
  228. *        8_LPI         :  8 Zeilen/Zoll
  229. *        6_LPI         :  6 Zeilen/Zoll
  230. *        25_LPP         :  25 Zeilen/Seite
  231. *        12_IPP         :  12 Zoll/Seite
  232. *        UNDERSCORE_ON     :  Unterstreichen an
  233. *        UNDERSCORE_OFF     :  Unterstreichen aus
  234. *        DOUBLE_HEIGHT_ON : doppelte Zeichenhöhe
  235. *        DOUBLE_HEIGHT_OFF : normale Zeichenhöhe
  236. *        LQ_ON         :  Letter Quality an
  237. *        LQ_OFF        :  und aus
  238. *
  239. procedure setprint
  240. parameters p
  241.  call utility with "20:"+p
  242. return
  243. **********************************************************
  244. **********************************************************
  245. *     CURSOR 
  246. *    Funktion 3
  247. *    SETCURS
  248. *    übergibt einen String vom Format "<u>,<l>" an
  249. *    den Handler. <u> ist eine Dezimalzahl für die
  250. *    Startzeile, <l> eine Dezimalzahl für die End-
  251. *    zeile (siehe auch SERV.C: setcurshape()).
  252. *
  253. procedure setcurs
  254. parameters a
  255.  call utility with "30:"+a
  256. return
  257. **********************************************************
  258. **********************************************************
  259. *     DELAY
  260. *    Funktion 4
  261. *    DELAY
  262. *    läßt den Rechner für ca. a Millisekunden
  263. *    pausieren
  264. *
  265. procedure delay
  266. parameters a
  267.  call utility with "40:"+str(a,5)
  268. return
  269. **********************************************************