TGC Codebase Backup



2D graphic commands by IanM

30th Aug 2003 10:07
Summary

The 'missing' 2D commands



Description

Includes various 2D commands not present in DBPro.

MoveTo(), LineTo() for qbasic type line drawing. Useful for drawing polygons.
FilledCircle() to draw a filled circle - as fast as I could make it.
BoxOutline() to draw a 4 line box
SaveBitmap() to save a bitmap to a file



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