Sorry your browser is not supported!

set display mode 1024,768,32
sync on
sync rate 0

load dll "user32.dll",1
load dll "gdi32.dll",2
hWnd = call dll(1,"GetActiveWindow")
hDC = call dll(1,"GetWindowDC",hWnd)

input "Image Name=",Image$
rem input "Size X=",SizeX
rem input "Size Y=",SizeY
SizeX=255
SizeY=255
load image Image$+".bmp",1
ink rgb(255,255,255),0
box 0,0,1024,768
paste image 1,0,0

wait key

if file exist(Image$+".BWCIMG~") then delete file Image$+".BWCIMG~"
open to write 1,Image$+".BWCIMG~"

Fois=0
color=point(1,1)
for y=1 to SizeY
   for x=1 to SizeX
      OldColor=Color
      Color=call dll(2,"GetPixel",hDC,X,Y)
      Color=rgb(rgbb(color),rgbg(color),rgbr(color))
      rem Color=Point(X,Y)
      if OldColor=Color then Fois=Fois+1
      if OldColor<>Color then write string 1,Str$(OldColor)+","+Str$(Fois)+",":Fois=1
   next x
next y
write string 1,"*"

close file 1
if file exist(Image$+".BWCIMG") then delete file Image$+".BWCIMG"
open to write 1,Image$+".BWCIMG"
open to read 2,Image$+".BWCIMG~"

NbData=1
read string 2,String$
while String$<>"*"
Frase$=Frase$+String$
if NbData=15 then Write string 1,left$("Data "+Frase$,len("Data "+Frase$)-1):NbData=0:Frase$=""
read string 2,String$
NbData=NbData+1
endwhile

if NbData<>0 then  Write string 1,"Data "+Frase$+"999999999"
Write string 1,"*"

close file 1
close file 2
delete file Image$+".BWCIMG~"


if file exist("CreateImage.Dba") then delete file "CreateImage.Dba"
open to write 1,"CreateImage.Dba"
open to read 2,Image$+".BWCIMG"

Read String$
while String$<>"*"
   Write string 1,String$
   Read String$
endwhile

Read string 2,String$
while String$<>"*"
   Write string 1,String$
   Read string 2,String$
endwhile

close file 1
close file 2
delete file Image$+".BWCIMG"

cls
print "now delete everything execpt CreateImage.Dba, and run it you will see your image"
end
data "set display mode 1024,768,32"
data "sync on"
data "cls"
data "SizeX=255"
data "x=0"
data "y=0"
data "read Color"
data "read Fois"
data "ink Color,0"
data "while (Color<>999999999) and (Fois<>999999999)"
data "   fois=fois-1"
data "   x=x+1"
data "   if x>=SizeX then x=1:y=y+1:sync"
data "   dot X,Y"
data "   if fois<=0 then read Color:read Fois:ink Color,0"
data "endwhile"
data "sync"
data "wait key"
data "end"
data "*"