home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tools / basic / show.bas < prev    next >
Encoding:
BASIC Source File  |  1991-10-14  |  6.7 KB  |  282 lines
  1. '***********************************************************
  2. '                        SHOW.BAS
  3. '          Copyright (C) Kay Glahn & DMV-Verlag
  4. ' Programm zum Darstellen von Icons und kleinen Bitmaps
  5. '            auf einer beliebigen Grafikkarte 
  6. '                Compiler:  Quick Basic 4.5
  7. '***********************************************************
  8.  
  9. DECLARE SUB GetGraf (mode%)
  10. DECLARE FUNCTION bestvideo% ()
  11. DECLARE SUB ReadPixel (Pixel() AS LONG, Farbe() AS INTEGER, BitProPix%, Begin&, Grose&)
  12. DEFINT A-Z
  13. ON ERROR GOTO Errorhandler
  14. TYPE video
  15.   maxx AS INTEGER
  16.   maxy AS INTEGER
  17.   maxh AS INTEGER
  18.   maxv AS INTEGER
  19.   Maxcolor AS INTEGER
  20. END TYPE
  21. DIM graf AS video
  22. DIM Farbe(0 TO 15) AS INTEGER
  23. DIM Kenn AS STRING * 2
  24. Datei$ = COMMAND$
  25. PRINT "Icon- und Bitmap-Betrachter (C) 1991 Kay Glahn & DMV-Verlag"
  26. PRINT
  27. IF Datei$ = "" THEN
  28.   INPUT "Anzuzeigende Datei : ", Datei$
  29. ELSE
  30.   SLEEP 3
  31. END IF
  32. OPEN Datei$ FOR BINARY AS #1
  33. IF LOF(1) = 0 THEN
  34.   CLOSE
  35.   KILL Datei$
  36.   PRINT "Die Datei "; Datei$; " existiert nicht !"
  37.   END
  38. END IF
  39. GET #1, 1, Kenn
  40. GET #1, 3, Art%
  41. GET #1, 5, Anzahl%
  42. Endung$ = UCASE$(MID$(Datei$, INSTR(Datei$, ".") + 1, 3))
  43. IF Endung$ = "BMP" AND Kenn = "BM" THEN
  44.   GET #1, 19, Breite&
  45.   GET #1, 23, Hohe&
  46.   GET #1, 29, BitProPix%
  47.   Grose& = Hohe& * Breite& * BitProPix% / 8
  48.   GET #1, 11, Begin&
  49. ELSEIF Endung$ = "ICO" AND Art% = 1 AND Anzahl% = 1 THEN
  50.   GET #1, 19, Infoheadbegin&
  51.   GET #1, Infoheadbegin& + 5, Breite&
  52.   GET #1, Infoheadbegin& + 9, Hohe&
  53.   Hohe& = Hohe& / 2
  54.   GET #1, Infoheadbegin& + 15, BitProPix%
  55.   GET #1, Infoheadbegin& + 1, Infoheadlen&
  56.   GET #1, Infoheadbegin& + 33, ColEntr&
  57.   IF ColEntr& = 0 THEN ColEntr& = 2 ^ BitProPix%
  58.   Grose& = Hohe& * Breite& * BitProPix% / 8
  59.   Begin& = Infoheadbegin& + Infoheadlen& + (ColEntr& * 4)
  60. ELSE
  61.   PRINT "Die Datei "; Datei$
  62.   PRINT "ist eine ungültige Bitmap- oder Icon-Datei !"
  63.   CLOSE
  64.   END
  65. END IF
  66. IF Hohe& * Breite& > 32767 THEN
  67.   PRINT "Bild zu groß !"
  68.   CLOSE
  69.   END
  70. END IF
  71. DIM Pixel(Hohe& * Breite&) AS LONG
  72. CALL ReadPixel(Pixel(), Farbe(), BitProPix%, Begin&, Grose&)
  73. CLS
  74. best = bestvideo
  75. CALL GetGraf(best)
  76. IF best = 0 THEN
  77.   PRINT "Kein grafikfähiger Videoadapter vorhanden !"
  78.   SLEEP 2
  79.   CLOSE
  80.   END
  81. END IF
  82. IF graf.Maxcolor < 2 ^ BitProPix% THEN
  83.   PRINT "Ihre Grafikkarte kann nicht genügend Farben darstellen !"
  84.   SLEEP 2
  85.   CLOSE
  86.   END
  87. END IF
  88. PRINT "Bild wird nun geladen !"
  89. PRINT "Größe kann mit <+> und <-> verändert werden, abbruch mit bel. Taste !"
  90. SLEEP 3
  91. SCREEN best
  92. f = 1
  93. DO
  94.   CLS
  95.   Counter = 1
  96.   FOR x = Hohe& TO 1 STEP -1
  97.     FOR y = 1 TO Breite&
  98.       LINE (y * f - f + 1, x * f - f + 1)-(y * f, x * f), Farbe(Pixel(Counter)), BF
  99.       Counter = Counter + 1
  100.     NEXT
  101.   NEXT
  102.   DO
  103.     Taste$ = INKEY$
  104.   LOOP WHILE Taste$ = ""
  105.   IF Taste$ = "+" THEN f = f + 1
  106.   IF Taste$ = "-" THEN f = f - 1
  107.   IF f = 0 THEN f = 1
  108. LOOP UNTIL Taste$ <> "+" AND Taste$ <> "-"
  109. SCREEN 0, 0, 0
  110. END
  111. Errorhandler:
  112.   PRINT "Systemfehler !"
  113.   SLEEP 2
  114.   CLOSE
  115.   END
  116. Videoerr:
  117.   SELECT CASE bestmode
  118.     CASE 12 'VGA
  119.       bestmode = 11 'MCGA
  120.     CASE 11 'MCGA
  121.       bestmode = 9  'EGA256
  122.     CASE 9  'EGA256
  123.       bestmode = 10 'MONO
  124.     CASE 10 'MONO
  125.       bestmode = 2  'CGA
  126.     CASE 2  'CGA
  127.       bestmode = 3  'HERC
  128.     CASE ELSE
  129.       bestmode = 0  'KEINE
  130.   END SELECT
  131.   RESUME
  132. EGAErr:
  133.   bestmode = 8 'EGA64
  134.   RESUME NEXT
  135.  
  136. 'Ermittlung des besten Grafikmodus 
  137. FUNCTION bestvideo
  138.   SHARED bestmode
  139.   bestmode = 12 'VGA
  140.   ON ERROR GOTO Videoerr
  141.   IF bestmode = 0 THEN
  142.     SCREEN 0
  143.     WIDTH 80, 25
  144.     bestvideo = bestmode
  145.     EXIT FUNCTION
  146.   END IF
  147.   SCREEN bestmode
  148.   ON ERROR GOTO EGAErr
  149.   IF bestmode = 9 THEN SCREEN 8, , 1
  150.   ON ERROR GOTO Errorhandler
  151.   SCREEN 0, , 0
  152.   WIDTH 80, 25
  153.   bestvideo = bestmode
  154. END FUNCTION
  155.  
  156. 'Ermittlung der Auflösung und der Anzahl der Farben
  157. SUB GetGraf (mode)
  158.   SHARED graf AS video
  159.   SELECT CASE mode
  160.     CASE 1
  161.       graf.maxx = 320
  162.       graf.maxy = 200
  163.       graf.maxh = 40
  164.       graf.maxv = 25
  165.       graf.Maxcolor = 4
  166.     CASE 2
  167.       graf.maxx = 640
  168.       graf.maxy = 200
  169.       graf.maxh = 80
  170.       graf.maxv = 25
  171.       graf.Maxcolor = 2
  172.     CASE 3
  173.       graf.maxx = 720
  174.       graf.maxy = 348
  175.       graf.maxh = 80
  176.       graf.maxv = 25
  177.       graf.Maxcolor = 2
  178.     CASE 4
  179.       graf.maxx = 640
  180.       graf.maxy = 400
  181.       graf.maxh = 80
  182.       graf.maxv = 25
  183.       graf.Maxcolor = 1
  184.     CASE 7
  185.       graf.maxx = 320
  186.       graf.maxy = 200
  187.       graf.maxh = 40
  188.       graf.maxv = 25
  189.       graf.Maxcolor = 16
  190.     CASE 8
  191.       graf.maxx = 640
  192.       graf.maxy = 200
  193.       graf.maxh = 80
  194.       graf.maxv = 25
  195.       graf.Maxcolor = 16
  196.     CASE 9
  197.       graf.maxx = 640
  198.       graf.maxy = 350
  199.       graf.maxh = 80
  200.       graf.maxv = 25
  201.       graf.Maxcolor = 16
  202.     CASE 10
  203.       graf.maxx = 640
  204.       graf.maxy = 350
  205.       graf.maxh = 80
  206.       graf.maxv = 25
  207.       graf.Maxcolor = 2
  208.     CASE 11
  209.       graf.maxx = 640
  210.       graf.maxy = 480
  211.       graf.maxh = 80
  212.       graf.maxv = 30
  213.       graf.Maxcolor = 2
  214.     CASE 12
  215.       graf.maxx = 640
  216.       graf.maxy = 480
  217.       graf.maxh = 80
  218.       graf.maxv = 30
  219.       graf.Maxcolor = 16
  220.     CASE 13
  221.       graf.maxx = 320
  222.       graf.maxy = 200
  223.       graf.maxh = 40
  224.       graf.maxv = 25
  225.       graf.Maxcolor = 256
  226.     CASE ELSE
  227.   END SELECT
  228. END SUB
  229.  
  230. 'Lesen der Daten aus der Datei
  231. SUB ReadPixel (Pixel() AS LONG, Farbe() AS INTEGER, BitProPix%, Begin&, Grose&)
  232.   Counter = 1
  233.   DIM Byte AS STRING * 1
  234.   SELECT CASE BitProPix%
  235.     CASE 1
  236.       FOR i = 1 TO Grose& * 8 STEP 8
  237.         GET #1, Begin& + Counter, Byte
  238.         Wert = ASC(Byte)
  239.         Pixel(i + 7) = Wert AND 1
  240.         Pixel(i + 6) = (Wert AND 2) / 2
  241.         Pixel(i + 5) = (Wert AND 4) / 4
  242.         Pixel(i + 4) = (Wert AND 8) / 8
  243.         Pixel(i + 3) = (Wert AND 16) / 16
  244.         Pixel(i + 2) = (Wert AND 32) / 32
  245.         Pixel(i + 1) = (Wert AND 64) / 64
  246.         Pixel(i) = (Wert AND 128) / 128
  247.         Counter = Counter + 1
  248.       NEXT i
  249.       Farbe(0) = 0
  250.       Farbe(1) = 15
  251.     CASE 4
  252.       FOR i = 1 TO Grose& * 2 STEP 2
  253.         GET #1, Begin& + Counter, Byte
  254.         Wert = ASC(Byte)
  255.         Pixel(i + 1) = (Wert AND 15)
  256.         Pixel(i) = (Wert AND 240) / 16
  257.         Counter = Counter + 1
  258.       NEXT
  259.       Farbe(0) = 0
  260.       Farbe(1) = 4
  261.       Farbe(2) = 2
  262.       Farbe(3) = 6
  263.       Farbe(4) = 1
  264.       Farbe(5) = 5
  265.       Farbe(6) = 3
  266.       Farbe(7) = 8
  267.       Farbe(8) = 7
  268.       Farbe(9) = 12
  269.       Farbe(10) = 10
  270.       Farbe(11) = 14
  271.       Farbe(12) = 9
  272.       Farbe(13) = 13
  273.       Farbe(14) = 11
  274.       Farbe(15) = 15
  275.     CASE ELSE
  276.       PRINT "Es könne nur 2- und 16-farbige Bilder angezeigt werden !"
  277.       CLOSE
  278.       END
  279.   END SELECT
  280. END SUB
  281.  
  282.