home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tools / basic / icoscan.bas < prev    next >
Encoding:
BASIC Source File  |  1991-10-14  |  7.5 KB  |  312 lines
  1. '***********************************************************
  2. '                         ICOSCAN.BAS
  3. '          Copyright (C) 1991 Kay Glahn & DMV-Verlag
  4. ' Programm zum Anzeigen aller in einem Inhaltsverzeichnis
  5. '                       enthaltener Icons
  6. '               Compiler: Basic-PDS ab Version 7.0
  7. '************************************************************
  8. DECLARE FUNCTION GetFileCount% (filespec$)
  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.  
  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. ON KEY(1) GOSUB Abbruch
  24. KEY(1) ON
  25. ON ERROR GOTO Errorhandler
  26. best = bestvideo
  27. PRINT "Icon-Scanner (C) 1991 Kay Glahn & DMV-Verlag"
  28. SLEEP 2
  29. CALL GetGraf(best)
  30. IF best = 0 THEN
  31.   PRINT "Kein grafikfähiger Videoadapter vorhanden !"
  32.   SLEEP 2
  33.   CLOSE
  34.   END
  35. END IF
  36. high% = Graf.maxy / Graf.maxv * 5
  37. Path$ = COMMAND$
  38. IF LEN(Path$) = 2 AND INSTR(Path$, ":") = 2 THEN
  39.   Path$ = CURDIR$(Path$)
  40. END IF
  41. IF INSTR(Path$, "\") <> LEN(Path$) THEN
  42.   filespec$ = Path$ + "\*.ico"
  43. ELSE
  44.   filespec$ = Path$ + "*.ico"
  45. END IF
  46. filecount = GetFileCount(filespec$)
  47. IF filecount THEN
  48.   REDIM Filelist$(filecount)
  49. ELSE
  50.   SCREEN 0, 0, 0
  51.   CLS
  52.   PRINT "Keine Icons im angegebenen Verzeichnis gefunden !"
  53.   SLEEP 2
  54.   END
  55. END IF
  56. Filelist$(1) = DIR$(filespec$)
  57. FOR Counter = 2 TO filecount
  58.   Filelist$(Counter) = DIR$
  59. NEXT Counter
  60. xp = 0
  61. yp = 0
  62. PRINT "Icons werden nun angezeigt ! Abbruch mit <F1> !"
  63. SLEEP 2
  64. SCREEN best
  65. FOR i = 1 TO filecount
  66.   CLOSE
  67.   Name$ = Filelist$(i)
  68.   IF INSTR(Path$, "\") <> LEN(Path$) THEN
  69.     Filelist$(i) = Path$ + "\" + Filelist$(i)
  70.   ELSE
  71.     Filelist$(i) = Path$ + Filelist$(i)
  72.   END IF
  73.   OPEN Filelist$(i) FOR BINARY AS #1
  74.   datei$ = Filelist$(i)
  75.   GET #1, 3, Art%
  76.   GET #1, 5, Anzahl%
  77.   Endung$ = UCASE$(MID$(datei$, INSTR(datei$, ".") + 1, 3))
  78.   IF Endung$ = "ICO" AND Art% = 1 AND Anzahl% = 1 THEN
  79.     GET #1, 19, infoheadbegin&
  80.     GET #1, infoheadbegin& + 5, Breite&
  81.     GET #1, infoheadbegin& + 9, hohe&
  82.     hohe& = hohe& / 2
  83.     GET #1, infoheadbegin& + 15, BitproPix%
  84.     GET #1, infoheadbegin& + 1, Infoheadlen&
  85.     GET #1, infoheadbegin& + 33, ColEntr&
  86.     IF ColEntr& = 0 THEN ColEntr& = 2 ^ BitproPix%
  87.     Grose& = hohe& * Breite& * BitproPix% / 8
  88.     Begin& = infoheadbegin& + Infoheadlen& + (ColEntr& * 4)
  89.     REDIM Pixel(hohe& * Breite&) AS LONG
  90.     IF BitproPix% = 1 OR BitproPix% = 4 THEN
  91.       CALL ReadPixel(Pixel(), Farbe(), BitproPix%, Begin&, Grose&)
  92.       IF Graf.Maxcolor >= 2 ^ BitproPix% THEN
  93.         Counter = 1
  94.         xpos = xp
  95.         ypos = yp + (high% / 2 - hohe& / 2)
  96.         FOR x = ypos + hohe& TO ypos + 1 STEP -1
  97.           FOR y = xpos + 1 TO xpos + Breite&
  98.             PSET (y, x), Farbe(Pixel(Counter))
  99.             Counter = Counter + 1
  100.           NEXT
  101.         NEXT
  102.         a = (yp) / (Graf.maxy / Graf.maxv) + 3
  103.         b = (xp + 48) / (Graf.maxx / Graf.maxh)
  104.         LOCATE a, b
  105.         PRINT Name$
  106.         xp = xp + 160
  107.         IF xp + 160 > Graf.maxx THEN
  108.           xp = 0
  109.           yp = yp + high%
  110.         END IF
  111.         IF yp + hohe& > Graf.maxy THEN
  112.           WHILE INKEY$ = "": WEND
  113.           CLS
  114.           xp = 0
  115.           yp = 0
  116.         END IF
  117.       END IF
  118.     END IF
  119.   END IF
  120. NEXT
  121. WHILE INKEY$ = "": WEND
  122. SCREEN 0, 0, 0
  123. END
  124. Errorhandler:
  125.   SCREEN 0, 0, 0
  126.   CLS
  127.   PRINT "Systemfehler !"
  128.   SLEEP 2
  129.   CLOSE
  130.   END
  131. Videoerr:
  132.   SELECT CASE bestmode
  133.     CASE 12 'VGA
  134.       bestmode = 11 'MCGA
  135.     CASE 11 'MCGA
  136.       bestmode = 9  'EGA256
  137.     CASE 9  'EGA256
  138.       bestmode = 10 'MONO
  139.     CASE 10 'MONO
  140.       bestmode = 2  'CGA
  141.     CASE 2  'CGA
  142.       bestmode = 3  'HERC
  143.     CASE ELSE
  144.       bestmode = 0  'KEINE
  145.   END SELECT
  146.   RESUME
  147. EGAErr:
  148.   bestmode = 8 'EGA64
  149.   RESUME NEXT
  150. Abbruch:
  151.   CLOSE
  152.   SCREEN 0, 0, 0
  153.   CLS
  154.   PRINT "Programm vom Anwender abgebrochen !"
  155.   SLEEP 2
  156.   END
  157. RETURN
  158.  
  159. 'Ermittlung des besten Grafikmodus
  160. FUNCTION bestvideo
  161.   SHARED bestmode
  162.   bestmode = 12 'VGA
  163.   ON ERROR GOTO Videoerr
  164.   IF bestmode = 0 THEN
  165.     SCREEN 0
  166.     WIDTH 80, 25
  167.     bestvideo = bestmode
  168.     EXIT FUNCTION
  169.   END IF
  170.   SCREEN bestmode
  171.   ON ERROR GOTO EGAErr
  172.   IF bestmode = 9 THEN SCREEN 8, , 1
  173.   ON ERROR GOTO Errorhandler
  174.   SCREEN 0, , 0
  175.   WIDTH 80, 25
  176.   bestvideo = bestmode
  177. END FUNCTION
  178.  
  179. 'Anzahl der auf filespec$ zutreffenden Dateien ermitteln
  180. FUNCTION GetFileCount (filespec$)
  181.   count = 0
  182.   fileName$ = DIR$(filespec$)
  183.   DO WHILE fileName$ <> ""
  184.     count = count + 1
  185.     fileName$ = DIR$
  186.   LOOP
  187.   GetFileCount = count
  188. END FUNCTION
  189.  
  190. 'Ermittlung der Auflösung und der Anzahl der Farben
  191. SUB GetGraf (mode)
  192.   SHARED Graf AS video
  193.   SELECT CASE mode
  194.     CASE 1
  195.       Graf.maxx = 320
  196.       Graf.maxy = 200
  197.       Graf.maxh = 40
  198.       Graf.maxv = 25
  199.       Graf.Maxcolor = 4
  200.     CASE 2
  201.       Graf.maxx = 640
  202.       Graf.maxy = 200
  203.       Graf.maxh = 80
  204.       Graf.maxv = 25
  205.       Graf.Maxcolor = 2
  206.     CASE 3
  207.       Graf.maxx = 720
  208.       Graf.maxy = 348
  209.       Graf.maxh = 80
  210.       Graf.maxv = 25
  211.       Graf.Maxcolor = 2
  212.     CASE 4
  213.       Graf.maxx = 640
  214.       Graf.maxy = 400
  215.       Graf.maxh = 80
  216.       Graf.maxv = 25
  217.       Graf.Maxcolor = 1
  218.     CASE 7
  219.       Graf.maxx = 320
  220.       Graf.maxy = 200
  221.       Graf.maxh = 40
  222.       Graf.maxv = 25
  223.       Graf.Maxcolor = 16
  224.     CASE 8
  225.       Graf.maxx = 640
  226.       Graf.maxy = 200
  227.       Graf.maxh = 80
  228.       Graf.maxv = 25
  229.       Graf.Maxcolor = 16
  230.     CASE 9
  231.       Graf.maxx = 640
  232.       Graf.maxy = 350
  233.       Graf.maxh = 80
  234.       Graf.maxv = 25
  235.       Graf.Maxcolor = 16
  236.     CASE 10
  237.       Graf.maxx = 640
  238.       Graf.maxy = 350
  239.       Graf.maxh = 80
  240.       Graf.maxv = 25
  241.       Graf.Maxcolor = 2
  242.     CASE 11
  243.       Graf.maxx = 640
  244.       Graf.maxy = 480
  245.       Graf.maxh = 80
  246.       Graf.maxv = 30
  247.       Graf.Maxcolor = 2
  248.     CASE 12
  249.       Graf.maxx = 640
  250.       Graf.maxy = 480
  251.       Graf.maxh = 80
  252.       Graf.maxv = 30
  253.       Graf.Maxcolor = 16
  254.     CASE 13
  255.       Graf.maxx = 320
  256.       Graf.maxy = 200
  257.       Graf.maxh = 40
  258.       Graf.maxv = 25
  259.       Graf.Maxcolor = 256
  260.     CASE ELSE
  261.   END SELECT
  262. END SUB
  263.  
  264. 'Lesen der Daten aus der Datei
  265. SUB ReadPixel (Pixel() AS LONG, Farbe() AS INTEGER, BitproPix%, Begin&, Grose&)
  266.   Counter = 1
  267.   DIM Byte AS STRING * 1
  268.   SELECT CASE BitproPix%
  269.     CASE 1
  270.       FOR i = 1 TO Grose& * 8 STEP 8
  271.         GET #1, Begin& + Counter, Byte
  272.         Wert = ASC(Byte)
  273.         Pixel(i + 7) = Wert AND 1
  274.         Pixel(i + 6) = (Wert AND 2) / 2
  275.         Pixel(i + 5) = (Wert AND 4) / 4
  276.         Pixel(i + 4) = (Wert AND 8) / 8
  277.         Pixel(i + 3) = (Wert AND 16) / 16
  278.         Pixel(i + 2) = (Wert AND 32) / 32
  279.         Pixel(i + 1) = (Wert AND 64) / 64
  280.         Pixel(i) = (Wert AND 128) / 128
  281.         Counter = Counter + 1
  282.       NEXT i
  283.       Farbe(0) = 0
  284.       Farbe(1) = 15
  285.     CASE 4
  286.       FOR i = 1 TO Grose& * 2 STEP 2
  287.         GET #1, Begin& + Counter, Byte
  288.         Wert = ASC(Byte)
  289.         Pixel(i + 1) = (Wert AND 15)
  290.         Pixel(i) = (Wert AND 240) / 16
  291.         Counter = Counter + 1
  292.       NEXT
  293.       Farbe(0) = 0
  294.       Farbe(1) = 4
  295.       Farbe(2) = 2
  296.       Farbe(3) = 6
  297.       Farbe(4) = 1
  298.       Farbe(5) = 5
  299.       Farbe(6) = 3
  300.       Farbe(7) = 8
  301.       Farbe(8) = 7
  302.       Farbe(9) = 12
  303.       Farbe(10) = 10
  304.       Farbe(11) = 14
  305.       Farbe(12) = 9
  306.       Farbe(13) = 13
  307.       Farbe(14) = 11
  308.       Farbe(15) = 15
  309.   END SELECT
  310. END SUB
  311.  
  312.