Simple button that fire on release

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Tourist Trap
Posts: 2383
Joined: Jun 02, 2015 16:24

Simple button that fire on release

Postby Tourist Trap » Jun 17, 2018 21:45

Hi there,

nothing very complicated. Can be of some use as yet another button example for the beginner anyway.

Code: Select all

 'a simple button that triggers a click on button released properly

#include "fbgfx.bi"     'comment: not necessary include here, just habit...

'__________________________________here stand the definitions
#macro _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(w, v)
    screenSet (w), (v)
#endMacro
#macro _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(w, v)
    screenCopy (w), (v)
#endMacro

type BUTTON
    declare constructor()
    declare sub TriggerMouseTest()
    declare sub DrawButton()
        as integer  _left
        as integer  _top
        as integer  _width
        as integer  _height
        as string   _text
        as boolean  _hasMouseOver
        as boolean  _hasMouseClick
        as boolean  _hasMouseButtonReleased
end type
constructor BUTTON
    dim as integer scrW, scrH
    screenInfo scrW, scrH
    with THIS
        ._left                      => scrW\2 - 2
        ._top                       => scrH\2 - 2
        ._width                     => scrW\24
        ._height                    => scrH\24
        ._text                      => "default"
        ._hasMouseOver              => FALSE
        ._hasMouseClick             => FALSE
        ._hasMouseButtonReleased    => FALSE
    end with
end constructor
sub BUTTON.TriggerMouseTest()
    dim as integer  whereMouseX, _
                    whereMouseY, _
                    whatMouseButtonClicked
    GetMouse whereMouseX, whereMouseY, , whatMouseButtonClicked
    with THIS
        if whereMouseX>=._left andAlso _
            whereMouseX<(._left+ ._width) andAlso _
            whereMouseY>=._top andAlso _
            whereMouseY<(._top + ._height) then
            if not ._hasMouseOver then
                ._hasMouseOver = TRUE
            end if
        else
            if ._hasMouseOver then
                ._hasMouseOver = FALSE
            end if
        end if
        '
        if ._hasMouseOver andAlso cBool(whatMouseButtonClicked>0) then
            if not ._hasMouseClick then
                ._hasMouseClick = TRUE
            end if
        else
            if ._hasMouseClick then
                ._hasMouseClick             = FALSE
                if ._hasMouseOver then
                    if not ._hasMouseButtonReleased then
                        ._hasMouseButtonReleased    = TRUE
                    else
                        ._hasMouseButtonReleased    = FALSE
                    end if
                end if
            else
                ._hasMouseButtonReleased    = FALSE
            end if
        end if
    end with
end sub
sub BUTTON.DrawButton()
    THIS.TriggerMouseTest()
    '
    dim as long btnColor
    with THIS
        if ._hasMouseButtonReleased then
                btnColor = rgb(100,200,100)
        elseIf ._hasMouseClick then
                btnColor = rgb(100,100,200)
        else
                btnColor = rgb(100,100,100)
        end if
        '
        line (._left,._top)- _
                (._left + ._width - 1,._top + ._height - 1), _
                btnColor, _
                bf
    end with
end sub


'_______________________________________here starts the execution
screenres 800, 600, 32, 2
dim as BUTTON   btn

'______________________________________________________main loop
do
    _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(1, 0)
   
    btn.DrawButton()
    if btn._hasMouseButtonReleased then
        cls
        circle(10,10), rnd()*1000
    end if
   
    _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(1, 0)
    '
    sleep 15
loop until inkey()=chr(27)

'_______________________here we pause before end, we'll be back!
getKey()

'(eof)
deltarho[1859]
Posts: 1443
Joined: Jan 02, 2017 0:34
Location: UK

Re: Simple button that fire on release

Postby deltarho[1859] » Jun 18, 2018 17:41

Very neat, but that is a heck of a lot more than a beginner's tip. <smile>

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest