TheGameCreators - CodeBase - Menue/Options functions

Category: Miscellaneous

Version: 0.9

Information

Uploaded: 4th Oct 2006 14:50

Modified: 4th Oct 2006 14:58

Author: Coder#05

Summary

Some Functions for creating a menue quikly. NOTE!: sub SetUp_Font is Scraggles font functions. scraggle`s font functions: http://forum.thegamecreators.com/?m=forum_view&t=85440&b=4

Full Description

Some Functions ive made to make some quick menues. Arent completly done, but all functions woork. Just thougt i would post em<br /> -coder#05

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: Option_Functions

REM SetUp

INI_OPTION_FUNCTIONS:

gosub SetUp_Font           : REM Call Font SetUp

gosub Initialize_Options   : REM Initialize Variables used in the option functions

gosub Initialize_Timers    : REM Timers used by the option functions

RETURN

Initialize_Options:

REM Type(s)

TYPE Txyxy

x1, x2, y1, y2 as integer

ENDTYPE

TYPE ToptionVisual

size           as integer  : REM The size off Sprite(s)

scale          as integer  : REM Percentage that the sprite gets scaled, if mouseover and mouse over effect is == to that

kern           as integer  : REM Kern

ImageNum       as integer  : REM The image used as sprite

spriteS        as integer  : REM Sprite start

spriteE        as integer  : REM Sprite end

SpriteX        as integer  : REM X position

SpriteY        as integer  : REM Y position

ENDTYPE

TYPE Toptions

id             as word     : REM The id to the correct array element

po             as Txyxy    : REM X1 Y1 X2 Y2 // the controls the position

on             as boolean  : REM If on == false, then option is not viseble

clicked        as word     : REM Used to return the clickvalue of an item, clickvalue is only stored in click when item is being clicked

clickVal       as word     : REM The value returned when item is clicked

ValidMB        as byte     : REM (Only used in function OPTION_STcontrolItems(f,t,mb) )Sets wich Mouse Botton is the valid one for clicking on an item (default = 1)

delayOn        as boolean  : REM If delay == 1, check for clicked on items, are skiped(if using the standard, OPTION_STcontrolItems(from,to,mb) Function). (Delay is on by standard, use function OPTION_setItemDelay(flag) to turn off

type1          as word     : REM Type, i.e. if todo=1 then "do...this"/call this function

updateOn       as boolean  : REM If == 1 then can be used to update new item numbers

updateStart    as integer  : REM If todo= update other option items, then this is the start item to be opdated/shown

jumpOverStart  as integer

jumpOverEnd    as integer  : REM If you want to jump over a set off items, lets say you wanted to show item 123 and 6 then you would need to jump over items 4 and 5

updateEnd      as integer  : REM the last item to be Updated after clicking on this option

hs,he          as integer  : REM Hide Items from to

titleOn        as boolean  : REM If == 1 then title$ is shown

title$         as string   : REM If mouse is over item for a time, then title shows up

item$          as string   : REM The text

MouseOverOn    as boolean  : REM If == 1 then mouse can be detected over option, but only if option is shown

MouseOverEff   as integer  : REM Mouse Over effect

MsgBoxOn       as boolean  : REM If == 1 then msgbox pops up with a string

MsgBoxString$  as string   : REM Msg Box String

OptionBoxOn    as boolean  : REM Becomes equal to one if, Make_OptionBox() is called

dragOn         as boolean  : REM If == 1 then item can be draged

draged         as boolean  : REM If == 1 then item is draged, becomes equal to 0 again once it hits the positoin of the mouse

ENDTYPE

global current_startItem as integer :       REM Used for checking if mouse is over current viseble items

global current_endItem   as integer :       REM Used for checking if mouse is over current viseble items

global total_OPTIONItems as integer :       REM Keeps track off the total number of option items

global OPTIONMX as integer                : REM Used to store mousex

global OPTIONMY as integer                : REM Used to store mousey

global OPTIONMB as integer                : REM Used to store mouse botton state

global OPTIONMMX as integer               : REM The mousemove x

global OPTIONMMY as integer               : REM The mousemove y

global ODragSpeed as integer              : REM The speed at wich an item will move towards the mouse when beeing fraged

global ODistToMou as integer              : REM Stores the distance from The Item to the mouse

global option_id_Clicked as integer       : REM Used to return the id of the current item beeing clicked ( parameter mb, in PTION_STcontrolItems(f,t,mb)

REM Arrays:

global DIM OPItem() as Toptions           : REM Main Options array, holds member variables of type Toption

global DIM OSprite() as ToptionVisual     : REM A part of the option functions, this arrays members, controls sprites size, kern value, and must important, the number of sprites in that option item(spriteS,spriteE)

add to queue OPItem() : add to queue OSprite() : REM Add element 0

'_______________________________________________________________________________________________

REM Input Box System

TYPE TopInputBox

on       as boolean  : REM Makes input box able to take input, until an other item is clicked

TStr$    as string   : REM Holding a tempuary string

mstrlen  as byte     : REM Max Input string lenght

S$       as string   : REM The Current string, in input "box"

strval   as integer  : REM Value of string(if string containes numbers)

TermKey  as byte     : REM Keystate for when done inputing string

Bcolor   as integer  : REM The background color

Item     as word     : REM Is binded to this item

ClickVal as word     : REM Is binded to the item containing this ClickVal, if Item <> clickval item is ignored

ENDTYPE

DIM OPinputBox() as TopInputBox : REM Array Count = Number off input boxes

add to queue OPinputBox()             : REM Make Element 0

'_______________________________________________________________________________________________

REM Page System

REM constants

#constant P_up         2

#constant P_down       -2

#constant P_left       -1

#constant P_right      1

REM Types

TYPE Ttpage

old_id

ENDTYPE

global DIM OPage() as Ttpage

RETURN

UNINSTAL_OPTIONS:

UNDIM OPItem()

UNDIM OSprite()

UNDIM OPage()

END

RETURN

Initialize_Timers:

type Tdelay

d as float

f as float

t1 as float

t2 as float

endtype

DIM delay(2) as Tdelay

Gfps as Tdelay

for n= 1 to 2

delay(n).t1 = timer()

delay(n).t2 = delay(n).t1 - timer()

next n

delay(1).f = 1000

delay(2).f = 500

Gfps.t1 = timer()

Gfps.t2 = Gfps.t1 - timer()

RETURN

REMSTART

Funcktion for adding an option item.

Returns integer

Returns the correct index, to use when accessing OPItem() or OSprite(), or when using an other function.

If newitem is set to 1, then all values are re initialized

If newitem == 0, then olditem needs to refear to an already created OPItem() element id, or the function will fail

`NOTE:

If function returns -1 then the function has failed (Happens if len(string$) == 0)

REMEND

FUNCTION Add_OptionItem(x,y,ImageNo,string$,ClickVal,newitem,olditem)

if newitem = 1

`Update Array dimensons

add to queue OPItem()

add to queue OSprite()

new as integer

new = array count(OPItem())

inc total_OPTIONItems, 1

`Function related vars // Start Propertys

OPItem(new).id = new

OPItem(new).on = %1

OPItem(new).type1 = 0

if not ClickVal

OPTION_SetItemClickVal(new,new)

else

OPItem(new).clickVal = ClickVal

endif

OPItem(new).ValidMB = 1

OPItem(new).delayOn = %1

OPItem(new).updateOn = %0

OPItem(new).updateStart = 0

OPItem(new).updateEnd = 0

OPItem(new).jumpOverStart = 0

OPItem(new).jumpOverEnd = 0

OPItem(new).titleOn = %0

OPItem(new).title$ = ""

OPItem(new).MouseOverOn = %1

OPItem(new).MouseOverEff = 0

OPItem(new).MsgBoxOn = %0

OPItem(new).MsgBoxString$ = ""

OPItem(new).OptionBoxOn = %0

OPItem(new).dragOn = %0

`Visual / Sprite related vars

OPItem(new).item$ = string$

OSprite(new).size = 100

OSprite(new).scale = 100

OSprite(new).kern = 1

OSprite(new).ImageNum = ImageNo

OSprite(new).spriteS = 0

OSprite(new).spriteE = 0

kern = OSprite(new).kern

else

new as integer

new = olditem

endif

REM Find free sprite

SpriteNo = freeSprite_From_TO(1,len(OPItem(new).item$))

OSprite(new).spriteS = SpriteNo

OSprite(new).spriteE = SpriteNo

if OSprite(new).spriteS = 0 then EXITFUNCTION -1 : REM An error has occured

for k = 1 to len(OPItem(new).item$)

REM Find image

Chr = asc(mid$(OPItem(new).item$,k))

if k > 1

sprite SpriteNo + (k-1),NewX - BMleft(Chr) ,Y ,ImageNo + Chr : REM Make sprite , NewX is the width of the sprite/image + the kern value., ImageNo = font image number, pluss the ASCII Char value so the correct image gets loaded to the sprite

inc OSprite(new).spriteE, 1                                  : REM Increase the end sprite by 1.

NewX = (NewX) + BMwidth(Chr) + Kern                          : REM increase value of newX

else

REM Create the first sprite in the string

sprite SpriteNo ,X - BMleft(Chr) ,Y ,ImageNo + Chr

NewX = X + BMwidth(Chr) + Kern

endif

next k

`X1,Y1,X2 and Y2 vars

`So we can find the postion off the entire option item

OPItem(new).po.x1 = x

OPItem(new).po.y1 = y

OPItem(new).po.x2 = NewX

OPItem(new).po.y2 = y + sprite height(OSprite(new).spriteS)

ENDFUNCTION new

REM Function returns the id, to the OPTION Item

FUNCTION Add_INPUTBOX(x,y,ImageNo,Bcolor,StartS$,mstrlen,ClickVal,TermValue)

temp1 = Add_OptionItem(x,y,ImageNo,StartS$,ClickVal,1,0)

box OPItem(temp1).po.x1,OPItem(temp1).po.y1,OPItem(temp1).po.x2,OPItem(temp1).po.y2,Bcolor,Bcolor,Bcolor,Bcolor

add to queue OPinputBox() : new = array count(OPinputBox())

OPinputBox(new).mstrlen  = mstrlen

OPinputBox(new).S$       = StartS$

OPinputBox(new).strval   = val(StartS$)

OPinputBox(new).TermKey  = TermValue

OPinputBox(new).Bcolor   = Bcolor

OPinputBox(new).Item     = temp1

OPinputBox(new).ClickVal = OPItem(temp1).ClickVal

ENDFUNCTION temp1

FUNCTION Control_InputBoxes()

if array count(OPinputBox()) > 0

for n = 1 to array count(OPinputBox())

i = OPinputBox(n).Item

if OPItem(i).clicked > 0 or OPinputBox(n).on = %1

if OPItem(i).clicked = OPinputBox(n).ClickVal or OPinputBox(n).on = %1

REM Store string

if OPinputBox(n).on = %0

clear entry buffer

REM If string is stored, dont overwrite

if len(OPinputBox(n).S$) <= 0

OPinputBox(n).Tstr$ = ""

for f = 1 to OPinputBox(n).mstrlen

OPinputBox(n).Tstr$ = OPinputBox(n).Tstr$ + "_"

next f

else

OPinputBox(n).Tstr$ = OPinputBox(n).S$

endif

OPinputBox(n).on = %1

endif

REM Store Key Board input(excludeing some of the "illigall" keys), Some errors still occures here, BUT DAM I USED A LOOT OF TIME, JUST TO FIGURE OUT THAT THE ERROR OCCURED JUST BECAUSE ENTER WAS SET TO THE TERMINATE KEY!!!, Aha!(for a moment i felt pretty stupid)

if len(entry$(1)) > 0 and keystate(OPinputBox(n).TermKey) = 0

for k = 2 to 57

if keystate(k) = 1 and k <> 15 and k <> 56 and k <> 29 and k <> 54 and k <> 28 and k <> 43 and keystate(56) = 0 and keystate(29) = 0

OPinputBox(n).Tstr$ = entry$(1)

endif

next k

endif

REM Save string but, Make sure we dont go over the max char lenght

if len(OPinputBox(n).Tstr$) <= OPinputBox(n).mstrlen

OPTION_NewItemString(OPinputBox(n).Item,OPinputBox(n).Tstr$)

OPinputBox(n).S$ = OPItem(i).item$

endif

REM Save new string, and turn input box of

if keystate(OPinputBox(n).TermKey) > 0

OPinputBox(n).S$ = OPItem(i).item$

OPinputBox(n).on = %0

if len(OPinputBox(n).Tstr$) <= OPinputBox(n).mstrlen and len(OPinputBox(n).Tstr$) > 0

OPTION_NewItemString(i,OPItem(i).item$)

OPinputBox(n).S$ = OPItem(i).item$

endif

next n

endif

ENDFUNCTION

REM TO GET THE CORRECT STRING FROM AN INPUT OPTION ITEM, PASS THE ID OF THE ITEM DECLARED AS AN InputBox

REM Function returns string. ( if string exist , else an empty string is returned )

FUNCTION OPTION_GetInputBox$(id)

REM Initialize local variables

local O_reString$ as string

REM Find correct output

for n = 1 to array count(OPinputBox())

if OPinputBox(n).item = id

O_reString$ = OPinputBox(n).s$

EXITFUNCTION O_reString$

endif

next n

ENDFUNCTION O_reString$

REM Change OPTION Items Properties functions

FUNCTION OPTION_SetITEMProperties(id as integer,on as boolean,delayOn as boolean,updateOn as boolean,titleOn as boolean,MOverOn as boolean,OptionBoxOn as boolean)

OPItem(id).on = on

OPItem(new).delayOn = delayon

OPItem(id).updateOn = updateOn

OPItem(id).titleOn = titleOn

OPItem(id).OptionBoxOn = OptionBoxOn

OPItem(id).MouseOverOn = MOverOn

ENDFUNCTION

FUNCTION OPTION_SetItemClickVal(id,clickval)

OPItem(id).ClickVal = clickval

ENDFUNCTION

FUNCTION OPTION_UdateClickValues(O_newVal)

for n = 1 to total_OPTIONItems

OPItem(n).ClickVal = OPItem(n).ClickVal + O_newVal

next n

ENDFUNCTION

FUNCTION OPTION_SetItemMouseB(id,O_newVal)

OPItem(id).ValidMB = O_newVal

ENDFUNCTION

FUNCTION OPTION_ItemOnOff(id,flag as boolean)

OPItem(id).on = flag

ENDFUNCTION

FUNCTION OPTION_SetUpdateOn(id,flag as boolean)

OPItem(id).updateOn = flag

ENDFUNCTION

FUNCTION set_UpDateNewOption(id,S,E,JS,JE,HS,HE) : REM JS/JE are optional(just set to 0) (used to jump over items)

OPItem(id).updateStart = S      : REM Update from this item

OPItem(id).updateEnd = E        : REM Last Item to Update

OPItem(id).jumpOverStart = JS   : REM Jump over from here

OPItem(id).jumpOverEnd = JE     : REM Last item to jump over (Can only jump over one set of items)

OPItem(id).hs = HS              : REM If You want to set item to hide other items, when clicked this sould be over 0

OPITEM(id).he = HE              : REM The last item to hide. If ==  0 no items are hiden

ENDFUNCTION

FUNCTION OPTION_SetItemType(id,typpe)

if typpe = 1

OPItem(id).type1 = typpe

OPTION_SetUpdateOn(id,1)

endif

ENDFUNCTION

REM BELOW FUNCTIONS Takes Care Of Items That Are set to Update new Items when they are clicked

FUNCTION OPTION_UpdateItems(id)

REM Check for exit/error conditions

if OPTION_ITEMExist(id) = 1

if OPItem(id).updateOn = %0 then EXITFUNCTION

else

EXITFUNCTION

endif

REM Handle Updateing of new items

for n = 1 to total_OPTIONItems

if OPItem(id).updateStart = n and OPTION_ITEMExist(n) = 1

for n2 = OPItem(id).UpdateStart to OPItem(id).UpdateEnd

if n2 < OPItem(id).jumpOverStart and n2 > OPItem(id).jumpOverEnd or OPItem(id).jumpOverEnd = 0 and OPTION_ITEMExist(n) = 1

OPTION_SHOWOption(n2)

endif

next n2

endif

if OPItem(id).hs = n

for n2 = OPItem(id).hs to OPItem(id).he

OPTION_HIDEOption(n2)

next n2

endif

next n

ENDFUNCTION

REM Below Functions return a value

REM Below functions us used to check for mouse over option item, and mouse clicking on an item

REM flag = 1 means that items not on also are checked for, if 0 then they are excluded

REM Return integer (1=true,0=false)

FUNCTION OPTION_CheckMouseOver(id,x,y,flag)

local reval as integer

if flag = 1 or OPItem(id).on = %1

if OPItem(id).MouseOverOn = %1

if x > OPItem(id).po.x1 and x < OPItem(id).po.x2 and y > OPItem(id).po.y1 and y < OPItem(id).po.y2

reval = 1

else

reval = 0

endif

else

reval = 0

endif

ENDFUNCTION reval

REM Return integer, 1 if mb = mouse botton(to cheat the OPItem(id).ValidMB) AND MouseOverOption=1, 0=false

FUNCTION OPTION_check_clicked(id,mb,x,y)

local reval as integer

if OPTION_CheckMouseOver(id,x,y,0) > 0 and OPTIONMB = mb

reval=1

else

reval=0

endif

ENDFUNCTION reval

REM return integer, returns the id to the Option item mouse is currently over

REM x sould be mousex, y sould be mousey, flag = 1 means that items not on also are checked for, if 0 then they are excluded

FUNCTION OPTION_getMouseOver(x,y,flag)

local reval as integer

for n=0 to array count(OPItem())

if OPItem(n).MouseOverOn = %1

if OPItem(n).on = %1 or flag = 1

if OPTION_CheckMouseOver(n,x,y,flag) > 0

reval = n

exitfunction reval

endif

next n

ENDFUNCTION reval

REM FUNCTION RETURNS THE CLICK VAL OF AN ITEM

FUNCTION OPTION_GetClickVal(id_Clicked)

reval as integer

reval = OPItem(id_Clicked).ClickVal

ENDFUNCTION reval

REM Check if item exist

REM Function returns 1 if ITEM DOES EXIST

FUNCTION OPTION_ITEMExist(id)

if id <= total_OPTIONItems

reval = 1

else

reval = 0

endif

ENDFUNCTION reval

REM Visual Functions

REM BELOW FUNCTIONS SOULD BE USED TO HIDE,SHOW,DELETE,SCALE DIV OPTION ITEMS

REM Function delete all sprites used in an option item

FUNCTION OPTION_HIDEOption(id)

REM Delete sprites

for n = OSprite(id).spriteS to OSprite(id).spriteE

hide sprite n

next n

REM Check if option is on before

if OPItem(id).on = %1

OPItem(id).on = %0

endif

ENDFUNCTION

REM Function Shows Option item

FUNCTION OPTION_SHOWOption(id)

REM Show Sprites

for n = OSprite(id).spriteS to OSprite(id).spriteE

show sprite n

next n

REM Check if option is already shown

if OPItem(id).on = %0

OPItem(id).on = %1

endif

ENDFUNCTION

REM Funcion scales the sprite in an OPtion item

FUNCTION OPTION_ScaleOPTION(id,scale)

if id > total_OPTIONItems then EXITFUNCTION

OSprite(id).scale = scale

for i = OSprite(id).spriteS to OSprite(id).spriteE

scale sprite i,scale

next i

ENDFUNCTION

REM Function deletes an item

FUNCTION OPTION_DeleteItem(id)

if id = array count(OPItem())

for n = OSprite(id).spriteS to OSprite(id).spriteE

delete sprite n

next n

array delete element OPItem(),id

array delete element OSprite(),id

dec total_OPTIONItems, 1

else

temp1 = OSprite(id).spriteE - OSprite(id).spriteS + 1 : REM Left shift all numbers(related to sprites, and array index(DBproo takes care of the last one))

shift = temp1

for n = OSprite(id).spriteS to OSprite(id).spriteE

delete sprite n

next n

OPTION_OrderSpriteNumbersTo(id,shift*(-1))

array delete element OPItem(),id

array delete element OSprite(),id

dec total_OPTIONItems

endif

ENDFUNCTION

REM Function for draging an OPTION Item, just like if you where draging an Window.

FUNCTION OPTION_SetItemDrag(id,drag as boolean)

OPItem(id).dragOn = drag

ENDFUNCTION

FUNCTION OPTION_dragItem(id,x,y,movex,movey)

if OPItem(id).dragOn = %1

if OPTION_CheckMouseOver(id,x,y,0) > 0

OPItem(id).po.x1 = OPItem(id).po.x1 + movex : OPItem(id).po.x2 = OPItem(id).po.x2 + movex

OPItem(id).po.y1 = OPItem(id).po.y1 + movey : OPItem(id).po.y2 = OPItem(id).po.y2 + movey

OPTION_redrawItem(id)

OPItem(id).draged = %1

endif

ENDFUNCTION

REM Updates draged items, so they arent "lost" this happens if user moves mouse to fast

REM PARAMETER f,t : f=item id from, t=item id to

REM PARAMETER x,y : the postion that draged items must reach before draged becomes equal to 0(sould be the mouse postion)

REM PARAMETER movex/movey the speed at witch items sould move towards, x,y(REM Could be faster if mouse was far away, and slower the closer?(Just an idea)

FUNCTION OPTION_UpdateDragedItems(f,t,x,y,mb,movex,movey)

for id= f to t

if OPTIONMB = mb

if OPItem(id).dragOn = %1

if OPItem(id).draged = %1

if OPTION_CheckMouseOver(id,x,y,0) = 0

if x > OPItem(id).po.x2

inc OPItem(id).po.x2, movex

inc OPItem(id).po.x1, movex

endif

if x < OPItem(id).po.x1

dec OPItem(id).po.x1, movex

dec OPItem(id).po.x2, movex

endif

if y > OPItem(id).po.y2

inc OPItem(id).po.y2, movey

inc OPItem(id).po.y1, movey

endif

if y < OPItem(id).po.y1

dec OPItem(id).po.y1, movey

dec OPItem(id).po.y2, movey

endif

OPTION_redrawItem(id)

endif

else

OPItem(id).draged = %0

endif

next id

ENDFUNCTION

REM BELOW FUNCTION ALOWS FOR CHANGEING OFF AN ALREADY SAVED OPTION ITEM STRING

REM Control / CHANGE Option Items strings

FUNCTION OPTION_NewItemString(id,s$)

if len(OPItem(id).Item$) > len(s$)

REM Left shift

shift = len(OPItem(id).Item$) - len(s$)

temp1 = OSprite(id).spriteS

temp2 = OSprite(id).spriteE

for n = 0 to shift

delete sprite temp2 - n

next n

OPItem(id).Item$ = s$

OSprite(id).spriteE = OSprite(id).spriteE - shift

OPTION_redrawItem(id)

OPTION_OrderSpriteNumbersTo(id,shift*(-1))

else

if array count(OSprite()) = id

REM make new

OPItem(id).Item$ = s$ : REM The new string item

OSprite(id).spriteE = OSprite(id).spriteS + (len(s$)-1) : REM The new end sprite number

OPTION_redrawItem(id) : REM Sprites are redrawn

exitfunction : REM No Need to conrinue

else

if len(OPItem(id).Item$) = len(s$)

OPItem(id).Item$ = s$

OPTION_redrawItem(id)

else

if len(OPItem(id).Item$) < len(s$)

REM Right shift

shift = len(s$) - len(OPItem(id).Item$)

OPItem(id).Item$ = s$

OSprite(id).spriteE = OSprite(id).spriteE + shift

OPTION_OrderSpriteNumbersTo(id,shift)

OPTION_redrawItem(id)

endif

ENDFUNCTION

FUNCTION OPTION_OrderSpriteNumbersTo(id,shift)

if array count(OSprite()) > id

REM Find out if start from low or start from the end of the array

if shift = 0 then EXITFUNCTION : REM Can see much use in redrawing the sprites, if they arent shifted

if shift < 0

temp1 = OSprite(n1).spriteE

temp2 = OSprite(n1).spriteS

f = id+1

t = array count(OSprite())

s = 1

else

temp1 = OSprite(n1).spriteS

temp2 = OSprite(n1).spriteE

f = array count(OSprite())

t = id+1

s = -1

endif

for n1 = f to t step s

REM Prepare next

if shift < 0

temp1 = OSprite(n1).spriteE

temp2 = OSprite(n1).spriteS

else

temp1 = OSprite(n1).spriteS

temp2 = OSprite(n1).spriteE

endif

OSprite(n1).spriteS = OSprite(n1).spriteS + shift

OSprite(n1).spriteE = OSprite(n1).spriteE + shift

REM Delete Old Sprites

for n = temp2 to temp1 step s

delete sprite n

next n

REM Make new sprites

OPTION_redrawItem(n1)

REM If OPTION Item Was turned off, hide it

if OPItem(n1).on = %0 then OPTION_HIDEOption(n1)

next n1

endif

ENDFUNCTION

FUNCTION OPTION_redrawItem(id)

for n = OSprite(id).spriteS to OSprite(id).spriteE

if n > 0

if sprite exist(n) = 1

delete sprite n

endif

inc i, 1

char = asc(mid$(OPItem(id).Item$,i))

if n > 0

if n = OSprite(id).spriteS

sprite n,OPItem(id).po.x1 - BMleft(char),OPItem(id).po.y1,OSprite(id).ImageNum + char

scale sprite n,OSprite(id).scale

REM New X2 needs to be stored

OPItem(id).po.x2 = OPItem(id).po.x1 + BMwidth(Char) + OSprite(id).Kern

else

sprite n,OPItem(id).po.x2 - BMleft(char),OPItem(id).po.y1,OSprite(id).ImageNum + char

REM New X2 needs to be stored

OPItem(id).po.x2 = OPItem(id).po.x2 + BMwidth(Char) + OSprite(id).Kern

scale sprite n,OSprite(id).scale

endif

next n

ENDFUNCTION

REM EXTRA FUNCTIONS

REM Simple function for makeing a square around the option item ( Changeing the ink will effect the color off the square

REM When cls is called, the sqaure is deleted/cleared

FUNCTION OPTION_MakeOptionSquare(id as integer)

line OPItem(id).po.x1,OPItem(id).po.y1,OPItem(id).po.x2,OPItem(id).po.y1

line OPItem(id).po.x1,OPItem(id).po.y1,OPItem(id).po.x1,OPItem(id).po.y2

line OPItem(id).po.x2,OPItem(id).po.y1,OPItem(id).po.x2,OPItem(id).po.y2

line OPItem(id).po.x1,OPItem(id).po.y2,OPItem(id).po.x2,OPItem(id).po.y2

REM Update Variables

OPItem(id).OptionBoxOn = %1

ENDFUNCTION

REM Standard Control OPTION ITEMS; FUNCTIONS;

FUNCTION OPTION_ControlItemAcctions(id)

if OPTION_ItemExist(id) = 1

if OPItem(id).on = %1

if option_id_clicked = id

REM Control types

if OPItem(id).Type1 = 1

REM Store Temp values

DIM temp(5) as integer

temp(0) = OPItem(id).updateStart

temp(1) = OPItem(id).updateEnd

temp(2) = OPItem(id).hs

temp(3) = OPItem(id).he

temp(4) = OPItem(id).jumpOverStart

temp(5) = OPItem(id).jumpOverEnd

REM Find out wich items to show/hide

if OPTION_ItemExist(temp(0)) = 1

if OPItem(temp(0)).on = %0

set_UpdateNewOption(id,temp(0),temp(1),temp(4),temp(5),temp(2),temp(3))

else

set_UpdateNewOption(id,temp(2),temp(3),temp(4),temp(5),temp(0),temp(1))

endif

REM Finaly Update to the new items

OPTION_UpdateItems(id)

REM Clean Up

UNDIM temp()

endif

ENDFUNCTION

FUNCTION OPTION_STcontrolItems(f,t,mb)

REM Check item clicked

for id = f to t

if OPTION_check_clicked(id,mb,OPTIONMX,OPTIONMY) = 1 and get_timer(2) > 1 and mb = OPItem(id).ValidMB

Restart_Timer(2)

option_id_Clicked = id

OPItem(id).clicked = OPItem(id).clickVal   : REM Item is clicked store the click value

exit

else

option_id_Clicked = 0

OPItem(id).clicked = 0

endif

next id

REM Update drag item function, and other extra functions

for id = f to t

if OPItem(id).dragOn = %1

REM Find out if any item is currently beeing draged

local dragnew as boolean

for n = f to t

if OPItem(n).draged = %1 and id <> n

dragnew = %0

exit

else

dragnew = %1

endif

next n

if OPTION_CheckMouseOver(id,OPTIONMX,OPTIONMY,0) and OPTIONMB = mb and dragnew = %1

OPTION_dragItem(id,OPTIONMX,OPTIONMY,OPTIONMMX,OPTIONMMY)

endif

REM Make sure drag item is draged even if mouse is outside off item

ODistToMou = sqrt( abs( (OPItem(id).po.x2 - OPItem(id).po.x2 / 2)- OPTIONMX )^2 + abs( (OPItem(id).po.y2 - OPITEM(id).po.y2 / 2) - OPTIONMY ) ^2 )

if ODistToMou > 50

ODragSpeed = ODragSpeed + 2

else

ODragSpeed = ODragSpeed - 1

endif

if ODragSpeed > 10

ODragSpeed = 10

else

if ODragSpeed < 1

ODragSpeed = 1

endif

OPTION_UpdateDragedItems(id,id,OPTIONMX,OPTIONMY,mb,ODragSpeed,ODragSpeed)

endif

if OPItem(id).OptionBoxOn = %1 and OPTION_CheckMouseOver(id,OPTIONMX,OPTIONMY,0) = 1

OPTION_MakeOptionSquare(id)

endif

next id

ENDFUNCTION

REM Timer Functions(Get time in secs, and get real fps)

FUNCTION Restart_Timer(id)

delay(id).t1 = timer()

delay(id).t2 = delay(id).t1 - timer()

ENDFUNCTION

FUNCTION Update_Timer(id)

delay(id).t2 = (timer() - delay(id).t1) / delay(id).f

ENDFUNCTION

FUNCTION Get_Timer(id)

out = delay(id).t2

ENDFUNCTION out

FUNCTION Update_Getfps()

Gfps.t1 = timer()

ENDFUNCTION

FUNCTION Get_Realfps()

` Calculate Frames Per Second, and update last checked time

Gfps# = 1000.0 / (Gfps.t1 - Gfps.t2 * 1.0)

Gfps.t2 = Gfps.t1

ENDFUNCTION Gfps#

SetUp_font:

REM YOU NEED TO ADD SCRAGGLES FONT FUNCTIONS

REM scraggle`s font functions: http://forum.thegamecreators.com/?m=forum_view&t=85440&b=4

Dim BMleft(127)

Dim BMwidth(127)

REM Blue font

img=freeIMG(100)

LoadBMfont("Video Phreak.png",img)

global blueFONT as integer

blueFONT=IMG

TrimBMFont(blueFONT)

REM green font

img=freeIMG(300)

LoadBMfont("LCD Green.png",img)

global greenFONT as integer

greenFONT=img

TrimBMFont(greenFONT)

RETURN

REM This Include handles all off the find_free Functions

FUNCTION freeimg(n)

repeat

if image exist(n)=1

inc n, 1

else

found=1

endif

until found=1

ENDFUNCTION n

FUNCTION freeSprite(n)

repeat

if sprite exist(n)=1

inc n, 1

else

found=1

endif

until found=1

ENDFUNCTION n

FUNCTION freeSprite_From_TO(f,t)

local test as integer

repeat

inc test, 1

if sprite exist(f)=1

inc f, 1

else

found=1

for n=f to f+t

if sprite exist(n)=1 then found=0

next n

endif

if test = 60000 then error = 1

until found=1 or error=1

ENDFUNCTION f

Download

Please login to download

Comments

No comments yet.

Author Name:	Coder#05
CodeBase Entries:	2

CodeBase - Menue/Options functions

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments