TheGameCreators - CodeBase

Return to the CodeBase listing

Category: 2D Effects

Version: 1.0

Information

Uploaded: 30th Aug 2003 05:05

Modified: 1st Jan 1970 01:00

Author: OSX Using Happy Dude

Summary

Handling of sprite fonts

Full Description

Allows the creation, and display sprites when used as fonts.

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: GrabFont

Rem Created: 21/10/2002 22:30:20

Rem ***** Main Source File *****

Rem Version 1.0.0.2 - Bug found by DarthPuff prevent the normal screen to be displayed

Rem                   if a line had fewer characters than the given size

Rem Version 1.0.0.3 - Allow buttons to be created

#constant   ERROR_OK            0

#constant   ERROR_FILENOTFOUND  1

#constant   ERROR_FEWCHARS      2

#constant   ERROR_COLOURSIZE    3

#constant   ERROR_NOCHARS       4

rem Invalid Width OR height

#constant   ERROR_INVALIDWIDTH  5

#constant   ERROR_IMAGEEXIST    6

#constant   ERROR_IMAGEMISSING  7

#constant   CHAR_BANK           256

function ASCIIToImage(one$ as string,bank as DWORD)

local value as DWORD

value=(bank*CHAR_BANK)+asc(mid$(one$,1))

endfunction value

function putCharIntoBitmap(img as DWORD,_

bm as DWORD,_

width as DWORD,_

string$ as string,_

bank as DWORD,_

tran as DWORD)

if image exist(img)=1 then exitfunction ERROR_IMAGEEXIST

if string$<>""

create bitmap bm, len(string$)*width, width

set current bitmap bm

cls 0

writeFontChars(string$,0,0,width,bank,tran)

get image img,0,0,len(string$)*width,width,1

set current bitmap 0

delete bitmap bm

else

exitfunction ERROR_NOCHARS

endif

endfunction ERROR_OK

function writeFontCharsCentre(str as string,_

y as DWORD,_

width as DWORD,_

bank as DWORD,_

tran as DWORD,_

areaWidth as DWORD)

local x as DWORD

local a as DWORD

local one as DWORD

local img as DWORD

if str<>""

if areaWidth=0

areaWidth=screen width()

endif

if width*len(str)>areaWidth then exitfunction ERROR_INVALIDWIDTH

x=(areaWidth-(len(str)*width))>>1

for one=1 to len(str)

a=asc(mid$(str,one))

img=a+(bank*CHAR_BANK)

if a<>32 and image exist(img)=1

paste image img,x+((one-1)*width),y,tran

endif

next one

endif

endfunction ERROR_OK

function writeFontCharsRightAligned(str as string,y as DWORD,width as DWORD,_

bank as DWORD,tran as DWORD,areaWidth as DWORD)

local one as DWORD

local a as DWORD

local img as DWORD

local pos as DWORD

if str<>""

pos=areaWidth-(len(str)*width)

a=writeFontChars(str,pos,y,width,bank,tran)

else

a=ERROR_NOCHARS

endif

endfunction a

function writeFontChars(str as string,_

x as DWORD,_

y as DWORD,_

width as DWORD,_

bank as DWORD,_

tran as DWORD)

local one as DWORD

local a as DWORD

local img as DWORD

if str<>""

for one=1 to len(str)

a=asc(mid$(str,one))

img=a+(bank*CHAR_BANK)

if a<>32 and image exist(img)=1

paste image img,x+((one-1)*width),y,tran

endif

next one

else

exitfunction ERROR_NOCHARS

endif

endfunction ERROR_OK

remstart

Hex is 4 lots of 32bit RGB colours in hex

"FFFFFFFF.."

The first 4 are the top left colours

The next 4 are the bottom right colours

The next 4 are the middle colours

The last 4 group of 4 is the background colour

AltImage allows an image to be pasted in the main button area

remend

function createButton(imb as DWORD,_

bmp as DWORD,_

str as string,_

width as DWORD,_

height as DWORD,_

bank as DWORD,_

hex as string,_

lWidth as DWORD,_

lHeight as DWORD,_

altImage as DWORD)

local backCol as DWORD

local boxCol as DWORD

local bWidth as DWORD

if str="" then exitfunction ERROR_NOCHARS

if len(hex)<>8*4 then exitfunction ERROR_COLOURSIZE

if image exist(imb)=1 then exitfunction ERROR_IMAGEEXIST

if altImage<>0

if image exist(altImage)=0 then exitfunction ERROR_IMAGEMISSING

endif

bWidth=len(str)*width

if lWidth=0 and lHeight=0

lWidth=bWidth+4

lHeight=width+4

else

if lWidth<bWidth or lHeight<height

exit prompt STR$(lwidth)+" "+str$(bWidth)+" "+str$(lHeight)+" "+str$(height),"8"

exitfunction ERROR_INVALIDWIDTH

endif

boxCol=hexToInt(mid$(hex,17,8))

backCol=hexToInt(mid$(hex,25,8))

create bitmap bmp,lWidth+1,lHeight+1

set current bitmap bmp

box 0,0,lWidth,lHeight,backCol,backCol,backCol,backCol

if altImage<>0

paste image altImage,0,0

endif

ink hexToInt(mid$(hex,1,8)),backCol

line 0,0,lWidth,0

line 0,0,0,lHeight

ink hexToInt(mid$(hex,9,8)),backcol

line 0,lHeight,lWidth,lHeight

line lWidth,0,lWidth,lHeight+1:Rem because the line command always finishes 1 pixel short, we need to add one here

rem Now paste the text on

writeFontCharsCentre(str,(lHeight-height)>>1,width,bank,1,lWidth)

get image imb,0,0,lWidth+1,lHeight+1,1:Rem always finishes 1 pixel short

set current bitmap 0

delete bitmap bmp

endfunction ERROR_OK

function createFont(width as DWORD,_

height as DWORD,_

charXWidth as DWORD,_

charYWidth as DWORD,_

charXOffset as DWORD,_

charYOffset as DWORD,_

charXStep as DWORD,_

charYStep as DWORD,_

filename as string,_

chars as string,_

bank as DWORD,_

tempBitmap as DWORD)

local xLoop as DWORD

local yLoop as DWORD

local pos as DWORD

local one as DWORD

if file exist(filename)=0 then exitfunction ERROR_FILENOTFOUND

if bitmap exist(tempBitmap) then delete bitmap tempBitmap

load bitmap filename,tempBitmap

set current bitmap tempBitmap

pos=1

for y=0 to height-1

for x=0 to width-1

if pos>len(chars)

set current bitmap 0

delete bitmap tempBitmap

exitfunction ERROR_FEWCHARS

endif

one=asc(mid$(chars,pos))+(bank*CHAR_BANK)

if image exist(one)=0

get image one,_

(x*charXStep)+charXOffset,_

(y*charYStep)+charYOffset,_

(x*charXStep)+charXOffset+(charXWidth),_

(y*charYStep)+charYOffset+(charYWidth),_

endif

inc pos

next x

next y

set current bitmap 0

delete bitmap tempBitmap

endfunction ERROR_OK

Download

Please login to download

Comments

No comments yet.

Author Name:	OSX Using Happy Dude
CodeBase Entries:	12

CodeBase - Bitmap Fonts

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments