home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tools / basic / icocon.bas next >
Encoding:
BASIC Source File  |  1991-10-14  |  4.8 KB  |  187 lines
  1. '-----------------------------------------------------------
  2. '                        ICOCON.BAS
  3. '        Copyright (C) 1991 Kay Glahn & DMV-Verlag
  4. '      Konvertieren von Icons in Bitmaps und umgekehrt
  5. '                Compiler: Quick Basic 4.5
  6. '-----------------------------------------------------------
  7. DECLARE SUB BmpToIco ()
  8. DECLARE SUB IcoToBmp ()
  9.  
  10. ON ERROR GOTO ErrorHandler
  11.  
  12. PRINT "Icon-/Bitmap-Converter ";
  13. PRINT "(C) 1991 Kay Glahn & DMV-Verlag"
  14. PRINT
  15. PRINT "(1) Icon --> Bitmap"
  16. PRINT "(2) Bitmap --> Icon"
  17. INPUT "Gewünschte Konvertierung : ", A$
  18. PRINT
  19. IF A$ = "1" THEN
  20.   INPUT "Icondatei   : ", Dat1$
  21.   INPUT "Bitmapdatei : ", Dat2$
  22. ELSE
  23.   INPUT "Bitmapdatei : ", Dat2$
  24.   INPUT "Icondatei   : ", Dat1$
  25. END IF
  26. PRINT
  27. IF NOT INSTR(Dat2$, ".") THEN Dat2$ = Dat2$ + ".BMP"
  28. IF NOT INSTR(Dat1$, ".") THEN Dat1$ = Dat1$ + ".ICO"
  29.  
  30. OPEN Dat1$ FOR BINARY AS #1
  31. OPEN Dat2$ FOR BINARY AS #2
  32.  
  33. SELECT CASE VAL(A$)
  34.   CASE 1
  35.     IF LOF(1) = 0 THEN
  36.       CLOSE
  37.       KILL Dat1$
  38.       PRINT "Datei "; Dat1$; " ist nicht vorhanden!"
  39.       END
  40.     END IF
  41.     CALL IcoToBmp
  42.   CASE 2
  43.     IF LOF(2) = 0 THEN
  44.       CLOSE
  45.       KILL Dat2$
  46.       PRINT "Datei "; Dat2$; " ist nicht vorhanden!"
  47.       END
  48.     END IF
  49.     CALL BmpToIco
  50.   CASE ELSE
  51.     PRINT "Falsche Parameter !"
  52. END SELECT
  53. CLOSE
  54. END
  55.  
  56. ErrorHandler:
  57.   PRINT "Systemfehler !"
  58.   CLOSE
  59.   END
  60.  
  61. ' Konvertierung von Bitmap zu Icon
  62. SUB BmpToIco
  63.   Kennung$ = SPACE$(2)
  64.   GET #2, 1, Kennung$
  65.   IF Kennung$ = "BM" THEN
  66.     GET #2, 15, InfoHeadLen&
  67.     InfoHead$ = SPACE$(InfoHeadLen&)
  68.     GET #2, 15, InfoHead$
  69.     GET #2, 47, ColEntr&
  70.     GET #2, 29, BitperPix%
  71.     IF BitperPix% <> 1 AND BitperPix% <> 3 AND BitperPix% <> 4 THEN
  72.       PRINT "Ungültige Anzahl Farben !"
  73.       CLOSE
  74.       END
  75.     END IF
  76.     IF ColEntr& = 0 THEN ColEntr& = 2 ^ BitperPix%
  77.     ColTable$ = SPACE$(ColEntr& * 4)
  78.     GET #2, 15 + InfoHeadLen&, ColTable$
  79.     GET #2, 11, BildDatBegin&
  80.     GET #2, 3, DatLen&
  81.     Bildlen& = DatLen& - BildDatBegin&
  82.     BildDatBegin& = BildDatBegin& + 1
  83.     IF Bildlen& > 32768 THEN
  84.       PRINT "Falsches Bildformat !"
  85.       CLOSE
  86.       END
  87.     END IF
  88.     Bild1$ = SPACE$(Bildlen&)
  89.     GET #2, BildDatBegin&, Bild1$
  90.     GET #2, 19, Breite&
  91.     GET #2, 23, Hohe&
  92.     IF Breite& <> 16 AND Breite& <> 32 AND Breite& <> 64 THEN
  93.       PRINT "Falsche Bildbreite !"
  94.       CLOSE
  95.       END
  96.     END IF
  97.     IF Hohe& <> 16 AND Hohe& <> 32 AND Hohe& <> 64 THEN
  98.       PRINT "Falsche Bildhöhe !"
  99.       CLOSE
  100.       END
  101.     END IF
  102.     Bild2$ = STRING$(Breite& * Hohe& / 8, 0)
  103.     Null% = 0
  104.     PUT #1, 1, Null%
  105.     Art% = 1
  106.     PUT #1, 3, Art%
  107.     AnzBilder% = 1
  108.     PUT #1, 5, AnzBilder%
  109.     Breite$ = CHR$(Breite&)
  110.     Hohe$ = CHR$(Hohe&)
  111.     Farben$ = CHR$(2 ^ BitperPix%)
  112.     PUT #1, 7, Breite$
  113.     PUT #1, 8, Hohe$
  114.     PUT #1, 9, Farben$
  115.     Null$ = CHR$(0)
  116.     PUT #1, 10, Null$
  117.     PUT #1, 11, Null%
  118.     PUT #1, 13, Null%
  119.     Bild2Len& = Hohe& * Breite& / 8
  120.     ColTableLen& = ColEntr& * 4
  121.     newbildlen& = InfoHeadLen& + Bildlen& + Bild2Len& + ColTableLen&
  122.     PUT #1, 15, newbildlen&
  123.     NewInfoHeadBegin& = 22
  124.     PUT #1, 19, NewInfoHeadBegin&
  125.     PUT #1, , InfoHead$
  126.     PUT #1, , ColTable$
  127.     PUT #1, , Bild1$
  128.     PUT #1, , Bild2$
  129.     NewHohe& = Hohe& * 2
  130.     PUT #1, 31, NewHohe&
  131.     PRINT "Konvertierung beendet !"
  132.   ELSE
  133.     PRINT "Ungültige Bitmap-Datei !"
  134.   END IF
  135. END SUB
  136.  
  137. ' Konvertierung von Icon zu Bitmap
  138. SUB IcoToBmp
  139.   GET #1, 3, Art%
  140.   IF Art% <> 1 THEN
  141.     PRINT "Ungültige Icondatei "
  142.     CLOSE
  143.     END
  144.   END IF
  145.   GET #1, 5, AnzBilder%
  146.   IF AnzBilder% = 1 THEN
  147.     GET #1, 19, InfoHeadBegin&
  148.     InfoHeadBegin& = InfoHeadBegin& + 1
  149.     GET #1, InfoHeadBegin&, InfoHeadLen&
  150.     InfoHeadLen& = InfoHeadLen& + 1
  151.     InfoHead$ = SPACE$(InfoHeadLen&)
  152.     GET #1, InfoHeadBegin&, InfoHead$
  153.     GET #1, InfoHeadBegin& + 32, ColEntr&
  154.     GET #1, InfoHeadBegin& + 14, BitperPix%
  155.     IF ColEntr& = 0 THEN ColEntr& = 2 ^ BitperPix%
  156.     ColTable$ = SPACE$(ColEntr& * 4)
  157.     GET #1, InfoHeadBegin& + InfoHeadLen&, ColTable$
  158.     Breite$ = SPACE$(1)
  159.     GET #1, 7, Breite$
  160.     Hohe$ = SPACE$(1)
  161.     GET #1, 8, Hohe$
  162.     GET #1, InfoHeadBegin& + 20, Bildlen&
  163.     newbildlen& = Bildlen& - ASC(Breite$) * ASC(Hohe$) / 8
  164.     Bild$ = SPACE$(newbildlen&)
  165.     GET #1, InfoHeadBegin& + InfoHeadLen& + ColEntr& * 4, Bild$
  166.     GET #1, 15, BildDatenLen&
  167.     DatLen& = InfoHeadBegin& + BildDatenLen&
  168.     NewBildDatBegin& = 14 + InfoHeadLen& + ColEntr& * 4 - 1
  169.     Kennung$ = "BM"
  170.     PUT #2, 1, Kennung$
  171.     PUT #2, 3, DatLen&
  172.     Nul% = 0
  173.     PUT #2, 7, Nul%
  174.     PUT #2, 9, Nul%
  175.     PUT #2, 11, NewBildDatBegin&
  176.     PUT #2, , InfoHead$
  177.     PUT #2, , ColTable$
  178.     PUT #2, , Bild$
  179.     Hohe& = ASC(Hohe$)
  180.     PUT #2, 23, Hohe&
  181.     PRINT "Konvertierung beendet !"
  182.   ELSE
  183.     PRINT "Datei enthält mehr als ein Bild !"
  184.   END IF
  185. END SUB
  186.  
  187.