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