2D graphic commands by IanM30th Aug 2003 10:07
|
---|
Summary The 'missing' 2D commands Description Includes various 2D commands not present in DBPro. Code ` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com ` 2dgraphic.dba ` Missing 2D commands remstart AVAILABLE FUNCTIONS********************************************************************* MoveTo() Moves the line origin point LineTo() Draws a line from the origin to the named position. That position then becomes the next origin. FilledCircle() Draws a filled circle BoxOutline() Draws an unfilled box SaveBitmap() Saves the bitmap in windows bitmap format **************************************************************************************** remend type _2D_LineTo_t X as integer Y as integer endtype global _2D_LastPoint as _2D_LineTo_t function MoveTo(X as integer, Y as integer) _2D_LastPoint.X = X _2D_LastPoint.Y = Y endfunction function LineTo(X as integer, Y as integer) line _2D_LastPoint.X, _2D_LastPoint.Y, X, Y MoveTo(X,Y) endfunction ` This one works out the largest square that can fit inside the circle and draws it. ` It then fills out the top, sides and bottom in the normal way. function FilledCircle( CX as integer, CY as integer, R as integer ) local x as integer local y as integer local i as integer local s as integer ` Precalculate the square of the radius - this is the hypotenuse i=R*R ` Calculate the size of the central square s=R*0.70710678 : ` this number is sin(45) ` Draw it box CX-s, CY-s, CX+s+1, CY+s+1 s=s+1 ` Loop through the bit we have not yet drawn for y=s to R x=sqrt( i-(y*y) ) ` Draw top and bottom box CX-x, CY-y, CX+x+1, CY-y+1 box CX-x, CY+y, CX+x+1, CY+y+1 ` Draw left and right box CX-y, CY-x, CX-y+1, CY+x+1 box CX+y, CY-x, CX+y+1, CY+x+1 next y endfunction function BoxOutline(x1 as integer, y1 as integer, x2 as integer, y2 as integer) box x1,y1,x2+1,y1+1 box x2,y1,x2+1,y2+1 box x1,y2,x2+1,y2+1 box x1,y1,x1+1,y2+1 endfunction function SaveBitmap(File as string, Bmp as integer) local x as integer local y as integer local Colour as dword local OldBmp as integer local Width as integer local Height as integer local PadSize as integer OldBmp=current bitmap() set current bitmap Bmp Width=bitmap width() Height=bitmap height() PadSize=4-((Width*3) mod 4) if PadSize=4 then PadSize=0 if file exist(File) then delete file File open to write 1, File write byte 1, asc("B") write byte 1, asc("M") write long 1, 26+( ((Width*3)+PadSize) * Height ) write word 1, 0 write word 1, 0 write long 1, 26 write long 1, 12 write word 1, Width write word 1, Height write word 1, 1 write word 1, 24 Width=Width-1 Height=Height-1 lock pixels for y=Height to 0 step -1 for x=0 to Width Colour=point(x,y) write byte 1, Colour write byte 1, Colour >> 8 write byte 1, Colour >> 16 next x if PadSize > 0 for x=1 to PadSize write byte 1,0 next x endif next y unlock pixels close file 1 set current bitmap OldBmp endfunction |