home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / baspcx / hlpcx.bas next >
Encoding:
BASIC Source File  |  1991-12-17  |  7.9 KB  |  215 lines
  1. '* -------------------------------------------------- *
  2. '*                   HLPCX.BAS                        *
  3. '*         (C) 1991 A. Maslo & DMV-Verlag             *
  4. '*               Sprache: Quick Basic                 *
  5. '*       Funktion: PCX-Lader für VGA, 640x480         *
  6. '*                 monochrome Fassung                 *
  7. '* -------------------------------------------------- *
  8. DECLARE FUNCTION FILL$ (Binaer$)
  9. DECLARE FUNCTION BIN$ (Zahl%)
  10. DECLARE FUNCTION DEZ& (Binaer$)
  11. DECLARE FUNCTION LFILL$ (Binaer$, Char$, n%)
  12. DECLARE FUNCTION Combine% (FirstByte$, SecondByte$)
  13. DECLARE SUB LoadPCX (Datei$)
  14. DECLARE SUB ClosePCX ()
  15. DECLARE SUB OpenPCX (Datei$)
  16. DECLARE FUNCTION PCXHeader$ ()
  17. DECLARE SUB PCXInit ()
  18.  
  19. ON ERROR GOTO Errorhandling   '* Fehlerverfolgung
  20. CLS                           '* Bildschirm löschen
  21. LoadPCX "TEST.PCX"            '* monochrome PCX-Datei
  22. WHILE INKEY$ = "": WEND       '* Warten auf Tastendruck
  23. END                           '* Programm beenden
  24.  
  25. Errorhandling:          '* Sprungmarke Fehlerbehandlung
  26.  SCREEN 0               '* Textbildschirm
  27.  IF ERR = 1 THEN        '* Fehler aus LoadPCX
  28.    PRINT "Die Zeichnung beinhaltet mehrere Farbenenen!"
  29.    PRINT "Eine Ausgabe ist mit diesem Programm nicht"
  30.    PRINT "möglich!"
  31.  ELSE
  32.    PRINT "Dateiausgabe nicht möglich..."
  33.                         '* Datei fehlt oder ist defekt!
  34.   END IF
  35.   END                   '* Programm abbrechen, wenn ein
  36. RESUME                  '* Fehler aufgetreten ist...
  37.     
  38.  
  39. FUNCTION BIN$ (Zahl%)   '* Integer in Binärstring
  40.                         '* umwandeln
  41.   Zahl% = ABS(Zahl%)
  42.   BIN$ = ""             '* Leerstring
  43.   x% = -1               '* Variable auf -1 setzen
  44.   WHILE Dummy& <= Zahl% '* höchstmöglichen Exponent
  45.                         '* ermitteln
  46.     x% = x% + 1         '* 1. Schleifenwert für x%=0
  47.     Dummy& = 1 * 2 ^ x% '* Berechnungsformel
  48.   WEND                  '* Ende While-Schleife
  49.   Max% = x% - 1         '* höchster Exponent (Schleife
  50.                         '* wird 1x zuviel durchlaufen)
  51.   Rest% = Zahl%         '* Mit Kopie der Eingabezahl
  52.                         '* weiterarbeiten
  53.   FOR Y% = Max% TO 0 STEP -1
  54.   '* zum Stringaufbau von links nach rechts
  55.     Rest% = Rest% - (1 * 2 ^ Y%)
  56.     '* Rest für nächsten Exponenten
  57.     IF Rest% >= 0 THEN Erg$ = "1"
  58.     '* Interpretation wann 0 oder 1
  59.     IF Rest% < 0 THEN
  60.        Rest% = Rest% + (1 * 2 ^ Y%)
  61.        Erg$ = "0"
  62.     END IF
  63.     Ergebnis$ = Ergebnis$ + Erg$
  64.     '* Binärstring aufbauen
  65.   NEXT Y%               '* nächster Exponent
  66.   IF Ergebnis$ = "" THEN Ergebnis$ = "0"
  67.   '* falls String leer, Nullstring ausgeben
  68.   BIN$ = Ergebnis$
  69.   '* String an Funktion übergeben
  70. END FUNCTION
  71.  
  72. SUB ClosePCX                     '* Datei schließen
  73.   SHARED PCXNr                   '* globale Dateinummer
  74.   CLOSE #PCXNr
  75. END SUB
  76.  
  77. FUNCTION Combine% (FirstByte$, SecondByte$)
  78.   '* Speicherwort generieren
  79.   First% = ASC(FirstByte$)
  80.   Second% = ASC(SecondByte$)
  81.   Combine% = INT(First% + Second% * 256)
  82. END FUNCTION
  83.  
  84. FUNCTION DEZ& (Binaer$)   '* Binärstring in Dezimalzahl
  85.   MaxLen% = LEN(Binaer$)  '* konvertieren
  86.   Dezimal% = 0
  87.   FOR x% = 1 TO MaxLen%
  88.     B% = VAL(MID$(Binaer$, x%, 1))
  89.     Dezimal& = Dezimal& + B% * 2 ^ (MaxLen% - x%)
  90.   NEXT x%
  91.   DEZ& = Dezimal&
  92. END FUNCTION
  93.  
  94. FUNCTION FILL$ (Binaer$)
  95. '* Binärstring auf 8 Zeichen auffüllen
  96.    Laenge% = LEN(Binaer$)   '* Ist-Länge ermitteln
  97.    Fehl% = 8 - Laenge%      '* Fehlende Zahl an Zeichen
  98.    FILL$ = STRING$(Fehl%, "0") + Binaer$
  99.                             '* Ergebnisstring aufbauen
  100. END FUNCTION
  101.  
  102. SUB LoadPCX (Datei$)      '* PCX-Datei laden
  103.   SHARED PCXNr            '* im Modul globale Variablen
  104.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  105.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  106.   SCREEN 12               '* 640x480 Pixel
  107.   OpenPCX Datei$          '* Datei öffnen
  108.   PCXInit                 '* Headervariablen zuweisen
  109.   IF Ebenen% > 1 THEN
  110.                       '* falls mehrere Ebenen=Farbmodus
  111.     ERROR 1           '* Programm beenden!
  112.   END IF
  113.   BildBreite% = x2% - x1% + 1 '* Bildbreite
  114.   Byte$ = SPACE$(1)           '* Informationseinheit
  115.   Zeile$ = SPACE$(BildBreite%)
  116.                             '* Bildschirmzeilenbreite
  117.   FOR K% = 0 TO y2% - y1%   '* Einzelne Bildschirmzeile
  118.     Zeile$ = RIGHT$(Zeile$, LEN(Zeile$) - BildBreite%)
  119.     I% = 0                  '* Information
  120.     WHILE NOT I% >= BildBreite%
  121.       '* Zeileninformation vollständig?
  122.       GET #PCXNr, , Byte$        '* Byte lesen
  123.       Byte% = ASC(Byte$)         '* ASCII-Code des Byte
  124.       BByte$ = FILL$(BIN$(Byte%)) '* binär kodieren
  125.       IF LEFT$(BByte$, 2) = "11" THEN
  126.                                 '* obere 2 Bits gesetzt
  127.         BinByte$ = BIN$(Byte%)  '* Zähler aus rest-
  128.                                 '* lichen 6 Bits
  129.         Zaehler% = DEZ&(RIGHT$(BinByte$, 6))
  130.         GET #PCXNr, , Byte$
  131.         '* Bildinformation im nächsten Byte
  132.         BildInfo$ = FILL$(RIGHT$(BIN$(ASC(Byte$)), 8))
  133.         FOR a% = 1 TO Zaehler%
  134.           Zeile$ = Zeile$ + BildInfo$
  135.           '* Binärstring für einzelne Bild-
  136.           '* schirmzeile aufbauen
  137.         NEXT a%
  138.       ELSE
  139.         Zaehler% = 1   '* einmalige Information
  140.         BinByte$ = FILL$(BIN$(Byte%))
  141.                        '* binär umkodieren
  142.         BildInfo$ = RIGHT$(BinByte$, 8)
  143.         Zeile$ = Zeile$ + BildInfo$
  144.                        '* Information der Zeile anfügen
  145.       END IF
  146.       I% = LEN(Zeile$) '* Informationslänge
  147.     WEND
  148.     FOR Z% = 1 TO BildBreite% - 1 STEP 1
  149.                        '* Farbe aus String ermitteln
  150.       IF DEZ&(MID$(Zeile$, Z%, 1)) = 1 THEN
  151.         FARBE% = 0
  152.       ELSE
  153.         FARBE% = 7
  154.       END IF
  155.       PSET (Z%, K%), FARBE% '* Punkt setzen, evtl. hier
  156.     NEXT Z%                 '* die Farben ändern
  157.   NEXT K%
  158.   ClosePCX                  '* Datei schließen
  159. END SUB
  160.  
  161. SUB OpenPCX (Datei$)             '* Datei öffnen
  162.   SHARED PCXNr                   '* globale Dateinummer
  163.   PCXNr = FREEFILE               '* freie Dateinummer
  164.   OPEN Datei$ FOR BINARY AS #PCXNr '* binär öffnen
  165. END SUB
  166.  
  167. FUNCTION PCXHeader$              '* PCX-Dateikopf lesen
  168.   SHARED PCXNr                   '* (128 Byte Länge)
  169.   Header$ = SPACE$(128)
  170.   IF LOF(PCXNr) >= 128 THEN
  171.     GET #PCXNr, , Header$
  172.     PCXHeader$ = Header$
  173.   END IF
  174. END FUNCTION
  175.  
  176. SUB PCXInit
  177.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  178.   '* im Modul global
  179.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  180.   Header$ = PCXHeader$          '* binäre Informationen
  181.   ID% = ASC(LEFT$(Header$, 1))
  182.   '* Identifikation=10, 1 Byte
  183.   Ver% = ASC(MID$(Header$, 2, 1))
  184.   '* Versionnummer, 1 Byte
  185.   Komp% = ASC(MID$(Header$, 3, 1))
  186.   '* Komprimierungsart=1, 1 Byte
  187.   Bits% = ASC(MID$(Header$, 4, 1))
  188.   '* Bits pro Bildpunkt, 1 Byte
  189.   x1% = Combine%(MID$(Header$, 5, 1), _
  190.    MID$(Header$, 6, 1))  '* linke obere Ecke, 2 Bytes
  191.   y1% = Combine%(MID$(Header$, 7, 1), _
  192.    MID$(Header$, 8, 1))  '* linke obere Ecke, 2 Bytes
  193.   x2% = Combine%(MID$(Header$, 9, 1), _
  194.    MID$(Header$, 10, 1)) '* rechte untere Ecke, 2 Bytes
  195.   y2% = Combine%(MID$(Header$, 11, 1), _
  196.    MID$(Header$, 12, 1)) '* rechte untere Ecke, 2 Bytes
  197.   AX% = Combine%(MID$(Header$, 13, 1), _
  198.    MID$(Header$, 14, 1))      '* hor. Auflösung 2 Bytes
  199.   ay% = Combine%(MID$(Header$, 15, 1), _
  200.    MID$(Header$, 16, 1))      '* ver. Auflösung 2 Bytes
  201.   Pal$ = MID$(Header$, 17, 48)
  202.   '* Palette jeweils 3 Byte
  203.   Reserve% = ASC(MID$(Header$, 65, 1))   '* Reserve
  204.   Ebenen% = ASC(MID$(Header$, 66, 1))
  205.   '* Anzahl der Farbebenen
  206.   BpL% = Combine%(MID$(Header$, 67, 1), _
  207.    MID$(Header$, 68, 1)) '* Anzahl Bytes/Zeile, 2 Byte
  208.   Pal% = Combine%(MID$(Header$, 69, 1), _
  209.    MID$(Header$, 70, 1))        '* Art der Palette
  210.   Rest$ = RIGHT$(Header$, 58)   '* unbenutzt
  211. END SUB
  212.  
  213. '* -------------------------------------------------- *
  214. '*                Ende von HLPCX.BAS                  *
  215.