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