home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / extensions / jd / _newprogs / jd_datei.amos / jd_datei.amosSourceCode
AMOS Source Code  |  1994-03-12  |  50KB  |  1,945 lines
  1. Set Buffer 150
  2. Break Off 
  3. VS#=0.0
  4. SETUP
  5. TMJ$= Extension_22_004C 
  6. LAST=2000 : MF=9
  7. Reserve Zone 40
  8. Dim S$(LAST),ME$(18),PO$(12),N$(MF),A$(MF),MM$(MF),A2$(MF),B$(MF),NB$(MF),SX$(MF),REP$(MF)
  9. Dim PRLEN(MF),PRAB(MF),MXLEN(MF),MXLEN2(MF),NEU(MF),MLEN(MF),PRLEN2(MF),PRAB2(MF),SB(61)
  10. Global ME$(),KK,AF,ML,NR,MX,B1,B2,SF,B1,B2,FELEN,RGBO,BC,FC,AKT
  11. Gosub CLEAR
  12. AKT=0 : SOF=0
  13. MA:
  14. Curs Off 
  15. Cls 1
  16. MA2:
  17. Ink 2 : Curs Off 
  18. B1=1 : B2=MX
  19. SF=0
  20. AUTOSAVE
  21. Restore HM : Gosub RD
  22. If AKT=0 Then If IN=3 or IN=4 or IN=5 or IN=11 or IN=12 or IN=13 or IN=15 Then AKT=1 : SOF=0 : Timer=0
  23. If AKT=0 Then If IN=8 Then AKT=1 : Timer=0
  24. On IN Goto LA,BL,DA,EG,SO,DRU,FW,UP,EN,SP,SU,MAE,AEN,ID,FL,IM,EX
  25. UP:
  26. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  27. AUTOSAVE
  28. If SOTE=0 Then Cls 1 : Locate 1,3 : Under On : Centre "Update" : Under Off 
  29. Show : Change Mouse 3
  30. If SOTE=0 Then Print : Print : Print "Phase 1"
  31. FELEN=0
  32. For ZZX=1 To AF
  33.    FELEN=Max(Len(N$(ZZX)),FELEN)
  34.    MXLEN(ZZX)=0 : PRLEN(ZZX)=0
  35. Next ZZX
  36. If SOTE=0 Then Print "Phase 2"
  37. For NR=1 To MX
  38.    Gosub MAKEFELDER
  39.    For ZZX=1 To AF
  40.       MXLEN(ZZX)=Max(Len(A$(ZZX)),MXLEN(ZZX))
  41.       MXLEN(ZZX)=Max(Len(N$(ZZX)),MXLEN(ZZX))
  42.    Next ZZX
  43. Next NR
  44. If SOTE=0 Then Print "Phase 3"
  45.    For ZZX=1 To AF
  46.       PRLEN(ZZX)=Max(Len(N$(ZZX)),PRLEN(ZZX))
  47.       PRLEN(ZZX)=Max(PRLEN(ZZX),MXLEN(ZZX))
  48.    Next ZZX
  49. If SOTE=0 Then Print "Phase 4"
  50. Gosub LCOUNT
  51. Change Mouse 1 : Hide 
  52. If SOTE=1 Then Return Else Goto MA
  53. EN:
  54. E=0 : If AKT<>0 Then Wait 5 : REQUESTER["Programm wirklich beenden?","Ja","Nein"] : E=Param
  55. If E=2 Then Goto MA
  56. End 
  57. LA:
  58. If S$(1)<>Chr$(255) Then Goto SCHONDATEI
  59. MEMCLR:
  60. Gosub CLEAR
  61. LADEDEG:
  62. Cls 1 : Clear Key 
  63. Show 
  64. DD$=Fsel$("*.seq","","Datei","laden")
  65. Hide 
  66. If DD$="" Then Goto MA
  67. If S$(1)<>Chr$(255) Then Goto ANHAENGEN
  68. On Error Goto SPFEHLER
  69. NR=0
  70. Change Mouse 3
  71. Show 
  72. Open In 8,DD$
  73. Input #8,KENN$ : If KENN$<>"JD-Datei-Sequenz" Then Goto FALSCH
  74. Input #8,TMJ2$
  75. Input #8,SOF
  76. Input #8,AF
  77. Input #8,SN
  78. Input #8,BR
  79. For X=1 To AF
  80.    Input #8,PRLEN(X)
  81.    Input #8,PRAB(X)
  82. Next X
  83. Input #8,FELEN
  84. For X=1 To AF
  85.    Input #8,N$(X)
  86.    Input #8,MXLEN(X)
  87. Next X
  88. Input #8,DN$
  89. Input #8,MX
  90. If MX=0 Then NR=0 : Goto GELADEN
  91. B1=1 : B2=MX
  92. For NR=1 To 61
  93.    Input #8,SB(NR)
  94. Next NR
  95. For NR=1 To MX
  96.    On Error Goto LADEFEHLER
  97.    POSITION[NR]
  98.    Input #8,S$(NR)
  99. Next NR
  100. GELADEN:
  101. Close 8 : Hide : Change Mouse 1
  102. Cls 1 : Locate 5,5 : Print "Es wurde die Datei ";Chr$(34);DN$;Chr$(34);" mit";MX;" Datens�tzen geladen"
  103. Locate 5,7 : If SOF=0 Then Print "Datei ist nicht sortiert" : Goto FGEL
  104. Print "Datei ist nach Feld Nr. ";Right$(Str$(SOF),Len(Str$(SOF))-1);" in ";
  105. If SOF<0 Then Print "absteigender";
  106. If SOF>0 Then Print "aufsteigender";
  107. Print " Reihenfolge sortiert"
  108. FGEL:
  109. Locate 5,9 : Print "Die letzte Speicherung war am: ";TMJ2$
  110. Locate 5,11 : Print "Lade-Fehler:";LF
  111. Locate 5,13 : Print "Freier Speicher:";Free;" Bytes"
  112. Goto RM
  113. SCHONDATEI:
  114. Cls 1 : Locate 1,10 : Centre "Es befindet sich bereits eine Datei im Speicher!" : Print 
  115. Restore LM : Gosub RD
  116. On IN Goto MEMCLR,MA,ANHAENGEN
  117. FALSCH:
  118. Close 8 : Hide : Change Mouse 1 : Cls 1
  119. MELDUNG[DD$+" ist keine JD-Datei-Sequenz!"]
  120. Goto LA
  121. ANHAENGEN:
  122. Cls 1
  123. Show : Clear Key 
  124. DD$=Fsel$("*.seq","","Datei","anh�ngen")
  125. Hide 
  126. If DD$="" Then Goto MA
  127. On Error Goto SPFEHLER
  128. Change Mouse 3 : Show 
  129. SOF=0
  130. Open In 8,DD$
  131. Input #8,KENN$ : If KENN$<>"JD-Datei-Sequenz" Then Goto FALSCH
  132. Input #8,TMJ3$ : TMJ2$= Extension_22_03A0(TMJ3$,TMJ2$)
  133. Input #8,SOF
  134. Input #8,AF2 : If AF2>AF Then Gosub ANH2 : ZV=1
  135. Input #8,SN
  136. Input #8,BR
  137. For NR=1 To AF2
  138.    Input #8,PRLEN2(NR) : PRLEN(NR)=Max(PRLEN(NR),PRLEN2(NR))
  139.    Input #8,PRAB2(NR) : PRAB(NR)=Max(PRAB2(NR),PRAB(NR))
  140. Next NR
  141. Input #8,FELEN2 : FELEN=Max(FELEN,FELEN2)
  142. If ZV=0 Then For X=1 To AF2 : Input #8,M$ : Input #8,MXLEN2(X) : Next X
  143. If ZV=1 Then For X=1 To AF2 : Input #8,N$(X) : Input #8,MXLEN2(X) : Next X
  144. If ZV=1 Then AF=AF2 : ZV=0
  145. Input #8,DN$
  146. Input #8,MX2
  147. If MX2=0 Then NR=0 : Goto ANHEND
  148. If MX+MX2>LAST Then MX2=LAST-MX : ZV=1
  149. B1=1 : B2=MX+MX2
  150. For NR=1 To 61
  151.    Input #8,SB2
  152. Next 
  153. For NR=MX+1 To MX+MX2
  154.    On Error Goto LADEFEHLER
  155.    POSITION[NR]
  156.    Input #8,S$(NR)
  157. Next NR
  158. If AF2=>AF Then Goto ANCON
  159. For NR=MX+1 To MX+MX2
  160.    For X=AF2+1 To AF
  161.       S$(NR)=S$(NR)+" |"
  162.    Next X
  163. Next NR
  164. ANCON:
  165. For X=1 To AF
  166.    MXLEN(X)=Max(MXLEN(X),MXLEN2(X))
  167. Next X
  168. ANHEND:
  169. Close 8 : Gosub LCOUNT : Hide : Change Mouse 1
  170. MX=MX+MX2
  171. Cls 1 : Locate 5,5 : Print "Es wurde die Datei ";Chr$(34);DD$;Chr$(34);" mit";MX2;" Datens�tzen angehangen"
  172. If ZV=1 Then Print : Centre "Die komplette Datei konnte leider nicht angehangen werden!"
  173. Print : Print "Freier Speicher:";Free;" Bytes"
  174. Goto FGEL
  175. ANH2:
  176. For NR=1 To MX
  177.    For X=AF+1 To AF2
  178.       S$(NR)=S$(NR)+" |"
  179.    Next X
  180. Next NR
  181. Return 
  182. Goto LADEDEG
  183. KONV_FEHLER:
  184. Cls 1 : Home 
  185. Print : Centre "Konvertierungs-Fehler" : Gosub RY
  186. Resume Label MA
  187. LADEFEHLER:
  188. S$(NR)="Lade-Fehler"
  189. Inc LF
  190. Resume Next 
  191. SP:
  192. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  193. Cls 1
  194. If PRLEN(1)=0 Then KLARO=1 : Gosub PREF
  195. Gosub LONG
  196. SPEICHERDEG:
  197. Clear Key 
  198. Show : DD$=Fsel$("*.seq","","Datei","Speichern") : Hide 
  199. If DD$="" Then Goto MA
  200. PFAD$=Left$(DD$,Instr(DD$,":"))
  201. CUR$=Dir$
  202. Dir$=PFAD$
  203. Restore MEM
  204. Read Y
  205. MEMO=0
  206. For X=1 To Y
  207.    Read MEM$
  208.    If PFAD$=MEM$ Then MEMO=1
  209. Next 
  210. If MEMO=1 Then Goto MEMCON
  211. If DILEN+5120>Dfree Then REQUESTER["WARNUNG! Datei braucht mehr Speicherplatz als auf Disk vorhanden.","Andere Diskette eingelegt!","Abbruch!"]
  212. If Param=2 Then Goto MA
  213. MEMCON:
  214. Dir$=CUR$
  215. If Right$(DD$,4)<>".seq" Then DD$=DD$+".seq"
  216. If Exist(DD$) Then Goto DEX
  217. UEBERSCHREIBEN:
  218. On Error Goto SPFEHLER
  219. NR=0
  220. If DN$="" Then DN$=DD$
  221. SPEICHERWEITER:
  222. NR=0
  223. Change Mouse 3 : Show : Open Out 8,DD$
  224. Print #8,"JD-Datei-Sequenz"
  225. Print #8,TMJ$
  226. Print #8,SOF
  227. Print #8,AF
  228. Print #8,SN
  229. Print #8,BR
  230. For NR=1 To AF
  231.    Print #8,PRLEN(NR)
  232.    Print #8,PRAB(NR)
  233. Next NR
  234. Print #8,FELEN
  235. For NR=1 To AF
  236.    Print #8,N$(NR)
  237.    Print #8,MXLEN(NR)
  238. Next NR
  239. Print #8,DN$
  240. Print #8,MX
  241. For NR=1 To 61
  242.    Print #8,SB(NR)
  243. Next NR
  244. For NR=1 To MX
  245.    POSITION[NR]
  246.    Print #8,S$(NR)
  247. Next NR
  248. Close 8 : Hide : Change Mouse 1
  249. Cls 1 : Locate 7,5 : Print "Datei-Name: "+DN$+"  File-Name: "+DD$
  250. Locate 7,7 : Print "Es wurden";MX;" Datens�tze gesichert!"
  251. Locate 7,9 : Print "Freier Speicher:";Free;" Bytes"
  252. AKT=0 : Goto RM
  253. DEX:
  254. Cls 1 : DD2$=DD$+"-Filename ist schon vergeben!"
  255. Locate 1,10
  256. Centre DD2$
  257. Restore SM : Gosub RD
  258. Cls 1 : On IN Goto UEBERSCHREIBEN,SPEICHERDEG
  259. SPFEHLER:
  260. If Errn=81 Then Locate 1,19 : Centre "FEHLER - Volume existiert nicht!"
  261. If Errn=82 and SPI=0 Then Locate 1,19 : Centre "FEHLER - Datei existiert nicht!"
  262. If Errn=89 Then Locate 1,19 : Centre "FEHLER - Datendiskette ist voll!" : Locate 1,21 : Centre "Bitte Diskette wechseln"
  263. If Errn=87 Then Locate 1,19 : Centre "FEHLER - Device existiert nicht!"
  264. If Errn=84 Then Locate 1,19 : Centre "--- Disk ist schreibgesch�tzt ---" : Locate 1,21 : Centre "- Bitte Schreibschutz entfernen -"
  265. If Errn=95 Then Locate 19,1 : Centre "FEHLER - Device nicht ansprechbar!" : Locate 21,1 : Centre "Bitte Diskette einlegen!"
  266. P= Extension_22_01C4("")
  267. If P=27 Then Resume Label MA
  268. If Errn=82 Then Resume Label LADEDEG
  269. If Errn=87 and SPI=1 Then Resume Label SPEICHERDEG
  270. If Errn=87 Then Resume Label LADEDEG
  271. If Errn=89 Then Resume Label SPEICHERDEG
  272. If Errn=84 Then Resume Label SPEICHERDEG
  273. If Errn=81 and SPI=1 Then Resume Label SPEICHERDEG
  274. If Errn=81 Then Resume Label LADEDEG
  275. Print Errn : Error(Errn) : Stop 
  276. BL:
  277. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  278. Cls 1
  279. Restore BM : Gosub RD
  280. NR=1 : Z=1
  281. B1=1 : B2=MX
  282. On IN Goto BLALL,BLGEZ,BLBER,BLLIST,MA
  283. BLGEZ:
  284. Locate 15,15 : Print "Welcher Buchstabe? ";
  285. A$=Chr$( Extension_22_01C4("")) : Print A$
  286. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  287. Z=Instr(Y$,A$)-1
  288. If SOF=1 Then If Z=0 Then NR=1 : Goto BLFIND
  289. If SOF=-1 Then Z=Z+1
  290. If Abs(SOF)=1 Then For Y=1 To Z : NR=NR+SB(Y) : Next Y
  291. If SOF=-1 Then NR=MX-NR
  292. BLFIND:
  293. If SOF=1 and(Left$(Upper$(S$(NR)),1)>A$) Then MELDUNG["Suche beendet!"] : Goto BL
  294. If SOF=-1 and(Left$(Upper$(S$(NR)),1)<A$) Then MELDUNG["Suche beendet!"] : Goto BL
  295. If Extension_22_0080(NR,1,MX)=0 Then MELDUNG["Suche beendet!"] : Goto BL
  296. POSITION[NR]
  297. If Left$(Upper$(S$(NR)),1)<>A$ Then NR=NR+Z : Goto BLFIND
  298. K1:
  299. Gosub SH
  300. GC[1] : Z=Param
  301. Gosub ZSPEC
  302. If Z=5196 or Z=5076 Then Goto K1
  303. If Z=5000 Then Goto BL
  304. NR=NR+Z
  305. Goto BLFIND
  306. BLALL:
  307. NR=Max(NR,1)
  308. NR=Min(NR,MX)
  309. K2:
  310. Gosub SH
  311. GC[1] : Z=Param
  312. Gosub ZSPEC
  313. If Z=5196 or Z=5076 Then Goto K2
  314. If Z=5000 Then Goto BL
  315. NR=NR+Z
  316. Goto BLALL
  317. BLBER:
  318. Locate 18,15 : Input "Bereich: ";BB$
  319. If BB$="" Then Goto BL
  320. Gosub BEREICH
  321. If B1=0 Then Goto BL
  322. BLBERN:
  323. NR=Max(NR,B1)
  324. NR=Min(NR,B2)
  325. K3:
  326. Gosub SH
  327. GC[1] : Z=Param
  328. Gosub ZSPEC
  329. If Z=5196 or Z=5076 Then Goto K3
  330. If Z=5000 Then Goto BL
  331. NR=NR+Z
  332. Goto BLBERN
  333. BLLIST:
  334. KK=1
  335. ANR=1
  336. BLIST:
  337. Cls 1 : Gosub BLTITEL
  338. NR=ANR
  339. NR=Min(NR,MX-19)
  340. NR=Max(NR,1)
  341. ANR=NR
  342. ZEILE=1
  343. Locate 0,2
  344. BLISNE:
  345. If ZEILE>20 Then Goto CURSOR
  346. If NR>MX Then Goto LEER
  347. Gosub MAKEFELDER
  348. Gosub BLIAUSDRUCK
  349. LEER:
  350. Print 
  351. Inc NR
  352. Inc ZEILE
  353. Goto BLISNE
  354. CURSOR:
  355. Print "Stand: ";
  356. If AKT=1 Then Print TMJ$;
  357. If AKT=0 Then Print TMJ2$;
  358. Print Space$(12);
  359. Print "Satz Nr.";ANR;" bis Satz Nr.";ANR+19
  360. Polyline 1,15 To 704,15
  361. Polyline 1,175 To 704,175
  362. GC[0] : Z=Param
  363. If Z=5000 Then Goto BL
  364. If Z=5033 Then Z=0
  365. ANR=ANR+Z
  366. Goto BLIST
  367. BLTITEL:
  368. Locate 0,1
  369. L=0
  370. For X=KK To AF
  371.    L=L+MXLEN(X)+2
  372.    If L<=84 Then ML=X
  373. Next X
  374. For X=KK To ML-1
  375.    Print N$(X);Space$(MXLEN(X)-Len(N$(X))+2);
  376. Next X
  377. Print N$(X)
  378. Return 
  379. BLIAUSDRUCK:
  380. For X=KK To ML-1
  381.    T$= Extension_22_006C(A$(X),"{",",")
  382.    Print T$;Space$(MXLEN(X)-Len(A$(X))+2);
  383. Next X
  384. T$= Extension_22_006C(A$(X),"{",",")
  385. Print T$;
  386. Return 
  387. SU:
  388. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  389. Cls 1
  390. AUTOSAVE
  391. B1=1 : B2=MX
  392. NR=0 : NLR=0
  393. SF=1
  394. Restore SUM : Gosub RD
  395. On IN Goto MA,SUOK,SUMIT
  396. SUFE:
  397. Cls 1 : Locate 1,1 : ZX=IN-3 : Print N$(ZX)+": ";
  398. IN$= Extension_22_024E("",60) : If IN$="" Then Goto SU
  399. If Extension_22_005A(IN$,"*")>2 Then Goto SU
  400. WORKING : Gosub SPECIAL
  401. JOK=0
  402. If Left$(IN$,1)="*" Then JOK=1
  403. If Left$(IN$,1)="?" Then JOK=1
  404. NR=1 : Z=1
  405. If JOK=1 Then Goto SUFENEXT
  406. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  407. SZ=Instr(Y$,Left$(IN$,1))-1
  408. If SOF=ZX Then If SZ=0 Then NR=1 : Goto SUFENEXT
  409. If SOF=ZX*(-1) Then SZ=SZ+1
  410. If Abs(SOF)=ZX
  411.    For SY=1 To SZ
  412.       NR=NR+SB(SY)
  413.    Next SY
  414. End If 
  415. If SOF=ZX*(-1) Then NR=MX-NR
  416. SUFENEXT:
  417. Change Mouse 3
  418. Gosub MAKEFELDER
  419. POSITION[NR]
  420. P= Extension_22_0080(NR,1,MX)
  421. If SOF=ZX*(-1) and JOK=0 and NLR=0 Then If Left$(A$(ZX),1)<Left$(IN$,1) Then Goto SUFENICHT
  422. If SOF=ZX and JOK=0 and NLR=0 Then If Left$(A$(ZX),1)>Left$(IN$,1) Then Goto SUFENICHT
  423. If P=0 and NLR=0 Then Goto SUFENICHT
  424. If SOF=ZX*(-1) and JOK=0 Then If Left$(A$(ZX),1)<Left$(IN$,1) Then NR=NLR : Bell : Goto SUFEND
  425. If SOF=ZX and JOK=0 Then If Left$(A$(ZX),1)>Left$(IN$,1) Then NR=NLR : Bell : Goto SUFEND
  426. If P=0 Then NR=NLR : Bell : Goto SUFEND
  427. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  428. IN= Extension_22_0006(Upper$(A$(ZX)),Upper$(IN$))
  429. If IN=0 Then NR=NR+Z : Goto SUFENEXT
  430. NLR=NR
  431. SUFEND:
  432. Gosub SH
  433. GC[1] : Z=Param
  434. Gosub ZSPEC
  435. If Z=5196 or Z=5076 Then Goto SUFEND
  436. If Z=5000 Then Goto SU
  437. Z=Max(Z,-1)
  438. Z=Min(Z,1)
  439. NR=NR+Z
  440. Goto SUFENEXT
  441. SUOK:
  442. Cls 1 : Locate 5,5 : Print "Such-Begriff: ";
  443. IN$= Extension_22_024E("",60) : If IN$="" Then Goto SU
  444. If Extension_22_005A(IN$,"*")>2 Then Goto SU
  445. WORKING
  446. NR=1 : Z=1
  447. SUNEXTOK2:
  448. Change Mouse 3
  449. POSITION[NR]
  450. P= Extension_22_0080(NR,1,MX) : If P=0 and NLR=0 Then Goto SUFENICHT
  451. If P=0 Then NR=NLR : Bell : Goto SUOEND
  452. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  453. Gosub MAKEFELDER
  454. ZX=0
  455. SUNEXTOK:
  456. Inc ZX
  457. If ZX>AF Then NR=NR+Z : Goto SUNEXTOK2
  458. IN= Extension_22_0006(Upper$(A$(ZX)),Upper$(IN$))
  459. If IN=0 Then Goto SUNEXTOK
  460. NLR=NR
  461. SUOEND:
  462. Gosub SH
  463. GC[1] : Z=Param
  464. Gosub ZSPEC
  465. If Z=5196 or Z=5076 Then Goto SUOEND
  466. If Z=5000 Then Goto SU
  467. Z=Max(Z,-1)
  468. Z=Min(Z,1)
  469. NR=NR+Z
  470. Goto SUNEXTOK2
  471. SUMIT:
  472. Cls 1 : MM=0 : Locate 5,5
  473. JOK=0
  474. For X=1 To AF
  475.    MM$(X)=""
  476.    Print : Print N$(X)+Space$(FELEN-Len(N$(X)))+": ";
  477.    IN$= Extension_22_024E("",60) : Gosub SPECIAL
  478.    If IN$<>"" Then MM$(X)=IN$ : Inc MM
  479.    If X=Abs(SOF) and(Left$(IN$,1)="*") Then JOK=1
  480.    If X=Abs(SOF) and(Left$(IN$,1)="?") Then JOK=1
  481. Next X
  482. WORKING
  483. NR=1 : Z=1
  484. If JOK=1 Then Goto SUMITNE
  485. Follow 
  486. X=Abs(SOF)
  487. If MM$(X)="" Then Goto SUMITNE
  488. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  489. SZ=Instr(Y$,Left$(MM$(X),1))-1
  490. If SOF>0 Then If SZ=0 Then NR=1 : Goto SUMITNE
  491. If SOF<0 Then SZ=SZ+1
  492. For SY=1 To SZ
  493.    NR=NR+SB(SY)
  494. Next SY
  495. If SOF<0 Then NR=MX-NR
  496. SUMITNE:
  497. Change Mouse 3
  498. POSITION[NR]
  499. Gosub MAKEFELDER
  500. P= Extension_22_0080(NR,1,MX)
  501. If SOF<0 and JOK=0 and NLR=0 Then If Left$(A$(SOF*(-1)),1)<Left$(MM$(SOF*(-1)),1) Then Goto SUFENICHT
  502. If SOF>0 and JOK=0 and NLR=0 Then If Left$(A$(SOF),1)>Left$(MM$(SOF),1) Then Goto SUFENICHT
  503. If P=0 and NLR=0 Then Goto SUFENICHT
  504. If SOF<0 and JOK=0 Then If Left$(A$(SOF*(-1)),1)<Left$(MM$(SOF*(-1)),1) Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  505. If SOF>0 and JOK=0 Then If Left$(A$(SOF),1)>Left$(MM$(SOF),1) Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  506. If P=0 Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  507. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  508. ININ=0
  509. For X=1 To AF
  510.    IN=0
  511.    If MM$(X)<>"" Then IN= Extension_22_0006(Upper$(A$(X)),Upper$(MM$(X)))
  512.    If IN=1 Then Inc ININ
  513. Next X
  514. SUMIEND:
  515. If ININ<>MM Then Goto NY
  516. NLR=NR : Gosub SH : GC[1] : Z=Param : Gosub ZSPEC
  517. If Z=5196 Then Goto SUMIEND
  518. If Z=5000 Then Goto SU
  519. Z=Max(Z,-1)
  520. Z=Min(Z,1)
  521. NY:
  522. NR=NR+Z
  523. Goto SUMITNE
  524. EX:
  525. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  526. If DD$="" Then Goto KEINEDATEN
  527. Cls 1 : Locate 1,2 : Under On : Centre "Export f�r QuerDruck" : Print : Print : Under Off 
  528. F2$= Extension_22_006C(DD$,".seq",".quer")
  529. Open Out 1,F2$
  530. For NR=1 To MX
  531.    Gosub MAKEFELDER
  532.    P$=""
  533.    For X=1 To AF
  534.       A$(X)=Left$(A$(X),PRLEN(X))
  535.       P$=P$+ Extension_22_011A(A$(X),PRLEN(X)+PRAB(X),1)
  536.       If Instr(P$,"{") Then P$= Extension_22_006C(P$,"{",",")
  537.    Next 
  538.    Print #1,P$;Chr$(10);
  539. Next 
  540. Close 1
  541. Goto MA
  542. FW:
  543. FC=2 : BC=0
  544. CHANGERGB
  545. Goto MA
  546. HCOP:
  547. PT= Extension_22_06FE 
  548. If PT<>0 Then Return 
  549. Gosub MAKEFELDER
  550. Gosub INIT
  551. Open Out 4,"PRT:"
  552. For TX=1 To AF
  553.    Print #4,"  ";
  554.    T$=N$(TX)
  555.    Gosub ADRU
  556.    Print #4,Space$(FELEN-Len(N$(TX)))+": ";
  557.    T$=A$(TX)
  558.    Gosub ADRU
  559.    Print #4,""
  560. Next TX
  561. Print #4,""
  562. Close 4
  563. Return 
  564. ADRU:
  565. T$= Extension_22_006C(A$(X),"{",",")
  566. T$= Extension_22_006C(T$,Chr$(228),"{")
  567. T$= Extension_22_006C(T$,Chr$(246),"|")
  568. T$= Extension_22_006C(T$,Chr$(252),"}")
  569. T$= Extension_22_006C(T$,Chr$(223),"~")
  570. T$= Extension_22_006C(T$,Chr$(196),"[")
  571. T$= Extension_22_006C(T$,Chr$(214),"\")
  572. T$= Extension_22_006C(T$,Chr$(220),"]")
  573. Print #4,T$;
  574. Return 
  575. LOESCHEN:
  576. Dec MX
  577. For X=NR To MX+1
  578.    S$(X)=S$(X+1)
  579. Next X
  580. Return 
  581. AENDERN:
  582. Gosub MAKEFELDER
  583. AWRONGAE:
  584. Cls 1 : Locate 1,5
  585. For X=1 To AF
  586.    AFAEFALSCH:
  587.    Locate 1,5+X*2 : Print N$(X)+Space$(FELEN-Len(N$(X)))+": "; : Gosub SDRU : Print Space$(FELEN+3)+""; : INVERS[MXLEN(X)] : Inverse On : IN$= Extension_22_024E("",MXLEN(X)) : Inverse Off 
  588.    A2$(X)= Extension_22_00D6(IN$)
  589.    If A2$(X)="" Then A2$(X)=A$(X) : Locate 0,Y Curs-1 : Print Space$(FELEN+3); : Inverse On : Gosub SDRU : Inverse Off 
  590. Next X
  591. Gosub DSLEN
  592. REQUESTER["Eingabe korrekt?","Ja","Nein"]
  593. If Param=2 Then Goto AWRONGAE
  594. For X=1 To AF
  595.    A$(X)=A2$(X) : A2$(X)=""
  596. Next X
  597. Gosub MAKESTRING
  598. Goto SH
  599. SDRU:
  600. T$=A$(X)
  601. T$= Extension_22_006C(T$,"{",",")
  602. Print T$
  603. Return 
  604. DUPLIZIEREN:
  605. If MX=>LAST Then Return 
  606. Inc MX
  607. S$(MX)=S$(NR)
  608. Locate Screen Width/8-Len(NR$)-Len(MX$)-6,1 : Print "Nr.:"+NR$+"/"+MX$
  609. Return 
  610. DA:
  611. If S$(1)=Chr$(255) Then Goto ERSTEMASKE
  612. REQUESTER["Datei im Speicher l�schen?","Ja","Nein"]
  613. If Param=2 Then Goto MAE
  614. ERSTEMASKE:
  615. Cls 1 : Locate 1,2 : Under On : Centre "Datei-Aufbau" : Under Off 
  616. Gosub CLEAR
  617. MX=0
  618. Locate 10,5 : Input "Datei-Name: ";DN$
  619. Curs Off : Locate 10,7 : Print "Anzahl der Felder (2-9) "; : AF$=Chr$( Extension_22_01C4("23456789")) : AF=Val(AF$)
  620. Print AF$ : Print 
  621. For X=1 To AF
  622.    Print "Feld-Nr.";X;":"; : Input N$(X)
  623.    If N$(X)="" Then N$(X)="Feld"+Str$(X)
  624. Next X
  625. FELEN=0
  626. For X=1 To AF
  627.    FELEN=Max(Len(N$(X)),FELEN)
  628.    MXLEN(X)=(Screen Width/8)-3-FELEN
  629. Next X
  630. If DN$="" Then DN$="Datei-Seq"
  631. REQUESTER["Maske korrekt?","Ja","Nein"]
  632. If Param=2 Then Goto DA
  633. Goto MA
  634. MAE:
  635. If S$(1)=Chr$(255) Then Goto DA
  636. Cls 1 : Locate 1,2 : Under On : Centre "Maske ï¿½ndern" : Under Off 
  637. Locate 5,4 : Print "Alter Datei-Name: "+DN$+"   ";
  638. Input "Neuer Datei-Name: ";NN$ : If NN$<>"" Then DN$=NN$
  639. Print 
  640. For X=1 To AF
  641.    Print "Feld-Nr.";X;": ";N$(X);Space$(FELEN-Len(N$(X)));"   ";
  642.    Input "Neuer Name: ";NN$ : If NN$<>"" Then N$(X)=NN$
  643. Next X
  644. FELEN=0
  645. For X=1 To AF
  646.    FELEN=Max(Len(N$(X)),FELEN)
  647. Next X
  648. DEL:
  649. Print 
  650. If AF=2 Then Goto INST
  651. Print "Soll ein Feld gel�scht werden? (J/N) "; : Z$=Chr$( Extension_22_01C4("JN"))
  652. Print Z$
  653. If Z$="N" Then Goto INST
  654. Input "Welche Feldnummer? ";NN
  655. If NN=0 or NN>AF Then Goto INST
  656. For NR=1 To MX
  657.    Gosub MAKEFELDER
  658.    If NN=AF Then Goto DEL2
  659.    For X=NN+1 To AF
  660.       A$(X-1)=A$(X)
  661.       MXLEN(X-1)=MXLEN(X)
  662.       PRAB(X-1)=PRAB(X)
  663.       PRLEN(X-1)=PRLEN(X)
  664.    Next X
  665.    DEL2:
  666.    Dec AF
  667.    Gosub MAKESTRING
  668.    Inc AF
  669. Next NR
  670. If NN=AF Then Dec AF : Goto DEL
  671. For X=NN+1 To AF
  672.    N$(X-1)=N$(X)
  673.    PRAB(X-1)=PRAB(X)
  674.    PRLEN(X-1)=PRLEN(X)
  675. Next X
  676. Dec AF
  677. FELEN=0
  678. For X=1 To AF
  679.    FELEN=Max(Len(N$(X)),FELEN)
  680. Next X
  681. Goto DEL
  682. INST:
  683. If AF=9 Then Goto NEUSORT
  684. Print "Soll ein Feld hinzugef�gt werden? (J/N) ";
  685. Z$=Chr$( Extension_22_01C4("JN")) : Print Z$
  686. If Z$="N" Then Goto NEUSORT
  687. Inc AF
  688. Input "Name des neuen Feldes: ";N$(AF)
  689. If N$(AF)="" Then N$(AF)="Feld"+Str$(AF)
  690. For NR=1 To MX
  691.    S$(NR)=S$(NR)+" |"
  692. Next NR
  693. PRAB(AF-1)=2 : PRAB(AF)=0 : PRLEN(AF)=Len(N$(AF)) : MXLEN(AF)=PRLEN(AF)
  694. FELEN=0
  695. For X=1 To AF
  696.    FELEN=Max(Len(N$(X)),FELEN)
  697. Next X
  698. Goto INST
  699. NEUSORT:
  700. Print : Print "Soll die Reihenfolge der Felder ge�ndert werden? (J/N) ";
  701. Z$=Chr$( Extension_22_01C4("JN")) : Print Z$
  702. If Z$="N" Then Goto FRAGE
  703. WW$=""
  704. For X=1 To AF
  705.    WW$=WW$+Str$(X)
  706. Next X
  707. For X=1 To AF
  708.    Print "Alte Feld-Nr.:";X;"   Neue Feld-Nummer ";
  709.    Z$=Chr$( Extension_22_01C4(WW$)) : NEU(X)=Val(Z$) : Print Z$
  710. Next X
  711. For NR=1 To MX
  712.    Gosub MAKEFELDER
  713.    For X=1 To AF
  714.       For Y=1 To AF
  715.          If NEU(X)=Y Then B$(Y)=A$(X)
  716.       Next Y
  717.    Next X
  718.    For X=1 To AF
  719.       A$(X)=B$(X) : B$(X)=""
  720.    Next X
  721.    Gosub MAKESTRING
  722. Next NR
  723. FELDNAMEORDNEN:
  724. For X=1 To AF
  725.    For Y=1 To AF
  726.       If NEU(X)=Y Then NB$(Y)=N$(X) : PRLEN2(Y)=PRLEN(X) : PRAB2(Y)=PRAB(X) : MXLEN2(Y)=MXLEN(X)
  727.    Next Y
  728. Next X
  729. For X=1 To AF
  730.    N$(X)=NB$(X) : PRLEN(X)=PRLEN2(X) : PRAB(X)=PRAB2(X) : MXLEN(X)=MXLEN2(X)
  731. Next X
  732. For X=1 To AF-1
  733.    If PRAB(X)=0 Then PRAB(X)=2
  734. Next X
  735. PRAB(AF)=0
  736. FRAGE:
  737. REQUESTER["Ist die neue Maske korrekt?","Ja","Nein"]
  738. If Param=2 Then Goto MAE
  739. Goto MA
  740. EG:
  741. Cls 1 : NR=0 : If AF=0 Then MELDUNG["Masken-Aufbau fehlt!"] : Goto MA
  742. EINNEXT:
  743. Cls 1 : If NR>LAST Then Goto DATEIVOLL
  744. AUTOSAVE
  745. BF1=(100*(MX*100))/LAST : BF1=10000-BF1 : BF$=Str$(BF1) : BF$=Left$(BF$,Len(BF$)-2)+"."+Right$(BF$,2)
  746. Locate 1,2 : Print "Speicherkapazit�t:";BF$;"% frei  -  ";"Freier Arbeitsspeicher:";Free;" Bytes"
  747. If DI=1 Then NR=MX+2 : Print " Satz-Nr.";E : X=1 : Goto EGL
  748. NR=MX+1 : Print " Satz-Nr.";NR : X=1
  749. EGL:
  750. If X<=AF Then Print : Print " "+N$(X)+Space$(FELEN-Len(N$(X)))+": "; : INVERS[MXLEN(X)] : Clear Key : Inverse On : IN$= Extension_22_024E("",MXLEN(X)) : If IN$="" Then IN$=" "
  751. Gosub SPECIAL : IN$= Extension_22_00D6(IN$) : A$(X)=IN$ : Inverse Off 
  752. If REP$(1)=" " Then If A$(1)=Chr$(9) Then A$(1)=" "
  753. If A$(1)=" " Then Goto MA
  754. If A$(X)=Chr$(9) Then A$(X)=REP$(X) : Inverse On : Print A$(X) : Inverse Off 
  755. REP$(X)=A$(X)
  756. If X<AF Then Inc X : Goto EGL
  757. Gosub DSLEN
  758. Gosub MAKESTRING : If DI Then Return 
  759. Inc MX
  760. REQUESTER["Weitere Eingaben?","Ja","Nein"]
  761. If Param=1 Then Inc NR : Goto EINNEXT
  762. Goto MA
  763. SPECIAL:
  764. IN$= Extension_22_006C(IN$,",","{")
  765. Return 
  766. DATEIVOLL:
  767. MELDUNG["Datei ist voll!"]
  768. Goto MA
  769. DSLEN:
  770. For X=1 To AF
  771.    MXLEN(X)=Max(Len(A$(X))+1,MXLEN(X))
  772.    MXLEN(X)=Max(MXLEN(X),Len(N$(X)))
  773. Next X
  774. Return 
  775. ZSPEC:
  776. If Z<5001 Then Return 
  777. If Z=5072 Then Gosub HCOP
  778. If Z=5076 Then Gosub LOESCHEN : Return 
  779. If Z=5196 Then Gosub AENDERN
  780. If Z=5068 Then Gosub DUPLIZIEREN
  781. GC[1] : Z=Param
  782. Return 
  783. AEN:
  784. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  785. Cls 1 : Locate 1,3 : Under On : Centre "Daten-Satz ï¿½ndern" : Under Off 
  786. AUTOSAVE
  787. Locate 17,5 : Input "Satz-Nummer: ";Z
  788. If Extension_22_0080(Z,1,MX)=0 Then Goto MA
  789. NR=Z
  790. Gosub AENDERN : Goto MA
  791. ID:
  792. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  793. Cls 1
  794. AUTOSAVE
  795. Restore DID : Gosub RD
  796. On IN Goto DASADEL,DASAINST,DABEDEL,MA
  797. DASADEL:
  798. Cls 1 : Locate 6,5 : Input "Nummer des zu l�schenden Satzes: ";L
  799. If Extension_22_0080(L,1,MX)=0 Then Goto MA
  800. SATZDEL:
  801. NR=L : Gosub SH
  802. REQUESTER["Datensatz korrekt?","Ja","Nein"]
  803. If Param=2 Then Goto DASADEL
  804. Dec MX
  805. For X=NR To MX+1
  806.    S$(X)=S$(X+1)
  807. Next X
  808. Goto REID
  809. DASAINST:
  810. Cls 1 : Locate 5,5 : Input "Nummer vor der eingef�gt werden soll: ";E : Print : Print 
  811. If Extension_22_0080(E,1,MX)=0 Then Goto MA
  812. WORKING
  813. NR=E : DI=1 : Gosub EINNEXT : DI=0
  814. For NR=MX To E Step -1
  815.    S$(NR+1)=S$(NR)
  816. Next NR
  817. S$(E)=S$(MX+2)
  818. S$(MX+2)=Chr$(255) : Inc MX
  819. WORKOFF
  820. Goto REID
  821. DABEDEL:
  822. Cls 1 : Locate 5,5 : Input "Welcher Bereich soll gel�scht werden: ";LB$
  823. If LB$="" Then Goto MA
  824. If LB$="0" Then Goto MA
  825. WORKING
  826. LB=Instr(LB$,"-")
  827. If LB=0 Then L=Val(LB$) : Goto SATZDEL
  828. If LB=1 Then Goto DELBIS
  829. If LB=Len(LB$) Then Goto DELAB
  830. Goto DELVB
  831. DELBIS:
  832. LB$=Mid$(LB$,2) : NR=Val(LB$)+1
  833. LR=1
  834. For X=NR To MX
  835.    S$(LR)=S$(X) : Inc LR
  836. Next X
  837. MX=MX-Val(LB$)
  838. For X=1 To Val(LB$)
  839.    S$(MX+X)=Chr$(255)
  840. Next X
  841. WORKOFF
  842. Goto REID
  843. DELAB:
  844. LB=Val(Mid$(LB$,1,Len(LB$)-1))
  845. For X=LB To MX
  846.    S$(X)=Chr$(255)
  847. Next X
  848. MX=LB-1
  849. WORKOFF
  850. Goto REID
  851. DELVB:
  852. K1=Val(Mid$(LB$,1,Instr(LB$,"-")-1)) : X=Val(Mid$(LB$,Instr(LB$,"-")+1)) : MX2=X-K1+1 : MX=MX-MX2
  853. For Y=K1 To X
  854.    S$(Y)=Chr$(255)
  855. Next Y
  856. Inc X
  857. While S$(X)<>Chr$(255)
  858. S$(K1)=S$(X) : Inc X : Inc K1
  859. Wend 
  860. WORKOFF
  861. REID:
  862. Gosub RY : Goto ID
  863. DRU:
  864. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  865. PT= Extension_22_06FE 
  866. If PT=0 Then Goto DRUCKEROK
  867. Cls 1
  868. If PT=2 Then REQUESTER["FEHLER - Drucker ist >OFFLINE<","Fehler behoben","Abbruch"]
  869. If PT=1 Then REQUESTER["FEHLER - Drucker ist nicht erreichbar","Fehler behoben","Abbruch"]
  870. If Param=2 Then Goto MA
  871. Goto DRU
  872. DRUCKEROK:
  873. Cls 1
  874. AUTOSAVE
  875. PREF:
  876. If PRLEN(1)=0
  877.    SN=0
  878.    For X=1 To AF
  879.       PRLEN(X)=MXLEN(X)
  880.       PRAB(X)=2
  881.    Next X
  882.    PRAB(AF)=0
  883.    GESLEN=0
  884.    For X=1 To AF
  885.       GESLEN=GESLEN+MXLEN(X)+PRAB(X)
  886.    Next X
  887. End If 
  888. If PRLEN(1)=0 and GESLEN<41 Then BR=0
  889. If PRLEN(1)=0 and GESLEN>40 and GESLEN<81 Then BR=1
  890. If PRLEN(1)=0 and GESLEN>80 and GESLEN<137 Then BR=2
  891. If PRLEN(1)=0 and GESLEN>136 Then MELDUNG["Achtung !!!"+Chr$(10)+"Bitte Drucker-Preferences einstellen!"] : BR=3
  892. If KLARO=1 Then KLARO=0 : Return 
  893. Gosub INIT
  894. Show : Restore DM : Gosub RD : Cls 1 : Locate 5,5
  895. On IN Goto ALLEDRU,DABEDRU,KRIDRU,DRUPREF,MA
  896. DRUPREF:
  897. GESLEN=0
  898. For X=1 To AF
  899.    GESLEN=GESLEN+PRLEN(X)+PRAB(X)
  900. Next X
  901. If SN=1 Then GESLEN=GESLEN+7
  902. PO$(1)="Satz-Nummer:" : PO$(2)="Druckbreite:"
  903. For X=1 To AF
  904.    PO$(X+2)=N$(X)+Space$(FELEN-Len(N$(X)))
  905. Next X
  906. PREFS:
  907. Hide : Curs Off : Cls 1
  908. PO=1 : PP=0
  909. PRELOP:
  910. Locate 0,5
  911. Print " Satz-Nummer:"
  912. Print 
  913. Print " Druckbreite:"
  914. Print 
  915. Print " Feld";Space$(FELEN-4);"   Feldbreite    Feldabstand    max. Feldbreite"
  916. Print 
  917. For X=1 To AF
  918.    Print " ";N$(X);Space$(FELEN-Len(N$(X)));"       "; Using "###";PRLEN(X);"            "; Using "###";PRAB(X);"             "; Using "###";MXLEN(X)
  919. Next X
  920. Print : Print " Gesamtbreite:"; Using "###";GESLEN
  921. Print : Print " ESC = Einstellungen ok"
  922. Y1=(AF+5)*8+65
  923. X1=(FELEN+49)*8
  924. Box 1,70 To X1,Y1
  925. Box 1,82 To X1,Y1-12
  926. Polyline(FELEN+2)*8,70 To(FELEN+2)*8,Y1-12
  927. Polyline(FELEN+16)*8,70 To(FELEN+16)*8,Y1-12
  928. Polyline(FELEN+31)*8,70 To(FELEN+31)*8,Y1-12
  929. Gosub INV2
  930. Goto SHPR
  931. GLO:
  932. Z$=Inkey$ : If Z$="" Then Goto GLO
  933. Z=Asc(Z$) : If Z=27 Then Goto DRU
  934. LOP2:
  935. If Extension_22_0080(Z,28,31)=0 Then Goto GLO
  936. If Z=30 or Z=31 Then Gosub INV
  937. If Z=31 Then Inc PO : If PO>AF+2 Then PO=1
  938. If Z=30 Then Dec PO : If PO<1 Then PO=AF+2
  939. If Z=30 or Z=31 Then Gosub INV2
  940. If PO=1 Then If Z=28 Then Inc SN : If SN=2 Then SN=0
  941. If PO=1 Then If Z=29 Then Dec SN : If SN<0 Then SN=1
  942. If PO=2 Then If Z=28 Then Inc BR : If BR=3 Then BR=0
  943. If PO=2 Then If Z=29 Then Dec BR : If BR<0 Then BR=2
  944. If PO<3 Then Goto SHPR
  945. If PO=AF+2 Then PP=0
  946. If PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  947. If PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  948. INV:
  949. If PO=1 Then Y=5
  950. If PO=2 Then Y=7
  951. If PO>2 Then Y=PO+8
  952. Locate 1,Y : Inverse Off : Print PO$(PO) : Return 
  953. INV2:
  954. If PO=1 Then Y=5
  955. If PO=2 Then Y=7
  956. If PO>2 Then Y=PO+8
  957. Locate 1,Y : Inverse On : Print PO$(PO) : Inverse Off : Return 
  958. SHPR:
  959. If SN=0 Then Locate 14,5 : Inverse On : Print "OFF"; : Inverse Off : Print "  ON"
  960. If SN=1 Then Locate 14,5 : Inverse Off : Print "OFF  "; : Inverse On : Print "ON"
  961. If BR=0 Then Locate 14,7 : Inverse On : Print "40"; : Inverse Off : Print "  80  160 cpl"
  962. If BR=1 Then Locate 14,7 : Inverse Off : Print "40  "; : Inverse On : Print "80"; : Inverse Off : Print "  160 cpl"
  963. If BR=2 Then Locate 14,7 : Inverse Off : Print "40  80  "; : Inverse On : Print "160"; : Inverse Off : Print " cpl"
  964. Gosub ML : Goto GLO
  965. FELDER:
  966. Z$=Inkey$ : If Z$="" Then Goto FELDER
  967. Z=Asc(Z$) : If Z=27 Then Goto DRU
  968. If Z=30 or Z=31 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print " " : Goto LOP2
  969. FELDER2:
  970. If Z=28 Then Inc PP : If PP>1 Then PP=0
  971. If Z=29 Then Dec PP : If PP<0 Then PP=1
  972. If PO=AF+2 and PP=1 Then PP=0 : Goto FELDER
  973. If Z=28 and PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  974. If Z=28 and PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  975. If Z=29 and PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  976. If Z=29 and PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  977. If Extension_22_0080(Z,48,57)=0 Then Goto FELDER
  978. TEST:
  979. If PP=1 Then Goto TEST1
  980. Locate FELEN+8,PO+8 : ZZ= Extension_22_01D6(Val(Z$),2)
  981. ZZ=Min(ZZ,MXLEN(PO-2))
  982. PRLEN(PO-2)=ZZ
  983. Locate FELEN+8,Y Curs-1 : Print Using "###";PRLEN(PO-2)
  984. Gosub ML
  985. Locate FELEN+7,PO+8 : Print ">" : Goto FELDER
  986. TEST1:
  987. If PO=AF+2 Then Z=28 : Goto FELDER2
  988. Locate FELEN+24,PO+8 : ZZ= Extension_22_01D6(Val(Z$),1)
  989. If ZZ=0 Then ZZ=1
  990. PRAB(PO-2)=ZZ
  991. Locate FELEN+24,Y Curs-1 : Print PRAB(PO-2)
  992. Gosub ML
  993. Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  994. ML:
  995. GESLEN=0
  996. For X=1 To AF
  997.    GESLEN=GESLEN+PRLEN(X)+PRAB(X)
  998. Next X
  999. If SN=1 Then GESLEN=GESLEN+7
  1000. Locate 14,AF+12 : Print Using "###";GESLEN
  1001. Return 
  1002. ALLEDRU:
  1003. NR=0
  1004. Gosub PARTITEL
  1005. ZEILE=4
  1006. ALLEDRUNE:
  1007. Inc NR : Inc ZEILE
  1008. POSITION[NR]
  1009. If S$(NR)=Chr$(255) Then Goto ALLEDRUEN
  1010. If ZEILE=LINES Then Print #4,Chr$(12) : Print #4,TITEL$; : Print #4,""
  1011. If ZEILE=LINES and SN=1 Then Print #4," Nr.: ";
  1012. If ZEILE=LINES Then For X=1 To AF-1 : DRUGERMAN[N$(X),PRLEN(X),PRAB(X)] : Next X
  1013. If ZEILE=LINES Then DRUGERMAN[N$(AF),PRLEN(AF),0]
  1014. If ZEILE=LINES Then Print #4,NORM$ : ZEILE=4
  1015. Gosub MAKEFELDER
  1016. Gosub AUSDRUCK
  1017. Print #4,"" : Goto ALLEDRUNE
  1018. ALLEDRUEN:
  1019. Print #4,TITEL$
  1020. PA2$="Anzahl der Datens�tze:"+Str$(NR-1)
  1021. DRUGERMAN[PA2$,Len(PA2$),0]
  1022. Print #4,INIT$
  1023. Print #4,BEL$
  1024. Close 4
  1025. Goto REDRU
  1026. DABEDRU:
  1027. Locate 0,Y Curs : Input "Welcher Bereich soll ausgedruckt werden? ";BB$
  1028. If BB$="" Then Goto DRUCKEROK
  1029. Gosub BEREICH
  1030. Print : Print "Satz Nummer: "; : CX=X Curs : CY=Y Curs
  1031. If B1=0 Then Goto DRUCKEROK
  1032. Gosub PARTITEL
  1033. For NR=B1 To B2
  1034.    POSITION[NR]
  1035.    Gosub MAKEFELDER
  1036.    Gosub AUSDRUCK
  1037.    Print #4,""
  1038. Next NR
  1039. Print #4,TITEL$
  1040. PA2$="Anzahl der Datens�tze:"+Str$(B2-B1+1)
  1041. DRUGERMAN[PA2$,Len(PA2$),0]
  1042. Print #4,INIT$
  1043. Print #4,BEL$
  1044. Close 4
  1045. Goto REDRU
  1046. KRIDRU:
  1047. KX$="" : Locate 0,Y Curs
  1048. For X=1 To AF
  1049.    Print X;" ";N$(X)
  1050.    KX$=KX$+Str$(X)
  1051. Next X
  1052. Print : Print "Welcher Begriff? "
  1053. DB$=Chr$( Extension_22_01C4(KX$)) : Print DB$
  1054. DB=Val(DB$)
  1055. Cls 1
  1056. Print N$(DB);": "; : IN$= Extension_22_024E("",60)
  1057. NR=0
  1058. Gosub PARTITEL
  1059. DRUNE:
  1060. Inc NR
  1061. POSITION[NR]
  1062. If S$(NR)=Chr$(255) Then Print #4,"" : Print #4,INIT$ : Print #4,BEL$ : Close 4 : Goto REDRU
  1063. Gosub MAKEFELDER
  1064. IN= Extension_22_0006(Upper$(A$(DB)),Upper$(IN$))
  1065. If IN=0 Then Goto DRUNE
  1066. Gosub AUSDRUCK : Print #4,"" : Goto DRUNE
  1067. REDRU:
  1068. Gosub RY : Goto DRUCKEROK
  1069. AUSDRUCK:
  1070. If SN=1 Then Print #4, Using "####";NR; : Print #4,": ";
  1071. For X=1 To AF-1
  1072.    DRUGERMAN[A$(X),PRLEN(X),PRAB(X)]
  1073. Next X
  1074. DRUGERMAN[A$(AF),PRLEN(AF),0]
  1075. Return 
  1076. INIT:
  1077. INIT$=Chr$(27)+"c"
  1078. BEL$=Chr$(8)
  1079. GERMAN$=Chr$(27)+"(K"
  1080. UNDERLINE$=Chr$(27)+"[4m"
  1081. BOLD$=Chr$(27)+"[1m"
  1082. FINE$=Chr$(27)+"[4w"
  1083. ACHTEL$=Chr$(27)+"[0z"
  1084. WIDE$=Chr$(27)+"[6w"
  1085. NORM$=Chr$(27)+"[24m"+Chr$(27)+"[22m"+Chr$(27)+"[0w"
  1086. LINES=58
  1087. If BR=2 Then PREF$=FINE$+ACHTEL$ : LINES=87
  1088. If BR=1 Then PREF$=NORM$
  1089. If BR=0 Then PREF$=WIDE$
  1090. INITSTRING$=INIT$+GERMAN$+PREF$
  1091. TITEL$=UNDERLINE$+BOLD$
  1092. Open Out 4,"PRT:"
  1093. Print #4,INITSTRING$
  1094. Close 4
  1095. Return 
  1096. PARTITEL:
  1097. Open Out 4,"PRT:"
  1098. Print #4,TITEL$;
  1099. Print #4,DN$
  1100. Print #4,""
  1101. Print #4,"Stand: ";
  1102. If AKT=1 Then Print #4,TMJ$
  1103. If AKT=0 Then Print #4,TMJ2$
  1104. Print #4,""
  1105. If SN=1 Then Print #4," Nr.: ";
  1106. For X=1 To AF-1
  1107.    DRUGERMAN[N$(X),PRLEN(X),PRAB(X)]
  1108. Next X
  1109. DRUGERMAN[N$(AF),PRLEN(AF),0]
  1110. Print #4,NORM$
  1111. Return 
  1112. FL:
  1113. Cls 1 : AUTOSAVE : Curs Off : On Error Goto FLFEHL
  1114. Restore DF : Gosub RD
  1115. Cls 1
  1116. On IN Goto RENA,DELFILE,DI,MA
  1117. FLFEHL:
  1118. Resume Next 
  1119. DI:
  1120. Locate 10,2 : Show : Clear Key : LD$=Fsel$("","","Inhalt","") : Hide : Goto FL
  1121. RENA:
  1122. Show : Clear Key : OAM$=Fsel$("","","Alter Name","") : Hide 
  1123. Locate 5,5 : Print "Alter Name: ";OAM$
  1124. Locate 5,7 : Input "Neuer Name: ";NNAM$
  1125. If NNAM$="" Then Goto FL
  1126. If NNAM$=OAM$ Then Goto FL
  1127. Rename OAM$ To NNAM$ : Goto FL
  1128. DELFILE:
  1129. Show : Clear Key : LD$=Fsel$("","","Datei","l�schen") : Hide 
  1130. If LD$="" Then Goto FL
  1131. REQUESTER[LD$+" wirklich l�schen?","Ja","Nein"]
  1132. If Param=1 Then Kill LD$
  1133. Goto FL
  1134. SO:
  1135. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  1136. Cls 1 : Locate 1,2 : Under On : Centre "Sortieren" : Print : Print : Under Off 
  1137. AUTOSAVE
  1138. Centre " Nach welchem Kriterium soll sortiert werden?"
  1139. For X=1 To AF
  1140.    ME$(X)=N$(X) : SX$(X)=SX$(X)+Str$(X)
  1141. Next X
  1142. ME$(AF+1)="Abbruch" : ME$(0)=""
  1143. ANZ=AF+1
  1144. MYMEN[ANZ]
  1145. Wait 5
  1146. SZ=Param
  1147. If SZ=ANZ Then Goto MA
  1148. SOV=SOF
  1149. SOF=SZ
  1150. REQUESTER["Sortiervorgang","aufsteigend","absteigend"]
  1151. WORKING
  1152. Show : Change Mouse 3 : AUF=Param : If AUF=2 Then SOF=SOF*(-1)
  1153. If SOF=SOV Then Goto SOVEND
  1154. If SZ=1 Then Goto SONORM
  1155. For L=1 To MX
  1156.    NR=L : Gosub MAKEFELDER : S$(L)=A$(SZ)+"|"
  1157.    For Q=1 To AF
  1158.       If Q<>SZ Then S$(L)=S$(L)+A$(Q)+"|"
  1159.    Next Q
  1160. Next L
  1161. SONORM:
  1162. Gosub SCRYPT : Gosub SOR : Gosub SENCRYPT
  1163. If SZ<>1 Then Gosub ALTEREIHE
  1164. SOVEND:
  1165. SOTE=1 : Gosub UP : SOTE=0
  1166. Change Mouse 1 : Hide : WORKOFF : Goto RM
  1167. ALTEREIHE:
  1168. For I=1 To MX
  1169.    NR=I : A$(SZ)=Left$(S$(I),Instr(S$(I),"|")-1)
  1170.    M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$ : If SZ<2 Then Goto ALTEREIHE2
  1171.    For Y=1 To SZ-1
  1172.       A$(Y)=Left$(S$(I),Instr(S$(I),"|")-1)
  1173.       M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$
  1174.    Next Y
  1175.    If SZ=AF Then Goto ALTEREIHE3
  1176.    ALTEREIHE2:
  1177.    If SZ=AF Then Goto ALTEREIHE3
  1178.    For Y=SZ+1 To AF
  1179.       A$(Y)=Left$(S$(I),Instr(S$(I),"|")-1)
  1180.       M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$
  1181.    Next Y
  1182.    ALTEREIHE3:
  1183.    Gosub MAKESTRING
  1184. Next I
  1185. Return 
  1186. SOR:
  1187. Sort S$(MX)
  1188. If AUF=1 Then Return 
  1189. For X=1 To MX/2
  1190.    Swap S$(MX-X+1),S$(X)
  1191. Next X
  1192. Return 
  1193. LCOUNT:
  1194. LCY$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  1195. For LC=1 To Len(LCY$)
  1196.    SB(LC)=0
  1197. Next LC
  1198. For NR=1 To MX
  1199.    Gosub MAKEFELDER
  1200.    LCZ=Instr(LCY$,Upper$(Left$(A$(SOF),1))) : If LCZ>0 Then SB(LCZ)=SB(LCZ)+1
  1201. Next NR
  1202. LCY$=""
  1203. Return 
  1204. IM:
  1205. Show 
  1206. Cls 1 : Home : Print : Centre "GoAmiga!-Datei.DAT zu JD-Datei.seq konvertieren."
  1207. Print : Centre "Es werden 5 Phasen ben�tigt!"
  1208. REQUESTER["GoAmiga!-Datei importieren?","Ja","Nein"]
  1209. If Param=2 Then Goto MA
  1210. Clear Key : DD$=Fsel$("*.DAT","","GoAmiga!-Datei","konvertieren")
  1211. If DD$="" Then Goto MA
  1212. On Error Goto KONV_FEHLER
  1213. Hide 
  1214. SOURCE$=DD$
  1215. DEST$=DD$+".conv"
  1216. Print : Print : Print "Phase 1"
  1217. FILE_COPY[SOURCE$,DEST$]
  1218. Print "Phase 2"
  1219. Open In 8,DD$+".conv"
  1220. For X=1 To MX
  1221.    Input #8,S$(X)
  1222. Next X
  1223. Close 
  1224. For X=1 To AF
  1225.    N$(X)="Feld"+Str$(X)
  1226. Next X
  1227. Print "Phase 3"
  1228. FELEN=0
  1229. For ZZX=1 To AF
  1230.    FELEN=Max(FELEN,Len(N$(ZZX)))
  1231.    MXLEN(ZZX)=0 : PRLEN(ZZX)=0
  1232. Next ZZX
  1233. Print "Phase 4"
  1234. For NR=1 To MX
  1235.    Gosub MAKEFELDER
  1236.    For ZZX=1 To AF
  1237.       A=Len(A$(ZZX)) : MXLEN(ZZX)=Max(MXLEN(ZZX),A)
  1238.    Next ZZX
  1239. Next NR
  1240. Print "Phase 5"
  1241. For ZZX=1 To AF
  1242.    PRLEN(ZZX)=Max(PRLEN(ZZX),MXLEN(ZZX))
  1243.    PRLEN(ZZX)=Max(Len(N$(ZZX)),PRLEN(ZZX))
  1244. Next ZZX
  1245. Gosub LCOUNT
  1246. Cls 1 : Locate 0,1 : Centre "GoAmiga!-Datei ist konvertiert!"
  1247. Locate 0,3 : Centre "Anzahl der Datens�tze:"+Str$(MX)
  1248. Locate 0,5 : Centre "Freier Speicher:"+Str$(Free)+" Bytes"
  1249. REQUESTER["Sequenz abspeichern?","Ja","Nein"]
  1250. If Param=2 Then Goto MA
  1251. JD$=Left$(DD$,Len(DD$)-4)+".seq"
  1252. Open Out 8,JD$
  1253. Print #8,"JD-Datei-Sequenz"
  1254. Print #8,TMJ$
  1255. Print #8,SOF
  1256. Print #8,AF
  1257. Print #8,0
  1258. Print #8,0
  1259. For X=1 To AF
  1260.    Print #8,PRLEN(X)
  1261.    Print #8,PRAB(X)
  1262. Next X
  1263. Print #8,FELEN
  1264. For X=1 To AF
  1265.    Print #8,N$(X)
  1266.    Print #8,MXLEN(X)
  1267. Next X
  1268. DN$=Left$(DD$,Len(DD$)-4)
  1269. Print #8,DN$
  1270. Print #8,MX
  1271. For NR=1 To 61
  1272.    Print #8,SB(NR)
  1273. Next NR
  1274. For X=1 To MX
  1275.    Print #8,S$(X)
  1276. Next X
  1277. Close 8
  1278. Kill DD$+".conv"
  1279. Goto MA
  1280. SCRYPT:
  1281. For I=1 To MX
  1282.    S$(I)= Extension_22_00F8(S$(I))
  1283. Next I
  1284. Return 
  1285. SENCRYPT:
  1286. For I=1 To MX
  1287.    S$(I)= Extension_22_0108(S$(I))
  1288. Next I
  1289. Return 
  1290. SH:
  1291. Cls 1,0,0 To 680,219 : Change Mouse 1
  1292. Locate 1,1 : Centre DN$ : Locate 0,3
  1293. Gosub MAKEFELDER
  1294. For TX=1 To AF
  1295.    Print N$(TX)+Space$(FELEN-Len(N$(TX)))+": ";
  1296.    For X=1 To Len(A$(TX))
  1297.       T$=Mid$(A$(TX),X,1)
  1298.       If T$="{" Then T$=","
  1299.       Print T$;
  1300.    Next 
  1301.    Print 
  1302. Next TX
  1303. NR$=Str$(NR)
  1304. MX$=Str$(MX)-" "
  1305. Locate 1,1
  1306. If AKT=1 Then Print TMJ$
  1307. If AKT=0 Then Print TMJ2$
  1308. Locate Screen Width/8-Len(NR$)-Len(MX$)-6,1 : Print "Nr.:"+NR$+"/"+MX$
  1309. Return 
  1310. MAKESTRING:
  1311. I=NR : If A$(1)=" " Then Return 
  1312. S$(I)=""
  1313. For X=1 To AF
  1314.    S$(I)=S$(I)+A$(X)+"|"
  1315. Next X
  1316. Return 
  1317. MAKEFELDER:
  1318. I=NR : If S$(I)=Chr$(255) Then Return 
  1319. C$=S$(I)
  1320. For X=1 To AF
  1321.    A$(X)=Left$(C$,Instr(C$,"|")-1)
  1322.    C$=Right$(C$,Len(C$)-Instr(C$,"|"))
  1323. Next X
  1324. Return 
  1325. RM:
  1326. Gosub RY : Goto MA
  1327. RY:
  1328. Clear Key : Bell : Change Mouse 1
  1329. RY2:
  1330. A$=Inkey$
  1331. If Mouse Key=1 Then Return 
  1332. If A$<>"" Then Return 
  1333. Goto RY2
  1334. KEINEDATEN:
  1335. MELDUNG["Es befinden sich keine Daten im Speicher!"]
  1336. Goto MA2
  1337. SUFENICHT:
  1338. MELDUNG["Suche erfolglos abgebrochen!"]
  1339. Goto SU
  1340. CLEAR:
  1341. For X=1 To LAST
  1342.    S$(X)=Chr$(255)
  1343. Next X
  1344. For X=1 To 9
  1345.    N$(X)="" : A$(X)="" : MM$(X)="" : A2$(X)="" : B$(X)="" : NB$(X)="" : REP$(X)="" : SX$(X)=""
  1346.    NEU(X)=0 : PRLEN(X)=0 : PRAB(X)=0 : MXLEN(X)=0 : MXLEN2(X)=0 : MLEN(X)=0 : PRLEN2(X)=0 : PRAB2(X)=0
  1347. Next X
  1348. Return 
  1349. RD:
  1350. Read ME$(0)
  1351. Read ANZ
  1352. If ANZ=99 Then Goto GSU
  1353. For X=1 To ANZ
  1354.    Read ME$(X)
  1355. Next X
  1356. Goto CON
  1357. GSU:
  1358. For X=1 To 3
  1359.    Read ME$(X)
  1360. Next X
  1361. For X=1 To AF
  1362.    ME$(X+3)=N$(X)
  1363. Next X
  1364. ANZ=AF+3
  1365. CON:
  1366. MYMEN[ANZ]
  1367. IN=Param
  1368. Return 
  1369. LONG:
  1370. DILEN=Len("JD-Datei-Sequenz")+2
  1371. DILEN=DILEN+Len(TMJ2$)+2
  1372. DILEN=DILEN+Len(DN$)+2
  1373. DILEN=DILEN+Len(Str$(AF))+2
  1374. DILEN=DILEN+Len(Str$(SN))+2
  1375. DILEN=DILEN+Len(Str$(BR))+2
  1376. DILEN=DILEN+Len(Str$(FELEN))+2
  1377. DILEN=DILEN+Len(Str$(MX))+2
  1378. For X=1 To AF
  1379.    DILEN=DILEN+Len(Str$(PRLEN(X)))+2
  1380.    DILEN=DILEN+Len(Str$(PRAB(X)))+2
  1381.    DILEN=DILEN+Len(N$(X))+2
  1382.    DILEN=DILEN+Len(Str$(MXLEN(X)))+2
  1383. Next X
  1384. For X=1 To MX
  1385.    DILEN=DILEN+Len(S$(X))+2
  1386. Next X
  1387. For X=1 To 61
  1388.    DILEN=DILEN+Len(Str$(SB(X)))+2
  1389. Next 
  1390. Return 
  1391. BEREICH:
  1392.  Extension_22_0162 : Extension_22_0150(BB$)
  1393. B1= Extension_22_0190 : B2= Extension_22_01A4 
  1394. B1=Max(B1,1) : B2=Min(B2,MX)
  1395. Return 
  1396. MEM:
  1397. Data 2,"RAM DISK:","BOOTRAM:"
  1398. HM:
  1399. Data "Datei-Verwaltung",17,"Laden","Bl�ttern","Neue Maske","Eingabe","Sortieren","Drucken","Farbe","Update","Ende"
  1400. Data "Speichern","Suchen","Maske ï¿½ndern","Daten ï¿½ndern","Daten Inst/Del","Disk-Befehle","ASC-Import","Quer-Export"
  1401. LM:
  1402. Data "",3,"Laden","Menu","Anh�ngen"
  1403. SM:
  1404. Data "",2,"�berschreiben","Neuer Name"
  1405. BM:
  1406. Data "Bl�ttern",5,"Alle","Gezielt","Bereich","Liste","Menu"
  1407. SUM:
  1408. Data "Suchen",99,"Menu","Ohne Kriterium","Mit Kriterium"
  1409. DID:
  1410. Data "Daten Inst/Del",4,"Satz l�schen","Satz einf�gen","Bereich l�schen","Menu"
  1411. DM:
  1412. Data "Drucken",5,"Alle","Bereich","Kriterium","Einstellungen","Menu"
  1413. DF:
  1414. Data "Disk-Befehle",4,"Umbenennen","L�schen","Inhalt","Menu"
  1415. Procedure SETUP
  1416.    Close Editor 
  1417.    Screen Open 0,680,257,4,Hires
  1418.    Limit Mouse 112,42 To 447,298
  1419.    Curs Off : Flash Off : Hide 
  1420.    SET_COL
  1421.    Request Off 
  1422.    TITEL
  1423.    SET_TIME
  1424. End Proc
  1425. Procedure MYMEN[ANZ]
  1426.    Shared ME$()
  1427.    Reset Zone 
  1428.    BREITE=Screen Width
  1429.    BREITE=BREITE/8
  1430.    Locate 1,3 : Under On : Centre ME$(0) : Under Off 
  1431.    BLEN=0
  1432.    For X=1 To ANZ
  1433.       ALEN=Len(ME$(X)) : BLEN=Max(BLEN,ALEN)
  1434.    Next 
  1435.    For X=1 To ANZ
  1436.       ME$(X)= Extension_22_011A(ME$(X),BLEN,0)
  1437.    Next 
  1438.    Inverse On : Show : Curs Off 
  1439.    Wait 10
  1440.    LL=2*BLEN+4
  1441.    L1=(BREITE-LL)/2
  1442.    L2=L1+4+BLEN
  1443.    P=4
  1444.    ANZ1=ANZ/2
  1445.    If ANZ/2*2<ANZ Then ANZ1=ANZ1+1
  1446.    For X=1 To ANZ1
  1447.       K$=ME$(X)
  1448.       P=P+2
  1449.       Box L1*8-1,P*8-1 To L1*8+BLEN*8,P*8+8
  1450.       Locate L1,P
  1451.       Print Zone$(K$,X)
  1452.    Next 
  1453.    P=4
  1454.    For X=ANZ1+1 To ANZ
  1455.       K$=ME$(X)
  1456.       P=P+2
  1457.       Box L2*8-1,P*8-1 To L2*8+BLEN*8,P*8+8
  1458.       Locate L2,P
  1459.       If K$<>"" Then Print Zone$(K$,X)
  1460.    Next 
  1461.    GMEN:
  1462.    IN=Mouse Zone
  1463.    If Mouse Key=1 and IN>0 and IN=<ANZ Then Goto GO
  1464.    Goto GMEN
  1465.    GO:
  1466.    LL=2*BLEN+4
  1467.    L1=(BREITE-LL)/2
  1468.    L2=L1+4+BLEN
  1469.    P=4
  1470.    ANZ1=ANZ/2
  1471.    If ANZ/2*2<ANZ Then ANZ1=ANZ1+1
  1472.    For X=1 To ANZ1
  1473.       P=P+2
  1474.       Locate L1,P
  1475.       If IN=X Then Inverse Off 
  1476.       Print ME$(X)
  1477.       If IN=X Then Inverse On 
  1478.    Next 
  1479.    P=4
  1480.    For X=ANZ1+1 To ANZ
  1481.       P=P+2
  1482.       Locate L2,P
  1483.       If IN=X Then Inverse Off 
  1484.       If ME$(X)<>"" Then Print ME$(X)
  1485.       If IN=X Then Inverse On 
  1486.    Next 
  1487.    Hide 
  1488.    Inverse Off 
  1489. End Proc[IN]
  1490. Procedure GC[P]
  1491.    Shared KK,AF,ML,NR,MX,B1,B2,SF
  1492.    Show : Curs Off 
  1493.    ANZ=1
  1494.    If P=0 Then ANZ=20
  1495.    Cls 1,0,219 To Screen Width,Screen Height
  1496.    Box 44,219 To 629,235
  1497.    Locate 9,28
  1498.    Print "|<     <<<      <<      <      STOP      >      >>      >>>      >|";
  1499.    If P=0 Then Cls 1,0,236 To 680,250 : Goto NOPR
  1500.    Box 44,236 To 629,250
  1501.    Locate 10,30
  1502.    Print "AUSDRUCK           L�SCHEN             ï¿½NDERN          DUPLIZIEREN ";""
  1503.    Box 44,235 To 190,250 : Set Zone 10,36,235 To 182,250
  1504.    Box 190,235 To 336,250 : Set Zone 11,190,235 To 336,250
  1505.    Box 336,235 To 482,250 : Set Zone 12,336,235 To 482,250
  1506.    Box 482,235 To 629,250 : Set Zone 13,482,235 To 629,250
  1507.    NOPR:
  1508.    Box 44,219 To 109,235 : Set Zone 1,44,219 To 109,235
  1509.    Box 109,219 To 174,235 : Set Zone 2,109,219 To 174,235
  1510.    Box 174,219 To 239,235 : Set Zone 3,174,219 To 239,235
  1511.    Box 239,219 To 304,235 : Set Zone 4,239,219 To 304,235
  1512.    Box 304,219 To 369,235 : Set Zone 5,304,219 To 369,235
  1513.    Box 369,219 To 434,235 : Set Zone 6,369,219 To 434,235
  1514.    Box 434,219 To 499,235 : Set Zone 7,434,219 To 499,235
  1515.    Box 499,219 To 564,235 : Set Zone 8,499,219 To 564,235
  1516.    Box 564,219 To 629,235 : Set Zone 9,564,219 To 629,235
  1517.    If P=0 and KK>1 Then Locate 3,28 : Print "<=" : Box 15,219 To 44,235 : Set Zone 14,15,219 To 44,235
  1518.    If P=0 and ML<AF Then Locate 79,28 : Print "=>" : Box 629,219 To 658,235 : Set Zone 15,629,219 To 658,235
  1519.    NR1=NR
  1520.    If P=0 Then NR1=NR1-20
  1521.    PMCHECK:
  1522.    If SF=0 Then If Mouse Key=2 Then NRFADER[ANZ,NR1,B1,B2] : NR1=Param : Z=NR1-NR : Goto NEWEX
  1523.    IN=Mouse Zone
  1524.    MK= Extension_22_0080(IN,1,13)
  1525.    MK2= Extension_22_0080(IN,1,9)
  1526.    MK3= Extension_22_0080(IN,14,15)
  1527.    If P=1 Then If Mouse Key=1 and MK=1 Then Goto PMCH
  1528.    If Mouse Key=1 and MK2=1 Then Goto PMCH
  1529.    If P=0 Then If Mouse Key=1 and MK3=1 Then Goto PMCH2
  1530.    Goto PMCHECK
  1531.    NEWEX:
  1532.    If P=0 Then Z=Z+20
  1533.    Goto NEWEX2
  1534.    PMCH2:
  1535.    If IN=14 Then KK=KK-1 : If KK<1 Then KK=1 : Goto PMCHECK
  1536.    If IN=15 Then KK=KK+1 : If ML=AF Then KK=KK-1 : Goto PMCHECK
  1537.    Z=5033
  1538.    PMCH:
  1539.    If IN=1 Then Z=-3000
  1540.    If IN=2 Then Z=-100
  1541.    If IN=3 Then Z=-20
  1542.    If IN=4 Then Z=-1
  1543.    If IN=5 Then Z=5000
  1544.    If IN=6 Then Z=1
  1545.    If IN=7 Then Z=20
  1546.    If IN=8 Then Z=100
  1547.    If IN=9 Then Z=3000
  1548.    If IN=10 Then Z=5072
  1549.    If IN=11 Then Z=5076
  1550.    If IN=12 Then Z=5196
  1551.    If IN=13 Then Z=5068
  1552.    NEWEX2:
  1553.    Hide 
  1554. End Proc[Z]
  1555. Procedure POSITION[NR]
  1556.    Shared B1,B2
  1557.    Fix(6)
  1558.    VSX#=Screen Width-2
  1559.    VMX0#=B1 : VMX1#=B2+1
  1560.    VNR#=NR : VMX#=VMX1#-VMX0#
  1561.    If VNR#<1 Then VNR#=1
  1562.    VX#=VMX#/VNR# : VV#=VMX#/VX# : VV#=VMX#/VV#
  1563.    VY#=VSX#-(VSX#/VV#)+1 : VY#=VSX#-VY#
  1564.    If VNR#=1 Then Ink 0 : Bar 1,0 To VSX#,5
  1565.    Ink 3 : Box 0,0 To VSX#+1,5
  1566.    If VY#>VSX# Then VY#=VSX#
  1567.    X1=1 : X2=VY# : If X1=>X2 Then X2=X1+1
  1568.    Ink 2 : Bar X1,1 To X2,4
  1569.    Fix(16)
  1570. End Proc
  1571. Procedure NRFADER[ANZ,NR1,MX0,MX1]
  1572.    Fix(6)
  1573.    VSX#=Screen Width-2
  1574.    SX=Screen Width-1
  1575.    HOEHE=Screen Height
  1576.    Get Block 241,0,0,Screen Width,HOEHE
  1577.    Cls 1,0,219 To Screen Width,HOEHE
  1578.    VMX0#=MX0 : VMX1#=MX1+1
  1579.    VNR#=NR1 : VMX#=VMX1#-VMX0#
  1580.    VANZ#=ANZ
  1581.    VPROP#=VMX#/VANZ#
  1582.    VPROP#=VSX#/VPROP#/2
  1583.    If VPROP#<1 Then VPROP#=1
  1584.    If VPROP#>VSX# Then VPROP#=VSX#
  1585.    NR$=Str$(NR1) : NR$=Right$(NR$,Len(NR$)-1)
  1586.    VX#=VMX#/VNR# : VV#=VMX#/VX# : VV#=VMX#/VV#
  1587.    VY#=VSX#-(VSX#/VV#)+1 : VY#=VSX#-VY#
  1588.    VP#=VY# : If VP#>VSX#-(Len(NR$)*8) Then VP#=VSX#-(Len(NR$)*8)
  1589.    REG:
  1590.    Text 0,HOEHE-16,Space$(Screen Width/8)
  1591.    Text VP#,HOEHE-16,NR$
  1592.    Ink 0 : Bar 1,HOEHE-12 To VSX#,HOEHE-2
  1593.    Ink 3 : Box 0,HOEHE-13 To VSX#+1,HOEHE-1
  1594.    V1#=VY#-VPROP# : If V1#<1 Then V1#=1
  1595.    V2#=VY#+VPROP# : If V2#>VSX# Then V2#=VSX#
  1596.    PROP=VPROP# : PROP=PROP/2
  1597.    X1=V1# : X2=V2# : If X1=>X2 Then X2=X1+1
  1598.    X1=Min(SX-PROP,X1) : X1=Max(1,X1-PROP) : X2=Min(SX,X2+PROP) : X2=Max(2+PROP,X2)
  1599.    Ink 2 : Bar X1,HOEHE-12 To X2,HOEHE-1
  1600.    While Mouse Key=2 : Wend 
  1601.    UNREG:
  1602.    If Mouse Key=2 Then Goto FEX
  1603.    If Mouse Key<>1 Then Goto UNREG
  1604.    Y=X Screen(X Mouse)
  1605.    If Y Screen(Y Mouse)<HOEHE-12 or Y Screen(Y Mouse)>HOEHE-1 Then Goto UNREG
  1606.    If Y<1 or Y>Screen Width-1 Then Goto UNREG
  1607.    VY#=Y
  1608.    VP#=VY#
  1609.    VSX#=VSX#-2
  1610.    If VY#=VSX# Then NR2=MX1 : Goto UNRECH
  1611.    VX#=VSX#/VY# : VV#=VSX#/VX# : VV#=VSX#/VV#
  1612.    VNR#=VMX#-(VMX#/VV#)+1 : VNR#=VMX#-VNR#
  1613.    NR2=VNR#
  1614.    NR2=NR2+MX0
  1615.    If NR2<MX0 Then NR2=MX0
  1616.    If NR2>MX1 Then NR2=MX1
  1617.    UNRECH:
  1618.    NR$=Str$(NR2) : NR$=Right$(NR$,Len(NR$)-1)
  1619.    If VP#>VSX#-(Len(NR$)*8) Then VP#=VSX#-(Len(NR$)*8)
  1620.    VSX#=VSX#+2
  1621.    Goto REG
  1622.    FEX:
  1623.    If NR2=0 Then NR2=NR1
  1624.    Put Block 241,0,0
  1625.    Del Block 241
  1626.    Fix(16)
  1627. End Proc[NR2]
  1628. Procedure DRUGERMAN[S$,PRLEN,PRAB]
  1629.    If PRLEN=0 Then Goto EXDRU
  1630.    U=0
  1631.    If Len(S$)>=PRLEN Then Y=PRLEN
  1632.    If Len(S$)<PRLEN Then Y=Len(S$) : U=1
  1633.    P$=""
  1634.    For X=1 To Y
  1635.       P$=P$+Mid$(S$,X,1)
  1636.    Next 
  1637.    P$= Extension_22_006C(P$,"{",",")
  1638.    P$= Extension_22_006C(P$,Chr$(228),"{")
  1639.    P$= Extension_22_006C(P$,Chr$(246),"|")
  1640.    P$= Extension_22_006C(P$,Chr$(252),"}")
  1641.    P$= Extension_22_006C(P$,Chr$(223),"~")
  1642.    P$= Extension_22_006C(P$,Chr$(196),"[")
  1643.    P$= Extension_22_006C(P$,Chr$(214),"\")
  1644.    P$= Extension_22_006C(P$,Chr$(220),"]")
  1645.    Print #4,P$;
  1646.    If U=1 Then Print #4,Space$(PRLEN-Len(S$));
  1647.    If PRAB>0 Then Print #4,Space$(PRAB);
  1648.    EXDRU:
  1649. End Proc
  1650. Procedure REQUESTER[A$,B$,C$]
  1651.    Show 
  1652.    BREITE=Screen Width : HOEHE=Screen Height
  1653.    HALB=BREITE/2 : TBREITE=BREITE/8 : HBREIT=TBREITE/2
  1654.    A=Len(A$)*8+60
  1655.    B=Len(B$)*8+60
  1656.    C=Len(C$)*8+60
  1657.    LASTLENG=Max(A,B+C)
  1658.    Get Block 241,0,0,BREITE,HOEHE
  1659.    Ink 0 : Bar HALB-LASTLENG/2+5,HOEHE-41 To HALB+LASTLENG/2+5,HOEHE-6
  1660.    Ink 1 : Bar HALB-LASTLENG/2,HOEHE-46 To HALB+LASTLENG/2,HOEHE-11
  1661.    Ink 2 : Box HALB-LASTLENG/2,HOEHE-46 To HALB+LASTLENG/2,HOEHE-11
  1662.    Locate 1,27 : Centre A$
  1663.    X1=HALB-LASTLENG/2+20 : X2=HALB-LASTLENG/2+B-20
  1664.    X3=HALB+LASTLENG/2-C+20 : X4=HALB+LASTLENG/2-20
  1665.    Box X1,HOEHE-27 To X2,HOEHE-15
  1666.    Box X3,HOEHE-27 To X4,HOEHE-15
  1667.    X Mouse=X Hard(X1+(X2-X1)/2) : Y Mouse=Y Hard(HOEHE-22)
  1668.    Curs Off 
  1669.    Locate HBREIT-(LASTLENG-60)/16,29 : Print Zone$(B$,1)
  1670.    Locate HBREIT+(LASTLENG-60)/16-Len(C$),29 : Print Zone$(C$,2)
  1671.    REQUES1:
  1672.    IN=Mouse Zone
  1673.    If Mouse Key=1 Then If IN<>0 Then Goto REQUES2
  1674.    Goto REQUES1
  1675.    REQUES2:
  1676.    Put Block 241,0,0
  1677.    Del Block 241
  1678.    Hide 
  1679. End Proc[IN]
  1680. Procedure MELDUNG[A$]
  1681.    Show : Curs Off : Change Mouse 1
  1682.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1683.    B$=""
  1684.    IN=Instr(A$,Chr$(10))
  1685.    If IN Then B$=Mid$(A$,IN+1) : A$=Left$(A$,IN-1)
  1686.    X=Max(Len(B$),Len(A$))
  1687.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1688.    X=X*4+8
  1689.    Z=HOEHE-23 : If IN Then Z=HOEHE-31
  1690.    Get Block 241,0,0,BREITE,HOEHE
  1691.    Ink 0 : Bar Y-X+3,Z+3 To HALB+X+3,HOEHE-2
  1692.    Ink 1 : Bar Y-X,Z To HALB+X,HOEHE-5
  1693.    Ink 2 : Box Y-X,Z To HALB+X,HOEHE-5
  1694.    X=30 : If IN Then X=29
  1695.    Locate 1,X : Centre A$
  1696.    If IN Then Locate 1,30 : Centre B$
  1697.    Bell : Wait 50
  1698.    While Mouse Key<>1 : Wend 
  1699.    Put Block 241,0,0
  1700.    Del Block 241
  1701.    Hide 
  1702. End Proc
  1703. Procedure CHANGERGB
  1704.    Shared FC,BC
  1705.    NCOLS=Screen Colour
  1706.    Cls : Show 
  1707.    Dim RGB(4)
  1708.    Reserve Zone 40
  1709.    Ink 0,0
  1710.    Bar 13,8 To 217,112
  1711.    Ink FC,BC
  1712.    Bar 8,3 To 212,107
  1713.    Ink BC,FC
  1714.    Box 9,4 To 211,106
  1715.    Ink BC,FC
  1716.    A=0 : Repeat 
  1717.       Bar 15+A*20,6 To 30+A*20,104
  1718.       Set Zone A+1,15+A*20,6 To 30+A*20,104
  1719.       Inc A
  1720.    Until A=3
  1721.    A=0 : Repeat 
  1722.       Draw 10,6+A*6 To 75,6+A*6
  1723.       Inc A
  1724.    Until A=17
  1725.    A=0 : Repeat 
  1726.       Ink A,A : X=A mod 8 : Y=A/8
  1727.       Bar X*16+80,Y*16+8 To X*16+95,Y*16+23
  1728.       Set Zone A+4,X*16+80,Y*16+8 To X*16+95,Y*16+23
  1729.       RGB(A)=Colour(A)
  1730.    Inc A : Until A>=Min(32,NCOLS)
  1731.    Ink BC,FC
  1732.    Box 79,7 To 96+16*X,24+16*Y
  1733.    Box 80,75 To 140,85
  1734.    Text 91,83,"Reset"
  1735.    Box 152,75 To 202,85
  1736.    Text 162,83,"Save"
  1737.    Box 80,90 To 140,100
  1738.    Text 86,98,"Cancel"
  1739.    Box 152,90 To 202,100
  1740.    Text 165,98,"Use"
  1741.    Set Zone 39,152,75 To 202,85
  1742.    Set Zone 38,80,75 To 140,85
  1743.    Set Zone 36,80,90 To 140,100
  1744.    Set Zone 37,152,90 To 202,100
  1745.    Ink SELCOL
  1746.    Bar 195,58 To 201,67
  1747.    Ink BC : Box 194,57 To 202,68
  1748.    SFADERS[SELCOL]
  1749.    OK=0 : While OK=0
  1750.       While Mouse Key=0 : Wend : YM=Y Screen(Y Mouse) : Z=Mouse Zone
  1751.       If Extension_22_0080(Z,1,3)=1
  1752.          CFADERS[SELCOL,Z-1,YM]
  1753.          SFADERS[SELCOL]
  1754.       End If 
  1755.       If Extension_22_0080(Z,4,35)
  1756.          SELCOL=Z-4
  1757.          Ink SELCOL
  1758.          Bar 195,58 To 201,67
  1759.          SFADERS[SELCOL]
  1760.          Ink SELCOL
  1761.       End If 
  1762.       If Z=37
  1763.          OK=1
  1764.       End If 
  1765.       If Z=39
  1766.          Open Out 1,"df1:JDD.col"
  1767.          For X=0 To NCOLS-1
  1768.             Print #1,Colour(X)
  1769.          Next 
  1770.          Close 
  1771.          OK=1
  1772.       End If 
  1773.       If Z=36 Then Gosub RESET : OK=1
  1774.       If Z=38 Then Gosub RESET
  1775.    Wend 
  1776.    Pop Proc
  1777.    RESET:
  1778.    A=0 : Repeat 
  1779.       Colour A,RGB(A) : SPCOL[A,RGB(A)]
  1780.    Inc A : Until A>=Min(32,NCOLS)
  1781.    Return 
  1782. End Proc
  1783. Procedure CFADERS[S,F,YM]
  1784.    Dim R(2)
  1785.    C=Colour(S)
  1786.    R(0)=C/256
  1787.    R(1)=(C/16) mod 16
  1788.    R(2)=C mod 16
  1789.    V=Max(0,Min(15,15-(YM-7)/6))
  1790.    R(F)=V
  1791.    Colour S,(R(0)*256+R(1)*16+R(2))
  1792.    SPCOL[S,Colour(S)]
  1793. End Proc
  1794. Procedure SFADERS[S]
  1795.    Shared RGBO,BC,FC
  1796.    Dim R(2)
  1797.    C=RGBO
  1798.    R(0)=C/256
  1799.    R(1)=(C/16) mod 16
  1800.    R(2)=C mod 16
  1801.    Ink BC,BC
  1802.    A=0 : Repeat 
  1803.       V=(15-R(A))*6 : Bar 17+20*A,7+V To 28+20*A,12+V
  1804.       Inc A
  1805.    Until A=3
  1806.    C=Colour(S)
  1807.    RGBO=C
  1808.    R(0)=C/256
  1809.    R(1)=(C/16) mod 16
  1810.    R(2)=C mod 16
  1811.    Ink BC,FC
  1812.    Text 80,66,"Col"+Right$(" "+Str$(S),2)+" Val:$"+Right$("000"+Mid$(Hex$(RGBO),2),3)
  1813.    Ink FC,FC
  1814.    A=0 : Repeat 
  1815.       Ink FC,FC
  1816.       V=(15-R(A))*6 : Box 17+20*A,7+V To 28+20*A,12+V
  1817.       Ink S
  1818.       Bar 18+20*A,8+V To 27+20*A,11+V
  1819.       Inc A
  1820.    Until A=3
  1821. End Proc
  1822. Procedure SPCOL[A,B]
  1823.    If Length(1)>0
  1824.       Doke Start(1)+2+8*Length(1)+2*A,B
  1825.    End If 
  1826. End Proc
  1827. Procedure INVERS[LL]
  1828.    XC=X Curs : YC=Y Curs
  1829.    Inverse On 
  1830.    Print Space$(LL)
  1831.    Locate XC,YC
  1832.    Inverse Off 
  1833. End Proc
  1834. Procedure SET_COL
  1835.    If Exist("devs:JDD.col")
  1836.       Open In 1,"devs:JDD.col"
  1837.       For X=0 To 3
  1838.          Input #1,FW
  1839.          Colour X,FW
  1840.       Next 
  1841.       Close 1
  1842.    End If 
  1843. End Proc
  1844. Procedure TITEL
  1845.    Cls 1
  1846.    Locate 1,24 : Centre "Dieses Programm wurde in  A M O S  geschrieben"
  1847.    C=2
  1848.    WA2:
  1849.    If K=1 Then Goto RES
  1850.    If C=1 Then C=0
  1851.    If C<0 Then C=1 : K=1
  1852.    Ink C
  1853.    Pen C
  1854.    Locate 1,9
  1855.    Centre "Datei-Verwaltung" : Print : Print 
  1856.    Centre "(C) 19xx" : Print 
  1857.    Centre "C16-Version 1985" : Print 
  1858.    Centre "Amiga-Version 1991" : Print 
  1859.    Centre "J�rg  Dommermuth"
  1860.    X1=242 : X2=429
  1861.    Y1=70 : Y2=120
  1862.    Polyline X1,83 To X2,83
  1863.    WA:
  1864.    Wait 5
  1865.    Box X1,Y1 To X2,Y2
  1866.    X1=X1-10 : X2=X2+10
  1867.    Y1=Y1-5 : Y2=Y2+5
  1868.    If Y1=25 Then C=C-1 : Goto WA2
  1869.    Goto WA
  1870.    RES:
  1871.    Pen 2 : Ink 2
  1872. End Proc
  1873. Procedure WORKING
  1874.    Curs Off 
  1875.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1876.    A$="Ich arbeite..."
  1877.    X=Len(A$)
  1878.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1879.    X=X*4+8
  1880.    Ink 0 : Bar Y-X+3,HOEHE-20 To HALB+X+3,HOEHE-2
  1881.    Ink 1 : Bar Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1882.    Ink 2 : Box Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1883.    Locate 1,30 : Centre A$
  1884. End Proc
  1885. Procedure WORKOFF
  1886.    Curs Off 
  1887.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1888.    A$="   Fertig...  "
  1889.    X=Len(A$)
  1890.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1891.    X=X*4+8
  1892.    Ink 0 : Bar Y-X+3,HOEHE-20 To HALB+X+3,HOEHE-2
  1893.    Ink 1 : Bar Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1894.    Ink 2 : Box Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1895.    Locate 1,30 : Centre A$
  1896. End Proc
  1897. Procedure FILE_COPY[SOURCE$,DEST$]
  1898.    Shared MX,AF
  1899.    FIND_LENGTH[SOURCE$]
  1900.    FILE_LENGTH=Param
  1901.    LONG_FILE_COPY[SOURCE$,DEST$,FILE_LENGTH]
  1902. End Proc
  1903. Procedure FIND_LENGTH[SOURCE$]
  1904.    Open In 1,SOURCE$
  1905.    L=Lof(1)
  1906.    Close 
  1907. End Proc[L]
  1908. Procedure LONG_FILE_COPY[SOURCE$,DEST$,L]
  1909.    Shared MX,AF
  1910.    Open In 1,SOURCE$
  1911.    Open Out 2,DEST$
  1912.       MX=0 : KOMMA=0 : AF=1
  1913.       For X=1 To L
  1914.          T$=""
  1915.          T$=Input$(1,1)
  1916.          If T$=Chr$(34) Then If KOMMA=0 Then KOMMA=1 : Goto SKIP
  1917.          If T$=Chr$(34) Then If KOMMA=1 Then KOMMA=0
  1918.          SKIP:
  1919.          If KOMMA=1 Then If T$="," Then T$="{"
  1920.          If KOMMA=0 Then If T$="," Then T$="|" : AF=AF+1
  1921.          If T$=Chr$(34) Then T$=""
  1922.          If T$=Chr$(13) Then T$="|"+Chr$(13)+Chr$(10) : MX=MX+1 : BF=AF : AF=1
  1923.          If T$<>"" Then Print #2,T$;
  1924.       Next 
  1925.    Close 
  1926.    AF=BF
  1927. End Proc
  1928. Procedure AUTOSAVE
  1929.    Shared AKT
  1930.    If AKT=0 Then Timer=0
  1931.    If Timer<45000 Then Pop Proc
  1932.    MELDUNG["Es sind 15 Minuten vergangen!"+Chr$(10)+"Bitte Datei speichern!"]
  1933. End Proc
  1934. Procedure SET_TIME
  1935.    TM$= Extension_22_004C 
  1936.    UHR2:
  1937.    Cls 1 : Locate 23,5 : Print "Bitte Datum eingeben! ("+TM$+")"
  1938.    Locate 34,7 : Clear Key : Input Z$ : Curs Off 
  1939.    Z$= Extension_22_00E8(Z$)
  1940.    If Z$="" Then Locate 36,7 : Print TM$
  1941.    P= Extension_22_005A(Z$,".") : If P<>2 Then Pop Proc
  1942.    P= Extension_22_0080(Len(Z$),6,10) : If P=0 Then Pop Proc
  1943.    If Instr(Right$(Z$,4),".")=0 Then Z$=Left$(Z$,Len(Z$)-4)+Right$(Z$,2)
  1944.     Extension_22_002C(Z$)
  1945. End Proc