About the only other code I require is for selecting and loading , saving , files .
This may also run faster than other GUI constructs and use less resources.
The while ... wend loop really requires a timer to occasionally check for mouse activity ; there's an example of this on the web for game construction .
The bmp icons for the buttons were constructed using a Bacon utility Tex to SVG/png generator ; quite useful .
The bmp icons are 100 x 40 , 16 bit colour ; with vertical gradients .
Can't figure out how to attach or insert to post from my computer the icons , might upload somewhere else first ; wonder if google drive is still available .
Code: Select all
'
' (c) Copyright 2019
'
'
' sciwiseg@gmail.com
'
' Dependent upon various FreeBASIC examples , from the documentation .
'
' Mouse routine 2
'
' Note Inkey$ is deprecated , use Inkey instead .
'
Const LEFTBUTTON = 1
Const MIDDLEBUTTON = 4 ' UNUSED IN THIS DEMO
Const RIGHTBUTTON = 2 ' UNUSED IN THIS DEMO
Const SHOWMOUSE = 1
Const HIDEMOUSE = 0
'
Dim CurrentX As Integer
Dim CurrentY As Integer
Dim MouseButtons As Integer
Dim CanExit As Integer
'
' ----------------------------------------------------------
'
declare sub pxy1()
declare sub ms3()
declare sub plot2d()
'
' ---------------------------------------------------------
'
'' A function that creates an image buffer with the same
'' dimensions as a BMP image, and loads a file into it.
Const NULL As Any Ptr = 0
declare Function bmp_load( ByRef filename As Const String ) As Any Ptr
dim As Any Ptr img1
'
' ----------------------------------------------------------------------
'
'Screen 12,24
'ScreenRes 640, 480, 32 ' screen 12 dimensions .
screen 18,16' screen 12 dimensions .
'window (-1,-1)-(1,1)
'view(118,0)-(679,479)
'line(-1,-1)-(1,1),11,b
'line(118,0)-(679,479),rgb(12,120,120),b
SetMouse 1, 1, SHOWMOUSE
CanExit = 1
'pxy1
ms3
'window (-1,-1)-(1,1)
'view(118,0)-(679,479)
'line(-1,-1)-(1,1),11,b
sleep 100
'
'
end
'
' ======================================================================
'
' Button location and colour .
'
'
bxd:
data 10,110
data 10,110
data 10,110
byd:
data 10,50
data 60,100
data 110,150
bcd:
data 2,2,1,1,4,4
'
' ----------------------------------------------------------------
'
sub pxy1
'
' Draw boundaries for graph .
'
static as integer w , h
static as integer depth
static as string driver_name
'Screen 15, 32
' Obtain info about current mode
ScreenInfo w, h, depth,,,,driver_name
'Print Str(w) + "x" + Str(h) + "x" + Str(depth);
'Print " using " + driver_name + " driver"
'Sleep
' Quit graphics mode and obtain info about desktop
'Screen 0
'ScreenInfo w, h, depth
Print "Desktop running at " + Str(w) + "x" + Str(h) + "x" + Str(depth);
line (118,0)-(w-1,h-1),11,b
line (0,0)-(w-1,h-1),11,b'
' draw graph ?
'sleep
'
'
end sub
'
' ----------------------------------------------------------------
'
'
' ----------------------------------------------------------------
'
sub ms3
'
' Draw buttons using data and select using array values .
'
'
static as integer CurrentX , CurrentY , MouseButtons
'
static as single x1,x2,y1,y2
static as integer colour,colorxy
static as integer i,j,k,n
static As Any Ptr img1 , img2
'
' Read data .
'
n=5
dim as single bxyc(0 to n,0 to 2)
restore bxd
for i=0 to n
read bxyc(i,0)
next i
restore byd
for i=0 to n
read bxyc(i,1)
next i
restore bcd
for i=0 to n
read bxyc(i,2)
next i
'
'
'cls
'
'
' Dedicated routine for this .
'
'color 15,2
'locate 2,7
'print "Run"
'
img1 = bmp_load( "run.bmp" )
If img1 = NULL Then
Print "bmp_load failed"
Else
Put (10, 10), img1
ImageDestroy( img1 )
End If
img2 = bmp_load( "draw.bmp" )
If img2 = NULL Then
Print "bmp_load failed"
Else
Put (10, 60), img2
ImageDestroy( img2 )
End If
img2 = bmp_load( "exit.bmp" )
If img2 = NULL Then
Print "bmp_load failed"
Else
Put (10, 110), img2
ImageDestroy( img2 )
End If
for i=0 to n step 2
x1=bxyc(i,0)
x2=bxyc(i+1,0)
y1=bxyc(i,1)
y2=bxyc(i+1,1)
colour = bxyc(i,2)
colour=rgb(colour,12,12)
'
'line (x1,y1)-(x2,y2),7,bf
' line (x1,y1)-(x2,y2),15,b
' line (x1+4,y1+4)-(x2-4,y2-4),colour,bf
' line (x1+4,y1+4)-(x2-4,y2-4),rgb(150,150,150),b
line (x1,y1)-(x2,y2),rgb(150,150,150),b
'
next i
'color 15,1
'locate 6,7
'print "Draw"
'color 15,4
'locate 9,7
'print "Exit"
'
' Select button .
'
MouseButtons = 0
k=0
while ( Inkey = "" )
GetMouse CurrentX, CurrentY, , MouseButtons
If MouseButtons And LEFTBUTTON Then
colour = Point(CurrentX,CurrentY)
for i = 0 to n step 2
'
k = 0
x1 = bxyc(i,0)
x2 = bxyc(i+1,0)
y1 = bxyc(i,1)
y2 = bxyc(i+1,1)
colorxy = bxyc(i,2)
' If CurrentY > y1+4 and CurrentY < y2 -4 and CurrentX > x1+4 and CurrentX < x2 - 4 and colour = colorxy then
If CurrentY > y1+4 and CurrentY < y2 -4 and CurrentX > x1+4 and CurrentX < x2 - 4 then
'color colorxy
color rgb(180,18,240)
Locate 23,4
j=int(i/2)
select case j
case 0:
print " Run "
case 1:
print " Draw "
window (-1,-1)-(1,1)
view(118,0)-(679,479)
plot2d
sleep 120
' Return to native resolution .
window
view
case 2:
print " Exit "
k=1
exit for
case else
end select
End If
'
next i
'
if k=1 then exit while
End If
wend
'
if k=1 then
color rgb(200,120,60)
Locate 24,4
print " Done "
end if
'
sleep 400
'
end sub
'
' ---------------------------------------------------------------------
'
sub plot2d
'
'
'
static as single x,y,yp,dx
static as integer colour
'
colour = rgb(240,240,240)
line(-1,-1)-(1,1),colour,b
line(0,-1)-(0,1),colour
line(-1,0)-(1,0),colour
colour = rgb(12,120,200)
dx =2/600
for x=-1 to 1 - dx step dx
y=sin(x*6.28)
yp =sin((x+dx)*6.28)
line (x,y)-(x+dx,yp),colour
next x
'
colour = rgb(240,240,240)
line(-1,-1)-(1,1),colour,b
line(0,-1)-(0,1),colour
line(-1,0)-(1,0),colour
'
end sub
'
' -------------------------------------------------------------------------
'
Function bmp_load( ByRef filename As Const String ) As Any Ptr
Dim As Long filenum, bmpwidth, bmpheight
Dim As Any Ptr img
'' open BMP file
filenum = FreeFile()
If Open( filename For Binary Access Read As #filenum ) <> 0 Then Return NULL
'' retrieve BMP dimensions
Get #filenum, 19, bmpwidth
Get #filenum, 23, bmpheight
Close #filenum
'' create image with BMP dimensions
img = ImageCreate( bmpwidth, Abs(bmpheight) )
If img = NULL Then Return NULL
'' load BMP file into image buffer
If BLoad( filename, img ) <> 0 Then ImageDestroy( img ): Return NULL
Return img
End Function
'
' -------------------------------------------------------------------------
'