'=========================================================================== ' Subject: CONVERT BMP/PCX/GIF FILES Date: 02-09-98 (23:31) ' Author: Sami Kyostila Code: QB, PDS ' Origin: hiteck@utanet.fi Packet: GRAPHICS.ABC '=========================================================================== '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' C O N V E R T v1.0 - by Sami Ky봲til� 1998 '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' ' See Program/About for more info on program. ' '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' You may use this code freely, as long as you give me some credit for it. '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 DECLARE SUB About () DECLARE SUB Append.Code (Code$) DECLARE SUB SaveBMP8 (Pic$, X1%, Y1%, X2%, Y2%) DECLARE FUNCTION LongToString$ (L&) DECLARE SUB Load.RAW (File$, XLen%, YLen%, Segment%, Offset%) DECLARE SUB Load.BSave (File$) DECLARE SUB Save.Palette (File$, InpFormat$, OutFormat$) DECLARE SUB Draw.PaletteMenu (Col%) DECLARE SUB SmoothPal (Iter&) DECLARE SUB Draw.Palette (ActiveCol%) DECLARE SUB View.Palette () DECLARE SUB Edit.Palette () DEFINT A-Z DECLARE SUB RotatePal () DECLARE SUB Roller (x%, y%, XLen%, Text$, FCol%) DECLARE FUNCTION FindBrightestColor% () DECLARE FUNCTION FindBrighestColor% () DECLARE SUB Save.Image (InpFile$, InpFormat$, OutFormat$) DECLARE FUNCTION QueryFile$ (WildCard$) DECLARE FUNCTION ScanDir% (FileSpec$, Output$) DECLARE SUB SeekFileItem (File%, Item%) DECLARE FUNCTION RealLen% (Text$) DECLARE SUB Center (Text$, YPos%) DECLARE SUB ColPrint (Text$) DECLARE FUNCTION DirEntry% (Entry AS STRING) DECLARE FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER) DECLARE SUB SetDTA (FileInfo AS ANY) DECLARE FUNCTION DirNext$ () DECLARE SUB DrawFileList (File%, Offset%, Selected%, Max%) DECLARE SUB DrawWindow (x%, y%, X2%, Y2%, FCol%, BCol%, Topic$, Shadow%) DECLARE SUB EraseMessage () DECLARE SUB ErrorDialog (Desc$) DECLARE FUNCTION InputField$ (Text$, Key$, MaxLen%, TPos%) DECLARE FUNCTION Query$ (Text$, Topic$, MaxLen%, TField$) DECLARE FUNCTION Load.Palette% (File$, Format$) '$DYNAMIC DECLARE FUNCTION Load.Image% (File$, Format$) DECLARE FUNCTION Getbit% () DECLARE SUB Plot (a%) DECLARE FUNCTION ReadCode% (CodeSize%) DECLARE SUB Show.Image () DECLARE SUB Gauge (XPos%, YPos%, XLen%, Value&, Max&, Char$) DECLARE SUB PrintText (Text$) DECLARE SUB ClearScreen () DECLARE SUB Set.Palette () DECLARE FUNCTION ReturnNibble% (Byte%, WhichOne%) DECLARE SUB FillChar (Segment%, Offset%, Value%, Bytes%) DECLARE SUB MemCopy (fromseg%, FromOffset%, toseg%, ToOffset%, Bytes%) DECLARE FUNCTION ReturnBit% (Byte%, Bit%) DECLARE SUB Create.MenuItem (Num%, Caption$, Style AS STRING, Selected AS STRING, Active AS STRING) DECLARE SUB Create.Menu (Num%, Caption$) DECLARE SUB Set.MenuTopic (Num%, Topic$) DECLARE SUB Main () DECLARE SUB Set.MenuItem (MenuNum%, Num%, Caption$, Active AS STRING, Style AS STRING, Selected AS STRING) DECLARE FUNCTION Get.MenuItem$ (MenuNum%, Num%) DECLARE SUB Get.MenuItemInfo (MenuNum%, Num%, Style AS STRING, Selected AS STRING, HelpText AS STRING) DECLARE SUB Draw.Menu () DECLARE SUB Init.Menu () DECLARE FUNCTION Exist% (File$) DECLARE SUB MStatus (x%, y%, B1%, B2%) DECLARE SUB UpdateMouse () DECLARE SUB PPrint (x%, y%, Text$, FCol%, BCol%) DECLARE SUB PokeChar (x%, y%, Char$, FCol%, BCol%) DECLARE FUNCTION PeekChar$ (x%, y%) DECLARE SUB Draw.Border (x%, y%, X2%, Y2%, FCol%, BCol%) DECLARE FUNCTION Get.MenuTopic$ (Num%) DECLARE FUNCTION PopupMenu% (x%, y%, Num%, Click%) DECLARE SUB MHide () DECLARE SUB MShow () DECLARE FUNCTION MInit! () DEFINT A-Z TYPE RegType ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER END TYPE TYPE RegTypeX ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE TYPE MenuItemType Caption AS STRING * 50 Active AS STRING * 1 Style AS STRING * 1 Selected AS STRING * 1 END TYPE TYPE MenuType Topics AS INTEGER BarSize AS INTEGER MenuFCol AS INTEGER MenuBCol AS INTEGER MenuDisabled AS INTEGER END TYPE TYPE MenuSelectedType Menu AS INTEGER Item AS INTEGER END TYPE TYPE DOSFileInfo fiReserved AS STRING * 21 'for DOS' internal use fiAttribute AS STRING * 1 'file attribute code fiFileTime AS INTEGER 'file time (in DOS format) fiFileDate AS INTEGER 'file date (in DOS format) fiSize AS LONG 'file size (in bytes) fiFileName AS STRING * 13 'file name (without path) END TYPE ' Type directory entry: CONST IsNONE = 0 'directory entry doesn't exist CONST IsFILE = 1 'is a file CONST IsDIRECTORY = 2 'is a directory CONST IsDEVICE = 3 'is a device CONST IsVOLUME = 4 'is a volume label ' Maximum length of directory path in DOS CONST MAXDOSPATH = 67 ' Bit value of carry bit in flags register CONST CARRY = 1 ' Boolean values CONST False = 0, True = -1 CONST Lines = 25 CONST F.NOR = &H200 'constant for "normal" files (*files* displayed with DIR) CONST F.NON = &H100 'constant for files without any attribute CONST F.ARC = &H20 'constant for archive file attribute CONST F.DIR = &H10 'constant for directory file attribute CONST F.VOL = &H8 'constant for volume file attribute CONST F.SYS = &H4 'constant for system file attribute CONST F.HID = &H2 'constant for hidden file attribute (may return directory) CONST F.RDO = &H1 'constant for read-only file attribute CONST F.ANY = &H0 'constant for any of the above ' Named common block with DOS error code COMMON SHARED /DOSError/ DOSError AS INTEGER DIM SHARED Pal AS STRING * 768 DIM SHARED Regs AS RegType DIM SHARED ASMMemCopy$ DIM SHARED ASMFillChar$ DIM SHARED Buffer(0 TO 319, 0 TO 199) AS STRING * 1 DIM SHARED Powers(8) AS INTEGER DIM SHARED Prefix(0 TO 4096) AS INTEGER DIM SHARED Suffix(0 TO 4096) AS INTEGER DIM SHARED OutCode(0 TO 1024) AS INTEGER DIM SHARED codemask(12) AS INTEGER DIM SHARED MaxCodes(12) AS INTEGER DIM SHARED Powers2(16) AS INTEGER DIM SHARED Xstart, Xend DIM SHARED FList AS STRING * 12 DIM SHARED Num AS INTEGER DIM SHARED Bitsin AS INTEGER DIM SHARED BlockLength AS INTEGER DIM SHARED FileInfo AS DOSFileInfo asm$ = "" asm$ = asm$ + CHR$(85) asm$ = asm$ + CHR$(137) + CHR$(229) asm$ = asm$ + CHR$(30) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) asm$ = asm$ + CHR$(142) + CHR$(192) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) asm$ = asm$ + CHR$(142) + CHR$(216) asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12) asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) asm$ = asm$ + CHR$(243) asm$ = asm$ + CHR$(164) asm$ = asm$ + CHR$(31) asm$ = asm$ + CHR$(93) asm$ = asm$ + CHR$(203) ASMMemCopy$ = asm$ asm$ = "" asm$ = asm$ + CHR$(85) asm$ = asm$ + CHR$(137) + CHR$(229) asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8) asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12) asm$ = asm$ + CHR$(30) asm$ = asm$ + CHR$(142) + CHR$(216) asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10) asm$ = asm$ + CHR$(136) + CHR$(23) asm$ = asm$ + CHR$(67) asm$ = asm$ + CHR$(226) + CHR$(251) asm$ = asm$ + CHR$(31) asm$ = asm$ + CHR$(93) asm$ = asm$ + CHR$(203) ASMFillChar$ = asm$ DIM SHARED MenuItems(1 TO 40) AS INTEGER DIM SHARED MenuItem AS MenuItemType DIM SHARED FBuffer(0 TO 2000) AS INTEGER DIM SHARED QMenu AS MenuType DIM SHARED MenuSelected AS MenuSelectedType SCREEN 0: WIDTH 80, 25 COLOR 7, 0: CLS IF NOT MInit THEN PRINT " � Mouse not found!": END IF Exist("Menuswap.tmp") = True THEN KILL "menuswap.tmp" IF Exist("Itemswap.tmp") = True THEN KILL "itemswap.tmp" OPEN "Menuswap.tmp" FOR BINARY AS #250 OPEN "Itemswap.tmp" FOR BINARY AS #251 SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS PALETTE 1, 40 PALETTE 3, 35 Draw.Border 1, 1, 80, 25, 7, 1 VIEW PRINT 2 TO 25 MShow Init.Menu DO Main IF MenuSelected.Menu = 2 THEN LOCATE 3 SELECT CASE MenuSelected.Item CASE 1 PrintText " � View BMP File" File$ = QueryFile("*.BMP") IF File$ <> "" THEN IF Load.Image(File$, "BMP") THEN Show.Image ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 2 PrintText " � View PCX File" File$ = QueryFile("*.PCX") IF File$ <> "" THEN IF Load.Image(File$, "PCX") THEN Show.Image ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 3 PrintText " � View GIF File" File$ = QueryFile("*.GIF") IF File$ <> "" THEN IF Load.Image(File$, "GIF") THEN Show.Image ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 4 Show.Image CASE 6 PrintText " � BSave BMP File" File$ = QueryFile("*.BMP") IF File$ <> "" THEN Save.Image File$, "BMP", "BSAVE" END IF ClearScreen CASE 7 PrintText " � BSave PCX File" File$ = QueryFile("*.PCX") IF File$ <> "" THEN Save.Image File$, "PCX", "BSAVE" END IF ClearScreen CASE 8 PrintText " � BSave GIF File" File$ = QueryFile("*.GIF") IF File$ <> "" THEN Save.Image File$, "GIF", "BSAVE" END IF ClearScreen CASE 10 PrintText " � Save BMP File As Raw Data" File$ = QueryFile("*.BMP") IF File$ <> "" THEN Save.Image File$, "BMP", "RAW" END IF ClearScreen CASE 11 PrintText " � Save PCX File As Raw Data" File$ = QueryFile("*.PCX") IF File$ <> "" THEN Save.Image File$, "PCX", "RAW" END IF ClearScreen CASE 12 PrintText " � Save GIF File As Raw Data" File$ = QueryFile("*.GIF") IF File$ <> "" THEN Save.Image File$, "GIF", "RAW" END IF ClearScreen CASE 14 PrintText " � Save BMP File As DATA Statements" File$ = QueryFile("*.BMP") IF File$ <> "" THEN Save.Image File$, "BMP", "DATA" END IF ClearScreen CASE 15 PrintText " � Save PCX File As DATA Statements" File$ = QueryFile("*.PCX") IF File$ <> "" THEN Save.Image File$, "PCX", "DATA" END IF ClearScreen CASE 16 PrintText " � Save GIF File As DATA Statements" File$ = QueryFile("*.GIF") IF File$ <> "" THEN Save.Image File$, "GIF", "DATA" END IF ClearScreen END SELECT END IF IF MenuSelected.Menu = 3 THEN LOCATE 3 SELECT CASE MenuSelected.Item CASE 1 PrintText " � Edit Raw Palette" File$ = QueryFile("*.*") IF File$ <> "" THEN IF Load.Palette(File$, "RAW") THEN Edit.Palette ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 2 PrintText " � Save Raw Palette As BMP Palette" File$ = QueryFile("*.*") IF File$ <> "" THEN IF Load.Palette(File$, "RAW") THEN Save.Palette File$, "RAW", "BMP" ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 4 PrintText " � View BMP Palette" File$ = QueryFile("*.BMP") IF File$ <> "" THEN IF Load.Palette(File$, "BMP") THEN View.Palette ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 5 PrintText " � View PCX Palette" File$ = QueryFile("*.PCX") IF File$ <> "" THEN IF Load.Palette(File$, "PCX") THEN View.Palette ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 6 PrintText " � View GIF Palette" File$ = QueryFile("*.GIF") IF File$ <> "" THEN IF Load.Palette(File$, "GIF") THEN View.Palette ELSE DO: LOOP UNTIL INKEY$ <> "" END IF ClearScreen CASE 8 PrintText " � Save BMP Palette As Raw Data" File$ = QueryFile("*.BMP") IF File$ <> "" THEN Save.Palette File$, "BMP", "RAW" END IF ClearScreen CASE 9 PrintText " � Save PCX Palette As Raw Data" File$ = QueryFile("*.PCX") IF File$ <> "" THEN Save.Palette File$, "PCX", "RAW" END IF ClearScreen CASE 10 PrintText " � Save GIF Palette As Raw Data" File$ = QueryFile("*.GIF") IF File$ <> "" THEN Save.Palette File$, "GIF", "RAW" END IF ClearScreen CASE 12 PrintText " � Save BMP Palette As DATA Statements" File$ = QueryFile("*.BMP") IF File$ <> "" THEN Save.Palette File$, "BMP", "DATA" END IF ClearScreen CASE 13 PrintText " � Save PCX Palette As DATA Statements" File$ = QueryFile("*.PCX") IF File$ <> "" THEN Save.Palette File$, "PCX", "DATA" END IF ClearScreen CASE 14 PrintText " � Save GIF Palette As DATA Statements" File$ = QueryFile("*.GIF") IF File$ <> "" THEN Save.Palette File$, "GIF", "DATA" END IF ClearScreen END SELECT END IF IF MenuSelected.Menu = 4 THEN LOCATE 3 SELECT CASE MenuSelected.Item CASE 1 PrintText " � Append BLoader" Append.Code "BLOAD" ClearScreen CASE 2 PrintText " � Append RAW-Loader" Append.Code "RAW" ClearScreen CASE 3 PrintText " � Append DATA-Loader" Append.Code "DATA" ClearScreen CASE 5 PrintText " � Append RAW Palette Loader" Append.Code "PALETTE" ClearScreen CASE 6 PrintText " � Append DATA Palette Loader" Append.Code "DATAPALETTE" ClearScreen END SELECT END IF IF MenuSelected.Menu = 1 AND MenuSelected.Item = 1 THEN About: ClearScreen LOOP UNTIL MenuSelected.Menu = 1 AND MenuSelected.Item = 3 MHide CLOSE #250 CLOSE #251 IF Exist("Menuswap.tmp") = True THEN KILL "menuswap.tmp" IF Exist("Itemswap.tmp") = True THEN KILL "itemswap.tmp" COLOR 7, 0: CLS SYSTEM GifDATA: DATA 4,8,16,&h20,&h40,&h80,&h100,&h200,&h400,&h800,&h1000,8192 DATA 1,3,7,15,31,63,127,255 DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384 REM $STATIC SUB About ClearScreen LOCATE 3 PrintText " � C O N V E R T - (C) Sami Ky봲til� 1998 �" PRINT PrintText " Convert is a multifunctional image convertion utility for MS QB 4.5" PRINT PrintText " This program can convert BMP/PCX/GIF files into formats that you can" PrintText " use in your own programs. It can also extract palettes from BMP/PCX/GIF" PrintText " files that you can edit and save to RAW palette files. If you are not" PrintText " sure how to load the files made by this program, not to worry! It even" PrintText " writes the loading routines for you!" PRINT PrintText " Images can be saved into the following formats: BSAVE, RAW, and DATA" PRINT PrintText " - BSAVE is a very fast format, good for full screen logos and such." PrintText " Palette can be appended to BSAVED files, too (320x200 only, see Options)" PrintText " - RAW is good for saving sprites and other small images. You can load these" PrintText " files on screen or into an array. Palette can't be saved with this format." PrintText " - DATA is also good for small images. These files are stored directly into" PrintText " a QBasic source file (QB45 File must be saved as ASCII)." PRINT PrintText " � Press any key to continue..." DO: LOOP UNTIL INKEY$ <> "" ClearScreen LOCATE 3 PrintText " � C O N V E R T - (C) Sami Ky봲til� 1998 �" PRINT PrintText " Palettes can be saved into the following formats: RAW, and DATA" PRINT PrintText " - RAW is a 768 byte binary file, that contains RGB format data." PrintText " - DATA is saved directly into a QBasic source file as DATA" PrintText " statements (QB45 File must be saved as ASCII)." PRINT PrintText " NOTE: In order to edit BMP/PCX/GIF palettes, you must first save them" PrintText " to RAW palette data files and then edit those." PRINT PrintText " � This program is Freeware! �" PRINT PrintText " You may use any part of this code, as long as you give me some" PrintText " credit for it." PRINT PrintText " This program was completely made by Sami Ky봲til�, except for:" PrintText " - The BMP-saving routine, which was made by Stephen L. Maxson" PrintText " - The BMP/PCX/GIF loaders were modified from Otso Karhu's/" PrintText " Kurt Kuzba's/Unknown's programs." PrintText " � Press any key to continue..." DO: LOOP UNTIL INKEY$ <> "" END SUB SUB Append.Code (Code$) MHide Out$ = RTRIM$(LTRIM$(UCASE$(Query(" Enter the output file ", "&0%7 Save Image ", 60, "")))) IF Out$ = "" THEN MShow: EXIT SUB LOCATE 3 OPEN Out$ FOR BINARY AS #1 Temp$ = SPACE$(1) GET #1, , Temp$ CLOSE #1 IF Temp$ = CHR$(252) THEN PrintText " � This file is probably a QB compressed file!" DO: LOOP UNTIL INKEY$ <> "" EXIT SUB END IF SELECT CASE Code$ CASE "BLOAD" PrintText " � Appending BLOADer..." OPEN Out$ FOR APPEND AS #1 PRINT #1, "" PRINT #1, "DEFINT A-Z" PRINT #1, "SUB Load.BSave (File$)" PRINT #1, "" PRINT #1, "' BLOADER from CONVERT (C) Sami Ky봲til� 1998" PRINT #1, "" PRINT #1, "DEF SEG = &HA000" PRINT #1, "BLOAD File$, 0" PRINT #1, "DEF SEG" PRINT #1, "File = FREEFILE" PRINT #1, "OPEN File$ FOR BINARY AS #File" PRINT #1, "IF LOF(File) > 320& * 200& THEN" PRINT #1, " TempPal$ = SPACE$(768)" PRINT #1, " GET #1, 320& * 200& + 7, TempPal$" PRINT #1, " FOR i& = 0 TO 255" PRINT #1, " r = ASC(MID$(TempPal$, (i& * 3) + 1, 1))" PRINT #1, " g = ASC(MID$(TempPal$, (i& * 3) + 2, 1))" PRINT #1, " b = ASC(MID$(TempPal$, (i& * 3) + 3, 1))" PRINT #1, " OUT (&H3C8), i&" PRINT #1, " OUT (&H3C9), r" PRINT #1, " OUT (&H3C9), g" PRINT #1, " OUT (&H3C9), b" PRINT #1, " NEXT" PRINT #1, "END IF" PRINT #1, "CLOSE File" PRINT #1, "END SUB" CLOSE #1 PrintText " � Done" CASE "RAW" PrintText " � Appending RAW Loader..." OPEN Out$ FOR APPEND AS #1 PRINT #1, "DEFINT A-Z" PRINT #1, "SUB Load.RAW (File$, XLen, YLen, Segment, Offset)" PRINT #1, "" PRINT #1, "' RAW Loader from CONVERT (C) Sami Ky봲til� 1998" PRINT #1, "" PRINT #1, "File = FREEFILE" PRINT #1, "OPEN File$ FOR BINARY AS #File" PRINT #1, "" PRINT #1, "DIM ReadByte AS STRING * 1" PRINT #1, "" PRINT #1, "IF Segment <> -1 AND Offset <> -1 THEN" PRINT #1, " DEF SEG = Segment" PRINT #1, " POffset = Offset" PRINT #1, " FOR y = 0 TO YLen" PRINT #1, " FOR x = 0 TO XLen" PRINT #1, " GET #File, , ReadByte" PRINT #1, " POKE POffset, ASC(ReadByte)" PRINT #1, " POffset = POffset + 1" PRINT #1, " NEXT" PRINT #1, " NEXT" PRINT #1, "ELSE" PRINT #1, " DEF SEG = &HA000" PRINT #1, " FOR y = 0 TO YLen" PRINT #1, " FOR x = 0 TO XLen" PRINT #1, " GET #File, , ReadByte" PRINT #1, " POKE (CLNG(y) * 320& + CLNG(x)), ASC(ReadByte)" PRINT #1, " NEXT" PRINT #1, " NEXT" PRINT #1, "END IF" PRINT #1, "DEF SEG" PRINT #1, "END SUB" CLOSE #1 PrintText " � Done" CASE "DATA" PrintText " � Appending DATA Loader..." OPEN Out$ FOR APPEND AS #1 PRINT #1, "DEFINT A-Z" PRINT #1, "SUB Load.DATA (XLen, YLen, Segment, Offset)" PRINT #1, "" PRINT #1, "' DATA Loader from CONVERT (C) Sami Ky봲til� 1998" PRINT #1, "" PRINT #1, "IF Segment <> -1 AND Offset <> -1 THEN" PRINT #1, " DEF SEG = Segment" PRINT #1, " FOR y = 0 TO YLen" PRINT #1, " FOR x = 0 TO XLen" PRINT #1, " READ ReadByte" PRINT #1, " POKE POffset, ReadByte" PRINT #1, " POffset = POffset + 1" PRINT #1, " NEXT" PRINT #1, " NEXT" PRINT #1, "ELSE" PRINT #1, " DEF SEG = &HA000" PRINT #1, " FOR y = 0 TO YLen" PRINT #1, " FOR x = 0 TO XLen" PRINT #1, " READ ReadByte" PRINT #1, " POKE (CLNG(y) * 320& + CLNG(x)), ReadByte" PRINT #1, " NEXT" PRINT #1, " NEXT" PRINT #1, "END IF" PRINT #1, "DEF SEG" PRINT #1, "CLOSE File" PRINT #1, "" PRINT #1, "END SUB" CLOSE #1 PrintText " � Done" CASE "PALETTE" PrintText " � Appending Palette Loader..." OPEN Out$ FOR APPEND AS #1 PRINT #1, "DEFINT A-Z" PRINT #1, "SUB Load.Palette (File$)" PRINT #1, "" PRINT #1, "' RAW Palette Loader from CONVERT (C) Sami Ky봲til� 1998" PRINT #1, "" PRINT #1, "DIM Bt AS STRING * 1" PRINT #1, "TempFile = FREEFILE" PRINT #1, "OPEN File$ FOR BINARY AS TempFile" PRINT #1, "FOR I = 0 TO 255" PRINT #1, " OUT &H3C8, I" PRINT #1, " GET #TempFile, , Bt" PRINT #1, " OUT &H3C9, ASC(Bt)" PRINT #1, " GET #TempFile, , Bt" PRINT #1, " OUT &H3C9, ASC(Bt)" PRINT #1, " GET #TempFile, , Bt" PRINT #1, " OUT &H3C9, ASC(Bt)" PRINT #1, "NEXT" PRINT #1, "CLOSE TempFile" PRINT #1, "END SUB" CLOSE #1 PrintText " � Done" CASE "DATAPALETTE" PrintText " � Appending DATA Palette Loader..." OPEN Out$ FOR APPEND AS #1 PRINT #1, "DEFINT A-Z" PRINT #1, "SUB Load.DATAPalette" PRINT #1, "" PRINT #1, "' DATA Palette Loader from CONVERT (C) Sami Ky봲til� 1998" PRINT #1, "" PRINT #1, "FOR x = 0 TO 255" PRINT #1, " OUT (&H3C8), x - 1" PRINT #1, " READ Red, Green, Blue" PRINT #1, " OUT (&H3C9), Red" PRINT #1, " OUT (&H3C9), Green" PRINT #1, " OUT (&H3C9), Blue" PRINT #1, "NEXT" PRINT #1, "END SUB" CLOSE #1 PrintText " � Done" END SELECT PRINT PrintText " � Press any key to continue..." DO: LOOP UNTIL INKEY$ <> "" END SUB SUB Center (Text$, YPos) LOCATE YPos, 40 - RealLen(Text$) \ 2 ColPrint Text$ END SUB SUB ClearScreen MHide PCOPY 0, 1 SCREEN , , 0, 1 COLOR 7, 1: CLS PALETTE 1, 40 PALETTE 3, 35 Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu SCREEN , , 0, 0 MShow END SUB SUB ColPrint (Text$) '---------------------------------------------------------------------------- ' S�Y�S�T�E�M '---------------------------------------------------------------------------- '---------------------------------------------------------------------------- ' Prints color-coded text '---------------------------------------------------------------------------- ' Color codes: ' ' & followed by a color value between 0-15 (in hex) ' % same as &, except for backround color ' ' Example: ' ' This text is &Cred '---------------------------------------------------------------------------- FOR I = 1 TO LEN(Text$) Done = 0 DO IF MID$(Text$, I, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, I + 1, 1)) AND I < LEN(Text$) THEN COLOR VAL("&H" + MID$(Text$, I + 1, 1)) I = I + 2 ELSEIF MID$(Text$, I, 1) = "%" AND INSTR("01234567", MID$(Text$, I + 1, 1)) AND I < LEN(Text$) THEN COLOR , VAL("&H" + MID$(Text$, I + 1, 1)) I = I + 2 ELSE Done = 1 END IF LOOP UNTIL Done PRINT MID$(Text$, I, 1); NEXT END SUB SUB Create.Menu (Num, Caption$) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Creates a main menu number Num, with the text Caption$ '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 IF Num >= QMenu.Topics THEN QMenu.Topics = QMenu.Topics + 1 Num = QMenu.Topics END IF Set.MenuTopic Num, Caption$ Draw.Menu END SUB SUB Create.MenuItem (Num, Caption$, Style AS STRING, Selected AS STRING, Active AS STRING) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Adds a menuitem into the menu Num with the text Caption$ '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' ' Style - "1" or "0" - If 1, then Item can be toggled on/off ' else it is a normal menu item ' ' Selected - "1" or "0" - If Style = "1", then you can choose whether the ' item is initially selected or not (1/0) ' ' Active - "1" or "0" - Specifies if the menu item is active, or ' grayed out. ' '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Set.MenuItem Num, MenuItems(Num) + 1, Caption$, Active, Style, Selected MenuItems(Num) = MenuItems(Num) + 1 END SUB FUNCTION DirEntry% (Entry AS STRING) '---------------------------------------------------------------------- ' Establishes if a directory entry exists and returns type of entry ' (file, subdirectory or device). ' Type of directory entry returned by the function is one of the ' following values: ' 0 (IsNONE ) ' 1 (IsFILE ) ' 2 (IsDIRECTORY) ' 3 (IsDEVICE ) ' Examples: ' FileExist = (DirEntry(FileName$) = IsFILE) ' DirExist = (DirEntry(FileName$) = IsDIRECTORY) '---------------------------------------------------------------------- DIM fiAttrib AS INTEGER DIM Temp AS STRING Temp$ = DirFirst$(Entry, &H77) 'attribute for everything except label IF LEN(Temp$) THEN fiAttrib = ASC(FileInfo.fiAttribute) IF fiAttrib AND &H40 THEN DirEntry% = IsDEVICE ELSEIF fiAttrib AND &H10 THEN DirEntry% = IsDIRECTORY ELSE DirEntry% = IsFILE END IF ELSE DirEntry% = IsNONE END IF END FUNCTION FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER) '---------------------------------------------------------------------- ' Gets the first file name with matching mask and attributes ' If an error is encountered the function returns "" as its value. '---------------------------------------------------------------------- DIM MaskZ AS STRING DIM Reg AS RegTypeX DIM Zero AS INTEGER MaskZ = Mask + CHR$(0) SetDTA FileInfo ' Set up FileInfo as DTA FileInfo.fiFileName = STRING$(13, 0) ' Clean the data structure Reg.ax = &H4E00 ' search attributes including read-only files Reg.cx = Attrib OR 1 Reg.ds = VARSEG(MaskZ) ' address of file mask Reg.dx = SADD(MaskZ) CALL InterruptX(&H21, Reg, Reg) IF (Reg.flags AND CARRY) THEN ' if error DOSError = Reg.ax ' error number in DOSError DirFirst$ = "" ELSE DOSError = 0 Zero = INSTR(FileInfo.fiFileName, CHR$(0)) DirFirst$ = LEFT$(FileInfo.fiFileName, Zero - 1) ' the file name END IF END FUNCTION FUNCTION DirNext$ '---------------------------------------------------------------------- ' Gets the next file name with matching mask and attributes. ' If an error is encountered the function returns "" as its value. '---------------------------------------------------------------------- DIM Reg AS RegTypeX DIM Zero AS INTEGER FileInfo.fiFileName = STRING$(13, 0) ' Clean the data structure Reg.ax = &H4F00 CALL InterruptX(&H21, Reg, Reg) IF (Reg.flags AND CARRY) THEN ' if error DOSError = Reg.ax ' error number in DOSError DirNext$ = "" ELSE DOSError = 0 Zero = INSTR(FileInfo.fiFileName, CHR$(0)) DirNext$ = LEFT$(FileInfo.fiFileName, Zero - 1) ' the file name END IF END FUNCTION SUB Draw.Border (x, y, X2, Y2, FCol, BCol) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Draws the menu border '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 FOR I = x + 1 TO X2 - 1 PokeChar I, y, "�", FCol, BCol PokeChar I, Y2, "�", FCol, BCol NEXT FOR I = y + 1 TO Y2 - 1 PokeChar x, I, "�", FCol, BCol PokeChar X2, I, "�", FCol, BCol NEXT PokeChar x, y, "�", FCol, BCol PokeChar X2, y, "�", FCol, BCol PokeChar x, Y2, "�", FCol, BCol PokeChar X2, Y2, "�", FCol, BCol END SUB SUB Draw.Menu '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Draws the menu bar at the top of the screen '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 MHide IF QMenu.Topics > 0 THEN xx = 1 yy = 1 FOR I = 1 TO QMenu.Topics Menu$ = Get.MenuTopic$(I) IF xx + LEN(Menu$) + 2 < 81 THEN PPrint xx, yy, " " + Menu$ + " ", QMenu.MenuFCol, QMenu.MenuBCol xx = xx + LEN(Menu$) + 2 ELSE PPrint xx, yy, STRING$(80 - xx + 1, " "), QMenu.MenuFCol, QMenu.MenuBCol yy = yy + 1 xx = 1 PPrint xx, yy, " " + Menu$ + " ", QMenu.MenuFCol, QMenu.MenuBCol xx = xx + LEN(Menu$) + 2 END IF PPrint xx, yy, STRING$(80 - xx + 1, " "), QMenu.MenuFCol, QMenu.MenuBCol NEXT QMenu.BarSize = yy END IF MShow END SUB SUB Draw.Palette (ActiveCol) BCol = FindBrightestColor Col = 0 FOR y = 20 TO 140 STEP 10 FOR x = 20 TO 280 STEP 10 LINE (x, y)-(x + 9, y + 9), Col, BF IF Col = ActiveCol THEN LINE (x, y)-(x + 9, y + 9), BCol, B END IF Col = Col + 1 IF Col = 256 THEN EXIT SUB NEXT NEXT END SUB SUB Draw.PaletteMenu (Col) COLOR Col LOCATE 16, 34 PRINT "R G B" LINE (299, 130)-(300, 193), Col, BF LINE (283, 130)-(284, 193), Col, BF LINE (267, 130)-(268, 193), Col, BF LOCATE 17, 1: PRINT "旼컴컴컫컴컴컴컴�" LOCATE 18, 1: PRINT "� Save � Restore�" LOCATE 19, 1: PRINT "읕컴컴컨컴컴컴컴�" LOCATE 20, 1: PRINT "旼컴컴컴컴컫컴컴컴컴컴�" LOCATE 21, 1: PRINT "� Gradient � Smoothen �" LOCATE 22, 1: PRINT "읕컴컴컴컴컨컴컴컴컴컴�" END SUB SUB DrawFileList (File, Offset, Selected, Max) BlockPos = (Selected + 1) / (Max) * (Lines - 9) + 4 COLOR 0, 7 FOR I = 4 TO Lines - 5 LOCATE I, 31 IF I <> BlockPos THEN PRINT "�"; NEXT LOCATE BlockPos, 31 PRINT "�"; LOCATE 3, 31 PRINT CHR$(24); LOCATE Lines - 4, 31 PRINT CHR$(25) Count = Offset SeekFileItem File, Count FOR I = 3 TO Lines - 4 GET #File, , FList LOCATE I, 16 IF Count = Selected THEN COLOR 15, 1 ELSE COLOR 7, 4 END IF IF FBuffer(Count) THEN COLOR 10 PRINT CHR$(16); ELSE PRINT " "; END IF PRINT FList; Count = Count + 1 NEXT END SUB SUB DrawWindow (x, y, X2, Y2, FCol, BCol, Topic$, Shadow) SCREEN , , 1, 0 PCOPY 0, 1 COLOR FCol, BCol XLen = X2 - x LOCATE y, x, 0 PRINT "�" + STRING$(XLen - 2, "�") + "�"; FOR I = y + 1 TO Y2 - 1 LOCATE I, x PRINT "�" + STRING$(XLen - 2, " ") + "�"; NEXT LOCATE Y2, x, 0 PRINT "�" + STRING$(XLen - 2, "�") + "�"; LOCATE y, x + ((X2 - x) \ 2) - RealLen(Topic$) \ 2 ColPrint Topic$ PCOPY 1, 0 SCREEN , , 0, 0 IF Shadow = True THEN FOR I = y + 1 TO Y2 + 1 PokeChar X2 + 0, I, PeekChar$(X2 + 0, I), 8, 0 PokeChar X2 + 1, I, PeekChar$(X2 + 1, I), 8, 0 NEXT FOR I = x + 2 TO X2 - 1 PokeChar I, Y2 + 1, PeekChar$(I, Y2 + 1), 8, 0 NEXT END IF END SUB SUB Edit.Palette MHide SCREEN 13: CLS ActiveCol = 0 Set.Palette Draw.Palette ActiveCol OrgPal$ = Pal RotPal = -1 Col = FindBrightestColor Draw.PaletteMenu Col MemCopy &HA000, 0, VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HFA00 RBar = ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) GBar = ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) BBar = ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) OrgPal$ = Pal Gradient = 0 DO Key$ = UCASE$(INKEY$) MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 IF MouseMove = 1 THEN WAIT &H3DA, 8 WAIT &H3DA, 8, 8 WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 IF Gradient = 1 THEN LOCATE 1, 1 PRINT "[GRADIENT] - Set color to fade to"; END IF LINE (297, 193 - BBar)-(302, 193), Col, BF LINE (281, 193 - GBar)-(286, 193), Col, BF LINE (265, 193 - RBar)-(270, 193), Col, BF PSET (Mx - 2, My), Col PSET (Mx + 2, My), Col PSET (Mx, My - 2), Col PSET (Mx, My + 2), Col PSET (Mx - 1, My), Col PSET (Mx + 1, My), Col PSET (Mx, My - 1), Col PSET (Mx, My + 1), Col END IF IF Mx > 20 AND My > 20 AND Mx < 289 AND My < 119 THEN IF Ml = -1 THEN OldCol = ActiveCol ActiveCol = POINT(Mx, My) IF OldCol <> ActiveCol THEN WAIT &H3DA, 8 WAIT &H3DA, 8, 8 WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 Draw.Palette ActiveCol MemCopy &HA000, 0, VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HFA00 RBar = ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) GBar = ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) BBar = ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) LINE (265, 193 - RBar)-(270, 193), Col, BF LINE (281, 193 - GBar)-(286, 193), Col, BF LINE (297, 193 - BBar)-(302, 193), Col, BF PSET (Mx - 2, My), Col PSET (Mx + 2, My), Col PSET (Mx, My - 2), Col PSET (Mx, My + 2), Col PSET (Mx - 1, My), Col PSET (Mx + 1, My), Col PSET (Mx, My - 1), Col PSET (Mx, My + 1), Col END IF END IF END IF ' IF My >= 130 AND My <= 193 AND Ml = -1 AND MouseMove = 1 AND Gradient = 0 THEN IF My >= 130 AND My <= 193 AND Ml = -1 AND Gradient = 0 THEN IF Mx >= 265 AND Mx <= 270 THEN MID$(Pal, (ActiveCol * 3) + 1, 1) = CHR$(ABS(63 - (My - 130))) RBar = ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) Set.Palette END IF IF Mx >= 281 AND Mx <= 286 THEN MID$(Pal, (ActiveCol * 3) + 2, 1) = CHR$(ABS(63 - (My - 130))) GBar = ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) Set.Palette END IF IF Mx >= 297 AND Mx <= 302 THEN MID$(Pal, (ActiveCol * 3) + 3, 1) = CHR$(ABS(63 - (My - 130))) BBar = ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) Set.Palette END IF END IF IF Click = 1 THEN IF Mx >= 5 AND Mx <= 58 AND My >= 133 AND My <= 147 THEN LOCATE 23, 1: PRINT "[SAVE] - Enter Filename:" File$ = "" DO Key$ = INKEY$ WAIT &H3DA, 8 LINE (TPos * 8, 24 * 8)-(TPos * 8 + 7, 24 * 8), 0 IF Key$ = CHR$(13) THEN EXIT DO IF Key$ = CHR$(27) THEN EXIT DO File$ = InputField(File$, Key$, 30, TPos) LOCATE 24, 1: PRINT File$ + SPACE$(30 - LEN(File$)); LINE (TPos * 8, 24 * 8)-(TPos * 8 + 7, 24 * 8), Col LOOP IF Key$ = CHR$(13) THEN OPEN File$ FOR BINARY AS #1 PUT #1, , Pal CLOSE #1 END IF Key$ = "" END IF IF Mx >= 61 AND Mx <= 130 AND My >= 133 AND My <= 147 THEN LOCATE 25, 1 PRINT "[RESTORE] - Are you sure? [Y/N]"; k$ = UCASE$(INPUT$(1)) IF k$ = "Y" THEN Pal = OrgPal$: Set.Palette Col = FindBrightestColor COLOR Col RBar = ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) GBar = ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) BBar = ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) LINE (265, 193 - RBar)-(270, 193), Col, BF LINE (281, 193 - GBar)-(286, 193), Col, BF LINE (297, 193 - BBar)-(302, 193), Col, BF END IF IF Mx >= 5 AND Mx <= 90 AND My >= 157 AND My <= 171 THEN Gradient = 1 GradientStart = ActiveCol END IF IF Mx >= 93 AND Mx <= 178 AND My >= 157 AND My <= 171 THEN SmoothPal 1 Col = FindBrightestColor COLOR Col RBar = ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) GBar = ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) BBar = ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) LINE (265, 193 - RBar)-(270, 193), Col, BF LINE (281, 193 - GBar)-(286, 193), Col, BF LINE (297, 193 - BBar)-(302, 193), Col, BF END IF END IF IF Gradient = 1 AND ActiveCol <> GradientStart THEN Gradient = 0 IF ActiveCol < GradientStart THEN SWAP ActiveCol, GradientStart r& = ASC(MID$(Pal, (GradientStart * 3) + 1, 1)) * 1024& g& = ASC(MID$(Pal, (GradientStart * 3) + 2, 1)) * 1024& b& = ASC(MID$(Pal, (GradientStart * 3) + 3, 1)) * 1024& Ln = ABS(ActiveCol - GradientStart) RDelta& = (ASC(MID$(Pal, (ActiveCol * 3) + 1, 1)) - ASC(MID$(Pal, (GradientStart * 3) + 1, 1))) / Ln * 1024& GDelta& = (ASC(MID$(Pal, (ActiveCol * 3) + 2, 1)) - ASC(MID$(Pal, (GradientStart * 3) + 2, 1))) / Ln * 1024& BDelta& = (ASC(MID$(Pal, (ActiveCol * 3) + 3, 1)) - ASC(MID$(Pal, (GradientStart * 3) + 3, 1))) / Ln * 1024& FOR I = GradientStart TO ActiveCol MID$(Pal, (I * 3) + 1, 1) = CHR$(ABS(r& \ 1024) MOD 256) MID$(Pal, (I * 3) + 2, 1) = CHR$(ABS(g& \ 1024) MOD 256) MID$(Pal, (I * 3) + 3, 1) = CHR$(ABS(b& \ 1024) MOD 256) r& = r& + RDelta& g& = g& + GDelta& b& = b& + BDelta& NEXT Set.Palette END IF IF Key$ = "R" THEN RotPal = -RotPal IF RotPal = -1 THEN Pal = RotPal$: Set.Palette ELSE RotPal$ = Pal END IF END IF IF RotPal = 1 THEN RotatePal OldMx = Mx OldMy = My IF Key$ = CHR$(27) AND Gradient = 1 THEN Gradient = 0: Key$ = "" 'LOCATE 1, 1: PRINT Mx; My; ActiveCol LOOP UNTIL (Key$ = CHR$(27) AND Gradient = 0) SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu MShow END SUB SUB EraseMessage PCOPY 2, 0 IF Row > 0 THEN LOCATE Row END SUB SUB ErrorDialog (Desc$) Row = CSRLIN PCOPY 0, 2 DrawWindow 40 - RealLen(Desc$) \ 2 - 2, Lines \ 2 - 2, 40 + RealLen(Desc$) \ 2 + 3, Lines \ 2 + 2, 7, 4, "&0%7 Error ", True COLOR 14, 4 Center Desc$, Lines \ 2 END SUB FUNCTION Exist% (File$) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Checks if a file exists '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' ' File$ - File to check ' '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns True if file exists, else False '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 IF File$ = "" THEN Exist = False: EXIT FUNCTION Checkfile = FREEFILE OPEN File$ FOR BINARY AS #Checkfile IF LOF(Checkfile) = 0 THEN Exist = False CLOSE #Checkfile KILL File$ ELSE Exist = True CLOSE #Checkfile END IF END FUNCTION SUB FillChar (Segment%, Offset%, Value%, Bytes%) DEF SEG = VARSEG(ASMFillChar$) CALL absolute(BYVAL Segment%, BYVAL Offset%, BYVAL Value%, BYVAL Bytes%, SADD(ASMFillChar$)) DEF SEG END SUB FUNCTION FindBrightestColor Br = 0 Index = 0 FOR I = 0 TO 255 OUT &H3C7, I r = INP(&H3C9) g = INP(&H3C9) b = INP(&H3C9) IF (r + b + g) \ 3 > Br THEN Br = (r + b + g) \ 3: Index = I NEXT FindBrightestColor = Index END FUNCTION SUB Gauge (XPos, YPos, XLen, Value&, Max&, Char$) LOCATE YPos, XPos PRINT LEFT$(Char$, 1); PRINT STRING$(Value& / Max& * (XLen - 2), MID$(Char$, 3, 1)); PRINT STRING$((XLen - 2) - (Value& / Max& * (XLen - 2)), MID$(Char$, 2, 1)); PRINT MID$(Char$, 4, 1); END SUB FUNCTION Get.MenuItem$ (MenuNum, Num) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns the menu item number Num caption in menu number MenuNum '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 SEEK #251, (CLNG(MenuNum - 1) * 6100) + (Num * 122) GET #251, , MenuItem Temp$ = MenuItem.Caption Temp2$ = "" FOR I = 1 TO LEN(Temp$) IF NOT MID$(Temp$, I, 1) = CHR$(0) THEN Temp2$ = Temp2$ + MID$(Temp$, I, 1) ELSE EXIT FOR NEXT Get.MenuItem$ = LTRIM$(RTRIM$(Temp2$)) END FUNCTION SUB Get.MenuItemInfo (MenuNum, Num, Style AS STRING, Selected AS STRING, Active AS STRING) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns info about item number Num in menu MenuNum ' See SUB Create.MenuItem for info on menu item variables. '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 SEEK #251, (CLNG(MenuNum - 1) * 6100) + (Num * 122) GET #251, , MenuItem Style = MenuItem.Style Selected = MenuItem.Selected Active = MenuItem.Active END SUB FUNCTION Get.MenuTopic$ (Num) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns the caption of a main menu item number Num '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 SEEK #250, CLNG(Num) * 16 Temp$ = SPACE$(16) GET #250, , Temp$ Temp2$ = "" FOR I = 1 TO LEN(Temp$) IF NOT MID$(Temp$, I, 1) = CHR$(0) THEN Temp2$ = Temp2$ + MID$(Temp$, I, 1) ELSE EXIT FOR NEXT Get.MenuTopic$ = LTRIM$(RTRIM$(Temp2$)) END FUNCTION FUNCTION Getbit STATIC SHARED ByteBuffer AS STRING * 1, Powers() AS INTEGER, Bitsin AS INTEGER, BlockLength AS INTEGER, Num AS INTEGER Bitsin = Bitsin + 1 IF Bitsin = 9 THEN GET #1, , ByteBuffer TempChar = ASC(ByteBuffer) Bitsin = 1 Num = Num + 1 IF Num = BlockLength THEN BlockLength = TempChar + 1 GET #1, , ByteBuffer TempChar = ASC(ByteBuffer) Num = 1 END IF END IF IF (TempChar AND Powers(Bitsin)) = 0 THEN Getbit = 0 ELSE Getbit = 1 END FUNCTION SUB GetFileInfo (pFileInfo AS DOSFileInfo) '---------------------------------------------------------------------- ' Gets FileInfo about file which name was returned by DirFirst/DirNext '---------------------------------------------------------------------- pFileInfo = FileInfo END SUB SUB Init.Menu '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Call this at the start of your programs, initializes the menu '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 QMenu.MenuFCol = 0 QMenu.MenuBCol = 3 QMenu.MenuDisabled = 8 Create.Menu 1, "Program" Create.Menu 2, "Image" Create.Menu 3, "Palette" Create.Menu 4, "Code" Create.Menu 5, "Options" '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Create.MenuItem 1, "About", "0", "0", "1" Create.MenuItem 1, "-", "0", "0", "1" Create.MenuItem 1, "Quit", "0", "0", "1" '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Create.MenuItem 2, "View BMP...", "0", "0", "1" Create.MenuItem 2, "View PCX...", "0", "0", "1" Create.MenuItem 2, "View GIF...", "0", "0", "1" Create.MenuItem 2, "View Currently Loaded Image...", "0", "0", "1" Create.MenuItem 2, "-", "0", "0", "1" Create.MenuItem 2, "BSave BMP...", "0", "0", "1" Create.MenuItem 2, "BSave PCX...", "0", "0", "1" Create.MenuItem 2, "BSave GIF...", "0", "0", "1" Create.MenuItem 2, "-", "0", "0", "1" Create.MenuItem 2, "Save BMP As Raw Byte Data...", "0", "0", "1" Create.MenuItem 2, "Save PCX As Raw Byte Data...", "0", "0", "1" Create.MenuItem 2, "Save GIF As Raw Byte Data...", "0", "0", "1" Create.MenuItem 2, "-", "0", "0", "1" Create.MenuItem 2, "Save BMP As DATA Statements...", "0", "0", "1" Create.MenuItem 2, "Save PCX As DATA Statements...", "0", "0", "1" Create.MenuItem 2, "Save GIF As DATA Statements...", "0", "0", "1" '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Create.MenuItem 3, "Edit Raw Palette...", "0", "0", "1" Create.MenuItem 3, "Save Raw Palette As BMP Palette...", "0", "0", "1" Create.MenuItem 3, "-", "0", "0", "1" Create.MenuItem 3, "View BMP Palette...", "0", "0", "1" Create.MenuItem 3, "View PCX Palette...", "0", "0", "1" Create.MenuItem 3, "View GIF Palette...", "0", "0", "1" Create.MenuItem 3, "-", "0", "0", "1" Create.MenuItem 3, "Save BMP Palette As Raw Byte Data...", "0", "0", "1" Create.MenuItem 3, "Save PCX Palette As Raw Byte Data...", "0", "0", "1" Create.MenuItem 3, "Save GIF Palette As Raw Byte Data...", "0", "0", "1" Create.MenuItem 3, "-", "0", "0", "1" Create.MenuItem 3, "Save BMP Palette As DATA Statements...", "0", "0", "1" Create.MenuItem 3, "Save PCX Palette As DATA Statements...", "0", "0", "1" Create.MenuItem 3, "Save GIF Palette As DATA Statements...", "0", "0", "1" '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Create.MenuItem 4, "Append BLoader...", "0", "0", "1" Create.MenuItem 4, "Append Raw Byte Loader...", "0", "0", "1" Create.MenuItem 4, "Append DATA Loader...", "0", "0", "1" Create.MenuItem 4, "-", "0", "0", "1" Create.MenuItem 4, "Append Palette Loader...", "0", "0", "1" Create.MenuItem 4, "Append DATA Statement Palette Loader...", "0", "0", "1" '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Create.MenuItem 5, "Add Palette To BSaved File (320x200 Only)", "1", "0", "1" END SUB FUNCTION InputField$ (Text$, Key$, MaxLen, TPos) IF Key$ = "" THEN InputField$ = Text$: EXIT FUNCTION SELECT CASE Key$ CASE IS = CHR$(8) IF LEN(Text$) > 0 THEN Text$ = LEFT$(Text$, TPos - 1) + MID$(Text$, TPos + 1, 255) TPos = TPos - 1 IF TPos = -1 THEN TPos = 0 Key$ = "" ELSE Key$ = "" END IF CASE IS = CHR$(0) + CHR$(75) IF TPos > 0 THEN TPos = TPos - 1 Key$ = "" CASE IS = CHR$(0) + CHR$(77) TPos = TPos + 1 IF TPos > MaxLen THEN TPos = MaxLen IF TPos > LEN(Text$) THEN TPos = LEN(Text$) Key$ = "" CASE IS = CHR$(0) + "S" Text$ = LEFT$(Text$, TPos) + MID$(Text$, TPos + 2, 255) Key$ = "" CASE IS = CHR$(9) Key$ = "" END SELECT IF LEFT$(Key$, 1) = CHR$(0) THEN Key$ = "" IF Key$ <> "" THEN Text$ = LEFT$(Text$, TPos) + Key$ + MID$(Text$, TPos + 1, 255) IF LEN(Text$) > MaxLen THEN Text$ = LEFT$(Text$, MaxLen) TPos = TPos + 1 IF TPos > MaxLen THEN TPos = MaxLen END IF InputField$ = Text$ END FUNCTION SUB Load.BSave (File$) DEF SEG = &HA000 BLOAD File$, 0 DEF SEG File = FREEFILE OPEN File$ FOR BINARY AS #File IF LOF(File) > 320& * 200& THEN TempPal$ = SPACE$(768) GET #1, 320& * 200& + 7, TempPal$ FOR I& = 0 TO 255 r = ASC(MID$(TempPal$, (I& * 3) + 1, 1)) g = ASC(MID$(TempPal$, (I& * 3) + 2, 1)) b = ASC(MID$(TempPal$, (I& * 3) + 3, 1)) OUT (&H3C8), I& OUT (&H3C9), r OUT (&H3C9), g OUT (&H3C9), b NEXT END IF CLOSE File END SUB SUB Load.DATA (XLen, YLen, Segment, Offset) IF Segment <> -1 AND Offset <> -1 THEN DEF SEG = Segment FOR y = 0 TO YLen FOR x = 0 TO XLen READ ReadByte POKE POffset, ReadByte POffset = POffset + 1 NEXT NEXT ELSE DEF SEG = &HA000 FOR y = 0 TO YLen FOR x = 0 TO XLen READ ReadByte POKE (CLNG(y) * 320& + CLNG(x)), ReadByte NEXT NEXT END IF DEF SEG CLOSE File END SUB FUNCTION Load.Image (File$, Format$) MHide COLOR 7 LOCATE 3, 3 Pal = "" IF Exist(File$) = False THEN Load.Image = False: PrintText "File not found!": EXIT FUNCTION ClearScreen FillChar VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), 0, &HFA00 COLOR 7 LOCATE 3, 3 PrintText "Loading " + UCASE$(File$) + "..." SELECT CASE UCASE$(Format$) CASE "BMP" DIM Tavu AS STRING * 1 OPEN File$ FOR BINARY AS #1 ' Avataan tiedosto binaarimuodossa. FOR Otto = 1 TO 2 GET #1, , Tavu Tyyppi$ = Tyyppi$ + Tavu NEXT IF Tyyppi$ <> "BM" THEN CLOSE #1 PrintText " � BMP: File is corrupted" Load.Image = False: EXIT FUNCTION END IF GET #1, 11, Tavu 'Ottaa tavusta tiedon, mihin palettitiedot PaletinLoppu = ASC(Tavu) 'loppuvat. GET #1, , Tavu 'Sama kuin yll�. PaletinLoppu = PaletinLoppu + ASC(Tavu) * 256 GET #1, 19, Tavu 'Kuvan leveys tavuista 19 ja 20. Leveys = ASC(Tavu) GET #1, , Tavu Leveys = Leveys + ASC(Tavu) * 256 GET #1, 23, Tavu 'Kuvan korkeus tavuista 23 ja 24. Korkeus = ASC(Tavu) GET #1, , Tavu Korkeus = Korkeus + ASC(Tavu) * 256 GET #1, 29, Tavu 'Tieto kuvan tyypist� tavusta 29. IF ASC(Tavu) <> 8 THEN PrintText " � BMP: Color depth not 8-bits!" CLOSE #1 Load.Image = False: EXIT FUNCTION END IF PrintText " � BMP: Loading palette..." FOR I = 0 TO 255 GET #1, 54 + I * 4 + 3, Tavu MID$(Pal, (I * 3) + 1, 1) = CHR$(ASC(Tavu) \ 4) GET #1, 54 + I * 4 + 2, Tavu MID$(Pal, (I * 3) + 2, 1) = CHR$(ASC(Tavu) \ 4) GET #1, 54 + I * 4 + 1, Tavu MID$(Pal, (I * 3) + 3, 1) = CHR$(ASC(Tavu) \ 4) NEXT JotainTarkistuksia = (LOF(1) - PaletinLoppu) / Korkeus - Leveys RuudulleMahtuvaKorkeus = Korkeus - 1 RuudulleMahtuvaLeveys = Leveys - 1 IF Korkeus - 1 > 199 THEN RuudulleMahtuvaKorkeus = 199 IF Leveys - 1 > 319 THEN RuudulleMahtuvaLeveys = 319 IF Leveys < 320 THEN XAlku = (320 - Leveys) / 2 IF Korkeus < 200 THEN YAlku = (200 - Korkeus) / 2 PrintText " � BMP: Loading data..." Rivi = CSRLIN - 1 COLOR 14 FOR y = 0 TO RuudulleMahtuvaKorkeus FOR x = 0 TO RuudulleMahtuvaLeveys GET #1, PaletinLoppu + 1 + Korkeus * CLNG(Leveys + JotainTarkistuksia) - (y + 1) * CLNG(Leveys + JotainTarkistuksia) + x, Tavu Buffer(x, y) = Tavu NEXT Gauge 40, INT(Rivi), 20, LOF(1) - SEEK(1), LOF(1), "[型]" NEXT COLOR 7, 1 CLOSE #1 PrintText "" PrintText " � BMP: File loaded successfully!" CASE "PCX" PrintText " � PCX: Loading palette..." OPEN File$ FOR BINARY AS #1 fin& = LOF(1) - 767 SEEK #1, fin& Pal = INPUT$(768, 1) FOR I = 1 TO 768 MID$(Pal, I, 1) = CHR$(ABS(ASC(MID$(Pal, I, 1)) \ 4)) NEXT SEEK #1, 129 rle% = 0 PrintText " � PCX: Loading data..." Rivi = CSRLIN - 1 COLOR 14 DO p$ = INPUT$(256, 1): fpos& = SEEK(1): L% = LEN(p$) IF fpos& > fin& THEN L% = L% - (fpos& - fin&): p$ = LEFT$(p$, L%): View$ = "done" END IF FOR p% = 1 TO L% dat% = ASC(MID$(p$, p%)) IF rle% = 0 THEN IF (dat% AND 192) = 192 THEN rle% = dat% AND 63 ELSE x = t& MOD 320 y = t& \ 320 IF x > 0 AND x < 320 AND y > 0 AND y < 200 THEN Buffer(x, y) = CHR$(dat%) t& = t& + 1 END IF ELSE FOR rle% = rle% TO 1 STEP -1 x = t& MOD 320 y = t& \ 320 IF x > 0 AND x < 320 AND y > 0 AND y < 200 THEN Buffer(x, y) = CHR$(dat%) t& = t& + 1 NEXT END IF Gauge 40, INT(Rivi), 20, SEEK(1), LOF(1), "[型]" NEXT LOOP UNTIL View$ = "done" CLOSE 1 PrintText "" PrintText " � PCX: File loaded successfully!" CASE "GIF" DIM ByteBuffer AS STRING * 1 RESTORE GifDATA FOR a = 1 TO 8: Powers(a) = 2 ^ (a - 1): NEXT FOR a = 0 TO 11: READ MaxCodes(a): NEXT FOR a = 1 TO 8: READ codemask(a): NEXT FOR a = 0 TO 14: READ Powers2(a): NEXT Num = 0 OPEN File$ FOR BINARY AS #1 FOR a = 1 TO 6 GET #1, , ByteBuffer: a$ = a$ + ByteBuffer NEXT IF a$ <> "GIF87a" THEN CLOSE #1 PrintText " � GIF: File format is not GIF7a" Load.Image = False: EXIT FUNCTION END IF GET #1, , TotalX GET #1, , TotalY GET #1, , ByteBuffer: a = ASC(ByteBuffer) BitsPixel = (a AND 7) + 1 GET #1, , ByteBuffer: Background = ASC(ByteBuffer) GET #1, , ByteBuffer IF ASC(ByteBuffer) <> 0 THEN CLOSE #1 PrintText " � GIF: Bad file." Load.Image = False: EXIT FUNCTION END IF PrintText " � GIF: Loading palette..." FOR a = 0 TO 2 ^ BitsPixel - 1 GET #1, , ByteBuffer: Red = ASC(ByteBuffer) GET #1, , ByteBuffer: Green = ASC(ByteBuffer) GET #1, , ByteBuffer: Blue = ASC(ByteBuffer) MID$(Pal, (a * 3) + 1, 1) = CHR$(Red \ 4) MID$(Pal, (a * 3) + 2, 1) = CHR$(Green \ 4) MID$(Pal, (a * 3) + 3, 1) = CHR$(Blue \ 4) NEXT GET #1, , ByteBuffer IF ByteBuffer <> "," THEN CLOSE #1 PrintText " � GIF: Bad file." Load.Image = False: EXIT FUNCTION END IF GET #1, , Xstart GET #1, , Ystart GET #1, , Xlength GET #1, , Ylength Xend = Xlength + Xstart - 1: Yend = Ylength + Ystart - 1 GET #1, , ByteBuffer a = ASC(ByteBuffer) IF (a AND 128) = 128 THEN PrintText " � GIF: Local colormap encountered." CLOSE #1 Load.Image = False: EXIT FUNCTION ELSEIF (a AND 64) = 64 THEN PrintText " � GIF: Image is interlaced!" CLOSE #1 Load.Image = False: EXIT FUNCTION END IF GET #1, , ByteBuffer CodeSize = ASC(ByteBuffer): ClearCode = Powers2(CodeSize) EOFCode = ClearCode + 1: FirstFree = ClearCode + 2 FreeCode = FirstFree: CodeSize = CodeSize + 1 InitCodeSize = CodeSize: Maxcode = MaxCodes(CodeSize - 2) Bitmask = codemask(BitsPixel) GET #1, , ByteBuffer BlockLength = ASC(ByteBuffer) + 1: Bitsin = 8 OutCount = 0 x = 1: y = 1 PrintText " � GIF: Loading data..." OutCount = 0 Rivi = CSRLIN - 1 COLOR 14 DO Code = ReadCode(CodeSize) IF Code <> EOFCode THEN IF Code = ClearCode THEN CodeSize = InitCodeSize Maxcode = MaxCodes(CodeSize - 2): FreeCode = FirstFree Code = ReadCode(CodeSize): CurCode = Code OldCode = Code: FinChar = Code AND Bitmask Plot FinChar ELSE CurCode = Code: InCode = Code IF Code >= FreeCode THEN CurCode = OldCode OutCode(OutCount) = FinChar OutCount = OutCount + 1 END IF IF CurCode > Bitmask THEN DO OutCode(OutCount) = Suffix(CurCode) OutCount = OutCount + 1 CurCode = Prefix(CurCode) LOOP UNTIL CurCode <= Bitmask END IF FinChar = CurCode AND Bitmask OutCode(OutCount) = FinChar OutCount = OutCount + 1 FOR I = OutCount - 1 TO 0 STEP -1 IF x% > 0 AND y% > 0 AND x% < 320 AND y% < 200 THEN Buffer(x%, y%) = CHR$(OutCode(I)) x% = x% + 1 IF x% > Xend% THEN x% = 0 y% = y% + 1 END IF NEXT OutCount = 0 Prefix(FreeCode) = OldCode: Suffix(FreeCode) = FinChar OldCode = InCode: FreeCode = FreeCode + 1 IF FreeCode >= Maxcode THEN IF CodeSize < 12 THEN CodeSize = CodeSize + 1: Maxcode = Maxcode * 2 END IF END IF END IF END IF Gauge 40, INT(Rivi), 20, SEEK(1), LOF(1), "[型]" LOOP UNTIL Code = EOFCode COLOR 7 CLOSE #1 PrintText "" PrintText " � GIF: File loaded successfully!" CASE ELSE Load.Image = False CLOSE #1 PrintText "Only BMP/PCX/GIF formats supported!" EXIT FUNCTION END SELECT CLOSE #1, #2 Load.Image = True MShow END FUNCTION FUNCTION Load.Palette (File$, Format$) MHide COLOR 7 LOCATE 3, 3 IF Exist(File$) = False THEN Load.Palette = False: PrintText "File not found!": EXIT FUNCTION ClearScreen FillChar VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), 0, &HFA00 COLOR 7 LOCATE 3, 3 PrintText "Loading palette from " + UCASE$(File$) + "..." SELECT CASE UCASE$(Format$) CASE "BMP" DIM Tavu AS STRING * 1 OPEN File$ FOR BINARY AS #1 ' Avataan tiedosto binaarimuodossa. FOR Otto = 1 TO 2 GET #1, , Tavu Tyyppi$ = Tyyppi$ + Tavu NEXT IF Tyyppi$ <> "BM" THEN CLOSE #1 PrintText " � BMP: File is corrupted" Load.Palette = False: EXIT FUNCTION END IF GET #1, 11, Tavu 'Ottaa tavusta tiedon, mihin palettitiedot PaletinLoppu = ASC(Tavu) 'loppuvat. GET #1, 29, Tavu 'Tieto kuvan tyypist� tavusta 29. IF ASC(Tavu) <> 8 THEN PrintText " � BMP: Color depth not 8-bits!" CLOSE #1 Load.Palette = False: EXIT FUNCTION END IF PrintText " � BMP: Loading palette..." FOR I = 0 TO 255 GET #1, 54 + I * 4 + 3, Tavu MID$(Pal, (I * 3) + 1, 1) = CHR$(ASC(Tavu) \ 4) GET #1, 54 + I * 4 + 2, Tavu MID$(Pal, (I * 3) + 2, 1) = CHR$(ASC(Tavu) \ 4) GET #1, 54 + I * 4 + 1, Tavu MID$(Pal, (I * 3) + 3, 1) = CHR$(ASC(Tavu) \ 4) NEXT COLOR 7, 1 CLOSE #1 PrintText " � BMP: Palette loaded successfully!" CASE "PCX" PrintText " � PCX: Loading palette..." OPEN File$ FOR BINARY AS #1 fin& = LOF(1) - 767 SEEK #1, fin& Pal = INPUT$(768, 1) FOR I = 1 TO 768 MID$(Pal, I, 1) = CHR$(ABS(ASC(MID$(Pal, I, 1)) \ 4)) NEXT PrintText " � PCX: Palette loaded successfully!" CASE "GIF" DIM ByteBuffer AS STRING * 1 OPEN File$ FOR BINARY AS #1 FOR a = 1 TO 6 GET #1, , ByteBuffer: a$ = a$ + ByteBuffer NEXT IF a$ <> "GIF87a" THEN CLOSE #1 PrintText " � GIF: File format is not GIF7a" Load.Palette = False: EXIT FUNCTION END IF GET #1, , TotalX GET #1, , TotalY GET #1, , ByteBuffer: a = ASC(ByteBuffer) BitsPixel = (a AND 7) + 1 GET #1, , ByteBuffer: Background = ASC(ByteBuffer) GET #1, , ByteBuffer IF ASC(ByteBuffer) <> 0 THEN CLOSE #1 PrintText " � GIF: Bad file." Load.Palette = False: EXIT FUNCTION END IF PrintText " � GIF: Loading palette..." FOR a = 0 TO 2 ^ BitsPixel - 1 GET #1, , ByteBuffer: Red = ASC(ByteBuffer) GET #1, , ByteBuffer: Green = ASC(ByteBuffer) GET #1, , ByteBuffer: Blue = ASC(ByteBuffer) MID$(Pal, (a * 3) + 1, 1) = CHR$(Red \ 4) MID$(Pal, (a * 3) + 2, 1) = CHR$(Green \ 4) MID$(Pal, (a * 3) + 3, 1) = CHR$(Blue \ 4) NEXT COLOR 7 CLOSE #1 PrintText " � GIF: Palette loaded successfully!" CASE "RAW" PrintText " � Loading Raw Palette..." OPEN File$ FOR BINARY AS #1 GET #1, , Pal CLOSE #1 PrintText " � Palette loaded successfully!" CASE ELSE Load.Palette = False PrintText "Only BMP/PCX/GIF formats supported!" CLOSE #1 EXIT FUNCTION END SELECT CLOSE #1, #2 Load.Palette = True MShow END FUNCTION SUB Load.RAW (File$, XLen, YLen, Segment, Offset) File = FREEFILE OPEN File$ FOR BINARY AS #File DIM ReadByte AS STRING * 1 IF Segment <> -1 AND Offset <> -1 THEN DEF SEG = Segment POffset = Offset FOR y = 0 TO YLen FOR x = 0 TO XLen GET #File, , ReadByte POKE POffset, ASC(ReadByte) POffset = POffset + 1 NEXT NEXT ELSE DEF SEG = &HA000 FOR y = 0 TO YLen FOR x = 0 TO XLen GET #File, , ReadByte POKE (CLNG(y) * 320& + CLNG(x)), ASC(ReadByte) 'PSET (x, y), ASC(ReadByte) NEXT NEXT END IF DEF SEG CLOSE File END SUB FUNCTION LongToString$ (L&) B4% = L& \ 16777216 L& = L& - B4% * 16777216 B3% = L& \ 65536 L& = L& - B3% * 65536 B2% = L& \ 256 L& = L& - CLNG(B2%) * 256 B1% = L& LongToString$ = CHR$(B1%) + CHR$(B2%) + CHR$(B3%) + CHR$(B4%) END FUNCTION SUB Main '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Handles the mouse and menu. ' Call this once per frame. '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 STATIC Click REDIM Ml&(0 TO 1) Ml&(0) = &HB31003B8 Ml&(1) = &HCB10CD00 DEF SEG = VARSEG(Ml&(0)) CALL absolute(VARPTR(Ml&(0))) ERASE Ml& MenuSelected.Menu = 0 MenuSelected.Item = 0 MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 8 + 1 My = HiiriY% \ 8 + 1 Ml = HiiriV% Mr = HiiriO% IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 DEF SEG = &H40 IF ((PEEK(&H17) AND &H8) / &H8) AND DragWin = 0 THEN Mx = 1 My = 1 Click = 1 END IF DEF SEG IF My <= QMenu.BarSize AND Click = 1 THEN IF QMenu.Topics > 0 THEN xx = 1 yy = 1 FOR I = 1 TO QMenu.Topics Menu$ = Get.MenuTopic$(I) IF xx + LEN(Menu$) + 2 < 81 THEN xx = xx + LEN(Menu$) + 2 ELSE yy = yy + 1 xx = 1 xx = xx + LEN(Menu$) + 2 END IF IF Mx >= xx - LEN(Menu$) - 2 AND Mx < xx AND My = yy THEN NewPopup = I DO MHide PPrint xx - LEN(Menu$) - 2, yy, " " + Menu$ + " ", QMenu.MenuBCol, QMenu.MenuFCol MShow NewPopup = PopupMenu(xx - LEN(Menu$) - 2, yy + 1, NewPopup, Click) MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 8 + 1 My = HiiriY% \ 8 + 1 MHide PPrint xx - LEN(Menu$) - 2, yy, " " + Menu$ + " ", QMenu.MenuFCol, QMenu.MenuBCol MShow IF NewPopup <> 0 OR Click = 1 THEN xx = 1 yy = 1 FOR ii = 1 TO QMenu.Topics Menu$ = Get.MenuTopic$(ii) IF xx + LEN(Menu$) + 2 < 81 THEN xx = xx + LEN(Menu$) + 2 ELSE yy = yy + 1 xx = 1 xx = xx + LEN(Menu$) + 2 END IF IF Click = 1 AND Mx >= xx - LEN(Menu$) - 2 AND Mx < xx AND My = yy THEN NewPopup = ii IF ii = NewPopup THEN EXIT FOR NEXT END IF LOOP UNTIL NewPopup = 0 EXIT FOR END IF NEXT END IF END IF END SUB SUB MemCopy (fromseg%, FromOffset%, toseg%, ToOffset%, Bytes%) DEF SEG = VARSEG(ASMMemCopy$) CALL absolute(BYVAL fromseg%, BYVAL FromOffset%, BYVAL toseg%, BYVAL ToOffset%, BYVAL Bytes%, SADD(ASMMemCopy$)) DEF SEG END SUB SUB Message (Text$, Topic$) Row = CSRLIN PCOPY 0, 2 DrawWindow 40 - RealLen(Text$) \ 2 - 2, Lines \ 2 - 2, 40 + RealLen(Text$) \ 2 + 3, Lines \ 2 + 2, 7, 4, Topic$, True COLOR 15, 4 Center Text$, Lines \ 2 END SUB DEFSNG A-Z SUB MHide '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Hides the mouse '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Regs.ax% = 2 CALL INTERRUPT(&H33, Regs, Regs) END SUB FUNCTION MInit '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Initializes the mouse ' Returns -1 if mouse is present, 0 if it isn't '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Regs.ax% = 0 CALL INTERRUPT(&H33, Regs, Regs) MInit = Regs.ax% END FUNCTION SUB MShow '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Shows the mouse after hiding '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Regs.ax% = 1 CALL INTERRUPT(&H33, Regs, Regs) WAIT &H3DA, 8 WAIT &H3DA, 8, 8 END SUB DEFINT A-Z SUB MStatus (x, y, B1, B2) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns location of mouse & status of buttons '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Regs.ax% = 3 CALL INTERRUPT(&H33, Regs, Regs) x = Regs.cx% y = Regs.dx% B1 = (Regs.bx% AND 1) <> 0 B2 = (Regs.bx% AND 2) <> 0 END SUB FUNCTION PeekChar$ (x, y) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Returns the character stored at x,y '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 DEF SEG = &HB800 PeekChar$ = CHR$(PEEK((y - 1) * 160 + (x - 1) * 2)) DEF SEG END FUNCTION SUB Plot (a%) STATIC Buffer(x%, y%) = CHR$(a%) x% = x% + 1 IF x% > Xend% THEN x% = Xstart% y% = y% + 1 END IF END SUB SUB PokeChar (x, y, Char$, FCol, BCol) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Writes the characted Char$ at x,y in color FCol,BCol '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 DEF SEG = &HB800 POKE ((y - 1) * 160 + (x - 1) * 2), ASC(Char$) POKE ((y - 1) * 160 + (x - 1) * 2) + 1, FCol + (BCol * 16) DEF SEG END SUB FUNCTION PopupMenu (x, y, Num, Click) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Handles the menu when popped up, called by SUB Main '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Items = MenuItems(Num) IF Items > 0 THEN DIM Menu$(1 TO Items) Longest = 0 FOR I = 1 TO Items Menu$(I) = Get.MenuItem$(Num, I) IF LEN(Menu$(I)) > Longest THEN Longest = LEN(Menu$(I)) NEXT MHide PCOPY 0, 1 SCREEN , , 0, 1 IF x + Longest > 78 THEN x = 78 - Longest - 3 IF Items > 0 THEN Draw.Border x, y, x + Longest + 3, y + Items + 1, QMenu.MenuFCol, QMenu.MenuBCol X2 = x + Longest + 3 Y2 = y + Items + 1 FOR I = y + 1 TO Y2 + 1 PokeChar X2 + 1, I, PeekChar$(X2 + 1, I), 8, 0 PokeChar X2 + 2, I, PeekChar$(X2 + 2, I), 8, 0 NEXT FOR I = x + 2 TO X2 PokeChar I, Y2 + 1, PeekChar$(I, Y2 + 1), 8, 0 NEXT FOR I = 1 TO Items Get.MenuItemInfo Num, I, Style$, Selected$, Active$ IF Active$ = "1" THEN IF Menu$(I) = "-" THEN PPrint x, y + I, CHR$(195) + STRING$(Longest + 2, "�") + CHR$(180), QMenu.MenuFCol, QMenu.MenuBCol ELSE IF Style$ = "0" THEN PPrint x + 1, y + I, " " + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuFCol, QMenu.MenuBCol ELSE IF Selected$ = "1" THEN PPrint x + 1, y + I, CHR$(7) + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuFCol, QMenu.MenuBCol ELSE PPrint x + 1, y + I, " " + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuFCol, QMenu.MenuBCol END IF END IF END IF ELSE IF Menu$(I) = "-" THEN PPrint x, y + I, CHR$(195) + STRING$(Longest + 2, "�") + CHR$(180), QMenu.MenuFCol, QMenu.MenuBCol ELSE IF Style$ = "0" THEN PPrint x + 1, y + I, " " + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuDisabled, QMenu.MenuBCol ELSE IF Selected$ = "1" THEN PPrint x + 1, y + I, CHR$(7) + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuDisabled, QMenu.MenuBCol ELSE PPrint x + 1, y + I, " " + Get.MenuItem$(Num, I) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, I))), QMenu.MenuDisabled, QMenu.MenuBCol END IF END IF END IF END IF NEXT Selected = 1 Get.MenuItemInfo Num, Selected, Style$, Selected$, Active$ IF Style$ = "0" THEN PPrint x + 1, y + Selected, " " + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol ELSE IF Selected$ = "1" THEN PPrint x + 1, y + Selected, CHR$(7) + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol ELSE PPrint x + 1, y + Selected, " " + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol END IF END IF END IF SCREEN , , 0, 0 MShow OldSelected = 0 MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 8 + 1 My = HiiriY% \ 8 + 1 Ml = HiiriV% Mr = HiiriO% OldMx = Mx OldMy = My DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 8 + 1 My = HiiriY% \ 8 + 1 Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 IF Key$ = CHR$(0) + "K" THEN NewMenu = Num - 1 IF NewMenu < 1 THEN NewMenu = QMenu.Topics PopupMenu = NewMenu END IF IF Key$ = CHR$(0) + "M" THEN NewMenu = Num + 1 IF NewMenu > QMenu.Topics THEN NewMenu = 1 PopupMenu = NewMenu END IF OldSelected = Selected IF Items > 0 THEN IF Key$ = CHR$(0) + "P" THEN Selected = Selected + 1 IF Selected > Items THEN Selected = 1 IF Menu$(Selected) = "-" THEN Selected = Selected + 1 IF Selected > Items THEN Selected = 1 Key$ = "" END IF IF Key$ = CHR$(0) + "H" THEN Selected = Selected - 1 IF Selected < 1 THEN Selected = Items IF Menu$(Selected) = "-" THEN Selected = Selected - 1 IF Selected < 1 THEN Selected = Items Key$ = "" END IF IF Key$ = CHR$(13) THEN Get.MenuItemInfo Num, Selected, Style$, Selected$, Active$ IF Active$ = "1" THEN MenuSelected.Menu = Num MenuSelected.Item = Selected IF Style$ = "1" THEN IF Selected$ = "0" THEN Selected$ = "1" ELSEIF Selected$ = "1" THEN Selected$ = "0" END IF Set.MenuItem Num, Selected, Get.MenuItem$(Num, Selected), Active$, Style$, Selected$ END IF ELSE Key$ = "" END IF END IF END IF IF Items > 0 AND (MouseMove = 1 OR Click = 1) THEN IF Mx > x AND Mx < x + Longest + 3 AND My > y AND My <= y + Items THEN Selected = My - y IF Click = 1 THEN Get.MenuItemInfo Num, Selected, Style$, Selected$, Active$ IF Active$ = "1" AND Get.MenuItem$(Num, Selected) <> "-" THEN MenuSelected.Menu = Num MenuSelected.Item = Selected MenuSelected.Menu = Num MenuSelected.Item = Selected IF Style$ = "1" THEN IF Selected$ = "0" THEN Selected$ = "1" ELSEIF Selected$ = "1" THEN Selected$ = "0" END IF Set.MenuItem Num, Selected, Get.MenuItem$(Num, Selected), Active$, Style$, Selected$ END IF EXIT DO ELSE Click = 0 END IF END IF END IF END IF IF OldSelected <> Selected THEN IF Menu$(Selected) = "-" THEN Selected = OldSelected ELSE MHide Get.MenuItemInfo Num, Selected, Style$, Selected$, Active$ IF Style$ = "0" THEN PPrint x + 1, y + Selected, " " + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol ELSE IF Selected$ = "1" THEN PPrint x + 1, y + Selected, CHR$(7) + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol ELSE PPrint x + 1, y + Selected, " " + Get.MenuItem$(Num, Selected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, Selected))), QMenu.MenuBCol, QMenu.MenuFCol END IF END IF Get.MenuItemInfo Num, OldSelected, Style$, Selected$, Active$ IF Active$ = "1" THEN FCol = QMenu.MenuFCol ELSE FCol = QMenu.MenuDisabled END IF IF Style$ = "0" THEN PPrint x + 1, y + OldSelected, " " + Get.MenuItem$(Num, OldSelected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, OldSelected))), FCol, QMenu.MenuBCol ELSE IF Selected$ = "1" THEN PPrint x + 1, y + OldSelected, CHR$(7) + Get.MenuItem$(Num, OldSelected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, OldSelected))), FCol, QMenu.MenuBCol ELSE PPrint x + 1, y + OldSelected, " " + Get.MenuItem$(Num, OldSelected) + SPACE$((Longest + 1) - LEN(Get.MenuItem$(Num, OldSelected))), FCol, QMenu.MenuBCol END IF END IF MShow END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 OR Key$ <> "" Key$ = "" MHide PCOPY 1, 0 MShow END FUNCTION SUB PPrint (x, y, Text$, FCol, BCol) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Prints text Text$ at x,y in color FCol, BCol '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 xx = x FOR I = 1 TO LEN(Text$) PokeChar xx, y, MID$(Text$, I, 1), FCol, BCol xx = xx + 1 NEXT END SUB SUB PrintText (Text$) COLOR 7, 1 LOCATE , 3: PRINT Text$ END SUB FUNCTION Query$ (Text$, Topic$, MaxLen, TField$) Row = CSRLIN PCOPY 0, 2 DrawWindow 40 - RealLen(Text$) \ 2 - 2, Lines \ 2 - 3, 40 + RealLen(Text$) \ 2 + 3, Lines \ 2 + 3, 7, 4, Topic$, True COLOR 15, 4 Center Text$, Lines \ 2 - 1 COLOR 0, 3 LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 PRINT STRING$(MaxLen + 1, " "); TextField$ = LEFT$(TField$, MaxLen) TPos = LEN(TextField$) COLOR 0, 4 LOCATE Lines \ 2 + 2, 40 - MaxLen \ 2 + 1 PRINT STRING$(MaxLen + 1, "�") LOCATE Lines \ 2 + 1, 40 + MaxLen \ 2 + 1 PRINT "�" COLOR 0, 3 LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 PRINT InputField(TextField$, k$, MaxLen, TPos); " "; LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 + TPos, 1, 29, 30 DO k$ = INKEY$ IF k$ = CHR$(13) THEN EXIT DO IF k$ = CHR$(27) THEN TextField$ = "": EXIT DO IF k$ <> "" THEN LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 COLOR 0, 3 PRINT InputField(TextField$, k$, MaxLen, TPos); " "; LOCATE Lines \ 2 + 1, 40 - MaxLen \ 2 + TPos, 1, 29, 30 END IF LOOP LOCATE 1, 1, 0 Query$ = LTRIM$(RTRIM$(TextField$)) EraseMessage END FUNCTION FUNCTION QueryFile$ (WildCard$) MHide WCard$ = UCASE$(RTRIM$(LTRIM$(Query$(" Enter directory/file ", "%7&0 Directory ", 60, "")))) EraseMessage IF WCard$ = "" THEN MShow: EXIT FUNCTION 'IF (INSTR(WCard$, "*") = 0 AND INSTR(WCard$, "?") = 0) THEN ' IF RIGHT$(WCard$, 1) <> "\" THEN WCard$ = WCard$ + "\" ' WCard$ = WCard$ + WildCard$ 'END IF IF RIGHT$(WCard$, 1) = "\" THEN WCard$ = WCard$ + WildCard$ IF WCard$ = "." THEN WCard$ = WCard$ + "\" + WildCard$ IF INSTR(WCard$, "\") > 0 THEN Directory$ = "" FOR XPos = LEN(WCard$) TO 1 STEP -1 IF MID$(WCard$, XPos, 1) = "\" THEN EXIT FOR NEXT FOR I = 1 TO XPos Directory$ = Directory$ + MID$(WCard$, I, 1) NEXT END IF Max = ScanDir(WCard$, "temp.tmp") IF Max = 0 THEN ErrorDialog "No files found!" DO: LOOP UNTIL INKEY$ <> "" EraseMessage MShow EXIT FUNCTION END IF Offset = 0 Selected = 0 OPEN "temp.tmp" FOR INPUT AS #1 OPEN "temp2.tmp" FOR OUTPUT AS #2 FOR I = 1 TO Max LINE INPUT #1, Temp$ Temp$ = Temp$ + STRING$(12 - LEN(Temp$), " ") PRINT #2, Temp$; NEXT CLOSE #1, #2 KILL "temp.tmp" NAME "temp2.tmp" AS "temp.tmp" DrawWindow 15, 2, 32, Lines - 3, 7, 4, "%7&0 Files ", True COLOR 0, 3 LOCATE Lines, 1 PRINT STRING$(80, " "); Center " &EEsc&0-Cancel &EEnter&0-Select", Lines File = FREEFILE OPEN "temp.tmp" FOR BINARY AS #File FOR I = 0 TO UBOUND(FBuffer) FBuffer(I) = 0 NEXT DrawFileList File, Selected, Offset, Max DO k$ = INKEY$ IF k$ <> "" THEN IF k$ = CHR$(0) + "P" THEN Selected = Selected + 1 IF Selected > Max - 1 THEN Selected = Max - 1 IF Selected > Offset + Lines - 7 THEN Offset = Offset + 1 END IF IF k$ = CHR$(0) + "H" THEN Selected = Selected - 1 IF Selected < 0 THEN Selected = 0 IF Selected < Offset THEN Offset = Offset - 1 IF Offset < 0 THEN Offset = 0 END IF IF k$ = CHR$(0) + CHR$(81) THEN Selected = Selected + (Lines - 7) Offset = Offset + (Lines - 7) IF Selected > Max - 1 THEN Selected = Max - 1 IF Offset > Max - 1 THEN Offset = Max - 1 END IF IF k$ = CHR$(0) + CHR$(73) THEN Selected = Selected - (Lines - 7) Offset = Offset - (Lines - 7) IF Selected < 0 THEN Selected = 0 IF Offset < 0 THEN Offset = 0 END IF IF k$ = CHR$(0) + CHR$(79) THEN Offset = Max - (Lines - 7) - 1 IF Offset < 0 THEN Offset = 0 Selected = Max - 1 END IF IF k$ = CHR$(0) + CHR$(71) THEN Offset = 0 Selected = 0 END IF IF k$ = CHR$(13) THEN SeekFileItem File, Selected GET #File, , FList QueryFile = Directory$ + RTRIM$(RTRIM$(FList)) EXIT DO END IF IF k$ = CHR$(27) THEN EXIT DO END IF DrawFileList File, Offset, Selected, Max END IF LOOP CLOSE #1, #2 KILL "temp.tmp" ClearScreen MShow END FUNCTION FUNCTION ReadCode (CodeSize) SHARED Powers2() AS INTEGER Code = 0 FOR Aa = 0 TO CodeSize - 1 Code = Code + Getbit * Powers2(Aa) NEXT ReadCode = Code END FUNCTION FUNCTION RealLen (Text$) Ln = LEN(Text$) FOR I = 1 TO LEN(Text$) Done = 0 DO IF MID$(Text$, I, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, I + 1, 1)) AND I < LEN(Text$) THEN Ln = Ln - 2 I = I + 2 ELSEIF MID$(Text$, I, 1) = "%" AND INSTR("01234567", MID$(Text$, I + 1, 1)) AND I < LEN(Text$) THEN Ln = Ln - 2 I = I + 2 ELSE Done = 1 END IF LOOP UNTIL Done NEXT RealLen = Ln END FUNCTION FUNCTION ReturnBit (Byte, Bit) SELECT CASE Bit CASE 1: IF (Byte AND 128) THEN ReturnBit = 1 CASE 2: IF (Byte AND 64) THEN ReturnBit = 1 CASE 3: IF (Byte AND 32) THEN ReturnBit = 1 CASE 4: IF (Byte AND 16) THEN ReturnBit = 1 CASE 5: IF (Byte AND 8) THEN ReturnBit = 1 CASE 6: IF (Byte AND 4) THEN ReturnBit = 1 CASE 7: IF (Byte AND 2) THEN ReturnBit = 1 CASE 8: IF (Byte AND 1) THEN ReturnBit = 1 END SELECT END FUNCTION FUNCTION ReturnNibble (Byte, WhichOne) IF WhichOne = 1 THEN IF Byte AND 128 THEN Total = Total + 8 IF Byte AND 64 THEN Total = Total + 4 IF Byte AND 32 THEN Total = Total + 2 IF Byte AND 16 THEN Total = Total + 1 ELSE IF Byte AND 8 THEN Total = Total + 8 IF Byte AND 4 THEN Total = Total + 4 IF Byte AND 2 THEN Total = Total + 2 IF Byte AND 1 THEN Total = Total + 1 END IF ReturnNibble = Total END FUNCTION SUB Roller (x, y, XLen, Text$, FCol) STATIC Count = Count + 1 IF Count = 8 THEN LOCATE y, 40 COLOR FCol IF RPos = 0 THEN RPos = 1 TText$ = SPACE$(XLen) + Text$ ' PRINT MID$(TText$, RPos, XLen) + STRING$(XLen - LEN(MID$(TText$, RPos, XLen)), " "); PRINT MID$(TText$, RPos + 40, 1); RPos = RPos + 1 IF RPos > LEN(TText$) THEN RPos = 1 Count = 0 END IF WAIT &H3DA, 8 REDIM ScrollBuffer(0 TO 8 * 320) AS INTEGER GET (1, (y - 1) * 8)-(319, (y - 1) * 8 + 7), ScrollBuffer PUT (0, (y - 1) * 8), ScrollBuffer, PSET END SUB SUB RotatePal 'FOR i& = 0 TO 255 ' OUT (&H3C7), i& ' r = INP(&H3C9) ' g = INP(&H3C9) ' b = INP(&H3C9) ' MID$(Pal, (i& * 3) + 1, 1) = CHR$(r) ' MID$(Pal, (i& * 3) + 2, 1) = CHR$(g) ' MID$(Pal, (i& * 3) + 3, 1) = CHR$(b) 'NEXT Temp$ = RIGHT$(Pal$, 3) Pal = Temp$ + MID$(Pal, 1, LEN(Pal) - 3) Set.Palette END SUB SUB Save.Image (File$, InpFormat$, OutFormat$) MHide Out$ = RTRIM$(LTRIM$(UCASE$(Query(" Enter the output file ", "&0%7 Save Image ", 60, "")))) IF Out$ = "" THEN MShow: EXIT SUB Loaded = True SELECT CASE UCASE$(InpFormat$) CASE "BMP" IF File$ <> "" THEN IF NOT Load.Image(File$, "BMP") THEN Loaded = False END IF CASE "PCX" IF File$ <> "" THEN IF NOT Load.Image(File$, "PCX") THEN Loaded = False END IF CASE "GIF" IF File$ <> "" THEN IF NOT Load.Image(File$, "GIF") THEN Loaded = False END IF CASE "BSAVE" IF File$ <> "" THEN IF NOT Load.Image(File$, "BSAVE") THEN Loaded = False END IF CASE ELSE MShow EXIT SUB END SELECT IF Loaded = False THEN DO: LOOP UNTIL INKEY$ <> "" MShow EXIT SUB END IF SCREEN 13: CLS Set.Palette MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 LOCATE 25, 1 Col = FindBrightestColor Text$ = File$ COLOR Col SELECT CASE OutFormat$ CASE "BSAVE" Get.MenuItemInfo 5, 1, Style$, Selected$, Active$ IF Selected$ = "1" THEN DEF SEG = &HA000 BSAVE Out$, 0, 64000 DEF SEG OPEN Out$ FOR BINARY AS #1 SEEK #1, LOF(1) PUT #1, , Pal CLOSE #1 Text$ = Text$ + " - Image BSAVED to " + Out$ + " with palette" ELSE DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 Upper = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 LINE (0, My)-(319, My), Col IF My < 100 THEN LOCATE 25, 1 PRINT " Set the upper bound with the mouse "; ELSE LOCATE 1, 1 PRINT " Set the upper bound with the mouse "; END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF My <= Upper + 1 THEN My = Upper + 1 IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 Lower = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 LINE (0, Upper)-(319, My), Col, B IF My < 100 THEN LOCATE 25, 1 PRINT " Set the lower bound with the mouse " ELSE LOCATE 1, 1 PRINT " Set the lower bound with the mouse " END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 DEF SEG = &HA000 BSAVE Out$, CLNG(Upper) * 320&, (CLNG(Lower) * 320&) - (CLNG(Upper) * 320&) DEF SEG Text$ = Text$ + " - Image BSAVED to " + Out$ END IF CASE "RAW" DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 X1 = Mx Y1 = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 PSET (Mx - 2, My), Col PSET (Mx + 2, My), Col PSET (Mx, My - 2), Col PSET (Mx, My + 2), Col PSET (Mx - 1, My), Col PSET (Mx + 1, My), Col PSET (Mx, My - 1), Col PSET (Mx, My + 1), Col IF My < 100 THEN LOCATE 25, 1 PRINT " Set the upper left corner "; RTRIM$(LTRIM$(STR$(X1))); ":"; RTRIM$(LTRIM$(STR$(Y1))); ELSE LOCATE 1, 1 PRINT " Set the upper left corner "; RTRIM$(LTRIM$(STR$(X1))); ":"; RTRIM$(LTRIM$(STR$(Y1))); END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 IF Mx < X1 + 1 THEN Mx = X1 + 1 IF My < Y1 + 1 THEN My = Y1 + 1 X2 = Mx Y2 = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 LINE (X1, Y1)-(X2, Y2), Col, B IF My < 100 THEN LOCATE 25, 1 PRINT " Set the lower right corner "; RTRIM$(LTRIM$(STR$(X2 - X1))); "x"; RTRIM$(LTRIM$(STR$(Y2 - Y1))); ELSE LOCATE 1, 1 PRINT " Set the lower right corner "; RTRIM$(LTRIM$(STR$(X2 - X1))); "x"; RTRIM$(LTRIM$(STR$(Y2 - Y1))); END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 OPEN Out$ FOR BINARY AS #1 FOR yy = Y1 TO Y2 FOR xx = X1 TO X2 Byte$ = CHR$(POINT(xx, yy)) PUT #1, , Byte$ NEXT NEXT CLOSE #1 LINE (X1, Y1)-(X2, Y2), Col, B Text$ = Text$ + " - Image Saved to " + Out$ + " as Raw Data - Saved Image Size: " + RTRIM$(LTRIM$(STR$(X2 - X1))) + "x" + RTRIM$(LTRIM$(STR$(Y2 - Y1))) CASE "DATA" DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 X1 = Mx Y1 = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 PSET (Mx - 2, My), Col PSET (Mx + 2, My), Col PSET (Mx, My - 2), Col PSET (Mx, My + 2), Col PSET (Mx - 1, My), Col PSET (Mx + 1, My), Col PSET (Mx, My - 1), Col PSET (Mx, My + 1), Col IF My < 100 THEN LOCATE 25, 1 PRINT " Set the upper left corner "; RTRIM$(LTRIM$(STR$(X1))); ":"; RTRIM$(LTRIM$(STR$(Y1))); ELSE LOCATE 1, 1 PRINT " Set the upper left corner "; RTRIM$(LTRIM$(STR$(X1))); ":"; RTRIM$(LTRIM$(STR$(Y1))); END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 DO Key$ = INKEY$ MStatus HiiriX%, HiiriY%, HiiriV%, HiiriO% Mx = HiiriX% \ 2 My = HiiriY% Ml = HiiriV% Mr = HiiriO% IF OldMx <> Mx OR OldMy <> My THEN MouseMove = 1 ELSE MouseMove = 0 IF Ml = 0 AND Click = -1 THEN Click = 1 ELSE IF Ml = 0 THEN Click = 0 IF Ml = -1 AND Click = 0 THEN Click = -1 IF Mx < X1 + 1 THEN Mx = X1 + 1 IF My < Y1 + 1 THEN My = Y1 + 1 X2 = Mx Y2 = My IF MouseMove = 1 THEN WAIT &H3DA, 8 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 LINE (X1, Y1)-(X2, Y2), Col, B IF My < 100 THEN LOCATE 25, 1 PRINT " Set the lower right corner "; RTRIM$(LTRIM$(STR$(X2 - X1))); "x"; RTRIM$(LTRIM$(STR$(Y2 - Y1))); ELSE LOCATE 1, 1 PRINT " Set the lower right corner "; RTRIM$(LTRIM$(STR$(X2 - X1))); "x"; RTRIM$(LTRIM$(STR$(Y2 - Y1))); END IF END IF OldMx = Mx OldMy = My LOOP UNTIL Click = 1 MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 OPEN Out$ FOR APPEND AS #1 PRINT #1, "" PRINT #1, "' � Image converted with CONVERT.BAS by Sami Ky봲til�" PRINT #1, "' � Input file: " + File$ PRINT #1, "' � Image size: " + RTRIM$(LTRIM$(STR$(X2 - X1))) + "x" + RTRIM$(LTRIM$(STR$(Y2 - Y1))) PRINT #1, "" PRINT #1, "' � Start of Image Data" PRINT #1, "DATA "; XPos = 1 FOR yy = Y1 TO Y2 FOR xx = X1 TO X2 Byte$ = RTRIM$(LTRIM$(STR$(POINT(xx, yy)))) Byte$ = Byte$ + SPACE$(4 - LEN(Byte$)) PRINT #1, Byte$; XPos = XPos + 1 IF XPos >= 50 THEN XPos = 1 PRINT #1, "" PRINT #1, "DATA "; ELSE PRINT #1, ","; END IF NEXT NEXT PRINT #1, "" PRINT #1, "' � End of Image Data" CLOSE #1 LINE (X1, Y1)-(X2, Y2), Col, B Text$ = Text$ + " - Image Appended to " + Out$ + " as DATA Statements - Saved Image Size: " + RTRIM$(LTRIM$(STR$(X2 - X1))) + "x" + RTRIM$(LTRIM$(STR$(Y2 - Y1))) END SELECT DO Roller 1, 25, 40, Text$, Col LOOP UNTIL INKEY$ <> "" SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu MShow END SUB SUB Save.Palette (File$, InpFormat$, OutFormat$) Out$ = RTRIM$(LTRIM$(UCASE$(Query(" Enter the output file ", "&0%7 Save Image ", 60, "")))) IF Out$ = "" THEN MShow: EXIT SUB Loaded = True SELECT CASE UCASE$(InpFormat$) CASE "BMP" IF File$ <> "" THEN IF NOT Load.Palette(File$, "BMP") THEN Loaded = False END IF CASE "PCX" IF File$ <> "" THEN IF NOT Load.Palette(File$, "PCX") THEN Loaded = False END IF CASE "GIF" IF File$ <> "" THEN IF NOT Load.Palette(File$, "GIF") THEN Loaded = False END IF CASE "RAW" IF File$ <> "" THEN IF NOT Load.Palette(File$, "RAW") THEN Loaded = False END IF CASE ELSE MShow EXIT SUB END SELECT IF Loaded = False THEN DO: LOOP UNTIL INKEY$ <> "" MShow EXIT SUB END IF SCREEN 13: CLS Set.Palette Draw.Palette -1 LOCATE 25, 1 Col = FindBrightestColor Text$ = File$ COLOR Col SELECT CASE OutFormat$ CASE "RAW" OPEN Out$ FOR BINARY AS #1 PUT #1, , Pal CLOSE #1 Text$ = Text$ + " - Palette Saved to " + Out$ + " as Raw Data" CASE "DATA" OPEN Out$ FOR APPEND AS #1 PRINT #1, "" PRINT #1, "' � Palette converted with CONVERT.BAS by Sami Ky봲til�" PRINT #1, "' � Input file: " + File$ PRINT #1, "' � Palette size: 786 bytes, RGB format" PRINT #1, "" PRINT #1, "' � Start of Palette Data" PRINT #1, "DATA "; XPos = 1 FOR I = 1 TO 768 Byte$ = RTRIM$(LTRIM$(STR$(ASC(MID$(Pal, I, 1))))) Byte$ = Byte$ + SPACE$(3 - LEN(Byte$)) PRINT #1, Byte$; XPos = XPos + 1 IF XPos >= 60 THEN XPos = 1 PRINT #1, "" PRINT #1, "DATA "; ELSE PRINT #1, ","; END IF NEXT PRINT #1, "" PRINT #1, "' � End of Palette Data" CLOSE #1 Text$ = Text$ + " - Palette Appended to " + Out$ + " as DATA Statements" CASE "BMP" SaveBMP8 Out$, 0, 0, 318, 198 Text$ = Text$ + " - Palette Saved to " + Out$ + " as BMP Palette" END SELECT DO Roller 1, 25, 40, Text$, Col LOOP UNTIL INKEY$ <> "" SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu MShow END SUB SUB SaveBMP8 (Pic$, X1%, Y1%, X2%, Y2%) 'Calculate width and height of image- BMPWidth% = X2% - X1% + 1 BMPHeight% = Y2% - Y1% + 1 'Each raster must be a multiple of 4 bytes, this next line takes 'care of 'padded' bytes at the end of rasters of odd-width images- IF BMPWidth% / 4 <> BMPWidth% \ 4 THEN PadBytes% = 4 - (BMPWidth% MOD 4) OPEN Pic$ FOR BINARY AS #1 'General Picture Information- ' BMP format marker- Buffer$ = "BM" ' File size minus header- L& = (CLNG(BMPWidth%) + PadBytes%) * BMPHeight% + 1078 Buffer$ = Buffer$ + LongToString$(L&) ' Reserved 1- Buffer$ = Buffer$ + CHR$(0) + CHR$(0) ' Reserved 2- Buffer$ = Buffer$ + CHR$(0) + CHR$(0) ' Number of bytes offset to picture data- Buffer$ = Buffer$ + LongToString$(1078) 'Information Header- ' Size of information header- Buffer$ = Buffer$ + LongToString$(40) ' Picture width in pixels- L& = BMPWidth% Buffer$ = Buffer$ + LongToString$(L&) ' Picture height in pixels- L& = BMPHeight% Buffer$ = Buffer$ + LongToString$(L&) ' Number of planes- Buffer$ = Buffer$ + CHR$(1) + CHR$(0) ' Bits per pixel- Buffer$ = Buffer$ + CHR$(8) + CHR$(0) ' Compression- Buffer$ = Buffer$ + LongToString$(0) ' Image size in bytes- L& = (CLNG(BMPWidth%) + PadBytes%) * BMPHeight% Buffer$ = Buffer$ + LongToString$(L&) ' Picture width in pixels per meter- Buffer$ = Buffer$ + LongToString$(0) ' Picture height in pixels per meter- Buffer$ = Buffer$ + LongToString$(0) ' Colors used in picture- Buffer$ = Buffer$ + LongToString$(256) ' Number of important colors- Buffer$ = Buffer$ + LongToString$(256) PUT #1, 1, Buffer$ 'Save palette data- Buffer$ = "" FOR I% = 0 TO 255 OUT &H3C7, I% Red% = INP(&H3C9) Green% = INP(&H3C9) Blue% = INP(&H3C9) 'Palette is saved B, G, R with unused byte trailing- Buffer$ = Buffer$ + CHR$(Blue% * 4) Buffer$ = Buffer$ + CHR$(Green% * 4) Buffer$ = Buffer$ + CHR$(Red% * 4) Buffer$ = Buffer$ + CHR$(0) NEXT I% PUT #1, , Buffer$ 'Save image data- FOR I% = (BMPHeight% - 1) TO 0 STEP -1 Buffer$ = "" FOR J% = 0 TO (BMPWidth% - 1) Buffer$ = Buffer$ + CHR$(POINT(X1% + J%, Y1% + I%)) NEXT J% IF PadBytes% > 0 THEN FOR J% = 1 TO PadBytes% Buffer$ = Buffer$ + CHR$(0) NEXT J% END IF PUT #1, , Buffer$ NEXT I% 'Put a fork in it, it's done- CLOSE #1 END SUB FUNCTION ScanDir (FileSpec$, Output$) File = FREEFILE OPEN Output$ FOR OUTPUT AS File File$ = LTRIM$(RTRIM$(DirFirst$(FileSpec$, F.NOR))) IF File$ = "" THEN Found = 0 ELSE Found = 1 PRINT #File, File$ DO File$ = LTRIM$(RTRIM$(DirNext$)) IF File$ = "" THEN EXIT DO PRINT #File, File$ Found = Found + 1 LOOP CLOSE File ScanDir = Found END FUNCTION SUB SeekFileItem (File, Item) SEEK #File, (Item) * 12 + 1 END SUB SUB Set.MenuItem (MenuNum, Num, Caption$, Active AS STRING, Style AS STRING, Selected AS STRING) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Sets menu item Num in menu MenuNum information variables, see ' SUB Create.MenuItem for information about the menu item variables. '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 SEEK #251, (CLNG(MenuNum - 1) * 6100) + (Num * 122) Temp$ = LEFT$(Caption$, 50) Temp$ = Temp$ + SPACE$(50 - LEN(Temp$)) MenuItem.Caption = Caption$ MenuItem.Active = Active MenuItem.Style = Style MenuItem.Selected = Selected PUT #251, , MenuItem END SUB SUB Set.MenuTopic (Num, Topic$) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Sets the main menu topic number Num to text Topic$ '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 SEEK #250, CLNG(Num) * 16 Temp$ = LEFT$(Topic$, 16) Temp$ = Temp$ + SPACE$(16 - LEN(Temp$)) PUT #250, , Temp$ END SUB SUB Set.Palette FOR I& = 0 TO 255 r = ASC(MID$(Pal, (I& * 3) + 1, 1)) g = ASC(MID$(Pal, (I& * 3) + 2, 1)) b = ASC(MID$(Pal, (I& * 3) + 3, 1)) OUT (&H3C8), I& OUT (&H3C9), r OUT (&H3C9), g OUT (&H3C9), b NEXT END SUB SUB SetDTA (FileInfo AS DOSFileInfo) '---------------------------------------------------------------------- ' Sets up FileInfo as Disk Transfer Area '---------------------------------------------------------------------- DIM Reg AS RegTypeX Reg.ax = &H1A00 Reg.ds = VARSEG(FileInfo) Reg.dx = VARPTR(FileInfo) CALL InterruptX(&H21, Reg, Reg) END SUB SUB Show.Image SCREEN 13: CLS Set.Palette MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 OrgPal$ = Pal RotPal = -1 DO Key$ = UCASE$(INKEY$) IF Key$ = "R" THEN RotPal = -RotPal IF RotPal = -1 THEN Pal = OrgPal$: Set.Palette END IF IF RotPal = 1 THEN RotatePal LOOP UNTIL Key$ = CHR$(32) OR Key$ = CHR$(27) OR Key$ = CHR$(13) SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu MShow END SUB DEFLNG A-Z SUB SmoothPal (Iter) DIM TempPal AS STRING * 768 FOR I& = 0 TO 255 OUT &H3C7, I& MID$(TempPal, (I& * 3) + 1, 1) = CHR$(INP(&H3C9)) MID$(TempPal, (I& * 3) + 2, 1) = CHR$(INP(&H3C9)) MID$(TempPal, (I& * 3) + 3, 1) = CHR$(INP(&H3C9)) NEXT RVal1 = ASC(MID$(TempPal, 1, 1)) RVal2 = ASC(MID$(TempPal, 4, 1)) RVal3 = ASC(MID$(TempPal, 766, 1)) GVal1 = ASC(MID$(TempPal, 2, 1)) GVal2 = ASC(MID$(TempPal, 5, 1)) GVal3 = ASC(MID$(TempPal, 767, 1)) BVal1 = ASC(MID$(TempPal, 3, 1)) BVal2 = ASC(MID$(TempPal, 6, 1)) BVal3 = ASC(MID$(TempPal, 768, 1)) MID$(TempPal, 1, 1) = CHR$((RVal1 + RVal2 + RVal3) \ 3) MID$(TempPal, 2, 1) = CHR$((GVal1 + GVal2 + GVal3) \ 3) MID$(TempPal, 3, 1) = CHR$((BVal1 + BVal2 + BVal3) \ 3) FOR Iteration = 1 TO Iter FOR I& = 1 TO 254 RVal1 = ASC(MID$(TempPal, (I& * 3) + 1, 1)) RVal2 = ASC(MID$(TempPal, (I& * 3) + 4, 1)) RVal3 = ASC(MID$(TempPal, (I& * 3) - 2, 1)) GVal1 = ASC(MID$(TempPal, (I& * 3) + 2, 1)) GVal2 = ASC(MID$(TempPal, (I& * 3) + 5, 1)) GVal3 = ASC(MID$(TempPal, (I& * 3) - 1, 1)) BVal1 = ASC(MID$(TempPal, (I& * 3) + 3, 1)) BVal2 = ASC(MID$(TempPal, (I& * 3) + 6, 1)) BVal3 = ASC(MID$(TempPal, (I& * 3), 1)) MID$(TempPal, (I& * 3) + 1, 1) = CHR$((RVal1 + RVal2 + RVal3) \ 3) MID$(TempPal, (I& * 3) + 2, 1) = CHR$((GVal1 + GVal2 + GVal3) \ 3) MID$(TempPal, (I& * 3) + 3, 1) = CHR$((BVal1 + BVal2 + BVal3) \ 3) NEXT NEXT RVal1 = ASC(MID$(TempPal, 1, 1)) RVal2 = ASC(MID$(TempPal, 763, 1)) RVal3 = ASC(MID$(TempPal, 766, 1)) GVal1 = ASC(MID$(TempPal, 2, 1)) GVal2 = ASC(MID$(TempPal, 764, 1)) GVal3 = ASC(MID$(TempPal, 767, 1)) BVal1 = ASC(MID$(TempPal, 3, 1)) BVal2 = ASC(MID$(TempPal, 765, 1)) BVal3 = ASC(MID$(TempPal, 768, 1)) MID$(TempPal, 766, 1) = CHR$((RVal1 + RVal2 + RVal3) \ 3) MID$(TempPal, 767, 1) = CHR$((GVal1 + GVal2 + GVal3) \ 3) MID$(TempPal, 768, 1) = CHR$((BVal1 + BVal2 + BVal3) \ 3) FOR I& = 0 TO 255 OUT &H3C8, I& OUT &H3C9, ASC(MID$(TempPal, (I& * 3) + 1, 1)) OUT &H3C9, ASC(MID$(TempPal, (I& * 3) + 2, 1)) OUT &H3C9, ASC(MID$(TempPal, (I& * 3) + 3, 1)) NEXT Pal = TempPal END SUB DEFSNG A-Z SUB Switch (Var, Value1, Value2) DEFINT A-Z '---------------------------------------------------------------------------- ' Switches values '---------------------------------------------------------------------------- ' ' Var - Variable to be changed ' Value1 - Value 1 ' Value2 - Value 2 ' '---------------------------------------------------------------------------- ' ' if Var = Value1 then Value2 will be assigned to Var ' ' if Var = Value2 then Value1 will be assigned to Var ' '---------------------------------------------------------------------------- IF Var = Value1 THEN Var = Value2: EXIT SUB IF Var = Value2 THEN Var = Value1 END SUB SUB Toggle.MenuItem (MenuNum, Num, State) '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 ' Sets the menu item Num in menu number MenuNum active or disabled ' ' State: True - Active, False - Disabled '컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 Caption$ = Get.MenuItem$(MenuNum, Num) Get.MenuItemInfo MenuNum, Num, Style$, Selected$, Active$ IF State THEN Set.MenuItem MenuNum, Num, Caption$, "1", Style$, Selected$ ELSE Set.MenuItem MenuNum, Num, Caption$, "0", Style$, Selected$ END IF END SUB SUB View.Palette MHide SCREEN 13: CLS Set.Palette 'MemCopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00 'FOR i = 0 TO 255: COLOR i: PRINT "�"; : NEXT Draw.Palette -1 OrgPal$ = Pal RotPal = -1 Col = FindBrightestColor COLOR Col LOCATE 23, 1 PRINT " R - Rotate Palette ESC - Return" DO Key$ = UCASE$(INKEY$) IF Key$ = "R" THEN RotPal = -RotPal IF RotPal = -1 THEN Pal = OrgPal$: Set.Palette END IF IF RotPal = 1 THEN RotatePal LOOP UNTIL Key$ = CHR$(32) OR Key$ = CHR$(27) OR Key$ = CHR$(13) SCREEN 0: WIDTH 80, 25 COLOR 7, 1: CLS Draw.Border 1, 1, 80, 25, 7, 1 Draw.Menu MShow END SUB