Write : Buttons

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|519\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Socoder -> Mini Challenges -> Write : Buttons
Fri, 09 Oct 2009, 07:55
Jayenkai	Create a neat looking scalable button function that can be reused in lots of place, using only code. ---- The Write Rhyme Print text and draw boxes, draw circles and lines. Use things that within your language you'd find. If you need a package for painting to do it, You haven't quite managed to keep in the spirit. -=-=- ''Load, Next List!''
Wed, 14 Oct 2009, 04:00
Jayenkai	Rather ~~blocky~~ Retro! Graphics 800,600,32,2 SetBuffer BackBuffer() SetFont LoadFont("Arial",34) Repeat Cls x=400:y=40 Color 255,50,50 Button(x,y,"Test"):y=y+80 Color 0,180,0 Button(x,y,"Test 2"):y=y+80 Color 100,100,255 Button(x,y,"Test 3"):y=y+80 Color 180,180,50 Button(x,y,"Test 4","Bigger Test"):y=y+120 Color 255,255,255 Button(x,y,"Test 5","Even Bigger Test","Really big big test"):y=y+80 Flip Until KeyDown(1) Function Button(cx,cy,txt$,txt2$="",txt3$="") out=0 pad=8 r=ColorRed():g=ColorGreen():b=ColorBlue() uw=StringWidth(txt$) If StringWidth(txt2$)>uw Then uw=StringWidth(txt2$) If StringWidth(txt3$)>uw Then uw=StringWidth(txt3$) uw=uw+(pad2) uh=FontHeight()+(pad2) If txt2$<>"" Then uh=(FontHeight()2)+(pad3) If txt3$<>"" Then uh=(FontHeight()3)+(pad4) ux=cx-(uw/2):uy=cy-(uh/2) If MouseX()=>ux And MouseY()=>uy And MouseX()<=ux+uw And MouseY()<=uy+uh Then out=1:If MouseDown(1) Then out=2 Color Sum(r),Sum(g),Sum(b) If out=1 Then Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Rect ux,uy,uw,uh Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r/2),Sum(g/2),Sum(b/2) Rect ux+(pad/4),uy+(pad/4),uw-(pad/2),uh-(pad/2) Color Sum(r/2),Sum(g/2),Sum(b/2) If out=1 Then Color Sum(r),Sum(g),Sum(b) If out=2 Then Color Sum(r2),Sum(g2),Sum(b2) Rect ux+(pad/2),uy+(pad/2),uw-pad,uh-pad Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Rect ux,uy,pad,pad Rect (ux+uw)-pad,uy,pad,pad Rect ux,(uy+uh)-pad,pad,pad Rect (ux+uw)-pad,(uy+uh)-pad,pad,pad liney=cy If txt2$<>"" Then liney=cy-((FontHeight()/2)+(pad/2)) If txt3$<>"" Then liney=cy-((FontHeight())+pad) Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt$,1,1 If txt2$<>"" liney=cy+((FontHeight()/2)+(pad/2)) If txt3$<>"" Then liney=cy Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt2$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt2$,1,1 EndIf If txt3$<>"" liney=cy+((FontHeight())+pad) Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt3$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt3$,1,1 EndIf Color r,g,b Return out End Function Function Sum(v) ; Limits the result to 0->255 If v>255 Then v=255 If v<0 Then v=0 Return v End Function --v -=-=- ''Load, Next List!''
Sat, 17 Oct 2009, 06:13
CodersRule	Jay, is there a way to make those buttons functional? That'd be cool isPushed=Button(x,y,"Lala","lala2") It would draw the button and return a value
Sat, 17 Oct 2009, 06:51
Jayenkai	Yes, it returns out.. So if button(x,y,"TADA")=1 then the mouse is over it, and if =2 then it's clicked.. Forgot to shove that example in there, but it works! -=-=- ''Load, Next List!''
Mon, 19 Oct 2009, 05:00
CodersRule	Ah cool EDIT -- Lame example ftw. (This is of Jay's) Global str1$ = 0 str2$ = 0 str3$ = 0 str4$ = 0 str5$ = 0 Graphics 800,600,32,2 SetBuffer BackBuffer() SetFont LoadFont("Arial",34) Repeat Cls x=400:y=40 Color 255,50,50 str1$ = Button(x,y,str1$):y=y+80 Color 0,180,0 str2$ = Button(x,y,str2$):y=y+80 Color 100,100,255 str3$ = Button(x,y,str3$):y=y+80 Color 180,180,50 str4$ = Button(x,y,str4$,"Bigger Test"):y=y+120 Color 255,255,255 str5$ = Button(x,y,str5$,"Even Bigger Test","Really big big test"):y=y+80 Flip Until KeyDown(1) Function Button(cx,cy,txt$,txt2$="",txt3$="") out=0 pad=8 r=ColorRed():g=ColorGreen():b=ColorBlue() uw=StringWidth(txt$) If StringWidth(txt2$)>uw Then uw=StringWidth(txt2$) If StringWidth(txt3$)>uw Then uw=StringWidth(txt3$) uw=uw+(pad2) uh=FontHeight()+(pad2) If txt2$<>"" Then uh=(FontHeight()2)+(pad3) If txt3$<>"" Then uh=(FontHeight()3)+(pad4) ux=cx-(uw/2):uy=cy-(uh/2) If MouseX()=>ux And MouseY()=>uy And MouseX()<=ux+uw And MouseY()<=uy+uh Then out=1:If MouseDown(1) Then out=2 Color Sum(r),Sum(g),Sum(b) If out=1 Then Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Rect ux,uy,uw,uh Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r/2),Sum(g/2),Sum(b/2) Rect ux+(pad/4),uy+(pad/4),uw-(pad/2),uh-(pad/2) Color Sum(r/2),Sum(g/2),Sum(b/2) If out=1 Then Color Sum(r),Sum(g),Sum(b) If out=2 Then Color Sum(r2),Sum(g2),Sum(b2) Rect ux+(pad/2),uy+(pad/2),uw-pad,uh-pad Color Sum(r2),Sum(g2),Sum(b2) If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Rect ux,uy,pad,pad Rect (ux+uw)-pad,uy,pad,pad Rect ux,(uy+uh)-pad,pad,pad Rect (ux+uw)-pad,(uy+uh)-pad,pad,pad liney=cy If txt2$<>"" Then liney=cy-((FontHeight()/2)+(pad/2)) If txt3$<>"" Then liney=cy-((FontHeight())+pad) Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt$,1,1 If txt2$<>"" liney=cy+((FontHeight()/2)+(pad/2)) If txt3$<>"" Then liney=cy Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt2$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt2$,1,1 EndIf If txt3$<>"" liney=cy+((FontHeight())+pad) Color 0,0,0:If out=2 Then Color Sum(r4),Sum(g4),Sum(b4) Text cx+1,liney+1,txt3$,1,1 Color Sum(r4),Sum(g4),Sum(b4):If out=2 Then Color 0,0,0 Text cx,liney,txt3$,1,1 EndIf Color r,g,b Return out End Function Function Sum(v) ; Limits the result to 0->255 If v>255 Then v=255 If v<0 Then v=0 Return v End Function --v
Mon, 19 Oct 2009, 21:53
Cower	Mine doesn't do the whole pressed/unpressed result thing (although it'd be easy to put that in there either as a callback, event, or just a result of "If button.Pressed() Then" sort of method. However, all I got out of the initial post was that it was visual, so I made something visual. Also, it's a type, not a function. This doesn't really change much in terms of how things work. Anyhow, code- requires BlitzMax and a healthy lack of sanity: Strict 'buildopt:gui Graphics 800,600,0 SetClsColor 64, 64, 64 'InputManager.Instance().Capture MOUSEINPUT ' <- isn't this a pretty line? ' add some buttons. New Button.Init "A Button with long text!", 30, 30, 80, 20 New Button.Init "A Button with long text!", 30, 60, 256, 45 While Not AppTerminate() And Not KeyHit(KEY_ESCAPE) Cls ' pretty background... Local t! = (Double(Millisecs() Mod 1000)/1000)120 SetLineWidth(10) SetColor(48,48,48) For Local i:Int = 0 Until 300 For Local x:Int = 0 Until 6 DrawLine -100+i120+t+x10, -20, -100+i120-(GraphicsHeight()+40)+t+x10, GraphicsHeight()+20 Next Next M2DStack.Push SetBlend(ALPHABLEND) SetAlpha(0.1) SetColor(0,0,0) SetRotation(16) For Local i:Int = -400 To GraphicsHeight() Step 80 DrawRect(0,GraphicsHeight()-i,GraphicsWidth()2,GraphicsHeight()2) Next M2DStack.Pop ' this is the button stuff. Button.UpdateButtons Button.DrawButtons ' InputManager.Instance().ImmediateCapture ' relic Flip 1 Wend Type Button ' Last mouse state and current mouse state (for button 1) ' used to track whether the mouse was just pressed or has remained pressed Global lm,cm Global buttons:TList = New TList Method Compare:Int(other:Object) Local b:Button = Button(other) If Not b Then Throw "Noel didn't feel like handling sorting with anything other than buttons" If y < b.y Then Return 1 If y > b.y Then Return -1 Return 0 End Method Function UpdateButtons() lm = cm cm = MouseDown(1) For Local b:Button = EachIn buttons b.Update Next End Function Function DrawButtons() For Local b:Button = EachIn buttons b.Draw Next End Function Method New() buttons.AddLast Self buttons.Sort End Method Method Init(txt$,x#,y#,w#,h#) Self.txt = txt Self.x = x Self.y = y Self.w = w Self.h = h Self.depression = 0 Self.font = GetImageFont() End Method Field txt$ Field font:TImageFont Field x#, y# Field w#, h# Field depression# Method Draw() M2DStack.Push M2DStack.Identity SetBlend ALPHABLEND Local r,g,b ; GetColor r, g, b Local dep2# = 2(1.0 - depression) Local dep4# = 4depression Local dep8# = 3dep2 Local Shadow#[] = .. [ x-dep2, y+dep2+dep4, .. x+w+dep2, y+dep2+dep4, .. x+w+dep22, y+h+dep8+dep4, .. x-dep22, y+h+dep8+dep4 ] Local scx# = (shadow[4]+shadow[6]).5 - x Local scy# = (shadow[5]+shadow[7]).5 - y M2DStack.Push SetColor 0, 0, 0 SetAlpha .1 For Local rot:Int = 0 Until 10 SetHandle Sin(rot36)1.5, Cos(rot36)1.5 SetScale 1, 1.0+(rot.01)(1.0-depression) DrawPoly Shadow Next M2DStack.Pop M2DStack.Push SetAlpha 1 SetColor 32,32,32 SetAlpha .9 DrawRect x-.5, y+dep4-.5, w+1, h+1 DrawRect x+.5, y+dep4+.5, w+1, h+1 SetAlpha 1 SetColor(255,255,255) DrawRect(x+.5,y+dep4-.5,w-1,h-1) For Local i:Double = 0 To 1 Step .025 Local osi! = 1.0 - i Local grad! = (255-55depression)i + (200+55depression)osi SetColor(grad, grad, grad) DrawRect x+1.5, y+dep4+1.5, w-3, (h-3)osi Next M2DStack.Pop Local tw#, th# Local b_txt$ = txt SetImageFont(font) tw = TextWidth(txt) th = TextHeight(txt) If th < h-2 Then While tw > w-2 Local l% = b_txt.Length-3 If l <= 0 Then b_txt = "" tw = 0 Exit EndIf b_txt = b_txt[..l]+".." tw = TextWidth(b_txt) Wend If b_txt Then Local tx# = x+w.5-tw.5 Local ty# = y+h.5+dep4-th.5 SetAlpha .6+.25depression SetColor 255,255,255 DrawText b_txt, tx-(1(1.0-depression)), ty+(1-2depression) SetColor 0,0,0 DrawText b_txt, tx, ty EndIf EndIf M2DStack.Pop End Method Method InButton() Local mx#, my# mx = MouseX() my = MouseY() Return (mx => x And my => y And mx <= x+w And my <= y+h) End Method Field depressing% = 0 Method Update() If Not lm And cm And InButton() Then depressing = True EndIf If depressing Then If cm Then depression = Min(Max(depression + .2, 0), 1) depressing = True Else depressing = False EndIf ElseIf depression > 0 And Not depressing Then depression = Min(Max(depression - .2, 0), 1) EndIf End Method End Type ' Max2D stack code so I can easily push/pop states. It's handy. Const STACK_COLOR%=%1 Const STACK_FONT%=%10 Const STACK_CLEARCOLOR%=%100 Const STACK_ALPHA%=%1000 Const STACK_BLEND%=%10000 Const STACK_HANDLE%=%100000 Const STACK_ORIGIN%=%1000000 Const STACK_SCALE%=%10000000 Const STACK_ROTATION%=%100000000 Const STACK_VIEWPORT%=%1000000000 Const STACK_LINEWIDTH%=%10000000000 Const STACK_ALL%=$FFFFFFFF Type M2DStack Global top:M2DStack=Null Field r%,g%,b%,a# Field cr%,cg%,cb% Field blend% Field linewidth% Field handle_x#,handle_y# Field origin_x#,origin_y# Field scale_x#,scale_y# Field rotation# Field font:TImageFont Field vx:Int,vy:Int,vw:Int,vh:Int Field _parent:M2DStack Method New() GetColor(r,g,b) a=GetAlpha() GetClsColor(cr,cg,cb) GetViewport(vx,vy,vw,vh) font=GetImageFont() rotation = GetRotation() GetScale(scale_x,scale_y) GetHandle(handle_x,handle_y) GetOrigin(origin_x,origin_y) blend = GetBlend() linewidth=GetLineWidth() End Method ' Restore the identity (this really is a bad term here, since identity is more of a maths thing) ' Max2D state, or just part of a state (see STACK_* masks) Function Identity(mask=STACK_ALL) If mask&STACK_COLOR Then SetColor(255,255,255) If mask&STACK_ALPHA Then SetAlpha(1) If mask&STACK_BLEND Then SetBlend(SOLIDBLEND) If mask&STACK_ROTATION Then SetRotation(0) If mask&STACK_SCALE Then SetScale(1,1) If mask&STACK_HANDLE Then SetHandle(0,0) If mask&STACK_ORIGIN Then SetOrigin(0,0) If mask&STACK_CLEARCOLOR Then SetClsColor(0,0,0) If mask&STACK_FONT Then SetImageFont(Null) If mask&STACK_VIEWPORT Then SetViewport(0,0,GraphicsWidth(),GraphicsHeight()) If mask&STACK_LINEWIDTH Then SetLineWidth(1) End Function Function Push() Local upper:M2DStack = New M2DStack upper._parent = top top = upper End Function Function Pop() Assert top Else "Stack underflow" top.Restore top = top._parent End Function ' Note: restoration does not imply destruction, you could save a state and restore it as many times as you want. Method Restore() SetColor(r,g,b) SetAlpha(a) SetBlend(blend) SetClsColor(cr,cg,cb) SetRotation(rotation) SetScale(scale_x,scale_y) SetHandle(handle_x,handle_y) SetOrigin(origin_x,origin_y) SetImageFont(font) SetViewport(vx,vy,vw,vh) SetLineWidth(linewidth) End Method End Type --v Edit: Updated code, may have severely gimped it, I'm not entirely sure. It's prettier, at least. And a video of it: View on YouTube
Wed, 21 Oct 2009, 02:22
LostUser	Here is my button library. The button themes aren't very nice looking though (for some reason using FatBox makes the thing very slow). Requirements: fatbox functions (follows code) ; Button class ; A very basic button class ; @updated: 25 Aug 2009 ;-------------------------------------------------- Type button Field name$, screen$ Field x,y,w,h Field fg,bg Field theme End Type Function Create_Button(name$="",screen$="",x=0,y=0,w=150,h=75,theme=1,fg=$FF00FF,bg=$FFFFFF) Local b.button = New button b\name$ = name$ b\screen = screen$ b\x = x b\y = y b\w = w b\h = h b\fg = fg b\bg = bg b\theme = theme End Function Function Count_Buttons() count = 0 For b.button = Each button: count = count + 1:Next Return (count) End Function Function Draw_Buttons.button(screen$="", showCaption=True) Local flag = False If (screen$ <> "") Then For b.button = Each button If ( Lower(b\screen$) = Lower(screen$) ) Then ; Mouse over If (mousein(b\x, b\y, b\w, b\h)=True) Then Color 0,0,ROLLOVER_BGCOLOR ; Handle LMB click If (LMB >= 1 ) Then flag = True End If ; Draw rectangle mouse-over theme Select (b\theme) Case 4: fatBox(b\x, b\y, b\w, b\h, 4) Case 5: Rect (b\x,b\y,b\w,b\h,True) Case 6: Rect (b\x,b\y,b\w,b\h,False) Case 7: RoundRect(b\x, b\y, b\w, b\h, 4, ROLLOVER_BGCOLOR) Case 8: RoundedRectOutlined(b\x,b\y,b\w,b\h,$000000,ROLLOVER_BGCOLOR,4) Default: ; Do nothing End Select Else Color 0,0,b\bg End If ; Draw button/box Select (b\theme) Case 1: fatBox(b\x, b\y, b\w, b\h, 4, 0) Case 2: Rect (b\x,b\y,b\w,b\h,True) Case 3: Rect (b\x,b\y,b\w,b\h,False) Case 4: ; Rollover fatbox Case 5: ; Rollover filled rect Case 6: ; Rollover non-filled rect Case 7: ; Round Rect Case 8: ; RoundedRectOutlined Default: Rect (b\x,b\y,b\w,b\h,False) End Select Restore_Color() If showCaption = True Then strlen = (StringWidth(b\name$)-Len(b\name$)) sum_v = ( (b\h - FontHeight()) /2 ) ;sum_h = ( (b\w - strlen ) /2) ; 15 sum_h = 15 ; Return ((GraphicsWidth() - w) / 2) ; Display caption Text b\x+sum_h,b\y+sum_v,b\name$ End If ; Handle click/return If flag = True Then Restore_Color() Return (b) End If End If flag = False Next End If End Function ; Delete buttons for a screen Function Delete_Buttons(screen$="") If (Lower(screen$)<>"") Then DebugLog("Deleting buttons for " + screen$) For b.button = Each button If ( Lower(b\screen) = Lower(screen$) ) Then Delete (b) End If Next End If Return (True) End Function Function Delete_All_Buttons() For b.button = Each button Delete (b) Next Return (True) End Function --v ; Fat functions ; @updated: 3 Aug 2009 ;-------------------------------------------------- ; Fat Functions ; by Andy_A ; URL: https://blitzbasic.com/codearcs/codearcs.php?code=803 ;---------------------------------------------------------------------------------------------------------------------------------------------------- ; ;This simple 2D demo shows examples of using lines of varying thickness to create graphic primitives. ;There are other methods to achieve the same results but other methods are usually plagued by 'banding' ; (artifacts caused by not filling in the thick line completely). These functions are free of 'banding' artifacts. ;The functions are: ; fatLine ; fatBox ; fatOval ; fatStar ; fatCircle ; fatSuperEllipse ; ;The fatBox and fatOval functions also allow full rotation through 360 degrees. ;Have commented the functions fairly well and each function has a description of the required parameters. ; ;I've tried to optimize all of the functions for speed, but some can be ;tweaked for better results by removing parameter checking and using LUT's. ; ;All of the functions except fatCircle are dependent on fatLine for line thickness, so if you want ;to use any of the other functions,don't forget to copy the fatLine function to ;your application as well. If you don't need the line thickness in the other functions, ;just replace all references to fatLine with Blitz's Line() function. ; ;fatLine written in Blitz+ by Andy Amaya 2003.06.23 ;fatFunctions compiled 2003.10.02 ;Update - fatSuperEllipse() function added 2003.10.06 ; ;Feel free to use these routines as you see fit. Enjoy 8) ; ------> Press any key to cycle through the different examples ;******************************** fatLine ************************************** ; Parameters are: ; x1%, y1%, x2%, y2%, penSize% ; ; x1%, y1% are the coords of the line origin ; x2%, y2% are the coords of the line end point ; penSize% is the thickness of line to be drawn ; ; BRESLINE.PAS - A general line drawing procedure. ; By Mark Feldman ; ; Source: https://www.gamedev.net/reference/articles/article767.asp ; ; Adapted for Blitz+ fatLine function by Andy Amaya ; ;*************************************************************************************** Function fatLine(x1%, y1%, x2%, y2%, penSize%) If penSize% < 1 Then Return False If penSize% = 1 Then Line(x1%, y1%, x2%, y2%): Return ; penSize% is thickness to draw line offset% = penSize% / 2 ;offset needed to place Oval correctly ; Calculate deltax and deltay for initialization deltax% = Abs(x2% - x1%) deltay% = Abs(y2% - y1%) ; Initialize all vars based on which is the independent variable If deltax% >= deltay% Then ; x is the independent variable numovals% = deltax% + 1 d% = (2 * deltay%) - deltax% dinc1% = deltay% Shl 1 dinc2% = (deltay% - deltax%) Shl 1 xinc1% = 1 xinc2% = 1 yinc1% = 0 yinc2% = 1 Else ; y is the independent variable numovals% = deltay% + 1 d% = (2 * deltax%) - deltay% dinc1% = deltax% Shl 1 dinc2% = (deltax% - deltay%) Shl 1 xinc1% = 0 xinc2% = 1 yinc1% = 1 yinc2% = 1 End If ; Make sure x and y move in the right directions If x1% > x2% Then xinc1% = - xinc1% xinc2% = - xinc2% End If If y1% > y2% Then yinc1% = - yinc1% yinc2% = - yinc2% End If ; Start drawing at x%, y% x% = x1% - offset% y% = y1% - offset% ; Draw the filled ovals For i% = 1 To numovals% Oval x%, y%, penSize%, penSize%, 1 If d% < 0 Then d% = d% + dinc1% x% = x% + xinc1% y% = y% + yinc1% Else d% = d% + dinc2% x% = x% + xinc2% y% = y% + yinc2% End If Next End Function ;******************************** fatBox ************************************** ; Parameters are: ; x%, y%, wide%, high%, penSize%, rotAngle% ; ; x%, y% are the coords of the upper left corner of the box to be plotted ; this function rotates box around the upper left corner (not center of box) ; wide% is the width of the box ; high% is the height of the box ; penSize% is the thickness of lines used to plot box ; rotAngle% is the rotation angle of the box to be plotted (0 to 360 typically) ; ;*************************************************************************************** Function fatBox(x%, y%, wide%, high%, penSize%, rotAngle%=0) If rotAngle > 360 Then rotAngle = rotAngle Mod 360 ;No rotation involved, so just draw a box If rotAngle% = 0 Or rotAngle% = 360 Then fatLine(x% , y% , x% + wide%, y% , penSize%) fatLine(x% + wide%, y% , x% + wide%, y% + high%, penSize%) fatLine(x% , y% + high%, x% + wide%, y% + high%, penSize%) fatLine(x% , y% , x%, y% + high%, penSize%) Else ;Make rotation calculations and draw rotated box vtx% = rotAngle% + 90 cs% = Cos(vtx%) * high% sn% = Sin(vtx%) * high% x1% = Cos(rotAngle%)* wide% + x% y1% = Sin(rotAngle%)* wide% + y% fatLine(x%, y%, x1%, y1%, penSize%) x2% = cs% + x1% y2% = sn% + y1% fatLine(x1%, y1%, x2%, y2%, penSize%) x3% = cs% + x% y3% = sn% + y% fatLine(x%, y%, x3%, y3%, penSize%) fatLine(x2%, y2%, x3%, y3%, penSize%) End If End Function ;******************************** fatOval ************************************** ; Parameters are: ; centerX%, centerY%, wide%, high%, penSize%, rotAngle%, sides% ; ; centerX%, centerY% coords locate center of oval to be plotted ; wide% is the x-radius of the oval ; high% is the y-radius of the oval ; penSize% is the thickness of lines used to plot oval ; rotAngle% is the rotation angle of the oval to plot (0 to 359) ; sides% is the number of connected points on plotted oval ; ;*************************************************************************************** Function fatOval(centerX%, centerY%, wide%, high%, penSize%, rotAngle%, sides%) ;360 sides generates the smoothest oval, 3 sides generates a triangle ;interval# is the number of degrees between plotted points interval# = Float(360 / sides%) If interval# <= 0.0 Or interval# > 180.0 Then Return False ;Keep rotAngle between 0 and 359 rotAngle% = rotAngle% Mod 360 If penSize% < 1 Then Return False ;If rotation angle is 0 don't do extra calculations If rotAngle% = 0 Then x1% = wide% + centerX% y1% = centerY% ;This While..Wend is same as For i# = interval# To 360.0 Step interval#) i# = interval# While i# <= 360.0 x2% = Cos(i#) * wide% + centerX% y2% = Sin(i#) * high% + centerY% fatLine(x1%, y1%, x2%, y2%, penSize%) x1% = x2% y1% = y2% i# = i# + interval# ;(increment loop index, else you end up with a Repeat..Forever loop) Wend Else ;Make rotation calculations and draw oval cs# = Cos(rotAngle%) sn# = Sin(rotAngle%) x1% = cs# * wide% + centerX% y1% = sn# * wide% + centerY% ;This While..Wend is same as For i# = interval# To 360.0 Step interval#) i# = interval# While i# <= 360.0 rotX# = Cos(i#) * wide% rotY# = Sin(i#) * high% x2% = cs# * rotX# - sn# * rotY# + centerX% y2% = sn# * rotX# + cs# * rotY# + centerY% fatLine(x1%, y1%, x2%, y2%, penSize%) x1% = x2% y1% = y2% i# = i# + interval# ;(increment loop index, else you end up with a Repeat..Forever loop) Wend End If End Function ;******************************** fatStar ************************************** ; Parameters are: ; centerX%, centerY%, majorRadius%, minorRadius%, points%, penSize%, mode% ; ; centerX%, centerY% coords locate center of star to be plotted ; majorRadius% is the size of 'convex' star points ; minorRadius% is the size of 'concave' star points ; points% is the number of ;convex; star points: 3 - 180 are valid number of points ; penSize% sets the thickness for lines that draw the star ; ;*************************************************************************************** Function fatStar(centerX%, centerY%, majorRadius%, minorRadius%, points%, penSize%, mode%) ;tell function to draw a star with 3 to 180 'convex' points, otherwise can't do - Return False If points% < 3 Or points% > 180 Then Return False ;inc is number of star points times 2 ;For example: a five point star has 5 ;convex; points + 5 ;concave; points inc# = 360.0/(points * 2) ;initialize variables ;toggle keeps track of 'concave' And 'convex' radii toggle% = 0 ;calculate First x,y coords to start due north of center point oldX% = centerX ;same as Cos(270)majorRadius + centerX oldY% = -majorRadius + centerY ;same as Sin(270)majorRadius + centerY ;remember First x,y coords To close polyStar firstX% = oldX%: firstY% = oldY% ;loop that draws the star ;next 3 lines are equivalent to: For i# = inc# To 360 - (inc#-1) Step inc i# = 0 While i# <= 360 - (inc#-1) i# = i# + inc# ;start first star point due north of center point angle% = i# + 270 ;scale back degrees to between 0 And 360 angle = angle Mod 360 ;make toggle either 0 Or 1 toggle% = 1 - toggle% ;If toggle is 1 Then calculate a 'concave' point x,y pair If toggle Then ;valid minorRadius values for stars are integers: 0 < minorRadius < majorRadius newX% = Cos(angle) * minorRadius + centerX newY% = Sin(angle) * minorRadius + centerY ;draw a line from last 'convex' point to new 'concave' point fatLine(oldX, oldY, newX, newY, penSize) ;If mode = 1 Then draw lines from center of star to a 'concave' point If mode% Then fatLine(newX, newY, centerX, centerY, penSize) End If Else ;valid majorRadius values for stars are integers: 0 < minorRadius <= majorRadius newX = Cos(angle) * majorRadius+ centerX newY = Sin(angle) * majorRadius+ centerY ;draw a line from last 'concave' point to new 'convex' point fatLine(oldX, oldY, newX, newY, penSize) End If ;remember last x,y pair to use as start for the next line segment oldX = newX oldY = newY Wend ;close the polyStar by drawing line from last 'concave' point to 1st 'convex' point fatLine(oldX, oldY, firstX, firstY, penSize) End Function ;******************************** fatCircle ************************************** ; Parameters are: ; centerX%, centerY%, rad%, penSize% ; ; centerX%, centerY% coords locate center of circle to be plotted ; rad% is the radius of the circle ; penSize% is the line thickness used to draw circle ; ; Note: Bresenham's circle algorithm is smoother but is about 10 times slower ; ;*************************************************************************************** Function fatCircle(centerX%, centerY%, rad%, penSize%) If penSize < 1 Or rad% < 1 Then Return False If penSize% = 1 Then Oval centerX%-rad%, centerY%-rad%, rad% Shl 1, rad% Shl 1, 0: Return offset% = penSize% Shr 1 For i% = 0 To 360 a% = Cos(i%) * rad% + centerX% b% = Sin(i%) * rad% + centerY% Oval a% - offset%, b% - offset%, penSize%, penSize%, 1 Next End Function ;**************************** fatSuperEllipse ********************************* ; Parameters are: ; centerX%, centerY%, wide%, high%, exponent#, levelOfDetail, penSize%, rotAngle% ; ; centerX%, centerY% coords locate center of SuperEllipse to be plotted ; wide% is the x-radius of the SuperEllipse ; high% is the y-radius of the SuperEllipse ; exponent# determines the overall shape of the SuperEllipse (0.1 to 99 typical) ; levelOfDetail# - determines number of points plotted & connected with lines ; penSize% is the thickness of lines used to plot SuperEllipse ( 1 to 200 typical) ; rotAngle% is the rotation angle of the SuperEllipse plotted ( 0 to 360 typical) ; ; Sources: ; https://www.cs.colorado.edu/lizb/graphics.html ; https://astronomy.swin.edu.au/pbourke/surfaces/superellipse/ ; https://www.wikipedia.org/wiki/Super_ellipse ; ; Ported to Blitz+ by Andy Amaya 2003.10.06 ;*************************************************************************************** Function fatSuperEllipse (centerX%, centerY%, wide%, high%, exponent#, levelOfDetail#, penSize%, rotAngle%) rotAngle% = rotAngle% Mod 360 ;Make sure we don't get any divide by zero errors If exponent# = 2.0 Or Exponent = 0.0 Then power# = 0.0 Else power# = 2.0/exponent#-1 End If ;If rotation angle is zero then don't do the extra calculations If rotAngle% = 0 Then theta# = 0.0 ;determine the first x,y coords x1% = wide% * 1.0^power# + centerX% y1% = centerY% ;initialize theta (current angle) and loop variable theta# = levelOfDetail# limit# = 360.0 + levelOfDetail# While theta# <= limit# cosTheta# = Cos(theta#) sinTheta# = Sin(theta#) ;calculate x,y coords using Super Ellipse formula x2% = wide% * cosTheta# * Abs(cosTheta#)^power# + centerX% y2% = high% * sinTheta# * Abs(sinTheta#)^power# + centerY% ;connect the 2 sets of coords calculated with a line fatLine (x1%, y1%, x2%, y2%, penSize%) ;last coords are now first coords of line x1% = x2% y1% = y2% ;increment loop variable by amount indicated by "levelOfDetail" theta# = theta# + levelOfDetail# Wend Else ;need to rotate SuperEllipse, so do the extra math theta# = 0.0 cosTheta# = 1.0 sinTheta# = 0.0 ;pre-calc Cos() and Sin() of rotation angle cs# = Cos(rotAngle%) sn# = Sin(rotAngle%) ;calculate the first rotated x,y coords rotX# = wide% * 1.0^power# rotY# = 0.0 x1% = cs# * rotX# - sn# * rotY# + centerX% y1% = sn# * rotX# + cs# * rotY# + centerY% ;initialize theta (current angle) and loop variable theta# = levelOfDetail# limit# = 360.0 + levelOfDetail# While theta# <= limit# cosTheta# = Cos(theta#) sinTheta# = Sin(theta#) ;calculate the next pair of rotated x,y coords rotX# = cosTheta# * wide% * Abs(cosTheta#)^power# rotY# = sinTheta# * high% * Abs(sinTheta#)^power# x2% = cs# * rotX# - sn# * rotY# + centerX% y2% = sn# * rotX# + cs# * rotY# + centerY% ;connect the 2 sets of coords calculated with a line fatLine(x1%, y1%, x2%, y2%, penSize) ;last coords are now first coords of line x1% = x2% y1% = y2% ;increment loop variable by amount indicated by "levelOfDetail" theta# = theta# + levelOfDetail# Wend End If End Function ; Examples of calls below; ; RoundedRectOutlined(100,200,400,200,$FFFF00,$FF9900,thick,rot,0) ; RoundedRectOutlined(100,30,100,50,$FFFF00,$FF9900,thick,rot,1) ; Function RoundedRectOutlined(x,y,width,height,FillCol=$FFFF00,OutlineCol=$FF9900,thick=8,rot=0,fade=0) ; Sorry, gave up trying to rotate it! Color 0,0,fillcol Rect x,y,width,height,1 For n=0 To thick Color 0,0,FillCol LockBuffer BackBuffer() For ang=0 To 90 Step 5 WritePixelFast x+(thick-1)-Sin(ang)n,y+(thick-1)-Cos(ang)n,FillCol WritePixelFast x-(thick-1)+width+Sin(ang)n,y+(thick-1)-Cos(ang)n,FillCol WritePixelFast x+(thick-1)-Sin(ang)n,y-(thick-1)+height+Cos(ang)n,FillCol WritePixelFast x-(thick-1)+width+Sin(ang)n,y-(thick-1)+height+Cos(ang)n,FillCol Next UnlockBuffer BackBuffer() Color 0,0,OutlineCol:argb=outlinecol If n<thick/2 Then Color 0,0,fillcol:argb=fillcol If fade=1 a=(fillcol And $FF0000) Shr 16 c=(outlinecol And $FF0000) Shr 16 r=(((c-a)n)/thick)+a a=(fillcol And $FF00) Shr 8 c=(outlinecol And $FF00) Shr 8 g=(((c-a)n)/thick)+a a=(fillcol And $FF) c=(outlinecol And $FF) b=(((c-a)n)/thick)+a Color r,g,b argb=(255 Shl 24)+(r Shl 16)+(g Shl 8)+b EndIf Line x-n,y,x-n,y+height Line x+width+n,y,x+width+n,y+height Line x,y-n,x+width,y-n Line x,y+height+n,x+width,y+height+n For ang=0 To 90 WritePixelFast x-Sin(ang)n,y-Cos(ang)n,argb WritePixelFast x+width+Sin(ang)n,y-Cos(ang)n,argb WritePixelFast x-Sin(ang)n,y+height+Cos(ang)n,argb WritePixelFast x+width+Sin(ang)n,y+height+Cos(ang)n,argb Next Next End Function Function RoundRect(x=0, y=0, width=0, height=0, thickness=0, borderColor$ = $FF9900) r = ColorRed() g = ColorGreen() b = ColorBlue() Color(0, 0, borderColor$) diameter = thickness 2 For i = 0 To 1 inner = i * thickness If(i = 1) Then Color(r, g, b) Oval(x + inner, y + inner, diameter, diameter) ; Top-Left Oval(x + width - diameter - inner, y + inner, diameter, diameter) ; Top-Right Oval(x + inner, y + height - diameter - inner, diameter, diameter) ; Bottom-Left Oval(x + width - diameter - inner, y + height - diameter - inner, diameter, diameter) ; Bottom-Right Rect(x + inner, y + thickness + inner, diameter, height - diameter - inner * 2) ; Left Rect(x + thickness + inner, y + inner, width - diameter - inner * 2, diameter) ; Top Rect(x + width - diameter - inner, y + thickness + inner, diameter, height - diameter - inner * 2) ; Right Rect(x + thickness + inner, y + height - diameter - inner, width - diameter - inner * 2, diameter) ; Bottom Next Rect(x + thickness * 2, y + thickness * 2, width - thickness * 4, height - thickness * 4) End Function --v