News:

PlayBASIC2DLL V0.99 Revision I Commercial Edition released! - Convert PlayBASIC programs to super fast Machine Code. 

Main Menu

Almost two weeks too late...

Started by empty, November 22, 2006, 04:54:53 AM

Previous topic - Next topic

empty

But better late than never. Happy B-Day Mr Picone :)

kevin


That'd be right, so where's my present.??    You know what i want   !  - gimme gimme  :)

Ian Price

Oh well, better late than never. Happy Belated Birthday Kevin.

Here's a present for you to unwrap :)

I came. I saw. I played some Nintendo.

kevin


  Cheers,  is it the JekPac final ? :)


Ian Price

LOL. You'll have to open it to find out :p
I came. I saw. I played some Nintendo.

stef

Best wishes!


screenw=800
screenh=600

LoadFont "comic sans ms",2,60,1


pink=RGB(255,0,255)
black=RGB(0,0,0)
white=RGB(255,255,255)

cutsize=80
cutsizex=400
cutsizey=100

sourceimsizex=800
sourceimsizey=400
sourceimposx=0
sourceimposy=0

maxshapes=1
Dim shapeim(maxshapes)
Dim copyofshapeim(maxshapes)
Dim getpartfromsourceim(maxshapes)
Dim endim(maxshapes)
Dim restim(maxshapes)

Type tshow
im
x#
y#
EndType

maxshow=2
Dim show(maxshow) As tshow
For count0=0 To maxshow
show(count0).im=NewImage(cutsizex,cutsizey)
Next
Gosub drawsourceimage

Gosub drawstuff

Gosub imagegenerating

Do

RenderToScreen

Cls 155

mx#=MouseX()
my#=MouseY()

If LeftMouseButton()
FlushMouse
x1#=mx#-cutsizex/2-sourceimposx
y1#=my#-cutsizey/2-sourceimposy
x2#=mx#+cutsizex/2-sourceimposx
y2#=my#+cutsizey/2-sourceimposy
RenderToImage getpartfromsourceim(index)
Cls 0
RenderToImage copyofsourceim
GetImage getpartfromsourceim(index),x1#,y1#,x2#,y2#
RenderToImage getpartfromsourceim(index)
ImageMaskColour getpartfromsourceim(index), pink
DrawImage shapeim(index),0,0,1

RenderToImage endim(index)
DrawImage getpartfromsourceim(index),0,0,1
ImageMaskColour getpartfromsourceim(index), black

RenderToImage restim(index)
Cls 0
DrawImage shapeim(index),0,0,1
ImageMaskColour restim(index), pink
RenderToImage copyofsourceim
DrawImage restim(index),x1#,y1#,1

RenderToImage show(counter).im
Cls 0
DrawImage endim(index),0,0,1
show(counter).x#=mx#-cutsizex/2
show(counter).y#=my#-cutsizey/2
Inc counter
If counter > maxshow Then counter =0

EndIf

RenderToScreen

DrawImage copyofsourceim,sourceimposx,sourceimposy,1

For count2= 0 To maxshow
DrawImage show(count2).im,show(count2).x#,show(count2).y#,1
show(count2).y# =show(count2).y#+1
If show(count2).y#>=screenh-cutsizey Then show(count2).y#=screenh-cutsizey
Next

Print "Leftclick in image"
Print "F1 or Middle MB refresh sourceimage"
If FunctionKeys(1) Or MidMouseButton()
CopyImage sourceim,copyofsourceim
For count4= 0 To maxshapes
RenderToImage endim(count4)
Cls 0
Next
For count5= 0 To maxshow
RenderToImage show(count5).im
Cls 0
Next

EndIf

Sync
If EscKey() Then End
Loop


drawsourceimage:

sourceim=NewFXImage(sourceimsizex,sourceimsizey)
copyofsourceim=NewFXImage(sourceimsizex,sourceimsizey)
RenderToImage sourceim
For x= 0 To 3000
CircleC Rnd(sourceimsizex),Rnd(sourceimsizey),20,1,RndRGB()
Next
CopyImage sourceim,copyofsourceim

Return

imagegenerating:

For ind=0 To maxshapes

shapeim(ind)=NewFXImage(cutsizex,cutsizey);cutting image
copyofshapeim(ind)=NewFXImage(cutsizex,cutsizey);cutting image
getpartfromsourceim(ind)=NewFXImage(cutsizex,cutsizey)
endim(ind)=NewFXImage(cutsizex,cutsizey)
restim(ind)=NewFXImage(cutsizex,cutsizey)
RenderToImage shapeim(ind)
Cls pink
col1=Point(0,0)
Select ind
Case 0
DrawImage textim2,0,0,0
EndSelect

CopyImage shapeim(ind),copyofshapeim(ind)

next

Return

drawstuff:

textim=NewImage(cutsizex,cutsizey)
textim2=NewImage(cutsizex,cutsizey)
RenderToImage textim

SetFont 2
Ink RGB(0,0,255)
CenterText cutsizex/2,0,"HAPPY BIRTHDAY"
CenterText cutsizex/2,40,"KEVIN"
For x=0 To cutsizex
For y =0 To cutsizey
RenderToImage textim
colt = Point (x,y)
RenderToImage textim2
If colt>20
DotC x,y,black
Else
DotC x,y,pink
EndIf

Next
Next

SetFont 1
Ink rgb(10,10,10)
PrepareFXImage textim2
Return





kevin


stevmjon

must be close to your b'day. what day is it?
It's easy to start a program, but harder to finish it...

I think that means i am getting old and get side tracked too easy.

kevin

almost perfect Steve..   almost, maybe next year