Simple GUI

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Simple GUI

Post by Lothar Schirm »

I was so much inspired by the examples of dodicat and BasicCoder2 in "Beginners" http://www.freebasic.net/forum/viewtopi ... 6&start=15 that I tried to write a simple GUI with FreeBasic only (no WinAPI, no libraries) in a modular way so that the main program can be very short. This is the first result - comments are in german, but I think the code is understandable:

Program for adding two numbers:

Code: Select all

#Include "GUI.bas"

'Globale Variablen für Buttons und Textboxen:
Dim Shared As Button Button_Add, Button_Close
Dim Shared As TextBox Text_a, Text_b, Text_result

Dim As Single a, b, result


Sub OpenWindow_Main()
' Fenster

	Dim As Label Label_a, Label_b, Label_result
	
	OpenWindow								(220, 200, "Add two numbers")
	Label_a = Label_New				(20, 20, 60, 20, "a:")
	Label_b = Label_New				(20, 50, 60, 20, "b:")
	Button_Add = Button_New		(100, 80, 80, 20, "Add")
	Label_result = Label_New	(20, 110, 60, 20, "a + b:")
	Text_a = TextBox_New			(100, 20, 80, 20, "0")
	Text_b = TextBox_New			(100, 50, 80, 20, "0")
	Text_result = TextBox_New	(100, 110, 80, 20, "0")
	Button_Close = Button_New	(150, 170, 60, 20, "Close")
	
End Sub


Sub Add(a As Single, b As Single)
'Werte a und b auslesen, addieren, Resultat anzeigen

	Dim As Single result
	
	a = Val(TextBox_GetText(Text_a))
	b = Val(TextBox_GetText(Text_b))
	result = a + b
	TextBox_SetText(Text_result, Str(result))

End Sub


'Hauptprogramm:

OpenWindow_Main()

Do
	If TextBox_Event(Text_a) Then TextBox_Edit(Text_a)
	If TextBox_Event(Text_b) Then TextBox_Edit(Text_b)
	If Button_Event(Button_Add) Then Add(a, b)
Loop Until Button_Event(Button_Close) Or Window_Event_Close

End
GUI.bas:

Code: Select all

'===============================================================================
' GUI.bas
' GUI für den FB-Grafikbildschirm, Farbtiefe 32 Bit, 8x16 Zeichensatz
' Erstellt am 09.01.2015
'===============================================================================

Type Label
  x As Integer		'Position links oben	
	y As Integer
	w As Integer		'Höhe
	h As Integer		'Breite
	text As String	'Beschriftung
End Type

Type TextBox
  x As Integer		'Position links oben	
	y As Integer
	w As Integer		'Höhe
	h As Integer		'Breite
	text As String	'Beschriftung	
End Type

Type Button
  x As Integer		'Position links oben	
	y As Integer
	w As Integer		'Höhe
	h As Integer		'Breite
	text As String	'Beschriftung
End Type


Sub OpenWindow(w As Integer, h As Integer, title As String)
'Fenster weiss, Textfarbe schwarz, 8x16 Zeichensatz

  Screenres(w, h, 32)
  Windowtitle title
  Width w \ 8, h \ 16
  Color &h000000, &hFFFFFF
  Cls 0

End Sub


Function Window_Event_Close() As Integer
'Prüft, ob das "Schließen" - Kreuz des Fensters geklickt wurde

	If Inkey = Chr(255, 107) Then Return 1 Else Return 0
	
End Function


Function Label_New(x As Integer, y As Integer, w As Integer, h As Integer, _
										text As String) As Label
'Neuen Label definieren und zeichnen

	Dim As Label lbl 
	
	'Label zeichnen:
	Draw String (x, y + 0.5 * (h - 16)), text

	'Label definieren:
  lbl.x = x
  lbl.y = y
  lbl.h = h
  lbl.w = w
  lbl.text = text
		
  Return lbl
  
 End Function
 
 
Function TextBox_New(x As Integer, y As Integer, w As Integer, h As Integer, _
											text As String) As TextBox
'Neue TextBox definieren und zeichnen

	Dim As TextBox tb
	
	'Textbox zeichnen:
	Line (x, y) - (x + w, y + h),, B
	Draw String (x, y + 0.5 * (h - 16)), Left(text, w / 8 - 1) 

	'Textbox definieren:
  tb.x = x
  tb.y = y
  tb.h = h
  tb.w = w
  tb.text = text
		
  Return tb
  
End Function


Sub TextBox_SetText(ByRef tb As TextBox, text As String)
'alten Text löschen, neuen Text reinsetzen

	Line (tb.x + 1, tb.y + 1) - (tb.x + tb.w - 2, tb.y + tb.h - 2), &hFFFFFF, BF
	Draw String (tb.x, tb.y + 0.5 * (tb.h - 16)), Left(text, tb.w / 8 - 1)
	tb.text = text 

End Sub


Function TextBox_GetText(tb As Textbox) As String
'Text aus der Textbox auslesen

	Return tb.text
	
End Function


Sub TextBox_Edit(ByRef tb As Textbox)
'Text in der Textbox editieren

	Dim As String s, keystr
	Dim As Integer key, ExitFlag = 0, mx, my, mb 
	
	s = TextBox_GetText(tb)
			
	Do
		ScreenLock
		TextBox_SetText(tb, s + "_")	'Cursor am Ende
		ScreenUnlock
		keystr = inkey
		If Len(keystr) = 1 Then key = Asc(keystr) Else key = 0
		GetMouse mx, my,,mb
		Select Case key
			Case 13	'Enter
				ExitFlag = 1
			Case 8	'Backspace
				s = RTrim(TextBox_GetText(tb), "_")
				If Len(s) > 0 Then s = Left(s, Len(s) - 1)
			Case 32 To 255
				If Len(s) < tb.w / 8 - 2 Then 
					s = RTrim(TextBox_GetText(tb), "_")
				  s = s + Chr(key)
				End If
		End Select
	Loop Until ExitFlag = 1 Or mb = 1
	
	TextBox_SetText(tb, s)
	
End Sub 
	

Sub Button_Draw(btn As Button, colour As UInteger)
'Button zeichnen - Hilfsprozedur

	Dim As Integer TextW, TextH
	
	'zeichnen:
	Line (btn.x, btn.y) - (btn.x + btn.w, btn.y + btn.h), colour, B
	TextW = 8 * Len(btn.text)
	TextH = 16
	Draw String (btn.x + 0.5 * (btn.w - TextW), btn.y + 0.5 * (btn.h - TextH)), _
								btn.text, colour

	Color &h000000
	
End Sub
	

Function Button_New(x As Integer, y As Integer, w As Integer, h As Integer, _
										Text As String) As Button
'Neuen Button definieren und zeichnen

	Dim As Button btn
	
	'Button definieren:
  btn.x = x
  btn.y = y
  btn.h = h
  btn.w = w
  btn.text = text
		
	Button_Draw(btn, &h000000) 
	
  Return btn
	
End Function


Function TextBox_Event(tb As TextBox) As Integer
'Prüft, ob die Textbox mit der maus geklickt wurde

	Dim As Integer mx, my, mbtn
    
  Getmouse(mx, my,, mbtn)
  
  If (mx >= tb.x) And (mx <= tb.x + tb.w) And (my >= tb.y) And (my <= tb.y + tb.h) _
		And mbtn = 1 Then
		Do
			Getmouse(mx, my,, mbtn)
		Loop Until mbtn = 0
		Return 1
	Else
		Return 0
	End if
	
End Function


Function Button_Event(btn As Button) As Integer
'Prüft, ob der Button geklickt wurde

	Dim As Integer mx, my, mbtn
    
  Getmouse(mx, my,, mbtn)
  
	If (mx >= btn.x) And (mx <= btn.x + btn.w) And (my >= btn.y) And (my <= btn.y + btn.h) _
		And mbtn = 1 Then
		Button_Draw(btn, &hFF0000)	'aktiven Zustand des Button zeichnen (rot)
		'Warten, bis Maustaste losgelassen wurde:
		Do
			Getmouse(mx, my,, mbtn)
		Loop Until mbtn = 0
		Button_Draw(btn, &h000000)	'inaktiven Zustand des Button zeichnen (schwarz)
		Return 1
	Else
		Return 0
	End if
	
End Function
Perhaps somebody can use it.

Edit Jan 23, 2015: The project is now at http://www.freebasic-portal.de/download ... i-356.html

Latest Update: November 28, 2016
Last edited by Lothar Schirm on Nov 28, 2016 17:18, edited 12 times in total.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

@Lothar Schirm,

I like it very much. Full marks. Nice clean simple easy to read code. Something I can learn from.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple GUI

Post by dodicat »

I agree with BasicCoder2.
Very clear code.

I have altered my own edit box a little.

Right/left arrow keys move the cursor.
As before, <esc> clears the line, <backspace> deletes the character before the cursor.

Simulates the Win api edit (nearly)

Added a framerate regulator to steady the cursor blink rate.

Code: Select all

Screenres 400,600,32
Color ,Rgb(236,233,216)
Width 400\8,600\16   'enlarge the font

Windowtitle "CALCULATE"
Dim As Integer numboxes=7
Dim Shared As String t(1 To 2),j(1 To numboxes)
Dim Shared As Integer k(1 To 2) 'cursor position tally
Type box
    As Integer x,y,w,h
    As Uinteger col
    As Zstring Ptr s
End Type

Function inbox(x As Integer,y As Integer,b As box) As Integer
    Return x>b.x And x<(b.x+b.w) And y>b.y And y<(b.y+b.h)
End Function

Sub drawbox(b As box,f As Integer=0)
    Line(b.x,b.y)-(b.x+b.w,b.y+b.h),b.col,bf
    Line(b.x,b.y)-(b.x+b.w,b.y+b.h),b.col/2,b
    If f Then Line(b.x-1,b.y-1)-(b.x+b.w+1,b.y+b.h+1),b.col/2,b
    Draw String(b.x+2,b.y+8),*b.s,Rgb(0,0,0)
End Sub

Sub insert(s As String,p As Integer, c As String)
    s=Mid(s,1,p-1)+c+Mid(s,p)
End Sub

Sub remove(s As String,p As Integer)
    s=Mid(s,1,p-1)+Mid(s,p+1)
End Sub

Sub _input(i As String,x As Integer,y As Integer,st As String,message As String,clr As Uinteger=Rgb(0,0,0),flag As Integer=1)
    Static As Integer count,gap=30
    Static As String blink
    count=count+1 Mod 100
    If Left(i,1)=Chr(08) Then  If k(flag)=0 Then j(flag)=Mid(j(flag),1,Len(j(flag))-1)
    Select Case Left(i,1)
    Case Chr(0) To Chr(254)
        If Left(i,1)<>Chr(08) Then
            If k(flag)=0 Then j(flag)=j(flag)+Left(i,1)
        End If
    End Select
    If count Mod gap=0 Then blink=" "
    If count Mod 2*gap=0 Then blink="_"
    If Left$(i,1)=Chr(27)   Then j(flag)="":k(flag)=0
    Dim As Integer s=-Len(j(flag))*8
    If i=Chr(256) +"K" Then If k(flag)>s Then k(flag)-=8
    If i=Chr(256) +"M" Then If k(flag) Then k(flag)+=8
    var l=Len(j(flag))+k(flag)\8 +1
    If k(flag) And i<>Chr(256) +"K"  And i<>Chr(256) +"M" Then
        If Left(i,1)<>Chr(8) and Left(i,1)<>Chr(27) Then insert(j(flag),l,Left(i,1)) Else if (l-1) then remove(j(flag),l-1)
    End If
    message=Mid(j(flag),1,25)
    Draw String(x+2,y+8),st & message,clr
    var Ln=Len(message)+Len(st)
    Draw String(x+2+k(flag)+8*Ln,y+8), blink,clr
End Sub

 Function Regulate(Byval MyFps As Integer,Byref fps As Integer) As Integer
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
                     'x  y   w  h     col           caption(s)
var Input1=Type<box>(50,80,200,30,Rgb(255,255,255),@"")
var Input2=Type<box>(50,280,200,30,Rgb(255,255,255),@"")
var answer=Type<box>(50,480,200,30,Rgb(236,233,216),@" ")
var add=   Type<box>(50,380,50,30,Rgb(200,200,200),@" A+B")
var minus= Type<box>(110,380,50,30,Rgb(200,200,200),@" A-B")
var prod=  Type<box>(170,380,50,30,Rgb(200,200,200),@" A*B")
var divide=Type<box>(230,380,50,30,Rgb(200,200,200),@" A/B")

Dim As Integer mx,my,mb,In1,In2,clkadd,clkminus,clkmult,clkdiv
Dim As Double sumf,difff,prodf,divf
Dim As Integer Flag,fps
Dim As String i

Do
    i=Inkey
    If i=Chr(256)+"k" Then End   'click the window close
    Getmouse mx,my,,mb
    Screenlock
    Cls
    'draw all the boxes
    drawbox(Input1):drawbox(Input2):drawbox(answer):drawbox(add):drawbox(minus)
    drawbox(prod):drawbox(divide)
    
    If mb=1  Then 'button down
        In1=inbox(mx,my,Input1) :In2=inbox(mx,my,Input2):clkadd= inbox(mx,my,add):clkminus=inbox(mx,my,minus)
        clkmult=inbox(mx,my,prod):clkdiv=inbox(mx,my,divide)
    End If
    'edits
    If In1 Then _input(i,Input1.x,Input1.y,"",t(1),,1):Input1.s=@t(1)[0]
    If In2 Then _input(i,Input2.x,Input2.y,"",t(2),,2):Input2.s=@t(2)[0]
    
    If In1 Or In2 Then
        'calculations
        sumf=(Val(*Input2.s)+Val(*Input1.s)):difff=(Val(*Input1.s)-Val(*Input2.s))
        prodf=(Val(*Input2.s)*Val(*Input1.s)):divf=(Val(*Input1.s)/Val(*Input2.s))
    End If
    'answer
    Draw String(answer.x,answer.y-16),"Answer:",Rgb(0,0,0)
    Draw String(Input1.x-30,Input1.y+8),"A = ",Rgb(0,0,0)
    Draw String(Input2.x-30,Input2.y+8),"B = ",Rgb(0,0,0)
    
    'click arithmetic operator
    If clkadd   Then Draw String(answer.x+2,answer.y+8),"" &sumf,Rgb(0,0,0):drawbox(add,1):flag=1  'highlight
    If clkminus Then Draw String(answer.x+2,answer.y+8),"" &difff,Rgb(0,0,0):drawbox(minus,1):flag=1
    If clkmult  Then Draw String(answer.x+2,answer.y+8),"" &prodf,Rgb(0,0,0):drawbox(prod,1):flag=1
    If clkdiv   Then Draw String(answer.x+2,answer.y+8),"" &divf,Rgb(0,0,0):drawbox(divide,1):flag=1
    
    If flag Then   For n As Integer=Lbound(k) To Ubound(k):k(n)=0:Next n:flag=0'reset the cursor
    
    Screenunlock
    Sleep regulate(60,fps),1
    Loop   
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Simple GUI

Post by Lothar Schirm »

Thank you both! Dodicat, your edit box is very luxury. I want to keep it rather simple, but I have an edit routine for the console which supports not only the backspace key, perhaps I will integrate it into my textbox editor. I want also to add a listbox, perhaps a data grid and a multiline textbox.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

Although the text boxes in the examples are only used to enter numbers you will find my text box has scrolling so text can be longer than the actual width of the text box. Another useful feature I would add is being able to use the TAB key to automatically exit the current text box and move onto the next one.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple GUI

Post by dodicat »

For your perusal (optional of course), here is a simplified Win Api of my previous code.

Code: Select all

#include "windows.bi"
freeconsole
Declare Sub OPERATE(flag As Integer)
Dim Shared As hwnd B1,B2,answer 'used in sub
Const MainWindow ="#32770"
Dim As MSG msg
'The window and boxes
Var hWnd= CreateWindowEx( 0,MainWindow, "CALCULATE", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 200, 200, 400, 600, 0, 0, 0, 0 )
B1      = CreateWindowEx( 0, "EDIT", "", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or ES_AUTOHSCROLL  , 50, 80, 200, 45, hWnd, 0, 0, 0 )
B2      = CreateWindowEx( 0, "EDIT", "", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or ES_AUTOHSCROLL , 50, 280, 200, 45, hWnd, 0, 0, 0 )
answer  = CreateWindowEx( 0, "EDIT", "", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or ES_AUTOHSCROLL  Or ES_READONLY, 50, 480, 200, 45, hWnd, 0, 0, 0 )
Var label    =CreateWindowEx( 0, "STATIC", "ANSWER:",WS_VISIBLE Or WS_CHILD , 20, 450, 70, 30, hWnd, 0, 0, 0 )
Var ADDBUTTON= CreateWindowEx( 0,"BUTTON", "A+B", WS_VISIBLE Or WS_CHILD, 50,380 , 50, 30, hWnd, 0, 0, 0 )
Var minus    = CreateWindowEx( 0,"BUTTON", "A-B", WS_VISIBLE Or WS_CHILD, 110,380 , 50, 30, hWnd, 0, 0, 0 )
Var prod     = CreateWindowEx( 0,"BUTTON", "A*B", WS_VISIBLE Or WS_CHILD, 170,380 , 50, 30, hWnd, 0, 0, 0 )
Var divide   = CreateWindowEx( 0,"BUTTON", "A/B", WS_VISIBLE Or WS_CHILD, 230,380 , 50, 30, hWnd, 0, 0, 0 )
Var lblA     =CreateWindowEx( 0, "STATIC", "A = ",WS_VISIBLE Or WS_CHILD , 15, 85, 30, 30, hWnd, 0, 0, 0 )
Var lblB     =CreateWindowEx( 0, "STATIC", "B = ",WS_VISIBLE Or WS_CHILD , 15, 285, 30, 30, hWnd, 0, 0, 0 )
'loop
While GetMessage( @msg, 0, 0, 0 )
    TranslateMessage( @msg )
    DispatchMessage( @msg )
    Select Case msg.hwnd
    Case hWnd
        Select Case msg.message
        Case 273
            End
        End Select
        '__________________  
    Case AddButton
        Select Case msg.message  
        Case WM_LBUTTONDOWN
            OPERATE(1)'ADDUP
        End Select
        '____________________   
    Case minus
        Select Case msg.message  
        Case WM_LBUTTONDOWN
            OPERATE(2)'SUBTRACT
        End Select
        '______________________  
    Case prod
        Select Case msg.message  
        Case WM_LBUTTONDOWN
            OPERATE(3)' MULTIPLY
        End Select 
        '_______________________
    Case divide
        Select Case msg.message  
        Case WM_LBUTTONDOWN
            OPERATE(4)'DIVIDE
        End Select 
    End Select
Wend

Sub OPERATE(flag As Integer)
    Dim As String outtext1,outtext2,result
    Dim As Integer charcount1,charcount2
    charcount1 = GetWindowTextLength(B1)
    charcount2 = GetWindowTextLength(B2)
    outtext1 = String(charcount1," ")
    outtext2 = String(charcount2," ")
    GetWindowText(B1,outtext1,charcount1+1)
    GetWindowText(B2,outtext2,charcount2+1)
    Select Case As Const flag
    Case 1:result= Str(Val(outtext1)+Val(outtext2))
    Case 2:result= Str(Val(outtext1)-Val(outtext2))
    Case 3:result= Str(Val(outtext1)*Val(outtext2))
    Case 4:result= Str(Val(outtext1)/Val(outtext2))
    End Select
    setWindowText(answer,result)
End Sub

 
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Simple GUI

Post by Lothar Schirm »

Scrolling text in the textbox and using the TAB key is something I want to implement. WinAPI is not my favourite, I want to see what I can do with FreeBasic alone by myself with a small GUI library. WinAPI is too cryptical for me.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

Lothar Schirm wrote:Scrolling text in the textbox and using the TAB key is something I want to implement.

In the past adding some simple roll your own buttons etc has been sufficient for the few FreeBasic projects I have played around with but I have sometimes thought about placing them in a GUI library so I would be interested in your efforts as a comparison. The key I think is for the creation of such items in the main program to be as intuitive and consistent as possible.

It also seems to me that this project lends itself well to being written as a simple OOP tutorial?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

dodicat wrote:For your perusal (optional of course), here is a simplified Win Api of my previous code.
Yes a very nice example. I dabbled with the winAPI but it really requires a deep understanding to use properly. I would rather use a higher level language that encapsulates all that complexity into a few high level commands. DirectX is another example. I would rather some expert embody all that as well into fast graphic routines.
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: Simple GUI

Post by Lothar Schirm »

BasicCoder2 wrote:In the past adding some simple roll your own buttons etc has been sufficient for the few FreeBasic projects I have played around with but I have sometimes thought about placing them in a GUI library so I would be interested in your efforts as a comparison. The key I think is for the creation of such items in the main program to be as intuitive and consistent as possible.

It also seems to me that this project lends itself well to being written as a simple OOP tutorial?
BasicCoder2, I thank you very much for your interest. I do not want to invest very much more time, I just found it interesting to learn how to write a simple event driven GUI with a few elements with FreeBasic alone for small applications. My textbox editor works now in the same way as yours, I have taken the code from my existing TUI for the console window. Perhaps I will still add a simple listbox and listview or data grid and then upload the code to the FreeBasic Portal http://www.freebasic-portal.de/. I will inform you here when it is ready. But for more complex programs, I still prefer to use FLTK or FireFly.

What do you mean by "a simple OOP tutorial"? I use UDTs (as you do), but I am not an expert for OOP, and I did not yet use all the FreeBasic OOP features. I like procedural programming as I learned it 25 years ago with QuickBasic and Turbo Pascal, so I feel I am not able to write an OOP tutorial.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

Lothar Schirm wrote:... I do not want to invest very much more time, ... I still prefer to use FLTK or FireFly.
ok.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple GUI

Post by dodicat »

I downloaded and tried FLTK.
OK.

If you roll out your own GUI as you go along, you have options galore really.
For example, buttons don't need to be rectangles.

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
    Declare Constructor
    Declare Constructor(As Integer, _
                        As Integer, _
                        As Integer,_
                        As String,_
                        As Uinteger)
                        
    private: Declare Function lineto(As Integer,As Integer,As Single,As Single) As Point
     public: Declare Sub Draw()
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
Constructor Hex:End Constructor

Constructor Hex(_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 Constructor
                
                
      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)=Type<Hex>(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)=Type<Hex>(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
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

dodicat wrote:If you roll out your own GUI as you go along, you have options galore really.
For example, buttons don't need to be rectangles.
In practice I have never felt the need to spend time trying to learn to use some included GUI library instead of simply rolling my own to give any of my FreeBasic projects a GUI interface. From the user point of view there isn't any difference. If I wanted a hexagon button I would still use a rectangle but have active and inactive (transparent) areas within the rectangle. It would simply be a sprite no complex math involved.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple GUI

Post by BasicCoder2 »

dodicat wrote:I downloaded and tried FLTK.
OK.If you roll out your own GUI as you go along, you have options galore really.
For example, buttons don't need to be rectangles.
Although I extracted the latest FB from,
http://www.freebasic-portal.de/download ... uilds.html
over the old FB I am unable to get example working:

Command executed:
"C:\FreeBasic\fbc.exe" "C:\FreeBasic\myGUI\dodi2.bas"

Compiler output:
C:\FreeBasic\myGUI\dodi2.bas(21) error 169: Base UDT without default constructor; missing copy constructor implementation in derived UDT, found 'End' in 'End Type'

Results:
Compilation failed

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 0.24.0 (07-30-2012) for win32
OS: Windows NT 6.1 (build 7601, Service Pack 1)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple GUI

Post by dodicat »

I got iFLTK here:
(If you want to try it)
http://www.freebasic.net/forum/viewtopi ... 14&t=21548

And one of D.J.Peter's examples:

Code: Select all

#include once "fltk-c.bi"

sub InputCB cdecl (byval self as FL_WIDGET ptr,byval arg as any ptr)
  dim as Fl_Input ptr ptr in = arg
  dim as double a = val(*Fl_Input_GetValue(in[0]))
  dim as double b = val(*Fl_Input_GetValue(in[1]))
  Fl_Input_SetValue  in[2], str(a+b)
end sub
'
' main
'
var win  = Fl_WindowNew(250,100,"add")
dim as any ptr in(...) = {Fl_Float_InputNew(40, 10, 200, 20,"a"), _
                          Fl_Float_InputNew(40, 40, 200, 20,"b"), _
                          Fl_Float_InputNew(40, 70, 200, 20,"a+b=") }
Fl_WidgetSetCallbackArg in(0),@InputCB,@in(0)
Fl_WidgetSetCallbackArg in(1),@InputCB,@in(0)
Fl_Input_SetReadonly    in(2),1
Fl_WindowShow win
Fl_Run 
I just pasted this code in the \fltk-c-1.3.3 folder, and called it ZZDJPETERS.BAS in order to set it last alphabetically, so I can recognise it again.

Can you not get the compiler 1.01 from the downloads page on this site?

Remember also that last night, that the code blocks here were being altered, the < and > characters did not register.

But I made the constructor as you can see from the code.
Was dodi2 the hexagon thing?

My code snippet before that used zstring ptr for the box caption, so I could use type<~~~>(,,,).
But upon reflection that was a bad idea at the time.
Better to call a string a string I think.
Post Reply