home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / baspcx / pbpcx.bas < prev    next >
Encoding:
BASIC Source File  |  1992-02-19  |  6.4 KB  |  165 lines
  1. '* -------------------------------------------------- *
  2. '*                     PBPCX.BAS                      *
  3. '*         (C) 1991 Andreas Maslo & DMV-Verlag        *
  4. '*             Sprache: Power-Basic 2.xx              *
  5. '*            Funktion: PCX-Lader für VGA             *
  6. '* -------------------------------------------------- *
  7.  
  8. '* Compilerschalter
  9. $STACK    32766           '* Maximaler Stack
  10. $COMPILE  EXE             '* EXE-Programm
  11. $LIB      GRAPH           '* Grafikbibliothek einbinden
  12. $LIB      FULLFLOAT       '* Fließkommaarithmetik einb.
  13. $FLOAT    PROCEDURE       '* schnelle Fließkommaarith.
  14. $LIB COM  OFF             '* keine serielle Unterst.
  15. $LIB LPT  OFF             '* keine Druckerunterst.
  16. $LIB VGA  ON              '* VGA-Grafik
  17. $LIB HERC OFF             '* keine Herculesgrafik
  18. $OPTION   CNTLBREAK OFF   '* Crt-Break abschalten
  19. $OPTION   AUTODIM OFF     '* kein ARRAY-AUTODIM
  20. $EVENT    ON              '* ON ERROR ...
  21. $CPU      8086            '* alle Maschinen
  22. $ERROR    ALL OFF         '* keine Fehlerroutinen
  23.  
  24. '* Hauptprogramm
  25.  
  26. CLS
  27. ON ERROR GOTO ErrorHandling    '* Fehlerbehandlung
  28. Datei$ = COMMAND$              '* Dateiname = Parameter
  29. IF Datei$ = "" THEN            '* Parameter vorhanden?
  30.   ERROR 1                      '* falls nicht, Fehler!
  31. END IF
  32.  Datei$ = UCASE$(Datei$)
  33. IF RIGHT$(Datei$, 4) <> ".PCX" THEN
  34.   '* Suffix angegeben?
  35.   Datei$ = Datei$ + ".PCX"
  36.   '* falls nicht, ergänzen!
  37. END IF
  38. CALL LoadPCX (Datei$)       '* Datei laden und anzeigen
  39. BEEP
  40. WHILE INKEY$ = "": WEND     '* auf Taste warten
  41. END                         '* Programm beenden
  42.  
  43. ErrorHandling:
  44.   PRINT "Datei kann nicht ausgegeben werden..."
  45.   PRINT "Programmaufruf: PCX Datei <─┘"
  46.   END
  47. RESUME
  48.  
  49. SUB ClosePCX                     '* Datei schließen
  50.   SHARED PCXNr                   '* globale Dateinummer
  51.   CLOSE #PCXNr
  52. END SUB
  53.  
  54. FUNCTION Combine% (FirstByte$, SecondByte$)
  55.   '* Speicherwort aus
  56.   First% = ASC(FirstByte$)
  57.   '* zwei Bytes generieren
  58.   Second% = ASC(SecondByte$)
  59.   Combine% = INT(First% + Second% * 256)
  60. END FUNCTION
  61.  
  62. SUB LoadPCX (Datei$)    '* PCX-Datei laden und anzeigen
  63.   SHARED PCXNr          '* globale Variablen im Modul
  64.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  65.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  66.   SCREEN 12                  '* 640x480 Pixel
  67.   CALL OpenPCX (Datei$)      '* Datei öffnen
  68.   CALL PCXInit               '* Kopfinformationen lesen
  69.   OUT &H3CE, 5
  70.   OUT &H3CF, 0
  71.   OUT &H3CE, 1
  72.   OUT &H3CF, 0
  73.   DEF SEG = &HA000          '* Segment der Grafikkarte
  74.   Zeile$ = SPACE$(BpL%)  '* Länge einer Bildschirmzeile
  75.   FOR K% = 0 TO y2% - y1%   '* Einzelne Bildschirmzeile
  76.     FOR J% = 0 TO Ebenen% - 1   '* Ebenen innerhalb der
  77.                                 '* Bildschirmzeile
  78.       Zeile$ = RIGHT$(Zeile$, LEN(Zeile$) - BpL%)
  79.       I% = 0                    '* Informationen
  80.       WHILE NOT I% >= BpL%      '* Information für die
  81.                                 '* Zeile ausreichend
  82.         GET$ #PCXNr,1 , Byte$   '* Byte lesen (String)
  83.         Byte% = ASC(Byte$)      '* Byte in ASCII-Wert
  84.                                 '* konvertieren
  85.         IF Byte% \ (2 ^ 6) = 3 THEN
  86.            '* obere 2 Bits gesetzt?
  87.            Zaehler% = Byte% XOR &HC0
  88.            '* 6 untere Bits ergeben Zaehler%
  89.            GET$ #PCXNr,1 , Byte$
  90.            '* Bildinformation
  91.            FOR a% = 1 TO Zaehler%
  92.              '* dekomprimieren
  93.              Zeile$ = Zeile$ + Byte$
  94.              '* ersetzt Byte$ f.BildInfo$
  95.            NEXT a%
  96.         ELSE         '* keine Dekomprimierung notwendig
  97.           Zaehler% = 1         '* einmalige Information
  98.           Zeile$ = Zeile$ + Byte$          '* BildInfo$
  99.         END IF
  100.         I% = LEN(Zeile$) '* Gesamtlänge der Information
  101.       WEND
  102.       OUT &H3C4, 2
  103.       OUT &H3C5, 1 * (2 ^ J%)       '* Ebene umschalten
  104.       Adr = K% * 80     '* Startadresse linker Rand und
  105.       POKE$ Adr, Zeile$ '* Zeile in Bildschirmspeicher
  106.      NEXT J%
  107.   NEXT K%
  108.   CALL ClosePCX         '* Datei schließen
  109.   DEF SEG               '* Umschaltung BASIC-Segment
  110. END SUB
  111.  
  112. SUB OpenPCX (Datei$)    '* PCX-Datei öffnen
  113.   SHARED PCXNr          '* globale Dateinummer
  114.   PCXNr = FREEFILE      '* freie Dateinummer verwenden
  115.   OPEN Datei$ FOR BINARY AS #PCXNr
  116.                         '* Datei binär öffnen
  117. END SUB
  118.  
  119. FUNCTION PCXHeader$           '* PCX-Header lesen
  120.   SHARED PCXNr                '* globale Dateinummer
  121.   IF LOF(PCXNr) >= 128 THEN   '*Dateilänge ausreichend?
  122.     GET$ #PCXNr,128 , Header$ '* Kopf lesen, 128 Bytes
  123.     PCXHeader$ = Header$      '* Zuweisung
  124.   END IF
  125. END FUNCTION
  126.  
  127. SUB PCXInit                     '* Dateikopf auswerten
  128.   SHARED ID%, Ver%, Komp%, Bits%, x1%, y1%, x2%, y2%
  129.                                 '* im Modul global
  130.   SHARED AX%, ay%, Pal$, Reserve%, Ebenen%, BpL%, Pal%
  131.   Header$ = PCXHeader$          '* binäre Informationen
  132.   ID% = ASC(LEFT$(Header$, 1))
  133.                          '* Identifikation=10, 1 Byte
  134.   Ver% = ASC(MID$(Header$, 2, 1))
  135.                          '* Versionnummer, 1 Byte
  136.   Komp% = ASC(MID$(Header$, 3, 1))
  137.                          '* Komprimierungsart=1, 1 Byte
  138.   Bits% = ASC(MID$(Header$, 4, 1))
  139.                           '* Bits pro Bildpunkt, 1 Byte
  140.   x1% = Combine%(MID$(Header$, 5, 1), _
  141.     MID$(Header$, 6, 1))   '* linke obere Ecke, 2 Bytes
  142.   y1% = Combine%(MID$(Header$, 7, 1), _
  143.     MID$(Header$, 8, 1))   '* linke obere Ecke, 2 Bytes
  144.   x2% = Combine%(MID$(Header$, 9, 1), _
  145.     MID$(Header$, 10, 1))  '* rechte unt. Ecke, 2 Bytes
  146.   y2% = Combine%(MID$(Header$, 11, 1), _
  147.     MID$(Header$, 12, 1))  '* rechte unt. Ecke, 2 Bytes
  148.   AX% = Combine%(MID$(Header$, 13, 1), _
  149.     MID$(Header$, 14, 1))   '* horiz. Auflösung 2 Bytes
  150.   ay% = Combine%(MID$(Header$, 15, 1), _
  151.     MID$(Header$, 16, 1))    '* vert. Auflösung 2 Bytes
  152.   Pal$ = MID$(Header$, 17, 48)    '* Palette je 3 Bytes
  153.   Reserve% = ASC(MID$(Header$, 65, 1))       '* Reserve
  154.   Ebenen% = ASC(MID$(Header$, 66, 1))
  155.                                '* Anzahl der Farbebenen
  156.   BpL% = Combine%(MID$(Header$, 67, 1), _
  157.     MID$(Header$, 68, 1)) '* Anzahl Bytes/Zeile, 2 Byte
  158.   Pal% = Combine%(MID$(Header$, 69, 1), _
  159.     MID$(Header$, 70, 1))            '* Art der Palette
  160.   Rest$ = RIGHT$(Header$, 58)              '* unbenutzt
  161. END SUB
  162.  
  163. '* -------------------------------------------------- *
  164. '*                 Ende von PBPCX.BAS                 *
  165.