04-24-2022, 04:30 PM
(This post was last modified: 04-24-2022, 04:33 PM by bplus.
Edit Reason: explain @
)
Code: (Select All)
_Title " MessageBox test - look behind the QB64 app on tool bar if not seen on top. Lean on esc to quit... "
' Thank you FellippeHeitor!
$If WIN Then
Declare Library
Function MessageBox (ByVal ignore&, message$, title$, Byval type&)
End Declare
$Else
DECLARE LIBRARY ""
FUNCTION MessageBox (BYVAL ignore&, message$, title$, BYVAL type&)
END DECLARE
$End If
Const xmax = 800, ymax = 600, PI = 3.141592653589793
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
Randomize Timer
Do
Cls
drawLandscape
Color &HFFFFFFFF, &HFF000000
kind = 1 + 4096 ' 0 is just OK, 1 is OK & Cancel ' 4096 keeps the message box on top
Print "Warning a Modal Message Box may come up off screen, you program is waiting for that!."
m$ = "You might have to look for me off screen. Lean on escape button to quit. Now you should quit seeing me with Cancel."
answer = MessageBox(0, m$, "Test MessageBox", 4097) ' 4097 for OK = 1 Cancel = 2 Modal on top messagebox
Print answer ' for kind = 4097 OK = 1 and Cancel = 2
'cant mess with first parameter?
_Delay 2
If answer = 2 Then End
k$ = InKey$ ' curious if key press in messageBox will interfere with inkey$
If k$ = "q" Then End
_Limit 1
Loop Until _KeyDown(27)
Sub drawLandscape
'needs midInk, irnd
Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
Dim lastx As Single, X As Long
'the sky
For i = 0 To ymax
midInk 0, 0, 128, 128, 128, 200, i / ymax
Line (0, i)-(xmax, i)
Next
'the land
startH = ymax - 200
rr = 70: gg = 70: bb = 90
For mountain = 1 To 6
Xright = 0
y = startH
While Xright < xmax
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown = (Rnd * .8 - .35) * (mountain * .5)
range = Xright + irnd&(15, 25) * 2.5 / mountain
lastx = Xright - 1
For X = Xright To range
y = y + upDown
Color _RGB(rr, gg, bb)
Line (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
lastx = X
Next
Xright = range
Wend
rr = irnd&(rr - 15, rr): gg = irnd&(gg - 15, gg): bb = irnd&(bb - 25, bb)
If rr < 0 Then rr = 0
If gg < 0 Then gg = 0
If bb < 0 Then bb = 0
startH = startH + irnd&(5, 20)
Next
End Sub
Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
Color _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub
Function irnd& (n1, n2) 'return an integer between 2 numbers
Dim l%, h%
If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
irnd& = Int(Rnd * (h% - l% + 1)) + l%
End Function
Yes so the top part is telling the compiler to add a function called MessageBox from another language or available from the OS.
Honestly those things are above my pay grade. But they can sure come in handy if you need something beyond QB64 limits.
Using @bplus signaled me that you were directing a note in post directly for me to answer use @ to get attention of any member of forum like requesting a reply from them.
b = b + ...