Post by honkytonk on Apr 13, 2019 17:56:04 GMT
Put a bmp in a folder with this script, launch, adjust the dimensions, crop the image, clic: "Go Work", and it will give a sprite.
Attention, the sprite is double the image height if the window is more big than the screen, is not good (and there is no verification for this).
Improvements will be welcome.
Attention, the sprite is double the image height if the window is more big than the screen, is not good (and there is no verification for this).
Improvements will be welcome.
' Whith "tsh73" Anatoly' algorithm from english forum--> http://justbasiccom.proboards.com/thread/262/on-painting
nomainwin
larg=250: haut=500
[reopen]
global larg, haut
WindowWidth = larg+200: WindowHeight = haut+40
UpperLeftX = 300: UpperLeftY = 10
STATICTEXT #w.twi, "Width", larg+20, 10, 70, 25
STATICTEXT #w.the, "Height", larg+120, 10, 70, 25
TEXTBOX #w.x, larg+20, 40, 70, 25
TEXTBOX #w.y, larg+120, 40, 70, 25
BUTTON #w.try, "Go Work ", [palpe], UL, larg+40, 140, 100, 25
BUTTON #w.dim, "Change Dim", [dim], UL, larg+70, 75, 70, 20
BUTTON #w.conf, "Confirme", [confirm], UL, larg+70, 100, 70, 25
STATICTEXT #w.txt, "", larg+20, 200, 200, 25
STATICTEXT #w.inf, "Clic and crop subject", larg+20, haut-50, 200, 25
GRAPHICBOX #w.m 5, 5, larg, haut
OPEN "Sprite Factory" FOR window_nf AS #w
#w, "TRAPCLOSE [closetest]"
filedialog "Open bmp file", "*.bmp", fileName$
loadbmp, "image", fileName$
lastX=-1
lastY=-1
p=0: pl=0 ': x$="": y$=""
dim matr(larg+1, haut+1)
#w.m "down;color white;size 1"
#w.m, "drawbmp image ";"0";" ";haut/2
#w.m, "when leftButtonMove [keepdraw]"
#w.m, "when leftButtonDown [startdraw]"
#w.try, "!font courrier 12 bold": #w.txt, "!font courrier 12 bold"
#w.twi, "!font courrier 10 bold": #w.the, "!font courrier 10 bold"
#w.x, str$(larg): #w.y, str$(haut)
#w.try, "!disable": #w.x, "!disable": #w.y, "!disable": #w.conf, "!disable"
wait
[startdraw]
x=MouseX: y= MouseY
lastX=x
lastY=y
wait
[keepdraw]
x=MouseX: y= MouseY
if x<0 or x>larg or y < 0 or y > haut then wait 'or it falls out of matrix
dx = x-lastX
dy = y-lastY
if dx = 0 and dy = 0 then wait 'no move, or breaks with /0
if abs(dx)>abs(dy) then
x1=lastX:x2=x
if x2<x1 then x2=lastX:x1=x
for xx=x1 to x2
yy=int(0.5+lastY+(y-lastY)/(x-lastX)*(xx-lastX))
matr(xx,yy)=1
#w.m, "set ";xx;" ";yy 'datas in box sure
next
else
y1=lastY:y2=y
if y2<y1 then y2=lastY:y1=y
for yy=y1 to y2
xx=int(0.5+lastX+(x-lastX)/(y-lastY)*(yy-lastY))
matr(xx,yy)=1
#w.m, "set ";xx;" ";yy 'datas in box sure
next
end if
lastX=x
lastY=y
p=p +1
#w.try, "!enable"
wait
sub FloodFill x,y
SCAN
if x <0 or x > larg or y < 0 or y > haut then exit sub
if matr(x,y) <> 0 then exit sub
matr(x,y) =2 'fills matr array - breaks it?
#w.m, "set ";x;" ";y
call FloodFill x+1,y
call FloodFill x,y+1
call FloodFill x-1,y
call FloodFill x,y-1
end sub
[palpe]
#w.txt, "In work please wait": #w.try, "!disable"
#w.m, "when mouseMove"
#w.m, "down;color black;size 1"
#w.txt, "In work please wait": gosub [pause]: #w.txt, "": gosub [pause]: #w.txt, "In work please wait"
call FloodFill 1,1
'fill white for mask
#w.txt, "In work please wait": gosub [pause]: #w.txt, "": gosub [pause]: #w.txt, "In work please wait"
#w.txt, "In work please wait"
for y=1 to haut/2
for x=1 to larg
#w.m, "down;color white;size 1"
#w.m, "set ";x;" ";y
next x
next y
'draw mask
#w.txt, "In work please wait": gosub [pause]: #w.txt, "": gosub [pause]: #w.txt, "In work please wait"
for y=haut/2 to haut
for x=1 to larg
#w.m, "down;color black;size 1"
if matr(x,y) <> 2 then
#w.m, "set ";x;" ";y-haut/2
end if
next x
next y
'erase trace
#w.txt, "In work please wait": gosub [pause]: #w.txt, "": gosub [pause]: #w.txt, "In work please wait"
#w.m "down;color black"
for y=haut/2 to haut
for x=1 to larg
if matr(x,y)= 1 then
#w.m, "set ";x;" ";y
end if
next x
next y
#w.m, "getbmp bmpName ";"0";" ";"0";" "; larg;" ";haut
bmpsave "bmpName", "sprite.bmp"
#w.txt, "sprite.bmp is in folder"
wait
[dim]
#w.conf, "!enable": #w.x, "!enable": #w.y, "!enable"
wait
[confirm]
#w.dim, "!disable"
#w.x, "!contents? var$": larg=val(var$)
#w.y, "!contents? var$": h=val(var$)
hh=h MOD 2: if hh <> 0 then haut=(h-1)*2: #w.y, str$(haut)
#w.conf, "!disable": #w.dim, "!enable"
close #w: goto [reopen]
wait
[pause]
timer 500, [temps]
wait
[temps]
timer 0
return
[closetest]
CLOSE #w
END