Simple GUI

[BasicCoder2]

Was dodi2 the hexagon thing?

Yes. I was just curious to see if it did what I thought it would do, make a hexagon button.

[dodicat]

BasicCoder2.
Thanks for testing.

I am going to quit using type<...>(a,b,c ... e.t.c) when the udt contains a string parameter.

For you have to create two constructors, and, as you have reported, there is no guarantee it will work.
Anyway, a simple sub does the job.
Here are the hexagons again, scrapping all constructors.

Code: Select all

Screen 19,32
Type Point
    As Integer x,y
End Type

Type Hex extends Point
    As Point p(1 To 6)
    As Integer size
    As String caption
    As Single Vr
    As Uinteger col
                        
    private: Declare Function lineto(As Integer,As Integer,As Single,As Single) As Point
     public: Declare Sub Draw()
     public: declare sub NewHex(As Integer, _
                                As Integer, _
                                As Integer,_
                                As String,_
                                As Uinteger)
End Type

Function hex.lineto(x As Integer,y As Integer,a As Single,L As Single) As Point
    Return Type<Point>(x+L*Cos(a*.01745329),y-L*Sin(a*.01745329))
End Function

Sub hex.draw()
    For n As Integer =1 To 5
        Line(p(n).x,p(n).y)-(p(n+1).x,p(n+1).y),col
    Next n
    Line(p(6).x,p(6).y)-(p(1).x,p(1).y),col
    Paint (x,y),col,col
    var lc=Len(caption)
    ..draw String(x-lc*4,y-8),caption
    End Sub

sub hex.NewHex(_x As Integer, _
                _y As Integer, _
                _size As Integer, _
                _caption As String, _
                _col As Uinteger)
          x=_x:y=_y:size=_size:caption=_caption:col=_col 
          Dim As Integer ctr
          Vr=(size/2)/Tan(30*.01745329)
          For n As Integer=60 To 360 Step 60
              ctr+=1
              p(ctr)=lineto(x,y,n,size)
              Next n
                End sub
                
                
      Function inpolygon(p1() As Point,Byval p2 As Point) As Integer
    #macro IsLeft(L1,L2,p)
    -Sgn((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  IsLeft(p1(index),p1(nextindex),p2)>0 Then wn+=1
        Else
            If p1(nextindex).y<=p2.y Andalso IsLeft(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

    'SET UP A BUNDLE OF HEXAGONS:
                Redim As Hex hx(1 To 35)
                Dim As Integer sx=100,sy=100,k=1,sz=80
                For n As Integer=1 To 7
                    hx(n).NewHex(sx,sy,40,Str(n),Rgb(Rnd*255,Rnd*255,Rnd*255))
                    sx+=hx(n).size*1.5:sy+=k*hx(n).vr
                    k=-k
                Next n
                 For y As Integer=1 To 4
                For n As Integer=1 To 7
                    Print n+7*y
                    hx(n+7*y).NewHex(hx(n).x,hx(n).y+hx(n).vr*2*y,hx(n).size,Str(Val(hx(n).caption)+7*y),Rgb(Rnd*255,Rnd*255,Rnd*255))
                Next n
            Next y
            
  

Dim As Integer mx,my,button,flag
Dim As String msg
Do
    Getmouse mx,my,,button
    Screenlock
    Cls
    Draw String(10,10)," GONE " &msg
    For n As Integer=Lbound(hx) To Ubound(hx)
        hx(n).draw
        If button=1 and flag=0 Then
    If inpolygon(hx(n).p(),Type<Point>(mx,my)) and hx(n).col <> 0 Then msg=hx(n).caption:hx(n).col=0:flag=1
        End If
    Next n
    flag=button
    Screenunlock
    Sleep 1,1
    Loop Until Len(Inkey)
                    
              

[BasicCoder2]

@dodicat,

Command executed:
"C:\FreeBasic\fbc.exe" "C:\FreeBasic\myGuiDesigner\test.bas"

Compiler output:
C:\FreeBasic\myGuiDesigner\test.bas(20) error 168: Base UDT without default constructor; missing default constructor implementation in derived UDT, found 'End' in 'End Type'

[dodicat]

Basiccoder2.
I get this error if I use fb version 24.

I don't think fb 24 uses extends, so, surely this works:

Code: Select all

Screen 19,32
Type Point
    As Integer x,y
End Type

Type Hex 
    as integer x,y
    As Point p(1 To 6)
    As Integer size
    As String caption
    As Single Vr
    As Uinteger col
                        
    private: Declare Function lineto(As Integer,As Integer,As Single,As Single) As Point
     public: Declare Sub Draw()
     public: declare sub NewHex(As Integer, _
                                As Integer, _
                                As Integer,_
                                As String,_
                                As Uinteger)
End Type

Function hex.lineto(x As Integer,y As Integer,a As Single,L As Single) As Point
    Return Type<Point>(x+L*Cos(a*.01745329),y-L*Sin(a*.01745329))
End Function

Sub hex.draw()
    For n As Integer =1 To 5
        Line(p(n).x,p(n).y)-(p(n+1).x,p(n+1).y),col
    Next n
    Line(p(6).x,p(6).y)-(p(1).x,p(1).y),col
    Paint (x,y),col,col
    var lc=Len(caption)
    ..draw String(x-lc*4,y-8),caption
    End Sub

sub hex.NewHex(_x As Integer, _
                _y As Integer, _
                _size As Integer, _
                _caption As String, _
                _col As Uinteger)
          x=_x:y=_y:size=_size:caption=_caption:col=_col 
          Dim As Integer ctr
          Vr=(size/2)/Tan(30*.01745329)
          For n As Integer=60 To 360 Step 60
              ctr+=1
              p(ctr)=lineto(x,y,n,size)
              Next n
                End sub
                
                
      Function inpolygon(p1() As Point,Byval p2 As Point) As Integer
    #macro IsLeft(L1,L2,p)
    -Sgn((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  IsLeft(p1(index),p1(nextindex),p2)>0 Then wn+=1
        Else
            If p1(nextindex).y<=p2.y Andalso IsLeft(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

    'SET UP A BUNDLE OF HEXAGONS:
                Redim As Hex hx(1 To 35)
                Dim As Integer sx=100,sy=100,k=1,sz=80
                For n As Integer=1 To 7
                    hx(n).NewHex(sx,sy,40,Str(n),Rgb(Rnd*255,Rnd*255,Rnd*255))
                    sx+=hx(n).size*1.5:sy+=k*hx(n).vr
                    k=-k
                Next n
                 For y As Integer=1 To 4
                For n As Integer=1 To 7
                    Print n+7*y
                    hx(n+7*y).NewHex(hx(n).x,hx(n).y+hx(n).vr*2*y,hx(n).size,Str(Val(hx(n).caption)+7*y),Rgb(Rnd*255,Rnd*255,Rnd*255))
                Next n
            Next y
            
  

Dim As Integer mx,my,button,flag
Dim As String msg
Do
    Getmouse mx,my,,button
    Screenlock
    Cls
    Draw String(10,10)," GONE " &msg
    For n As Integer=Lbound(hx) To Ubound(hx)
        hx(n).draw
        If button=1 and flag=0 Then
    If inpolygon(hx(n).p(),Type<Point>(mx,my)) and hx(n).col <> 0 Then msg=hx(n).caption:hx(n).col=0:flag=1
        End If
    Next n
    flag=button
    Screenunlock
    Sleep 1,1
    Loop Until Len(Inkey)
                    
              

[fxm]

Bug corrected in fbc 1.00.0.

Extract of changelog.txt:
Version 1.00.0 (former 0.91.0):
[fixed]
- The compiler refused to generate an implicit default-constructor and copy-constructor for UDTs derived from a simple plain-old-data base UDT (that itself didn't have any constructors)

[BasicCoder2]

... surely this works:

It works!!

[dodicat]

Thanks fxm.
It works on fb24 if, as you say, the two constructors are made for the first udt.

Basiccoder2.
Have you a problem upgrading to fb 1.01 ?

[fxm]

It works on fb24 if, as you say, the two constructors are made for the first udt.

One constructor with two optionnel parameters is sufficient:
Declare Constructor (Byval As Integer = 0, Byval As Integer = 0)

[BasicCoder2]

Basiccoder2. Have you a problem upgrading to fb 1.01 ?

I thought I had updated to the latest (see a previous post) but apparently not.
I don't use the newer OOP features of FB as I haven't been motivated to learn them. I seem to be able to do what I want without them. Thus it has never been an issue except when trying to compile and run someone else's code.

[BasicCoder2]

This is a version of dodicat's hexButtons program using a different method for comparison.
It is a generic button with the image of a hexagon. The button only reacts if the pixel isn't transparent.

Code: Select all

screenres 640,480,32

const arrayW = 7   'width of array of hex buttons
const arrayH = 5

dim shared as integer mx,my,mb
dim shared as integer lastOne    'last button pressed

dim as uinteger r,g,b

type hexBUTTON
    as integer x
    as integer y
    as integer w
    as integer h
    as integer a    'active?
    as any ptr img
end type

dim shared as hexBUTTON hexButtons(arrayW-1,arrayH-1) 'create array of hex buttons

'generate images and locations
dim as integer flag
flag = 1
for j as integer = 0 to arrayH-1
    for i as integer = 0 to arrayW-1
        r = int(rnd(1)*256):g = int(rnd(1)*256):b = int(rnd(1)*256)
        hexButtons(i,j).img = imagecreate(80,70,rgb(255,0,255))
        line hexButtons(i,j).img,(20,0)-(0,35),rgb(r,g,b)
        line hexButtons(i,j).img,(0,35)-(20,69),rgb(r,g,b)
        line hexButtons(i,j).img,(20,69)-(60,69),rgb(r,g,b)
        line hexButtons(i,j).img,(60,69)-(79,35),rgb(r,g,b)
        line hexButtons(i,j).img,(79,35)-(60,0),rgb(r,g,b)
        line hexButtons(i,j).img,(60,0)-(20,0),rgb(r,g,b)
        paint hexButtons(i,j).img,(40,35),rgb(r,g,b),rgb(r,g,b)
        draw string hexButtons(i,j).img,(36,32),str(j*arrayW+i)
        if flag = 1 then
            hexButtons(i,j).x = i*60+50
            hexButtons(i,j).y = j*70+50
        else
            hexButtons(i,j).x = i*60+50
            hexButtons(i,j).y = j*70+35+50
        end if
        hexButtons(i,j).w = 80
        hexButtons(i,j).h = 70
        flag = -flag
        hexButtons(i,j).a = 1   'turn on button
    next i
    flag = -flag
next j

'display buttons
sub displayButtons()
    screenlock()
    cls
    for j as integer = 0 to arrayH-1
        for i as integer = 0 to arrayW-1
            if hexButtons(i,j).a = 1 then
                put (hexButtons(i,j).x,hexButtons(i,j).y),hexButtons(i,j).img,trans
            end if
        next i
    next j
    locate 2,2
    print "GONE ";lastOne
    screenunlock()
   sleep 2
end sub

do
    displayButtons()
    getmouse mx,my,,mb
    if mb = 1 then
        'any button pressed?
        for j as integer = 0 to arrayH-1
            for i as integer = 0 to arrayW-1
                if mx>hexButtons(i,j).x and mx<hexButtons(i,j).x + hexButtons(i,j).w then
                    if my>hexButtons(i,j).y and my<hexButtons(i,j).y+hexButtons(i,j).h then
                        if point (mx-hexButtons(i,j).x,my-hexButtons(i,j).y,hexButtons(i,j).img)<>rgb(255,0,255) then
                            hexButtons(i,j).a = 0  'deactivate
                            lastOne = j*arrayW+i
                        end if
                    end if
                end if
            next i
        next j
        
        while mb=1
            getmouse mx,my,,mb
        wend
    end if

loop until multikey(&H01)

[Coolman]

This code compiles fine with FreeBasic 1.00 and 1.01 but a crash execution. no problem with the 0.24 version of FreeBasic ...

[dodicat]

Yes,
dim shared as hexBUTTON hexButtons(5,5) 'create array of hex buttons ... Better to make this array (6,6) to accommodate the given values.

[fxm]

dim shared as hexBUTTON hexButtons(arrayW-1,arrayH-1) 'create array of hex buttons

[Coolman]

I confirm. it corrects the problem ...

[BasicCoder2]

Sorry for some reason (FB version used?) the program ran for me and it should not have.
I started with a 5x5 array using actual numbers and then decided to replace them with constant values set at the start of the program but missed a line.