'Icon Editor V1.00 - over_clox@yahoo.com - August 20, 2002 ' 'Icon Editor V1.00 can open and save icons, import bitmaps 'from your favorite image editor, and manage many formats. 'It also provides a crude pixel oriented image editor. ' 'Note: Does NOT support true color/alpha transparency/Vista 'I made this program long ago and I've forgot it's internals. 'I still keep and use it somewhat regularyly, but I will not 'update this program any further. Any new icon editor I may 'eventually make will be rewritten from the ground up. ' 'Control: Press F1 in the editor for help, and be sure to 'include complete file names and extensions when opening, 'saving, importing, or exporting any files. The GUI isn't 'all that friendly, but it has most everything needed to 'manipulate icons except the ability to change the colors 'currently in the palette. Export a BMP, edit externally, 'and import the edited copy to change palette entries. 'Use FreeDraw (Enter) to leave the drawing pen on. 'Use Mask Mode (M) to toggle transparent pixels. DECLARE SUB AddIcon (IcoIndex%, PixelSize%, ColourDepth%) DECLARE SUB ChangeFormat (PixelSize%, ColourDepth%) DECLARE SUB CopyIcon (IcoIndex%, NewIcoIndex%) DECLARE SUB DeleteIcon (IcoIndex%) DECLARE SUB DisplayIconData (IcoIndex%) DECLARE SUB ExportBmp (FileName$) DECLARE SUB FillHeaders () DECLARE SUB ImportBmp (FileName$) DECLARE SUB MakeBmpData () DECLARE SUB MakePal () DECLARE SUB OpenIcon (FileName$) DECLARE SUB ReadPal (Index%, Red%, Green%, Blue%) DECLARE SUB IconEditor () DECLARE SUB SaveIcon (FileName$) DECLARE SUB UpdateEditBox () DECLARE SUB UpdateEditCsr () DECLARE SUB UpdatePal () DECLARE SUB UpdatePalBox () DECLARE SUB UpdatePalCsr () DECLARE SUB UpdatePixel () DECLARE SUB UpdateScreen () DECLARE SUB WritePal (Index%, Red%, Green%, Blue%) DECLARE FUNCTION BitmapFileSize! (IcoIndex%) DECLARE FUNCTION BitmapImageOffset! (IcoIndex%) DECLARE FUNCTION BitmapImageSize! (IcoIndex%) DECLARE FUNCTION IconImageOffset! (IcoIndex%) DECLARE FUNCTION IconImageSize! (IcoIndex%) DECLARE FUNCTION NearestColor! (Red%, Green%, Blue%) TYPE ProgDataType PrgSysColor AS INTEGER PrgEditBoxX AS INTEGER PrgEditBoxY AS INTEGER PrgEditBoxZoom AS INTEGER PrgPalBoxX AS INTEGER PrgPalBoxY AS INTEGER PrgPalBoxZoom AS INTEGER PrgCurIcon AS INTEGER PrgCurColor AS INTEGER PrgOldColor AS INTEGER PrgCurCsrX AS INTEGER PrgCurCsrY AS INTEGER PrgOldCsrX AS INTEGER PrgOldCsrY AS INTEGER PrgMaskMode AS INTEGER PrgPenStat AS INTEGER END TYPE TYPE IcoFileHeaderType IcoReserved AS INTEGER IcoType AS INTEGER IcoCount AS INTEGER END TYPE TYPE IcoDataHeaderType IcoWidth AS STRING * 1 IcoHeight AS STRING * 1 IcoColors AS STRING * 1 IcoReserved AS STRING * 1 IcoHotSpotX AS INTEGER IcoHotSpotY AS INTEGER IcoImageSize AS LONG IcoImageOffset AS LONG END TYPE TYPE BmpFileHeaderType BmpFileType AS STRING * 2 BmpFileSize AS LONG BmpReserved AS LONG BmpImageOffset AS LONG END TYPE TYPE BmpDataHeaderType BmpDataHeaderSize AS LONG BmpWidth AS LONG BmpHeight AS LONG BmpPlanes AS INTEGER BmpBitsPP AS INTEGER BmpCompress AS LONG BmpImageSize AS LONG BmpXPixels AS LONG BmpYPixels AS LONG BmpUsedColors AS LONG BmpNeedColors AS LONG END TYPE TYPE BmpPalType Blue AS STRING * 1 Green AS STRING * 1 Red AS STRING * 1 Reserved AS STRING * 1 END TYPE TYPE BmpDataType Image AS STRING * 1 Mask AS STRING * 1 END TYPE DIM SHARED ProgData AS ProgDataType DIM SHARED IcoFileHeader AS IcoFileHeaderType DIM SHARED IcoDataHeader(1 TO 8) AS IcoDataHeaderType DIM SHARED BmpFileHeader(1 TO 8) AS BmpFileHeaderType DIM SHARED BmpDataHeader(1 TO 8) AS BmpDataHeaderType DIM SHARED BmpPal(1 TO 8, 0 TO 255) AS BmpPalType DIM SHARED BmpData(1 TO 8, 0 TO 63, 0 TO 63) AS BmpDataType ProgData.PrgEditBoxX = 0: ProgData.PrgEditBoxY = 0 ProgData.PrgPalBoxX = 221: ProgData.PrgPalBoxY = 0 ProgData.PrgEditBoxZoom = 4: ProgData.PrgPalBoxZoom = 6 ProgData.PrgCurIcon = 1 CALL IconEditor Win16Pal: DATA 0,0,0, 128,0,0, 128,128,0, 0,128,0 DATA 0,128,128, 0,0,128, 128,0,128, 192,192,192 DATA 128,128,128, 255,0,0, 255,255,0, 0,255,0 DATA 0,255,255, 0,0,255, 255,0,255, 255,255,255 SUB AddIcon (IcoIndex%, PixelSize%, ColourDepth%) IcoFileHeader.IcoCount = IcoFileHeader.IcoCount + 1 IF IcoIndex% < IcoFileHeader.IcoCount THEN FOR CopyIndex% = IcoFileHeader.IcoCount - 1 TO IcoIndex% STEP -1 CALL CopyIcon(CopyIndex%, CopyIndex% + 1) NEXT END IF ProgData.PrgCurCsrX = 0: ProgData.PrgCurCsrY = 0 ProgData.PrgCurColor = 0 ProgData.PrgCurIcon = IcoIndex% BmpDataHeader(IcoIndex%).BmpWidth = PixelSize% BmpDataHeader(IcoIndex%).BmpHeight = PixelSize% * 2 BmpDataHeader(IcoIndex%).BmpBitsPP = ColourDepth% CALL FillHeaders: CALL MakePal CALL MakeBmpData: CALL UpdateScreen END SUB FUNCTION BitmapFileSize (IcoIndex%) BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight \ 2 BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP PalSize& = (2 ^ BmpBitsPP%) * 4 LineSize& = (((BmpWidth& - 1) * BmpBitsPP% \ 8) OR 3) + 1 ImageSize& = LineSize& * BmpHeight& BitmapFileSize = 14 + 40 + PalSize& + ImageSize& END FUNCTION FUNCTION BitmapImageOffset (IcoIndex%) PalSize& = (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) * 4 BitmapImageOffset = 14 + 40 + PalSize& END FUNCTION FUNCTION BitmapImageSize (IcoIndex%) BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight \ 2 BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP LineSize& = (((BmpWidth& - 1) * BmpBitsPP% \ 8) OR 3) + 1 ImageSize& = LineSize& * BmpHeight& LineSize& = (((BmpWidth& - 1) \ 8) OR 3) + 1 MaskSize& = LineSize& * BmpHeight& BitmapImageSize = ImageSize& + MaskSize& END FUNCTION SUB ChangeFormat (PixelSize%, ColourDepth%) ProgData.PrgCurCsrX = 0: ProgData.PrgCurCsrY = 0 ProgData.PrgCurColor = 0 IcoIndex% = ProgData.PrgCurIcon BmpDataHeader(IcoIndex%).BmpWidth = PixelSize% BmpDataHeader(IcoIndex%).BmpHeight = PixelSize% * 2 BmpDataHeader(IcoIndex%).BmpBitsPP = ColourDepth% CALL FillHeaders: CALL MakePal CALL MakeBmpData: CALL UpdateScreen END SUB SUB CopyIcon (IcoIndex%, NewIcoIndex%) IcoDataHeader(NewIcoIndex%).IcoHotSpotX = IcoDataHeader(IcoIndex%).IcoHotSpotX IcoDataHeader(NewIcoIndex%).IcoHotSpotY = IcoDataHeader(IcoIndex%).IcoHotSpotY BmpDataHeader(NewIcoIndex%).BmpWidth = BmpDataHeader(IcoIndex%).BmpWidth BmpDataHeader(NewIcoIndex%).BmpHeight = BmpDataHeader(IcoIndex%).BmpHeight BmpDataHeader(NewIcoIndex%).BmpBitsPP = BmpDataHeader(IcoIndex%).BmpBitsPP FOR Index% = 0 TO 255 BmpPal(NewIcoIndex%, Index%).Red = BmpPal(IcoIndex%, Index%).Red BmpPal(NewIcoIndex%, Index%).Green = BmpPal(IcoIndex%, Index%).Green BmpPal(NewIcoIndex%, Index%).Blue = BmpPal(IcoIndex%, Index%).Blue NEXT FOR X% = 0 TO 31: FOR Y% = 0 TO 31 BmpData(NewIcoIndex%, X%, Y%).Image = BmpData(IcoIndex%, X%, Y%).Image BmpData(NewIcoIndex%, X%, Y%).Mask = BmpData(IcoIndex%, X%, Y%).Mask NEXT: NEXT END SUB SUB DeleteIcon (IcoIndex%) IF IcoIndex% < IcoFileHeader.IcoCount THEN FOR CopyIndex% = IcoIndex% + 1 TO IcoFileHeader.IcoCount CALL CopyIcon(CopyIndex%, CopyIndex% - 1) NEXT END IF ProgData.PrgCurCsrX = 0: ProgData.PrgCurCsrY = 0 ProgData.PrgCurColor = 0 IcoFileHeader.IcoCount = IcoFileHeader.IcoCount - 1 IF ProgData.PrgCurIcon > IcoFileHeader.IcoCount THEN ProgData.PrgCurIcon = IcoFileHeader.IcoCount END IF CALL FillHeaders: CALL UpdateScreen END SUB SUB DisplayIconData (IcoIndex%) CLS PRINT "IcoWidth$ "; ASC(IcoDataHeader(IcoIndex%).IcoWidth) PRINT "IcoHeight$ "; ASC(IcoDataHeader(IcoIndex%).IcoHeight) PRINT "IcoColors$ "; ASC(IcoDataHeader(IcoIndex%).IcoColors) PRINT "IcoReserved$ "; ASC(IcoDataHeader(IcoIndex%).IcoReserved) PRINT "IcoHotSpotX% "; IcoDataHeader(IcoIndex%).IcoHotSpotX PRINT "IcoHotSpotY% "; IcoDataHeader(IcoIndex%).IcoHotSpotY PRINT "IcoImageSize& "; IcoDataHeader(IcoIndex%).IcoImageSize PRINT "IcoImageOffset& "; IcoDataHeader(IcoIndex%).IcoImageOffset PRINT PRINT "BmpDataHeaderSize& "; BmpDataHeader(IcoIndex%).BmpDataHeaderSize PRINT "BmpWidth& "; BmpDataHeader(IcoIndex%).BmpWidth PRINT "BmpHeight& "; BmpDataHeader(IcoIndex%).BmpHeight PRINT "BmpPlanes% "; BmpDataHeader(IcoIndex%).BmpPlanes PRINT "BmpBitsPP% "; BmpDataHeader(IcoIndex%).BmpBitsPP PRINT "BmpCompress& "; BmpDataHeader(IcoIndex%).BmpCompress PRINT "BmpImageSize& "; BmpDataHeader(IcoIndex%).BmpImageSize PRINT "BmpXPixels& "; BmpDataHeader(IcoIndex%).BmpXPixels PRINT "BmpYPixels& "; BmpDataHeader(IcoIndex%).BmpYPixels PRINT "BmpUsedColors& "; BmpDataHeader(IcoIndex%).BmpUsedColors PRINT "BmpNeedColors& "; BmpDataHeader(IcoIndex%).BmpNeedColors END SUB SUB ExportBmp (FileName$) CALL FillHeaders: IcoIndex% = ProgData.PrgCurIcon FileNum% = FREEFILE: OPEN FileName$ FOR BINARY AS FileNum% PUT FileNum%, , BmpFileHeader(IcoIndex%) BmpDataHeader(IcoIndex%).BmpHeight = BmpDataHeader(IcoIndex%).BmpHeight \ 2 PUT FileNum%, , BmpDataHeader(IcoIndex%) BmpDataHeader(IcoIndex%).BmpHeight = BmpDataHeader(IcoIndex%).BmpHeight * 2 FOR Index% = 0 TO (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) - 1 PUT FileNum%, , BmpPal(IcoIndex%, Index%).Blue PUT FileNum%, , BmpPal(IcoIndex%, Index%).Green PUT FileNum%, , BmpPal(IcoIndex%, Index%).Red PUT FileNum%, , BmpPal(IcoIndex%, Index%).Reserved NEXT BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight \ 2 BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP MaxVal% = 2 ^ BmpBitsPP% - 1: MaxPxl% = 8 \ BmpBitsPP% - 1 SEEK FileNum%, BmpFileHeader(IcoIndex%).BmpImageOffset + 1 FOR Y% = BmpHeight& - 1 TO 0 STEP -1 LineData$ = STRING$((((BmpWidth& * BmpBitsPP% - 1) \ 8) OR 3) + 1, 0) FOR X% = 0 TO BmpWidth& - 1 Pixel% = ASC(BmpData(IcoIndex%, X%, Y%).Image) PxlPos% = X% \ (MaxPxl% + 1): PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel$ = CHR$(HexVal% + Pixel% * BinVal%) MID$(LineData$, PxlPos% + 1, 1) = Pixel$ NEXT PUT FileNum%, , LineData$ NEXT CLOSE : CALL FillHeaders: CALL UpdateScreen END SUB SUB FillHeaders IcoFileHeader.IcoReserved = 0 IcoFileHeader.IcoType = 1 FOR IcoIndex% = 1 TO IcoFileHeader.IcoCount IcoDataHeader(IcoIndex%).IcoWidth = CHR$(BmpDataHeader(IcoIndex%).BmpWidth) IcoDataHeader(IcoIndex%).IcoHeight = CHR$(BmpDataHeader(IcoIndex%).BmpHeight \ 2) IcoDataHeader(IcoIndex%).IcoColors = CHR$(0) IcoDataHeader(IcoIndex%).IcoImageSize = IconImageSize(IcoIndex%) IcoDataHeader(IcoIndex%).IcoImageOffset = IconImageOffset(IcoIndex%) Colours% = 2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP IF Colours% < 256 THEN IcoDataHeader(IcoIndex%).IcoColors = CHR$(Colours%) IcoDataHeader(IcoIndex%).IcoReserved = CHR$(0) BmpFileHeader(IcoIndex%).BmpFileType = "BM" BmpFileHeader(IcoIndex%).BmpFileSize = BitmapFileSize(IcoIndex%) BmpFileHeader(IcoIndex%).BmpReserved = 0 BmpFileHeader(IcoIndex%).BmpImageOffset = BitmapImageOffset(IcoIndex%) BmpDataHeader(IcoIndex%).BmpDataHeaderSize = 40 BmpDataHeader(IcoIndex%).BmpPlanes = 1 BmpDataHeader(IcoIndex%).BmpCompress = 0 BmpDataHeader(IcoIndex%).BmpImageSize = BitmapImageSize(IcoIndex%) BmpDataHeader(IcoIndex%).BmpXPixels = 0 BmpDataHeader(IcoIndex%).BmpYPixels = 0 BmpDataHeader(IcoIndex%).BmpUsedColors = 0 BmpDataHeader(IcoIndex%).BmpNeedColors = 0 NEXT END SUB SUB IconEditor SCREEN 13: CALL AddIcon(1, 32, 4) DO Hit$ = UCASE$(INKEY$) SELECT CASE Hit$ CASE CHR$(0) + "H" IF ProgData.PrgCurCsrY > 0 THEN ProgData.PrgOldCsrX = ProgData.PrgCurCsrX ProgData.PrgOldCsrY = ProgData.PrgCurCsrY ProgData.PrgCurCsrY = ProgData.PrgCurCsrY - 1 CALL UpdateEditCsr END IF CASE CHR$(0) + "P" IcoIndex% = ProgData.PrgCurIcon BmpHeight% = BmpDataHeader(IcoIndex%).BmpHeight \ 2 IF ProgData.PrgCurCsrY < BmpHeight% - 1 THEN ProgData.PrgOldCsrX = ProgData.PrgCurCsrX ProgData.PrgOldCsrY = ProgData.PrgCurCsrY ProgData.PrgCurCsrY = ProgData.PrgCurCsrY + 1 CALL UpdateEditCsr END IF CASE CHR$(0) + "K" IF ProgData.PrgCurCsrX > 0 THEN ProgData.PrgOldCsrX = ProgData.PrgCurCsrX ProgData.PrgOldCsrY = ProgData.PrgCurCsrY ProgData.PrgCurCsrX = ProgData.PrgCurCsrX - 1 CALL UpdateEditCsr END IF CASE CHR$(0) + "M" IcoIndex% = ProgData.PrgCurIcon BmpWidth% = BmpDataHeader(IcoIndex%).BmpWidth IF ProgData.PrgCurCsrX < BmpWidth% - 1 THEN ProgData.PrgOldCsrX = ProgData.PrgCurCsrX ProgData.PrgOldCsrY = ProgData.PrgCurCsrY ProgData.PrgCurCsrX = ProgData.PrgCurCsrX + 1 CALL UpdateEditCsr END IF CASE CHR$(0) + "R" IF ProgData.PrgCurIcon > 1 THEN ProgData.PrgCurIcon = ProgData.PrgCurIcon - 1 ProgData.PrgCurCsrX = 0: ProgData.PrgCurCsrY = 0 CALL UpdateScreen END IF CASE CHR$(0) + "I" IF ProgData.PrgCurIcon < IcoFileHeader.IcoCount THEN ProgData.PrgCurIcon = ProgData.PrgCurIcon + 1 ProgData.PrgCurCsrX = 0: ProgData.PrgCurCsrY = 0 CALL UpdateScreen END IF CASE CHR$(0) + "G" IF ProgData.PrgCurColor > 15 THEN ProgData.PrgOldColor = ProgData.PrgCurColor ProgData.PrgCurColor = ProgData.PrgCurColor - 16 CALL UpdatePalCsr END IF CASE CHR$(0) + "O" IcoIndex% = ProgData.PrgCurIcon Colours% = 2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP IF ProgData.PrgCurColor < Colours% - 16 THEN ProgData.PrgOldColor = ProgData.PrgCurColor ProgData.PrgCurColor = ProgData.PrgCurColor + 16 CALL UpdatePalCsr END IF CASE CHR$(0) + "S" IF ProgData.PrgCurColor > 0 THEN ProgData.PrgOldColor = ProgData.PrgCurColor ProgData.PrgCurColor = ProgData.PrgCurColor - 1 CALL UpdatePalCsr END IF CASE CHR$(0) + "Q" IcoIndex% = ProgData.PrgCurIcon Colours% = 2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP IF ProgData.PrgCurColor < Colours% - 1 THEN ProgData.PrgOldColor = ProgData.PrgCurColor ProgData.PrgCurColor = ProgData.PrgCurColor + 1 CALL UpdatePalCsr END IF CASE "N" IcoFileHeader.IcoCount = 0 LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "New Icon - Size, Depth: ", PixelSize%, ColourDepth% IcoFileHeader.IcoCount = 0 CALL AddIcon(1, PixelSize%, ColourDepth%) CASE "A" LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Add Icon - Index: ", IcoIndex% LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Add Icon - Res (16/32): ", PixelSize% LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Add Icon - BPP (4/8): ", ColourDepth% CALL AddIcon(IcoIndex%, PixelSize%, ColourDepth%) CASE "D" LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Delete Icon - Index: ", IcoIndex% CALL DeleteIcon(IcoIndex%) CASE "F" LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Change Format - Size, Depth: ", PixelSize%, ColourDepth% CALL ChangeFormat(PixelSize%, ColourDepth%) CASE "O" LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Open File - File Name: ", FileName$ CALL OpenIcon(FileName$) CASE "S" LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Save File - File Name: ", FileName$ CALL SaveIcon(FileName$) CASE "C" LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Copy Icon - Index: ", IcoIndex% LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Copy Icon - New Index: ", NewIcoIndex% CALL CopyIcon(IcoIndex%, NewIcoIndex%) CALL FillHeaders: CALL UpdateScreen CASE "M": ProgData.PrgMaskMode = NOT ProgData.PrgMaskMode CASE " ": CALL UpdatePixel CASE CHR$(27), "Q": SCREEN 0: WIDTH 80: CLS : END CASE "P" COLOR ProgData.PrgSysColor CALL DisplayIconData(ProgData.PrgCurIcon) DO: LOOP WHILE INKEY$ = "": CALL UpdateScreen CASE "I" LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Import Bmp - File Name: ", FileName$ CALL ImportBmp(FileName$) CASE "E" LOCATE 25, 1: PRINT SPACE$(40); LOCATE 25, 1: COLOR ProgData.PrgSysColor INPUT ; "Export BMP: ", FileName$ CALL ExportBmp(FileName$): CALL FillHeaders CASE CHR$(13): ProgData.PrgPenStat = NOT ProgData.PrgPenStat CASE CHR$(0) + ";" SCREEN 0: WIDTH 80 PRINT "Key Commands:": PRINT PRINT "F1 - This Help Screen" PRINT "N - New Icon" PRINT "O - Open Icon" PRINT "S - Save Icon" PRINT "I - Import Bitmap" PRINT "E - Export Bitmap" PRINT "Space - Draw Pixel" PRINT "Enter - FreeDraw On/Off" PRINT "M - Mask Mode On/Off" PRINT "Home - Color Palette Up" PRINT "End - Color Palette Down" PRINT "Delete - Color Palette Left" PRINT "Page Down - Color Palette Right" PRINT "Insert - Previous Icon" PRINT "Page Up - Next Icon" PRINT "A - Add Icon" PRINT "C - Copy Icon" PRINT "D - Delete Icon" PRINT "F - Change Icon Format" DO: LOOP WHILE INKEY$ = "" SCREEN 13: CALL UpdateScreen END SELECT IF ProgData.PrgPenStat THEN CALL UpdatePixel LOOP END SUB FUNCTION IconImageOffset (IcoIndex%) Offset1% = 6 + 16 * IcoFileHeader.IcoCount FOR CurIco% = 2 TO IcoIndex% Offset2% = Offset2% + IconImageSize(CurIco% - 1) NEXT IconImageOffset = Offset1% + Offset2% END FUNCTION FUNCTION IconImageSize (IcoIndex%) BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight \ 2 BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP PalSize& = (2 ^ BmpBitsPP%) * 4 LineSize& = (((BmpWidth& - 1) * BmpBitsPP% \ 8) OR 3) + 1 ImageSize& = LineSize& * BmpHeight& LineSize& = (((BmpWidth& - 1) \ 8) OR 3) + 1 MaskSize& = LineSize& * BmpHeight& IconImageSize = 40 + PalSize& + ImageSize& + MaskSize& END FUNCTION SUB ImportBmp (FileName$) FileNum% = FREEFILE: IcoIndex% = ProgData.PrgCurIcon OPEN FileName$ FOR BINARY AS FileNum% GET FileNum%, , BmpFileHeader(IcoIndex%) GET FileNum%, , BmpDataHeader(IcoIndex%) BmpDataHeader(IcoIndex%).BmpHeight = BmpDataHeader(IcoIndex%).BmpHeight * 2 FOR Index% = 0 TO (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) - 1 GET FileNum%, , BmpPal(IcoIndex%, Index%).Blue GET FileNum%, , BmpPal(IcoIndex%, Index%).Green GET FileNum%, , BmpPal(IcoIndex%, Index%).Red GET FileNum%, , BmpPal(IcoIndex%, Index%).Reserved NEXT BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight \ 2 BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP LineData$ = SPACE$((((BmpWidth& * BmpBitsPP% - 1) \ 8) OR 3) + 1) MaxVal% = 2 ^ BmpBitsPP% - 1: MaxPxl% = 8 \ BmpBitsPP% - 1 FOR Y% = BmpHeight& - 1 TO 0 STEP -1 GET FileNum%, , LineData$ FOR X% = 0 TO BmpWidth& - 1 PxlPos% = X% \ (MaxPxl% + 1) PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel% = (HexVal% AND (BinVal% * MaxVal%)) \ BinVal% BmpData(IcoIndex%, X%, Y%).Image = CHR$(Pixel%) NEXT NEXT FOR Y% = BmpHeight& - 1 TO 0 STEP -1: FOR X% = 0 TO BmpWidth& - 1 BmpData(IcoIndex%, X%, Y%).Mask = CHR$(0) NEXT: NEXT CLOSE : CALL FillHeaders: CALL UpdateScreen END SUB SUB MakeBmpData IcoIndex% = ProgData.PrgCurIcon FOR X% = 0 TO 31: FOR Y% = 0 TO 31 BmpData(IcoIndex%, X%, Y%).Image = CHR$(0) BmpData(IcoIndex%, X%, Y%).Mask = CHR$(1) NEXT: NEXT END SUB SUB MakePal IcoIndex% = ProgData.PrgCurIcon Colours% = 2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP FOR Index% = 0 TO 255 BmpPal(IcoIndex%, Index%).Red = CHR$(0) BmpPal(IcoIndex%, Index%).Green = CHR$(0) BmpPal(IcoIndex%, Index%).Blue = CHR$(0) NEXT RESTORE Win16Pal FOR Index% = 0 TO 15 READ Red%, Green%, Blue% BmpPal(IcoIndex%, Index%).Red = CHR$(Red%) BmpPal(IcoIndex%, Index%).Green = CHR$(Green%) BmpPal(IcoIndex%, Index%).Blue = CHR$(Blue%) NEXT IF Colours% = 256 THEN FOR Index% = 16 TO 31 Lum% = (Index% - 16) * 17 BmpPal(IcoIndex%, Index%).Red = CHR$(Lum%) BmpPal(IcoIndex%, Index%).Green = CHR$(Lum%) BmpPal(IcoIndex%, Index%).Blue = CHR$(Lum%) NEXT FOR R% = 0 TO 5: FOR G% = 0 TO 5: FOR B% = 0 TO 5 Index% = R% + G% * 6 + B% * 36 + 32 Red% = R% * 51: Green% = G% * 51: Blue% = B% * 51 BmpPal(IcoIndex%, Index%).Red = CHR$(Red%) BmpPal(IcoIndex%, Index%).Green = CHR$(Green%) BmpPal(IcoIndex%, Index%).Blue = CHR$(Blue%) NEXT: NEXT: NEXT END IF END SUB FUNCTION NearestColor (Red%, Green%, Blue%) IcoIndex% = ProgData.PrgCurIcon: TotalError% = 765 Colours% = 2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP - 1 FOR Index% = 0 TO Colours% R% = ASC(BmpPal(IcoIndex%, Index%).Red): RError% = ABS(Red% - R%) G% = ASC(BmpPal(IcoIndex%, Index%).Green): GError% = ABS(Green% - G%) B% = ASC(BmpPal(IcoIndex%, Index%).Blue): BError% = ABS(Blue% - B%) TError% = RError% + GError% + BError% IF TError% < TotalError% THEN NearestMatch% = Index%: TotalError% = TError% END IF NEXT NearestColor = NearestMatch% END FUNCTION SUB OpenIcon (FileName$) FileNum% = FREEFILE OPEN FileName$ FOR BINARY AS FileNum% GET FileNum%, , IcoFileHeader FOR IcoIndex% = 1 TO IcoFileHeader.IcoCount GET FileNum%, , IcoDataHeader(IcoIndex%) NEXT FOR IcoIndex% = 1 TO IcoFileHeader.IcoCount SEEK FileNum%, IcoDataHeader(IcoIndex%).IcoImageOffset + 1 GET FileNum%, , BmpDataHeader(IcoIndex%) FOR Index% = 0 TO (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) - 1 GET FileNum%, , BmpPal(IcoIndex%, Index%).Blue GET FileNum%, , BmpPal(IcoIndex%, Index%).Green GET FileNum%, , BmpPal(IcoIndex%, Index%).Red GET FileNum%, , BmpPal(IcoIndex%, Index%).Reserved NEXT BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP LineData$ = SPACE$((((BmpWidth& * BmpBitsPP% - 1) \ 8) OR 3) + 1) MaxVal% = 2 ^ BmpBitsPP% - 1: MaxPxl% = 8 \ BmpBitsPP% - 1 FOR Y% = BmpHeight& \ 2 - 1 TO 0 STEP -1 GET FileNum%, , LineData$ FOR X% = 0 TO BmpWidth& - 1 PxlPos% = X% \ (MaxPxl% + 1) PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel% = (HexVal% AND (BinVal% * MaxVal%)) \ BinVal% BmpData(IcoIndex%, X%, Y%).Image = CHR$(Pixel%) NEXT NEXT LineData$ = SPACE$((((BmpWidth& - 1) \ 8) OR 3) + 1) MaxVal% = 1: MaxPxl% = 7 FOR Y% = BmpHeight& \ 2 - 1 TO 0 STEP -1 GET FileNum%, , LineData$ FOR X% = 0 TO BmpWidth& - 1 PxlPos% = X% \ (MaxPxl% + 1) PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel% = (HexVal% AND (BinVal% * MaxVal%)) \ BinVal% BmpData(IcoIndex%, X%, Y%).Mask = CHR$(Pixel%) NEXT NEXT NEXT CLOSE : CALL FillHeaders: CALL UpdateScreen END SUB SUB ReadPal (Index%, Red%, Green%, Blue%) OUT &H3C7, Index%: Red% = INP(&H3C9) Green% = INP(&H3C9): Blue% = INP(&H3C9) END SUB SUB SaveIcon (FileName$) CALL FillHeaders FileNum% = FREEFILE OPEN FileName$ FOR BINARY AS FileNum% PUT FileNum%, , IcoFileHeader FOR IcoIndex% = 1 TO IcoFileHeader.IcoCount PUT FileNum%, , IcoDataHeader(IcoIndex%) NEXT FOR IcoIndex% = 1 TO IcoFileHeader.IcoCount SEEK FileNum%, IcoDataHeader(IcoIndex%).IcoImageOffset + 1 PUT FileNum%, , BmpDataHeader(IcoIndex%) FOR Index% = 0 TO (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) - 1 PUT FileNum%, , BmpPal(IcoIndex%, Index%).Blue PUT FileNum%, , BmpPal(IcoIndex%, Index%).Green PUT FileNum%, , BmpPal(IcoIndex%, Index%).Red PUT FileNum%, , BmpPal(IcoIndex%, Index%).Reserved NEXT BmpWidth& = BmpDataHeader(IcoIndex%).BmpWidth BmpHeight& = BmpDataHeader(IcoIndex%).BmpHeight BmpBitsPP% = BmpDataHeader(IcoIndex%).BmpBitsPP MaxVal% = 2 ^ BmpBitsPP% - 1: MaxPxl% = 8 \ BmpBitsPP% - 1 FOR Y% = BmpHeight& \ 2 - 1 TO 0 STEP -1 LineData$ = STRING$((((BmpWidth& * BmpBitsPP% - 1) \ 8) OR 3) + 1, 0) FOR X% = 0 TO BmpWidth& - 1 Pixel% = ASC(BmpData(IcoIndex%, X%, Y%).Image) PxlPos% = X% \ (MaxPxl% + 1): PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel$ = CHR$(HexVal% + Pixel% * BinVal%) MID$(LineData$, PxlPos% + 1, 1) = Pixel$ NEXT PUT FileNum%, , LineData$ NEXT MaxVal% = 1: MaxPxl% = 7 FOR Y% = BmpHeight& \ 2 - 1 TO 0 STEP -1 LineData$ = STRING$((((BmpWidth& - 1) \ 8) OR 3) + 1, 0) FOR X% = 0 TO BmpWidth& - 1 Pixel% = ASC(BmpData(IcoIndex%, X%, Y%).Mask) PxlPos% = X% \ (MaxPxl% + 1): PxlNum% = X% MOD (MaxPxl% + 1) HexVal% = ASC(MID$(LineData$, PxlPos% + 1, 1)) BinVal% = ((MaxVal% + 1) ^ (MaxPxl% - PxlNum%)) Pixel$ = CHR$(HexVal% + Pixel% * BinVal%) MID$(LineData$, PxlPos% + 1, 1) = Pixel$ NEXT PUT FileNum%, , LineData$ NEXT NEXT CLOSE : CALL FillHeaders: CALL UpdateScreen END SUB SUB UpdateEditBox IcoIndex% = ProgData.PrgCurIcon MaxSize% = BmpDataHeader(IcoIndex%).BmpWidth IF MaxSize% < BmpDataHeader(IcoIndex%).BmpHeight \ 2 THEN MaxSize% = BmpDataHeader(IcoIndex%).BmpHeight \ 2 END IF ProgData.PrgEditBoxZoom = 192 \ MaxSize% X1% = ProgData.PrgEditBoxX Y1% = ProgData.PrgEditBoxY X2% = X1% + ProgData.PrgEditBoxZoom * BmpDataHeader(IcoIndex%).BmpWidth + 2 Y2% = Y1% + ProgData.PrgEditBoxZoom * BmpDataHeader(IcoIndex%).BmpHeight \ 2 + 2 LINE (X1%, Y1%)-(X2%, Y2%), 0, BF LINE (X1%, Y1%)-(X2%, Y2%), ProgData.PrgSysColor, B Zoom% = ProgData.PrgEditBoxZoom FOR Y% = 0 TO BmpDataHeader(IcoIndex%).BmpHeight \ 2 - 1 FOR X% = 0 TO BmpDataHeader(IcoIndex%).BmpWidth - 1 Pixel% = ASC(BmpData(IcoIndex%, X%, Y%).Image) Mask% = ASC(BmpData(IcoIndex%, X%, Y%).Mask) XX1% = X% * Zoom% + 2 + X1%: YY1% = Y% * Zoom% + 2 + Y1% XX2% = (X% + 1) * Zoom% + X1%: YY2% = (Y% + 1) * Zoom% + Y1% IF Mask% THEN LINE (XX1%, YY1%)-(XX2%, YY2%), 0, BF LINE (XX1% + 1, YY1% + 1)-(XX2% - 1, YY2% - 1), ProgData.PrgSysColor LINE (XX1% + 1, YY2% - 1)-(XX2% - 1, YY1% + 1), ProgData.PrgSysColor ELSE LINE (XX1%, YY1%)-(XX2%, YY2%), Pixel%, BF END IF NEXT NEXT END SUB SUB UpdateEditCsr IcoIndex% = ProgData.PrgCurIcon Zoom% = ProgData.PrgEditBoxZoom BoxX% = ProgData.PrgEditBoxX BoxY% = ProgData.PrgEditBoxY OldX1% = BoxX% + ProgData.PrgOldCsrX * Zoom% + 1 OldY1% = BoxY% + ProgData.PrgOldCsrY * Zoom% + 1 OldX2% = OldX1% + Zoom%: OldY2% = OldY1% + Zoom% LINE (OldX1%, OldY1%)-(OldX2%, OldY2%), 0, B X1% = BoxX% + ProgData.PrgCurCsrX * Zoom% + 1 Y1% = BoxY% + ProgData.PrgCurCsrY * Zoom% + 1 X2% = X1% + Zoom%: Y2% = Y1% + Zoom% LINE (X1%, Y1%)-(X2%, Y2%), ProgData.PrgSysColor, B END SUB SUB UpdatePal IcoIndex% = ProgData.PrgCurIcon Colours% = (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) FOR Index% = 0 TO 255: CALL WritePal(Index%, 0, 0, 0): NEXT FOR Index% = 0 TO Colours% - 1 Red% = ASC(BmpPal(IcoIndex%, Index%).Red) \ 4 Green% = ASC(BmpPal(IcoIndex%, Index%).Green) \ 4 Blue% = ASC(BmpPal(IcoIndex%, Index%).Blue) \ 4 CALL WritePal(Index%, Red%, Green%, Blue%) NEXT ProgData.PrgSysColor = NearestColor(255, 255, 255) END SUB SUB UpdatePalBox IcoIndex% = ProgData.PrgCurIcon Zoom% = ProgData.PrgPalBoxZoom Colours% = (2 ^ BmpDataHeader(IcoIndex%).BmpBitsPP) X1% = ProgData.PrgPalBoxX: Y1% = ProgData.PrgPalBoxY X2% = X1% + Zoom% * 16 + 2: Y2% = Y1% + Zoom% * 16 + 2 LINE (X1%, Y1%)-(X2%, Y2%), 0, BF LINE (X1%, Y1%)-(X2%, Y2%), ProgData.PrgSysColor, B FOR Index% = 0 TO Colours% - 1 X% = Index% MOD 16: Y% = Index% \ 16 XX1% = X% * Zoom% + 2 + X1%: YY1% = Y% * Zoom% + 2 + Y1% XX2% = (X% + 1) * Zoom% + X1%: YY2% = (Y% + 1) * Zoom% + Y1% LINE (XX1%, YY1%)-(XX2%, YY2%), Index%, BF NEXT END SUB SUB UpdatePalCsr IcoIndex% = ProgData.PrgCurIcon: Zoom% = ProgData.PrgPalBoxZoom BoxX% = ProgData.PrgPalBoxX: BoxY% = ProgData.PrgPalBoxY OldIndex% = ProgData.PrgOldColor OldX1% = BoxX% + (OldIndex% MOD 16) * Zoom% + 1 OldY1% = BoxY% + (OldIndex% \ 16) * Zoom% + 1 OldX2% = OldX1% + Zoom%: OldY2% = OldY1% + Zoom% LINE (OldX1%, OldY1%)-(OldX2%, OldY2%), 0, B Index% = ProgData.PrgCurColor X1% = BoxX% + (Index% MOD 16) * Zoom% + 1 Y1% = BoxY% + (Index% \ 16) * Zoom% + 1 X2% = X1% + Zoom%: Y2% = Y1% + Zoom% LINE (X1%, Y1%)-(X2%, Y2%), ProgData.PrgSysColor, B END SUB SUB UpdatePixel IcoIndex% = ProgData.PrgCurIcon BoxX% = ProgData.PrgEditBoxX: BoxY% = ProgData.PrgEditBoxY X% = ProgData.PrgCurCsrX: Y% = ProgData.PrgCurCsrY Colour% = ProgData.PrgCurColor: Mask% = ABS(ProgData.PrgMaskMode) Zoom% = ProgData.PrgEditBoxZoom BmpData(IcoIndex%, X%, Y%).Image = CHR$(Colour%) IF Mask% THEN BmpData(IcoIndex%, X%, Y%).Image = CHR$(0) BmpData(IcoIndex%, X%, Y%).Mask = CHR$(Mask%) XX1% = X% * Zoom% + 2 + X1%: YY1% = Y% * Zoom% + 2 + Y1% XX2% = (X% + 1) * Zoom% + X1%: YY2% = (Y% + 1) * Zoom% + Y1% IF Mask% THEN LINE (XX1%, YY1%)-(XX2%, YY2%), 0, BF LINE (XX1% + 1, YY1% + 1)-(XX2% - 1, YY2% - 1), ProgData.PrgSysColor LINE (XX1% + 1, YY2% - 1)-(XX2% - 1, YY1% + 1), ProgData.PrgSysColor ELSE LINE (XX1%, YY1%)-(XX2%, YY2%), Colour%, BF END IF END SUB SUB UpdateScreen CLS : CALL UpdatePal CALL UpdateEditBox: CALL UpdatePalBox CALL UpdateEditCsr: CALL UpdatePalCsr END SUB SUB WritePal (Index%, Red%, Green%, Blue%) OUT &H3C8, Index%: OUT &H3C9, Red% OUT &H3C9, Green%: OUT &H3C9, Blue% END SUB