BMPtoCODE (image to code compression and overlay tool)

This version is for BBC Basic. It requires LBB to run.

Get LBB: link

It is my greatest work.! I wanted to make it work for both languages I play with.
It was meant for the public use. The original version I gave to the LB community. I thank everyone that helped me, especially Alyce for her support on the previous version.

Now you don't have to copy/paste anything ! The entire image and program are now created in Expfina.bas !!!!
You now can open the generated file and RUN !!
1) Name this program BMPTOCODE.bas
2) In windows paint make a blank image that is 200x200 pixels (it doesn't have to be that big but make it a square that has the same width and height)
3) Save the blank image in 255 color bmp image format
4) You can now make a image using all default colors except bottom right one
5) Save your creation
6) Run BMPTOCODE.bas and select your picture and wait for 30 seconds
7) Open EXPfina.bas
8) Copy the program into your clip board and paste it into BBC basic and RUN IT !!
9) If there is any problems let me know plz
nomainwin
 bmpheight=0
 bmpwidth=0
 bitmap$=""
 hBitmap=0
 hWindow=0
 menu #1, "&File", "&Open BMP File",[openBMP],|,"E&xit",[quit]
open "BMP IMAGE TO R, G, B   DATA FILE" for graphics_fs_nsb as #1
 print #1, "trapclose [quit]"
 print #1, "down;place 100 100"
 print #1, "|Open a bmp image."
 print #1, "|This program will take the BMP image data"
 print #1, "|and convert it into compressed R,G,B data statements"
 print #1, "|Save file name is EXPDATA.bas "
 hWindow=hwnd(#1)
[loop]
 input aVar$
[openBMP]
 if hBitmap<>0 then
   unloadbmp ("bm")
   print #1, "cls"
 end if
 filedialog "Open Bmp Image","*.bmp",bitmap$
 if bitmap$="" then
   notice "No bitmap chosen!"
   goto [loop]
 end if
 print #1, "cls"
 loadbmp "bm" , bitmap$
 hBitmap=hbmp("bm")
 print #1, "down;drawbmp bm 0 0"
 bmpheight=HeightBitmap(bitmap$)
 bmpwidth=WidthBitmap(bitmap$)
 print #1, "drawbmp bm 0 ";bmpheight
 call Scanbmp bmpwidth, bmpheight, hWindow
 goto [loop]


sub Scanbmp wide, high, hWnd
 cursor hourglass
 white=16777215
 black=0
 gray=12636112
 lightgray=12632256
 red=167777215
 coun=0
 r2=0
 g2=0
 b2=0
 t=0
 open "EXPdata.bas" for output as #f
 print #f, str$(wide-1)
 print #f, str$(high-1)
 open "user32" for dll as #user
 Open "gdi32"for DLL as #gdi
 CallDll #user, "GetDC",_
   hWnd as long,_
   hDC as long
 for i = 0 to wide-1
   for j = 0 to high-1
     CallDll #gdi, "GetPixel",_
       hDC as long,_
       i as long,_
       j as long,_
       pColor as long
call getRGB pColor,r,g,b
      nst$=""
      if r=0 and g=0 and b=0 then nst$="0" 'black
      if r=192 and g=128 and b=64 then nst$="1" ' brown
      if r=64 and g=64 and b=192 then nst$="2" 'dark blue
      if r=128 and g=128 and b=128 then nst$="3" ' dark grey
      if r=128 and g=0 and b=0 then nst$="4" 'dark red
      if r=224 and g=192 and b=0 then nst$="5" 'dark yellow
      if r=128 and g=160 and b=192 then nst$="6" 'flat blue
      if r=32 and g=192 and b=64 then nst$="7" 'green
      if r=166 and g=202 and b=240 then nst$="8" 'light blue
      if r=192 and g=192 and b=192 then nst$="9" 'light gray
      if r=192 and g=224 and b=0 then nst$="a" 'light green
      if r=224 and g=32 and b=64 then nst$="b" 'light red
      if r=0 and g=160 and b=192 then nst$="c" 'medblue
      if r=224 and g=128 and b=64 then nst$="d" 'orange
      if r=224 and g=160 and b=192 then nst$="e" 'pink
      if r=160 and g=64 and b=192 then nst$="f" 'purple
      if r=192 and g=220 and b=192 then nst$="g" 'tan
      if r=255 and g=255 and b=255 then nst$="h" 'white
      if r=255 and g=255 and b=0 then nst$="i" 'yellow
      if nst$="" then nst$="0" 'prevent misses
      print #f, nst$
   next j
 next i
 close #f
 CallDll #user, "ReleaseDC",_
   hWnd as long,_
   hDC as long,_
   r as long
 close #user
 close #gdi
 cursor normal
ost$=""
 nst$=""
 coun=0
 t=0
 open "EXPdata.bas" for input as #r
 open "EXPcomp.bas" for output as #f
 input #r, x
 input #r, y
 print #f, x
 print #f, y
 #1 "down;fill black"
 while c <y
   input #r, nst$
if nst$="0" then r=0:g=0:b=0  'black
            if nst$="1" then r=192:g=128:b=64  ' brown
            if nst$="2" then r=64:g=64:b=192 'dark blue
            if nst$="3" then r=128:g=128:b=128' dark grey
            if nst$="4" then r=128:g=0:b=0'dark red
            if nst$="5" then r=224:g=192:b=0 'dark yellow
            if nst$="6" then r=128:g=160:b=192'flat blue
            if nst$="7" then r=32:g=192:b=64 'green
            if nst$="8" then r=166:g=202:b=240'light blue
            if nst$="9" then r=192:g=192:b=192 'light gray
            if nst$="a" then r=192:g=224:b=0  'light green
            if nst$="b" then r=224:g=32:b=64'light red
            if nst$="c" then r=0:g=160:b=192 'medblue
            if nst$="d" then r=224:g=128:b=64  'orange
            if nst$="e" then r=224:g=160:b=192'pink
            if nst$="f" then r=160:g=64:b=192'purple
            if nst$="g" then r=192:g=220:b=192'tan
            if nst$="h" then r=255:g=255:b=255'white
            if nst$="i" then r=255:g=255:b=0'yellow
   #1 "color ";r;" ";g;" ";b
    a=a+1: print #1, "set ";c;" ";a :if a>x  then c=c+1:a=0

    if ost$="" then ost$=nst$: goto [jump]
    if ost$=nst$ then t=t+1
    if ost$<>nst$ then print #f, ost$+","+str$(t): t=0
    ost$=nst$

[jump]
 wend
 close #f
close #r
end$="no"
open "EXPcomp.bas" for input as #r
open "EXPfina.bas" for output as #f
'*
print #f, "VDU 22,8"
print #f, "VDU 23,23,1|"
print #f, "OFF:VDU 5:COLOUR 0:CLG"
print #f, "PROC_image(100,500)"
print #f, "WAIT 0:END"
Print #f, "DEF PROC_image(h,v)"
print #f, "u=0:r=0:g=0:b=0:a=0:c=0:t=0"
print #f, "ost$=";chr$(34);"";chr$(34)
print #f, "READ x,y:REPEAT"
print #f, " READ nst$,t"
print #f, "IF nst$=";chr$(34);"0";chr$(34);" THEN r=0:g=0:b=0 :REM 'black              0   0   0"
print #f, "IF nst$=";chr$(34);"1";chr$(34);" THEN r=192:g=128:b=64:REM  ' brown      192 128  64"
print #f, "IF nst$=";chr$(34);"2";chr$(34);" THEN r=64:g=64:b=192 :REM'dark blue     64  64 192"
print #f, "IF nst$=";chr$(34);"3";chr$(34);" THEN r=128:g=128:b=128:REM' dark grey 128 128 128"
print #f, "IF nst$=";chr$(34);"4";chr$(34);" THEN r=128:g=0:b=0:REM'dark red       128   0   0"
print #f, "IF nst$=";chr$(34);"5";chr$(34);" THEN r=224:g=192:b=0 :REM'dark yellow  224   192   0"
print #f, "IF nst$=";chr$(34);"6";chr$(34);" THEN r=128:g=160:b=192:REM'flat blue  128 160 192"
print #f, "IF nst$=";chr$(34);"7";chr$(34);" THEN r=32:g=192:b=64 :REM'green        32 192  64"
print #f, "IF nst$=";chr$(34);"8";chr$(34);" THEN r=166:g=202:b=240:REM'light blue 166 202 240"
print #f, "IF nst$=";chr$(34);"9";chr$(34);" THEN r=192:g=192:b=192:REM 'light gray 192 192 192"
print #f, "IF nst$=";chr$(34);"a";chr$(34);" THEN r=192:g=224:b=0:REM  'light green  192 224   0"
print #f, "IF nst$=";chr$(34);"b";chr$(34);" THEN r=224:g=32:b=64:REM'light red    224  32  64"
print #f, " IF nst$=";chr$(34);"c";chr$(34);" THEN r=0:g=160:b=192 :REM'medblue        0 160 192"
print #f, " IF nst$=";chr$(34);"d";chr$(34);" THEN r=224:g=128:b=64 :REM 'orange       224 128 64"
print #f, " IF nst$=";chr$(34);"e";chr$(34);" THEN r=224:g=160:b=192:REM'pink       224 160 192"
print #f, " IF nst$=";chr$(34);"f";chr$(34);" THEN r=160:g=64:b=192:REM'purple      160 64 192"
print #f, "IF nst$=";chr$(34);"g";chr$(34);" THEN r=192:g=220:b=192:REM'tan        192 220 192"
print #f, "IF nst$=";chr$(34);"h";chr$(34);" THEN r=255:g=255:b=255:REM'white      255 255 255"
print #f, "IF nst$=";chr$(34);"i";chr$(34);" THEN r=255:g=255:b=0:REM'yellow       255 255 0"
print #f, "COLOUR 0,r,g,b:GCOL 0"
print #f, "FOR u=0 TO t"
print #f, "a=a+2: MOVE h+c,v-a:DRAW h+c,v-a:IF a>x  THEN c=c+2:a=0"
print #f, "NEXT u"
print #f, "UNTIL nst$="+chr$(34)+"100000"+chr$(34)
print #f, "MOVE 0,0:ENDPROC"
'   last line---
input #r, x
input #r, y
print #f, "DATA "+str$(x)+","+str$(y)
print #f, "DATA ";
while end$="no"
input #r,nst$
if coun>39 then print #f, nst$ :coun=coun+1 :print #f, "DATA ";
if coun<40 then print #f, nst$+","; :coun=coun+1
if coun>40 then coun =0
if eof(#r)= -1 then end$="yes"
wend
print #f, "100000,0"
close #r
close #f
end sub
sub getRGB pixcol, byref r, byref g, byref b
  b = int(pixcol / (256*256))  '*
  g = int((pixcol - b *256*256) / 256) '*
  r = int(pixcol - b*256*256 - g*256) '*
end sub
function WidthBitmap(name$)
 open name$ for input as #pic
 pic$=input$(#pic,29)
 close #pic
 WidthBitmap = asc(mid$(pic$,19,1)) + _
   (asc(mid$(pic$,20,1)) * 256)
end function

function HeightBitmap(name$)
 open name$ for input as #pic
 pic$=input$(#pic,29)
 close #pic
 HeightBitmap = asc(mid$(pic$,23,1)) + _
   (asc(mid$(pic$,24,1)) * 256)
end function

[quit]
 close #1
 end