home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / inline.bas < prev    next >
BASIC Source File  |  1989-10-10  |  3KB  |  116 lines
  1. '* ------------------------------------------------------- *
  2. '*                       INLINE.BAS                        *
  3. '*      Utility zum Erzeugen einer INLINE - Prozedur       *
  4. '*           (C) 1989 H. Stellbrink & TOOLBOX              *
  5. '* ------------------------------------------------------- *
  6. SUB Monitor (Farbe%)                        '* Farbmonitor ?
  7. LOCAL Modus%
  8.   DEF SEG = 0
  9.   Modus% = (PEEK (&H410) AND 48) / 16
  10.   DEF SEG
  11.   SELECT CASE Modus%
  12.     CASE 1 : Farbe% = -1
  13.     CASE 2 : Farbe% = -1
  14.     CASE 3 : Farbe% = 0
  15.   END SELECT
  16. END SUB
  17.  
  18. SUB Taste (z$)                              '* Tastenabfrage
  19.   IF z$ = "" THEN z$ = "Weiter mit einer Taste"
  20.   PRINT
  21.   PRINT z$
  22.   z$ = INPUT$(1)
  23. END SUB
  24.  
  25. SUB Bild (Farbe%)
  26.   IF Farbe% THEN COLOR 14,1 ELSE COLOR 0,7
  27.   PRINT "┌"+STRING$(77,"─")+"┐"
  28.   PRINT "│";TAB(10);"I N L I N E  -  P R O Z E D U R";
  29.   PRINT "  -  E R Z E U G U N G";TAB(79);"│"
  30.   PRINT "└"+STRING$(71,"─")+" H.St.┘"
  31.   IF Farbe% THEN COLOR 14,0 ELSE COLOR 7,0
  32. END SUB
  33.  
  34. SUB Eingabe (BinDatei$, SubName$)
  35.   LOCATE 5,1
  36.   PRINT "Bitte geben Sie die vollständige Datei"+_
  37.         "bezeichnung der binären Quelldatei ein."
  38.   PRINT
  39.   INPUT BinDatei$
  40.   PRINT
  41.   PRINT "Wie soll die INLINE - Prozedur heißen ?"
  42.   PRINT
  43.   INPUT SubName$
  44. END SUB
  45.  
  46. '* ------------------------------------------------------- *
  47. TextDatei$ = "INLINE.TXT"      '* Name der Ausgabe-Datei
  48. ProZeile%  = 10                '* Anzahl der Codes pro Zeile
  49.  
  50. CLS
  51. ON ERROR GOTO Fehler
  52. CALL Monitor (Farbe%)          '* Klärt, ob Farbmonitor
  53. CALL Bild (Farbe%)             '* Kopfbild
  54. CALL Eingabe (BinDatei$, SubName$)
  55.  
  56. OPEN BinDatei$ FOR INPUT AS #1    '* Datei vorhanden ?
  57. CLOSE
  58. OPEN TextDatei$ FOR OUTPUT AS #1
  59. OPEN BinDatei$ FOR BINARY AS #2
  60.  
  61. CLS
  62. PRINT "Bearbeitet wird ";UCASE$(BinDatei$)
  63. PRINT
  64. PRINT #1, "SUB ";SubName$;" INLINE"
  65. PRINT "SUB ";SubName$;" INLINE"
  66. DO
  67.   IF EOF(2) THEN EXIT LOOP
  68.   PRINT #1, "  $INLINE ";
  69.   PRINT "  $INLINE ";
  70.   FOR i% = 1 TO ProZeile%
  71.     IF EOF(2) THEN EXIT LOOP
  72.     GET$ #2, 1, b$
  73.     b$ = STR$ (ASC (b$))
  74.     b$ = RIGHT$ ("    "+b$, 4)
  75.     PRINT b$;
  76.     PRINT #1, b$;
  77.     IF i% <> ProZeile% AND NOT EOF(2) THEN
  78.       PRINT #1, ",";
  79.       PRINT ",";
  80.     ELSE
  81.       PRINT
  82.       PRINT #1,
  83.     END IF
  84.   NEXT i%
  85. LOOP
  86. PRINT "END SUB"
  87. PRINT #1,"END SUB"
  88. CLOSE
  89. PRINT
  90. PRINT "Diese Prozedur finden Sie in der Datei "; TextDatei$
  91. CALL Taste ("")
  92. COLOR 7,0
  93. END
  94.  
  95. '* ------------------------------------------------------- *
  96. Fehler:
  97. BEEP
  98. CLOSE
  99. PRINT
  100. SELECT CASE err
  101. CASE 53, 61, 64, 70, 71, 72, 75, 76
  102.   PRINT "Fehler beim Zugriff auf Datenträger"
  103. CASE ELSE
  104.   PRINT "F E H L E R.............."
  105.   PRINT
  106.   PRINT "Nummer    ";ERR
  107.   PRINT "Adresse   ";ERADR
  108. END SELECT
  109. RESUME FehlerEnde
  110. FehlerEnde:
  111. CALL Taste ("")
  112. COLOR 7,0
  113. END
  114. '* ------------------------------------------------------- *
  115. '*                  Ende von INLINE.BAS                    *
  116.