Custom Menu

[TurtleProgrammer]

I am writing my own simple menu. The code I've written looks right to me but when I run it I get the current coordinates but the box does not show up at those coordinates.

Code: Select all

dim x as integer
dim y as integer
dim x2 as integer
dim y2 as integer
dim res as integer
dim buttons as integer

screenres 640, 480, 8

do 
locate 1, 1

res = getmouse(x, y, buttons)

print x, y

if buttons and 2 then 
    line (x, y)-(x2, y2), 15, b
end if


loop while inkey = ""

[D.J.Peters]

first: getmouse(x, y,buttons) are wrong and must be getmouse(x, y,,buttons)
secondly: don't use all CPU cycles in a loop use the sleep command instead !

Joshy

Code: Select all

dim x as integer
dim y as integer
dim x2 as integer
dim y2 as integer
dim res as integer
dim buttons as integer

screenres 640,480

do
  if getmouse(x, y,,buttons)=0 then
    locate 1, 1 : print x, y
    if buttons and 2 then line (x, y)-(x2,y2), 15, b
  end if
  sleep 10
loop while inkey = ""

[MrSwiss]

A *floating* Popup Menu ... using a double buffered screen! 32bit Color.
GetMouse_Example01.bas:

Code: Select all

' GetMouse_Example01.bas -- 2017-01-30, MrSwiss -- floating popup menu

Dim As Integer  x, y, buttons
Dim As ULong    fnr = 1, fres

Declare Function menu(ByVal As ULong, ByVal As ULong) As ULong

' ===== MAIN =====
ScreenRes(640, 480, 32, 2)

Do
    If GetMouse(x, y,, buttons) = 0 Then
        Locate 59, 5 : Print x, y, buttons
        If buttons and 2 Then
            fres = menu(fnr, &hFFFF7F00)
            If fres = 0 Then
                Locate 2, 2 : Print "menu: "; fres; " not yet implemented!"
            Else
                Locate 30, 5 : Print "menu says: "; fres
            EndIf 
        EndIf
    EndIf
    Flip
    Sleep(50, 1)
Loop Until Len(InKey)
' ===== END MAIN =====

' implementation of above declared Function
Function menu( _
    ByVal nr    As ULong = 0, _         ' as of now: only nr = 1 used
    ByVal clr   As ULong = &hFFFFFFFF _ ' color 32bit
    ) As ULong
    ' delay: to NOT take over prev. mouse-click
    Sleep(100, 1)
    Dim As ULong    ret = nr
    Dim As Integer  mx, my, mbtn

    Select Case As Const nr
        Case 1
            Do
                Cls
                Line (mx, my)-step(180, 30), clr, bf
                Draw String (mx + 4, my + 4), "left-click, to close"
                If GetMouse(mx, my,, mbtn) = 0 Then
                    If mbtn and 1 Then
                        Cls : Return ret
                    ElseIf mbtn and 2 Then
                        Line (230, 215)-Step(180, 50), &hFFFF0000, bf
                        Draw String (240, 236), "illegal operation !!", &hFFFFFFCF
                        Sleep(1500, 1)
                    EndIf
                EndIf
                Flip
                Sleep(50 , 1)
            Loop
        Case Else
            Menu = 0    ' indicate ERROR
    End Select
End Function
' ----- EOF -----

[Trinity]

A *floating* Popup Menu ... using a double buffered screen! 32bit Color.

Brilliant and inspirational code example , thank you :-)

[BasicCoder2]

Your choice of variable labels makes me think you have taken this from the documentation?

You haven't given x2,y2 any values. They need to be relative to the top/left corner of the rectangle x,y

Code: Select all

dim x as integer
dim y as integer
dim x2 as integer
dim y2 as integer
dim res as integer
dim buttons as integer

screenres 640, 480, 8

do 
    locate 1, 1
    ' result = GetMouse (x, y, wheel,buttons) 
    res = getmouse(x,y, ,buttons)

    if buttons and 2 then  'if menu button down
        cls                'clear screen to redraw rectangle else where
        line (x, y)-(x+200, y+16), 15, b  'rectangle top/left at x,y with width 200 and height 16
    end if
    
    print x, y
    
    sleep 2
    
loop while inkey = ""

I hope you don't mind that this response is more than you asked for but it may be useful to others reading the thread who might have also thought about writing their own simple GUI.

GUI objects are just displayed as rectangle areas be they buttons of any kind (eg. menu button) or labels, drop down menu, picture boxes and so on.

This is what I would consider a minimal start to a GUI based menu.

Code: Select all

screenres 640, 480, 32

dim as integer mx,my,mb   'mouse variables
color rgb(0,0,0),rgb(255,255,255)  'black ink, white paper

type RECTANGLE
    as integer x       'position
    as integer y
    as integer w       'dimensions
    as integer h
    as string  text    'rectangle text
    as ulong   c       'color
    as integer a       'rectangle selected
end type

'make a rectangle
dim shared as RECTANGLE rect
'initialize rectangle
rect.x = 100
rect.y = 100
rect.text = "MY RECTANGLE"
rect.w = len(rect.text)*8+16  'width to fit text with standard size font
rect.h = 16                   'hight to fit text with standard size font

sub update()
    screenlock
    cls
    'draw the rectangle
    line (rect.x,rect.y)-(rect.x+rect.w,rect.y+rect.h),rgb(200,200,255),bf
    line (rect.x,rect.y)-(rect.x+rect.w,rect.y+rect.h),rgb(0,0,0),b
    'change text if left mouse button down within rectangle
    if rect.a = 0 then
        draw string (rect.x+4,rect.y+4),rect.text
    else
        draw string (rect.x+4,rect.y+4),"  GOT ME!    "
    end if
    screenunlock
end sub

update()

Do
    update()
    getmouse (mx, my, ,mb)
    if mb = 1 then  'left mouse button down
        if mx>rect.x and my>rect.y and mx<rect.x+rect.w and my<rect.y+rect.h then  'mouse down on button
            rect.a = 1  'activate button
        end if
    else
        rect.a = 0  'deactivate button
    end if
    
    sleep 2
        
Loop While Inkey = ""

This is easy to expand to a list of rectangles.

Code: Select all

screenres 640, 480, 32

dim as integer mx,my,mb   'mouse variables
color rgb(0,0,0),rgb(255,255,255)  'black ink, white paper

type RECTANGLE
    as integer x       'position
    as integer y
    as integer w       'dimensions
    as integer h
    as string  text    'button text
    as ulong   c       'color
    as integer a       'button selected
end type

dim shared as integer ID   'currently selected rectangle

'make a rectangle
dim shared as RECTANGLE rect(0 to 3)  'make four rectangles
'initialize rectangle
for i as integer = 0 to 3
    rect(i).x = 100
    rect(i).y = 32 + i*16  'position down y axis
    rect(i).text = "MENU ITEM " & str(i+1)
    rect(i).w = len(rect(i).text)*8+16  'width to fit text with standard size font
    rect(i).h = 12                      'height to fit text with standard size font
next i


sub update()
    screenlock
    cls
    'draw the rectangles
    for i as integer = 0 to 3
        if ID = i then 'show this is selected by changing its color
            line (rect(i).x,rect(i).y)-(rect(i).x+rect(i).w,rect(i).y+rect(i).h),rgb(200,200,255),bf
        else
            line (rect(i).x,rect(i).y)-(rect(i).x+rect(i).w,rect(i).y+rect(i).h),rgb(255,200,200),bf
        end if
        'border rectagle if needed
        'line (rect(i).x,rect(i).y)-(rect(i).x+rect(i).w,rect(i).y+rect(i).h),rgb(0,0,0),b
        draw string (rect(i).x+4,rect(i).y+4),rect(i).text
    next i
    screenunlock
end sub

update()

Do
    update()
    getmouse (mx, my, ,mb)
    ID = -1   'none selected
    if mb = 1 then  'left mouse button down
        for i as integer = 0 to 3
            if mx>rect(i).x and my>rect(i).y and mx<rect(i).x+rect(i).w and my<rect(i).y+rect(i).h then
                ID = i  'active button
            end if
        next i
    end if
    
    sleep 2
        
Loop While Inkey = ""

[Trinity]

This is what I would consider a minimal start to a GUI based menu.
GUI objects are just displayed as rectangle areas be they buttons of any kind (eg. menu button) or labels, drop down menu, picture boxes and so on.

Thank you very much , that is a good demonstration :-)
Funny thing is that the reason that I choose to start with FB is because I have never been really keen on the GUI as a programmer. But after having seen what one can do with FB from the examples from MrSwiss and you then I might consider making one for programs at some point in the future.
Also , in the short amount of time that I have been a member of this forum then I have learned that there are many really great coders here at freebasic.net which makes me wonder why I have never heard of FreeBASIC before I stumbled over it only recently. Anyway , I ought not derail this thread with all my philosophizing.
Thank you :-)

[MrSwiss]

Your choice of variable labels makes me think you have taken this from the documentation?

You happen to think wrong ...

You haven't given x2,y2 any values. They need to be relative to the top/left corner of the rectangle x,y

Sorry, if you can't follow my code, don't comment it ... (I've used literals, instead of x2, y2!).
You also don't seem to understand that *Step(x2, y2)* in the Line command, makes the
following literals *relative* to (x1, y1), ...

[BasicCoder2]

@MrSwiss,
The post was meant for TurtleProgrammer. I didn't actually read your code.
.

[sancho3]

I would describe both BasicCoder's and MrSwiss's as unworkable examples of a pop up menu.
Both make no attempt to replace the background they overwrite.
In fact both examples completely erase the screen.

[BasicCoder2]

@sancho3,
The question was addressed. Mine and I presume MrSwiss's code was just a simple as possible illustration as to how to use the mouse to pop up a rectangle at the position of the mouse it was not an explanation of how to program a full blown GUI event driven environment. TurtleProgammer didn't respond to the suggestions anyway but had he given the context in which it was to be used and that required a more general purpose solution then of course the extra suggestions could have been made.
.

[sancho3]

But my point is that he can't use the code as is. It needs over hauling just to make it a popup.
What you are showing is really not much more than the Line,B command as it stands.

The very minimum the popup must do is show and hide properly.

I am not trying to offend either of you, however, I stand by statement that this is not as you say, "minimal start to a GUI based menu" any more than a rectangle with text in it is a "minimal start to a window".

[BasicCoder2]

Well of course you could always tap out an example of what you would consider a minimal start.
This one is perhaps closer to what you expect as a demo of some of the mechanisms required? It was a quick write so it might have some bugs.

Code: Select all

screenres 640, 480, 32
color rgb(0,0,0),rgb(255,255,255):cls

dim as integer mx,my,mb   'mouse variables

color rgb(0,0,0),rgb(255,255,255)  'black ink, white paper

type popUpMenu
    as integer x
    as integer y
    as integer w
    as integer h
    as string  items(0 to 6)
    as integer id   'item selected
    as integer id2   'mouse over this item
    as integer sel  'has been selected
    as any ptr scrSave
end type

dim shared as popUpMenu pum
'initialize popUpMenu
pum.items(0) = "Undo"
pum.items(1) = "Redo"
pum.items(2) = "Cut"
pum.items(3) = "Copy"
pum.items(4) = "Paste"
pum.items(5) = "Delete"
pum.items(6) = "Select All"

pum.x = 0
pum.y = 0
pum.w = 12*8  'wide enough for widest item
pum.h = 7*16  'high enough for number of items

pum.scrSave = imagecreate(pum.w,pum.h)  'to save stuff behind popupmenu box

sub update()
    screenlock
    if pum.sel = 1 then
        line (pum.x,pum.y)-(pum.x+pum.w-1,pum.y+pum.h-1),rgb(200,200,255),bf
        line (pum.x,pum.y)-(pum.x+pum.w-1,pum.y+pum.h-1),rgb(100,100,255),b
        for i as integer = 0 to 6
            if i = pum.ID2 then
                line (pum.x,pum.y+i*16)-(pum.x+pum.w-1,pum.y+i*16),rgb(240,240,240),bf
                draw string (pum.x+4,pum.y+4+i*16),pum.items(i),rgb(255,0,0)
            else
                draw string (pum.x+4,pum.y+4+i*16),pum.items(i),rgb(0,0,0)
            end if
        next i
    end if
    locate 2,2
    print "pum.ID = ";pum.ID
    screenunlock
end sub

'FILL BACKGROUND WITH STUFF
dim as integer x,y,r
dim as ulong c
for i as integer = 0 to 80
    x = int(rnd(1)*640)
    y = int(rnd(1)*480)
    r = int(rnd(1)*50)+10
    c = rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    circle (x,y),r,c,,,,f
next i

            
Do
    getmouse mx,my,,mb
    

    if mb = 2 then
        if pum.sel = 0 then 'create a new pop up
            pum.ID = -1
            pum.x = mx
            pum.y = my
            if pum.x+pum.w > 640 then pum.x = 640-pum.w
            if pum.y+pum.h > 480 then pum.y = 480-pum.h
            pum.sel = 1
            get (pum.x,pum.y)-(pum.x+pum.w-1,pum.y+pum.h-1),pum.scrSave
        else
            if mx>=pum.x and mx<pum.x+pum.w and my>=pum.y and my<pum.y+pum.h then 'inside pop up
                pum.ID = (my - pum.y-4)/16
            else
                pum.sel = 0
                put (pum.x,pum.y),pum.scrSave,trans
            end if
        end if
    end if
    
    if mx>=pum.x and mx<pum.x+pum.w and my>=pum.y and my<pum.y+pum.h then 'inside pop up
        pum.ID2 = (my - pum.y-4)/16
        pum.ID = -1
        if mb=1 then
            pum.ID = pum.ID2
        end if
    else
        pum.ID2 = -1
        if mb=1 then
            pum.sel = 0
            put (pum.x,pum.y),pum.scrSave,trans
        end if
    end if

    update()
    
    sleep 2
        
Loop While Inkey = ""

[MrSwiss]

I would describe both BasicCoder's and MrSwiss's as unworkable examples of a pop up menu.

This section is clearly titled: Beginners, not advanced programming ...
Therefore, a beginner must be able to comprehend the code, leading to: as simple as possible!
(not only reading it but, also understanding, what it does, every used KeyWord)

Both make no attempt to replace the background they overwrite.

see above ...

In fact both examples completely erase the screen.

it's the simplest way ...
(I'm not willing to discuss this any further, since I consider, that you are missing the point, by miles!)

[sancho3]

Very nice BasicCoder. That is an excellent example of a pop up menu.

Its the fact that this is the beginners thread that makes it all the more important that example code be a jumping off point as opposed to code that must be discarded.

[Jawade]

I ve made a menu, it's just a begin without mouse. Press LMenu and arrows.

Code: Select all

Extern _CRT_glob Alias "_CRT_glob" As Integer
Dim Shared _CRT_glob As Integer = 0


#INCLUDE "windows.bi"


Dim Shared a As Integer
Dim Shared alt As Integer
Dim Shared alt1 As Integer
Dim Shared b As Integer
Dim Shared c As Integer
Dim Shared d As Integer
Dim Shared nav As Integer
Dim Shared slip As Integer
Dim Shared slo As Integer
Dim Shared ss As Integer
Dim Shared wij As Integer


Dim Shared aa As String
Dim Shared bb As String
Dim Shared cc As String
Dim Shared dd As String
Dim Shared mo(99) As String


  mo(&h10) = " Bestand "
  mo(&h20) = " Bewerken "
  mo(&h30) = " Opmaak "
  mo(&h40) = " Beeld "
  mo(&h50) = " Help "

  mo(&h11) = " Nieuw             "
  mo(&h12) = " Nieuw venster     "
  mo(&h13) = " Openen            "
  mo(&h14) = " Opslaan           "
  mo(&h15) = "-------------------"
  mo(&h16) = " Pagina-instelling "
  mo(&h17) = " Afdrukken         "
  mo(&h18) = "-------------------"
  mo(&h19) = " Afsluiten         "
  mo(&h1A) = "                   "


Main:
  ScreenRes 640, 480, 32: Width 80, 30
  slip = 0: slo = 0: wij = &h10
  Color 0, rgb(255, 255, 255): Cls
  Color rgb(0, 0, 0), rgb(222, 222, 222)
  Print String$(80, " ");:Locate 1, 1
  Print " Bestand  Bewerken  Opmaak  Beeld  Help"
  Do
    If slip = 0 Then
      Do
        aa = InKey$: Sleep 3 'oooooooooooooooooooooooooooooooooooo
        If MultiKey(56) <> 0 And MultiKey(62) <> 0 Then aa = "einde"
      Loop Until aa <> "" Or GetKeyState(VK_LMENU) < 0
      If MultiKey(56) <> 0 And MultiKey(29) = 0 Then
        If GetKeyState(VK_LMENU) < 0 Then
          alt = alt Xor 1
          If alt Then alt1 = 1 : nav = &h10 Else alt1 = 0
          Do
            If MultiKey(62) <> 0 Then aa = "einde": alt = alt Xor 1 ' Truuk voor Alt-F4.
          Loop Until GetKeyState(VK_LMENU) > -1 Or aa = "einde"
        End If
      End If
    End If
    ss = GetKeyState(VK_SHIFT)
    If alt1 Then
      Locate 1, 1: Color 0, rgb(200, 200, 200)
      Print mo(&h10);
      If aa = Chr$(255, 80) Then wij = wij + 1
      If aa = Chr$(255, 72) Then wij = wij - 1
      If aa = Chr$(255, 76) Then wij = wij - 1
      nav = 17
      Color 0, rgb(222, 222, 222)
      Do
        If slo = 0 Then slo = 1: Sleep
        Locate nav - 15, Int(nav / 16)
        If wij = nav Then Color 0, rgb(200, 200, 200)
        Print mo(nav); 
        nav = nav + 1
        If Left$(mo(wij+0), 3) = "---" And aa = Chr$(255, 80) Then
          wij = wij + 1
        End If
        If Left$(mo(wij-0), 3) = "---" And aa = Chr$(255, 72) Then
          wij = wij - 1
        End If
        Color 0, rgb(222, 222, 222)
      Loop Until Left$(mo(nav), 3) = "   "
      Locate nav - 15, Int(nav / 16): Print mo(nav);
    Else
      Locate 1, 1: Color 0, rgb(222, 222, 222)
      Print " Bestand ";
    End If
    If GetKeyState(VK_LMENU) < 0 Then
      alt1 = 0
      Color 0, &hFFFFFF
      Locate 2, 1: Print "                   ";
      Locate 3, 1: Print "                   ";
      Locate 4, 1: Print "                   ";
      Locate 5, 1: Print "                   ";
      Locate 6, 1: Print "                   ";
      Locate 7, 1: Print "                   ";
      Locate 8, 1: Print "                   ";
      Locate 9, 1: Print "                   ";
      Locate 10, 1: Print "                   ";
      Locate 11, 1: Print "                   ";
      slo = 0
    End If  
  Loop Until aa = Chr$(27)
System