March 28, 2024, 06:03:45 PM

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


Experimenting with colors II - Bar Graphs

Started by Egil, August 11, 2016, 12:16:56 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Egil

The second program produced during our workshop today was converted from a routine I made several year ago for MiniBASIC, how to show a Bar Graph.

Have fun!


'-------------------------------------------------------------------------------------
' BarGraph.cba
'-------------------------------------------------------------------------------------
'
AutoDefine "Off"

DECLARE Legend(x:int,Y:int,width:int,height:int,br:int,bg:int,bb:int,fr:int,fg:int,fb:int,msg:string)
DECLARE Bar(x:int,Y:int,width:int,height:int,br:int,bg:int,bb:int,fr:int,fg:int,fb:int)
DECLARE About(wnd:window)
DECLARE AskExit(wnd:window)
DECLARE MyMenu(wnd:window)

def win:window 
def run:int 

Window win,-480,0,480,300,0,0,"    CB Skeleton Window",messages 

move win,140,10
print win,"Right-Click for Menu"

Bar(100,200,8,100,128,128,128,128,222,128)
Legend(300,100,18,8,128,128,128,128,222,128,"-  Oslo")

Bar(110,200,8,150,128,128,128,255,128,128)
Legend(300,115,18,8,128,128,128,255,128,128,"-  Stockholm")

Bar(120,200,8,80,128,128,128,222,222,255)
Legend(300,130,18,8,128,128,128,222,222,255,"-  Helsinki")

Bar(130,200,8,40,128,128,128,128,0,255)
Legend(300,145,18,8,128,128,128,128,0,255,"-  Copenhagen")

Bar(140,200,8,60,128,128,128,128,128,0)
Legend(300,160,18,8,128,128,128,128,128,0,"-  Reykjavik")

Bar(150,200,8,120,128,128,128,128,0,128)
Legend(300,175,18,8,128,128,128,128,0,128,"-  London")

Bar(160,200,8,98,128,128,128,255,0,255)
Legend(300,190,18,8,128,128,128,255,0,255,"-  Paris")

run = 1 

WAITUNTIL run = 0 
CLOSEWINDOW win 
END 


SUB messages(),int
'----------------------------------------------------------------------------------------
' Main Loop
'----------------------------------------------------------------------------------------

SELECT @class

CASE @idcreate 
centerwindow win 

CASE @idclosewindow 
run = 0 

CASE @IDKEYDOWN
if GETKEYSTATE(0x1B) <> 0 then AskExit(win) :' ESC pressed - want to exit?

CASE @IDRBUTTONUP
MyMenu(win)
CASE @IDMENUPICK
SELECT @MENUNUM
case 10
About(win)
case 20
system "http://www.ionicwind.com/forums/"
case 30
AskExit(win)
ENDSELECT

ENDSELECT 
RETURN
'-------------------------  END OF LOOP  ---------------------------------


SUB Bar(x:int,y:int,width:int,height:int,br:int,bg:int,bb:int,fr:int,fg:int,fb:int)
'----------------------------------------------------------------------------------------
' HOW TO USE:
'   x, y   = position
'   width  = bar width in pixels
'   height = bar height in pixels
'   br, bg, bb = bar border color
'   fr, fg, fb = bar fill color
'----------------------------------------------------------------------------------------
Rect win,x,y-height,width,height,RGB(br,bg,bb),RGB(fr,fg,fb)
RETURN


SUB Legend(x:int,y:int,width:int,height:int,br:int,bg:int,bb:int,fr:int,fg:int,fb:int,msg:string)
'----------------------------------------------------------------------------------------
' HOW TO USE:
'   x, y   = position
'   width  = width in pixels
'   height = height in pixels
'   br, bg, bb = border color
'   fr, fg, fb = fill color
'   msg    = legend name
'----------------------------------------------------------------------------------------
Rect win,x,y,width,height,RGB(br,bg,bb),RGB(fr,fg,fb)
move win,x+25,y-5
PRINT win,msg
RETURN

 
SUB MyMenu(wnd:window)
'----------------------------------------------------------------------------------------
' Contextmenu - Popping up at pointer location
'---------------------------------------------------------------------------------------- 
CONTEXTMENU wnd,@MOUSEX,@MOUSEY,"I,About,0,10","I,IonicWind User Forums,0,20","I,Exit,0,30"

RETURN


SUB AskExit(wnd:window)
'----------------------------------------------------------------------------------------
' Ask if you really want to exit
'----------------------------------------------------------------------------------------
def txt0$,txt1$,crlf$:string
crlf$=chr$(10)+chr$(13)
txt0$=""
txt1$="        Do you really want to exit? "
if MESSAGEBOX(wnd,txt1$,txt0$,0x30|0x04) = 0x06 then  run = 0
RETURN


SUB About(wnd:window)
'----------------------------------------------------------------------------------------
' Showing messagebox
'----------------------------------------------------------------------------------------
def txt0$,txt1$,crlf$:string
crlf$=chr$(10)+chr$(13)
txt0$="      Coded with Creative Basic          "
txt1$="      ENJOY!  "
MESSAGEBOX wnd,txt1$,txt0$,0x40
RETURN
Support Amateur Radio  -  Have a ham  for dinner!

GWS

Egil,

Nice one - that's gone into the archive of useful bits ..  ;D

all the best, :)

Graham
Tomorrow may be too late ..