DVX_GUI/sdk/samples/basic/basicdemo/basicdemo.frm

937 lines
22 KiB
Text

VERSION DVX 1.00
Begin Form BasicDemo
Caption = "DVX BASIC Feature Tour"
Layout = VBox
AutoSize = False
Resizable = True
Centered = True
Width = 600
Height = 440
Begin Menu mnuFile
Caption = "&File"
Begin Menu mnuClear
Caption = "&Clear OutArea"
End
Begin Menu mnuSaveOut
Caption = "&Save OutArea..."
End
Begin Menu mnuSepF1
Caption = "-"
End
Begin Menu mnuExit
Caption = "E&xit"
End
End
Begin Menu mnuRun
Caption = "&Demos"
Begin Menu mnuRunAll
Caption = "Run &All Text Demos"
End
Begin Menu mnuSepR1
Caption = "-"
End
Begin Menu mnuGraphics
Caption = "&Graphics..."
End
Begin Menu mnuDynamic
Caption = "&Dynamic Form..."
End
Begin Menu mnuTimer
Caption = "&Timer..."
End
End
Begin Menu mnuHelp
Caption = "&Help"
Begin Menu mnuAbout
Caption = "&About..."
End
End
Begin Frame fraButtons
Caption = "Language Demonstrations"
Layout = VBox
Weight = 0
Begin HBox rowA
Weight = 0
Begin CommandButton btnTypes
Caption = "&Types"
Weight = 1
End
Begin CommandButton btnMath
Caption = "&Math"
Weight = 1
End
Begin CommandButton btnStrings
Caption = "&Strings"
Weight = 1
End
Begin CommandButton btnArrays
Caption = "&Arrays"
Weight = 1
End
Begin CommandButton btnData
Caption = "&DATA/READ"
Weight = 1
End
End
Begin HBox rowB
Weight = 0
Begin CommandButton btnFlow
Caption = "Control &Flow"
Weight = 1
End
Begin CommandButton btnUdt
Caption = "&UDT"
Weight = 1
End
Begin CommandButton btnOpt
Caption = "&Optional"
Weight = 1
End
Begin CommandButton btnError
Caption = "&Errors"
Weight = 1
End
Begin CommandButton btnFormat
Caption = "F&ormat"
Weight = 1
End
End
Begin HBox rowC
Weight = 0
Begin CommandButton btnFileIO
Caption = "File &I/O"
Weight = 1
End
Begin CommandButton btnSystem
Caption = "S&ystem"
Weight = 1
End
Begin CommandButton btnIni
Caption = "I&NI"
Weight = 1
End
Begin CommandButton btnDialogs
Caption = "Di&alogs"
Weight = 1
End
Begin CommandButton btnClear
Caption = "Clea&r"
Weight = 1
End
End
End
Begin TextArea OutArea
Weight = 1
End
Begin Label LblStatus
Caption = "Ready. Click any button to run a demo."
Weight = 0
End
End
OPTION EXPLICIT
TYPE PointT
x AS INTEGER
y AS INTEGER
END TYPE
' ============================================================
' OutArea helpers
' ============================================================
SUB Say(s AS STRING)
OutArea.AppendText s + CHR$(10)
END SUB
SUB Header(title AS STRING)
Say ""
Say "--- " + title + " ---"
END SUB
Load BasicDemo
BasicDemo.Show
OutArea.SetShowLineNumbers False
OutArea.SetReadOnly True
Say "Welcome to the DVX BASIC Feature Tour!"
Say "Each button below runs a self-contained example."
Say "Check the Demos menu for graphics, dynamic UI, and timer demos."
Say ""
' ============================================================
' Menu handlers
' ============================================================
SUB mnuClear_Click
OutArea.Text = ""
LblStatus.Caption = "OutArea cleared."
END SUB
SUB mnuSaveOut_Click
DIM path AS STRING
path = basFileSave("Save OutArea", "Text Files (*.txt)|All Files (*.*)")
IF path = "" THEN
EXIT SUB
END IF
OPEN path FOR OUTPUT AS #1
PRINT #1, OutArea.Text
CLOSE #1
LblStatus.Caption = "Saved: " + path
END SUB
SUB mnuExit_Click
Unload BasicDemo
END SUB
SUB mnuRunAll_Click
btnTypes_Click
btnMath_Click
btnStrings_Click
btnArrays_Click
btnData_Click
btnFlow_Click
btnUdt_Click
btnOpt_Click
btnError_Click
btnFormat_Click
btnFileIO_Click
btnSystem_Click
LblStatus.Caption = "All text demos complete."
END SUB
SUB mnuAbout_Click
DIM msg AS STRING
msg = "DVX BASIC Feature Tour" + CHR$(10) + CHR$(10)
msg = msg + "A visual catalog of DVX BASIC language"
msg = msg + " and runtime features." + CHR$(10) + CHR$(10)
msg = msg + "(c) 2026 DVX Project"
MsgBox msg, vbOKOnly, "About"
END SUB
' ============================================================
' Types: INTEGER, LONG, SINGLE, DOUBLE, STRING, BOOLEAN
' ============================================================
SUB btnTypes_Click
Header "Types"
DIM i AS INTEGER
DIM l AS LONG
DIM s AS SINGLE
DIM d AS DOUBLE
DIM t AS STRING
DIM b AS BOOLEAN
i = 32767
l = 2147483647
s = 3.14159
d = 2.718281828459045
t = "Hello, DVX!"
b = True
Say "INTEGER (16-bit): " + STR$(i)
Say "LONG (32-bit): " + STR$(l)
Say "SINGLE (float): " + STR$(s)
Say "DOUBLE (double): " + STR$(d)
Say "STRING: " + CHR$(34) + t + CHR$(34)
Say "BOOLEAN True: " + STR$(b)
' CONST with AS type annotation
CONST PI AS DOUBLE = 3.1415926535
Say "CONST PI = " + STR$(PI)
LblStatus.Caption = "Types demo complete."
END SUB
' ============================================================
' Math: integer + float operators, built-in functions
' ============================================================
SUB btnMath_Click
Header "Math"
DIM a AS INTEGER
DIM b AS INTEGER
a = 17
b = 5
Say "a = 17, b = 5"
Say "a + b = " + STR$(a + b)
Say "a - b = " + STR$(a - b)
Say "a * b = " + STR$(a * b)
Say "a \ b = " + STR$(a \ b) + " (integer divide)"
Say "a MOD b = " + STR$(a MOD b)
Say "a / b = " + STR$(a / b) + " (float divide)"
Say ""
Say "SQR(144) = " + STR$(SQR(144))
Say "ABS(-42) = " + STR$(ABS(-42))
Say "INT(3.7) = " + STR$(INT(3.7))
Say "FIX(-3.7) = " + STR$(FIX(-3.7))
Say "SGN(-9) = " + STR$(SGN(-9))
Say "SIN(0) = " + STR$(SIN(0))
Say "COS(0) = " + STR$(COS(0))
Say "2 ^ 10 = " + STR$(2 ^ 10)
RANDOMIZE TIMER
DIM r AS INTEGER
r = INT(RND * 100)
Say "RND (0-99) = " + STR$(r)
Say "TIMER = " + STR$(TIMER) + " (seconds since midnight)"
LblStatus.Caption = "Math demo complete."
END SUB
' ============================================================
' Strings: concatenation, LEFT$/RIGHT$/MID$/LEN/INSTR/UCASE$/LCASE$
' ============================================================
SUB btnStrings_Click
Header "Strings"
DIM s AS STRING
s = "The quick brown fox"
Say "Source: " + CHR$(34) + s + CHR$(34)
Say "LEN = " + STR$(LEN(s))
Say "LEFT$(s, 3) = " + LEFT$(s, 3)
Say "RIGHT$(s, 3) = " + RIGHT$(s, 3)
Say "MID$(s, 5, 5) = " + MID$(s, 5, 5)
Say "UCASE$ = " + UCASE$(s)
Say "LCASE$('HELLO') = " + LCASE$("HELLO")
Say "INSTR(s, 'brown')= " + STR$(INSTR(s, "brown"))
Say "TRIM$(' hi ') = " + CHR$(34) + TRIM$(" hi ") + CHR$(34)
Say "STRING$(5, 42) = " + STRING$(5, 42)
Say "CHR$(65) = " + CHR$(65)
Say "ASC('A') = " + STR$(ASC("A"))
Say "HEX$(255) = " + HEX$(255)
Say "VAL('42.5xyz') = " + STR$(VAL("42.5xyz"))
LblStatus.Caption = "Strings demo complete."
END SUB
' ============================================================
' Arrays: 1D, 2D, LBOUND/UBOUND, REDIM PRESERVE
' ============================================================
SUB btnArrays_Click
Header "Arrays"
' 1D array
DIM squares(9) AS INTEGER
DIM i AS INTEGER
FOR i = 0 TO 9
squares(i) = i * i
NEXT i
DIM lineS AS STRING
lineS = "squares(0..9) = "
FOR i = 0 TO 9
lineS = lineS + STR$(squares(i)) + " "
NEXT i
Say lineS
' Bounds: DIM a(lo TO hi)
DIM prices(1 TO 3) AS SINGLE
prices(1) = 9.99
prices(2) = 14.99
prices(3) = 29.99
Say "LBOUND(prices) = " + STR$(LBOUND(prices)) + ", UBOUND = " + STR$(UBOUND(prices))
Say "prices(2) = " + STR$(prices(2))
' 2D array
DIM matrix(2, 2) AS INTEGER
matrix(0, 0) = 1 : matrix(0, 1) = 2 : matrix(0, 2) = 3
matrix(1, 0) = 4 : matrix(1, 1) = 5 : matrix(1, 2) = 6
matrix(2, 0) = 7 : matrix(2, 1) = 8 : matrix(2, 2) = 9
Say "3x3 matrix:"
DIM r AS INTEGER
DIM c AS INTEGER
FOR r = 0 TO 2
lineS = " "
FOR c = 0 TO 2
lineS = lineS + STR$(matrix(r, c))
NEXT c
Say lineS
NEXT r
' REDIM PRESERVE
DIM nums(2) AS INTEGER
nums(0) = 10
nums(1) = 20
nums(2) = 30
REDIM PRESERVE nums(4) AS INTEGER
nums(3) = 40
nums(4) = 50
Say "After REDIM PRESERVE: " + STR$(nums(0)) + " " + STR$(nums(1)) + " " + STR$(nums(2)) + " " + STR$(nums(3)) + " " + STR$(nums(4))
LblStatus.Caption = "Arrays demo complete."
END SUB
' ============================================================
' DATA / READ / RESTORE
' ============================================================
SUB btnData_Click
Header "DATA / READ / RESTORE"
DATA "Red", 255, 0, 0
DATA "Green", 0, 255, 0
DATA "Blue", 0, 0, 255
DIM colorName AS STRING
DIM r AS INTEGER
DIM g AS INTEGER
DIM b AS INTEGER
DIM i AS INTEGER
FOR i = 1 TO 3
READ colorName
READ r
READ g
READ b
Say colorName + ": (" + STR$(r) + "," + STR$(g) + "," + STR$(b) + ")"
NEXT i
Say ""
Say "RESTORE resets pointer. Reading first entry again:"
RESTORE
READ colorName
Say " first = " + colorName
LblStatus.Caption = "DATA/READ demo complete."
END SUB
' ============================================================
' Control flow: IF, SELECT CASE, FOR, DO WHILE, GOSUB
' ============================================================
SUB btnFlow_Click
Header "Control Flow"
' FOR with STEP
Say "FOR i = 10 TO 0 STEP -2:"
DIM i AS INTEGER
DIM lineS AS STRING
lineS = " "
FOR i = 10 TO 0 STEP -2
lineS = lineS + STR$(i)
NEXT i
Say lineS
' DO WHILE
Say ""
Say "DO WHILE n < 32 (doubling):"
DIM n AS LONG
n = 1
lineS = " "
DO WHILE n < 32
lineS = lineS + STR$(n)
n = n * 2
LOOP
Say lineS
' IF / ELSEIF / ELSE
Say ""
DIM score AS INTEGER
score = 78
IF score >= 90 THEN
Say "score " + STR$(score) + " -> A"
ELSEIF score >= 80 THEN
Say "score " + STR$(score) + " -> B"
ELSEIF score >= 70 THEN
Say "score " + STR$(score) + " -> C"
ELSE
Say "score " + STR$(score) + " -> F"
END IF
' SELECT CASE
Say ""
DIM day AS INTEGER
day = 3
SELECT CASE day
CASE 1
Say "day 1 = Monday"
CASE 2, 3
Say "day " + STR$(day) + " = midweek"
CASE 4 TO 5
Say "day " + STR$(day) + " = late week"
CASE ELSE
Say "day " + STR$(day) + " = weekend"
END SELECT
' GOSUB / RETURN
Say ""
Say "GOSUB to a local label:"
GOSUB labelHello
Say "back from subroutine"
LblStatus.Caption = "Control flow demo complete."
EXIT SUB
labelHello:
Say " inside GOSUB"
RETURN
END SUB
' ============================================================
' User-Defined Type
' ============================================================
SUB btnUdt_Click
Header "User-Defined Type"
DIM p AS PointT
p.x = 10
p.y = 20
Say "PointT p = (" + STR$(p.x) + "," + STR$(p.y) + ")"
' Array of UDT
DIM corners(3) AS PointT
corners(0).x = 0 : corners(0).y = 0
corners(1).x = 10 : corners(1).y = 0
corners(2).x = 10 : corners(2).y = 10
corners(3).x = 0 : corners(3).y = 10
Say "Rectangle corners:"
DIM i AS INTEGER
FOR i = 0 TO 3
Say " (" + STR$(corners(i).x) + "," + STR$(corners(i).y) + ")"
NEXT i
LblStatus.Caption = "UDT demo complete."
END SUB
' ============================================================
' Optional parameters (DVX extension)
' ============================================================
FUNCTION Greet(who AS STRING, OPTIONAL greeting AS STRING) AS STRING
IF greeting = "" THEN
greeting = "Hello"
END IF
Greet = greeting + ", " + who + "!"
END FUNCTION
SUB btnOpt_Click
Header "Optional Parameters"
Say Greet("World")
Say Greet("Scott", "Howdy")
Say Greet("DVX", "Greetings from")
LblStatus.Caption = "Optional params demo complete."
END SUB
' ============================================================
' ON ERROR GOTO
' ============================================================
SUB btnError_Click
Header "ON ERROR GOTO"
ON ERROR GOTO handler
DIM a AS INTEGER
DIM b AS INTEGER
a = 10
b = 0
Say "Attempting 10/0 ..."
Say " 10 / 0 = " + STR$(a / b)
Say "(should not reach here)"
EXIT SUB
handler:
Say " caught! ERR = " + STR$(ERR)
LblStatus.Caption = "Error handler ran successfully."
END SUB
' ============================================================
' PRINT USING / FORMAT$
' ============================================================
SUB btnFormat_Click
Header "Formatting"
Say "FORMAT$(1234.5, '#,##0.00') = " + FORMAT$(1234.5, "#,##0.00")
Say "FORMAT$(0.075, 'percent') = " + FORMAT$(0.075, "percent")
Say "FORMAT$(-42, '+#0') = " + FORMAT$(-42, "+#0")
Say "FORMAT$(3.14159, '0.00') = " + FORMAT$(3.14159, "0.00")
LblStatus.Caption = "Format demo complete."
END SUB
' ============================================================
' File I/O
' ============================================================
SUB btnFileIO_Click
Header "File I/O"
DIM path AS STRING
path = App.Data + "/demo.txt"
Say "Writing: " + path
OPEN path FOR OUTPUT AS #1
PRINT #1, "Line one"
PRINT #1, "Line two"
PRINT #1, "The answer is "; 42
CLOSE #1
Say "LOF = " + STR$(FILELEN(path))
Say "Reading back:"
OPEN path FOR INPUT AS #1
DIM ln AS STRING
DO WHILE NOT EOF(1)
LINE INPUT #1, ln
Say " " + ln
LOOP
CLOSE #1
KILL path
Say "Deleted."
LblStatus.Caption = "File I/O demo complete."
END SUB
' ============================================================
' System: App object, environment, current directory
' ============================================================
SUB btnSystem_Click
Header "System / App"
Say "App.Path = " + App.Path
Say "App.Config = " + App.Config
Say "App.Data = " + App.Data
Say "CurDir = " + CurDir()
Say "Date = " + Date$
Say "Time = " + Time$
Say "PATH env = " + LEFT$(Environ$("PATH"), 40) + "..."
LblStatus.Caption = "System demo complete."
END SUB
' ============================================================
' INI read/write
' ============================================================
SUB btnIni_Click
Header "INI Read/Write"
DIM path AS STRING
path = App.Data + "/demo.ini"
Say "Writing: " + path
IniWrite path, "General", "UserName", "Scott"
IniWrite path, "General", "Version", "1.00"
IniWrite path, "Options", "AutoSave", "True"
Say "Reading back:"
Say " UserName = " + IniRead$(path, "General", "UserName", "(missing)")
Say " Version = " + IniRead$(path, "General", "Version", "(missing)")
Say " AutoSave = " + IniRead$(path, "Options", "AutoSave", "(missing)")
Say " Missing = " + IniRead$(path, "General", "NotThere", "(default)")
KILL path
LblStatus.Caption = "INI demo complete."
END SUB
' ============================================================
' Dialog demos (spawns the real dialogs)
' ============================================================
SUB btnDialogs_Click
Header "Dialogs"
DIM response AS INTEGER
response = MsgBox("MessageBox demo." + CHR$(10) + "Are you enjoying the demo?", vbYesNo + vbQuestion, "Feedback")
IF response = vbYes THEN
Say "MsgBox: user said yes"
ELSE
Say "MsgBox: user said no"
END IF
DIM text AS STRING
text = basInputBox2("Input", "What is your name?", "Anonymous")
Say "InputBox returned: " + text
DIM choice AS INTEGER
choice = basChoiceDialog("Favorite", "Pick a color:", "Red|Green|Blue|Yellow", 1)
IF choice >= 0 THEN
Say "Choice index: " + STR$(choice)
ELSE
Say "Choice cancelled"
END IF
DIM n AS INTEGER
n = basIntInput("Number", "Pick a number (1-100):", 42, 1, 100)
Say "IntInput: " + STR$(n)
LblStatus.Caption = "Dialog demo complete."
END SUB
SUB btnClear_Click
mnuClear_Click
END SUB
' ============================================================
' Graphics demo (opens a second form with Canvas)
' ============================================================
DIM gfxWin AS LONG
gfxWin = 0
SUB mnuGraphics_Click
IF gfxWin <> 0 THEN
EXIT SUB
END IF
DIM frm AS LONG
SET frm = CreateForm("GraphicsForm", 360, 320)
GraphicsForm.Caption = "Graphics Demo"
gfxWin = frm
DIM cv AS LONG
SET cv = CreateControl(frm, "Canvas", "GfxCanvas")
GfxCanvas.Width = 340
GfxCanvas.Height = 260
GfxCanvas.Weight = 1
DIM btnRow AS LONG
SET btnRow = CreateControl(frm, "HBox", "GfxRow")
DIM bDraw AS LONG
SET bDraw = CreateControl(frm, "CommandButton", "GfxDraw", btnRow)
GfxDraw.Caption = "Draw"
SetEvent bDraw, "Click", "GfxDrawAll"
DIM bClear AS LONG
SET bClear = CreateControl(frm, "CommandButton", "GfxClear", btnRow)
GfxClear.Caption = "Clear"
SetEvent bClear, "Click", "GfxClearCanvas"
frm.Show
GfxDrawAll
END SUB
SUB GfxDrawAll
DIM w AS LONG
DIM h AS LONG
w = 340
h = 260
' Gradient background bars
DIM y AS INTEGER
DIM shade AS LONG
FOR y = 0 TO h - 1 STEP 4
shade = (y * 255) \ h
GfxCanvas.FillRect 0, y, w, 4, RGB(shade, shade \ 2, 128)
NEXT y
' Star field
RANDOMIZE TIMER
DIM s AS INTEGER
DIM sx AS INTEGER
DIM sy AS INTEGER
FOR s = 1 TO 40
sx = INT(RND * w)
sy = INT(RND * h)
GfxCanvas.SetPixel sx, sy, RGB(255, 255, 255)
NEXT s
' Rectangle + outline
GfxCanvas.FillRect 20, 20, 80, 50, RGB(240, 240, 0)
GfxCanvas.DrawRect 20, 20, 80, 50, RGB(0, 0, 0)
' Circle approximated by line segments
DIM cx AS INTEGER
DIM cy AS INTEGER
DIM r AS INTEGER
cx = 250
cy = 80
r = 40
DIM a AS DOUBLE
DIM px AS INTEGER
DIM py AS INTEGER
DIM qx AS INTEGER
DIM qy AS INTEGER
px = cx + r
py = cy
FOR a = 0 TO 6.3 STEP 0.2
qx = cx + INT(r * COS(a))
qy = cy + INT(r * SIN(a))
GfxCanvas.DrawLine px, py, qx, qy, RGB(255, 128, 0)
px = qx
py = qy
NEXT a
' Text
GfxCanvas.DrawText 60, 200, "Canvas + math + colors", RGB(255, 255, 255)
GfxCanvas.DrawText 60, 220, "DVX BASIC graphics", RGB(255, 255, 0)
GfxCanvas.Refresh
END SUB
SUB GfxClearCanvas
GfxCanvas.Clear RGB(0, 0, 0)
GfxCanvas.Refresh
END SUB
SUB GraphicsForm_Unload
gfxWin = 0
END SUB
' ============================================================
' Dynamic form demo
' ============================================================
DIM dynForm AS LONG
dynForm = 0
SUB mnuDynamic_Click
IF dynForm <> 0 THEN
EXIT SUB
END IF
DIM frm AS LONG
SET frm = CreateForm("DynForm", 320, 200)
DynForm.Caption = "Dynamic Form (built in code)"
dynForm = frm
DIM lbl AS LONG
SET lbl = CreateControl(frm, "Label", "DynLabel")
DynLabel.Caption = "This form was created 100% in code."
DIM lbl2 AS LONG
SET lbl2 = CreateControl(frm, "Label", "CountLabel")
CountLabel.Caption = "Counter: 0"
DIM btns AS LONG
SET btns = CreateControl(frm, "HBox", "DynBtns")
DIM bInc AS LONG
SET bInc = CreateControl(frm, "CommandButton", "BInc", btns)
BInc.Caption = "Count Up"
SetEvent bInc, "Click", "DynInc"
DIM bBye AS LONG
SET bBye = CreateControl(frm, "CommandButton", "BBye", btns)
BBye.Caption = "Close"
SetEvent bBye, "Click", "DynBye"
frm.Show
END SUB
DIM dynCount AS INTEGER
dynCount = 0
SUB DynInc
dynCount = dynCount + 1
CountLabel.Caption = "Counter: " + STR$(dynCount)
END SUB
SUB DynBye
Unload DynForm
END SUB
SUB DynForm_Unload
dynForm = 0
dynCount = 0
END SUB
' ============================================================
' Timer demo
' ============================================================
DIM timerWin AS LONG
timerWin = 0
SUB mnuTimer_Click
IF timerWin <> 0 THEN
EXIT SUB
END IF
DIM frm AS LONG
SET frm = CreateForm("TimerForm", 260, 140)
TimerForm.Caption = "Timer Demo"
timerWin = frm
DIM lbl AS LONG
SET lbl = CreateControl(frm, "Label", "TickLabel")
TickLabel.Caption = "Ticks: 0"
DIM t AS LONG
SET t = CreateControl(frm, "Timer", "Ticker")
Ticker.Interval = 500
SetEvent t, "Timer", "TickHandler"
frm.Show
END SUB
DIM tickCount AS LONG
tickCount = 0
SUB TickHandler
tickCount = tickCount + 1
TickLabel.Caption = "Ticks: " + STR$(tickCount) + " Time: " + TIME$
END SUB
SUB TimerForm_Unload
timerWin = 0
tickCount = 0
END SUB