+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: DEMO ZAPPER- early use of Inform (/showthread.php?tid=988)
DEMO ZAPPER- early use of Inform - James D Jarvis - 10-20-2022
I saw a couple posts on inform recently so I dug this out.
It's one of my first attempts at using qb64 and Inform from several months ago during the before times. It's pretty crude and not remotely amazing but nonetheless semi-functional and shows how I tried to make use of Inform.
DemoZapper
Code: (Select All)
'Demo Zapper
'just fiddling with inform a several months back and whipped this up while still rediscovering QB64
'it's crude, I've gotten a little better witrh qb64 since I did this, but someone may find it useful as a samplen to figure out inform
'one "alien" and one cannon/ship
'
' you are going to need the form (which is posted alogn with this) and you are going to need inform installed to make use of this.
'
'
'
': This program uses
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
Dim Shared DEMOZAPPER As Long
Dim Shared DEMOZAPPERPX As Long
Dim Shared BT2 As Long
Dim Shared BT As Long
Dim Shared FIREBT As Long
Dim Shared MessageBoxTB As Long
Dim Shared SCORELB As Long
Dim Shared ScoreT As Long
Dim Shared POWERLB As Long
Dim Shared ScoreT2 As Long
Dim Shared HULLLB As Long
Dim Shared ScoreT3 As Long
Dim Shared gamescore As Long
Dim Shared power As Long
Dim Shared hull As Long
Dim Shared shipx As Long
Dim Shared shipY As Long
Dim Shared shipshape$, alienshape$, zapshape$
Dim Shared ax, ay, zx(10), zy(10) As Long
Dim Shared shot, allshots
Dim Shared ASPEED
Dim Shared mess$(5)
mess$(1) = "My Totally lame shooter demo"
mess$(2) = "Take Careful Aim"
mess$(3) = "only one alien for now"
mess$(4) = "Power drain does nothing...yet"
mess$(5) = "Hmmm...."
Randomize Timer
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'demozapper.frm'
': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit
End Sub
Sub __UI_OnLoad
'here's where I initialize my part of the program.
gamescore = 0
power = 1000
hull = 100
shipx = 256
shipY = 240
shot = 0
allshots = 0
shipshape$ = "R4D8F6D8H6U4L4D4G6U8E6U8"
alienshape$ = "R8F6G3H3G3H3E6"
zapshape$ = "R4D6L4U6"
ax = 30
ay = 30
zx = -1
zy = -1
ASPEED = 1
Caption(MessageBoxTB) = " "
End Sub
Sub __UI_BeforeUpdateDisplay
'This event occurs at approximately 60 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
' this looked like a good spot in what is effectively the main event loop to pur most of the program.
Caption(ScoreT) = Str$(gamescore)
Caption(ScoreT2) = Str$(power)
Caption(ScoreT3) = Str$(hull)
mm = Int(Rnd * 500) + 1
If mm < 6 Then Caption(MessageBoxTB) = mess$(mm)
'drawship
_Dest Control(Canvas).HelperCanvas
k = _RGB(111, 200, 200)
BeginDraw DEMOZAPPERPX
Cls , _RGB32(0, 0, 50)
PSet (shipx, shipY), k
Draw shipshape$
If ax > 0 Then
PSet (ax, ay), k
Draw alienshape$
End If
If shot > 0 Then
For z = 1 To shot
If zx(z) > 0 Then
k = _RGB(200, 20, 20)
PSet (zx(z), zy(z)), k
Draw zapshape$
If Int(zx(z) / 8) = Int((ax + 2.5) / 8) And Int(zy(z) / 8) = Int(ay / 8) Then
Beep
ax = -1
ay = -1
gamescore = gamescore + 100
zx(z) = -1
zy(z) = -1
End If
End If
Next z
End If
EndDraw DEMOZAPPERPX
'move game elements
If ax < 500 Then
ax = ax + ASPEED
Else
ax = -10
ay = Int(Rnd * 20) + 20
End If
If shot > 0 Then
For z = 1 To shot
If zy(z) > 0 Then
zy(z) = zy(z) - 4
Else
zx(z) = -1
zy(z) = -1
End If
Next z
If zy(shot) = -1 And shot = 10 Then shot = 0
End If
End Sub
Sub __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
End Sub
Sub __UI_Click (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
shipx = shipx - 4
Case BT
shipx = shipx + 4
Case FIREBT
'if the fire button is pressed do this!
If power > 0 And shot < 10 Then
shot = shot + 1
zx(shot) = shipx
zy(shot) = shipY - 8
power = power - 1
End If
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseEnter (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseLeave (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_FocusIn (id As Long)
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_FocusOut (id As Long)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_MouseDown (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
'go that way
shipx = shipx - 1
Case BT
'go this way
shipx = shipx + 1
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseUp (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_KeyPress (id As Long)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_TextChanged (id As Long)
Select Case id
Case MessageBoxTB
End Select
End Sub
Sub __UI_ValueChanged (id As Long)
Select Case id
End Select
End Sub
Sub __UI_FormResized
End Sub
'$INCLUDE:'InForm\InForm.ui'and the form so that works.
Code: (Select All)
': This form was generated by
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
Sub __UI_LoadForm
Dim __UI_NewID As Long, __UI_RegisterResult As Long
__UI_NewID = __UI_NewControl(__UI_Type_Form, "DEMOZAPPER", 889, 494, 0, 0, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "DEMO ZAPPER"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)
Control(__UI_NewID).HasBorder = False
__UI_NewID = __UI_NewControl(__UI_Type_PictureBox, "DEMOZAPPERPX", 520, 320, 31, 26, 0)
__UI_RegisterResult = 0
Control(__UI_NewID).Stretch = True
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).Align = __UI_Center
Control(__UI_NewID).VAlign = __UI_Middle
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Button, "BT2", 80, 40, 605, 332, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "<"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 24)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "BT", 80, 38, 715, 332, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, ">"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 24)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_Button, "FIREBT", 190, 49, 605, 392, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "FIRE !"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).CanHaveFocus = True
__UI_NewID = __UI_NewControl(__UI_Type_TextBox, "MessageBoxTB", 520, 85, 31, 374, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "Message Box"
Control(__UI_NewID).HasBorder = True
Control(__UI_NewID).CanHaveFocus = True
Control(__UI_NewID).BorderSize = 1
__UI_NewID = __UI_NewControl(__UI_Type_Label, "SCORELB", 150, 29, 592, 15, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "SCORE"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "ScoreT", 237, 37, 592, 49, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "0"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Right
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "POWERLB", 150, 29, 592, 91, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "POWER"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "ScoreT2", 227, 37, 605, 125, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "0"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Right
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "HULLLB", 150, 29, 592, 179, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "HULL"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).VAlign = __UI_Middle
__UI_NewID = __UI_NewControl(__UI_Type_Label, "ScoreT3", 224, 37, 605, 223, 0)
__UI_RegisterResult = 0
SetCaption __UI_NewID, "0"
Control(__UI_NewID).Font = SetFont("segoeui.ttf", 18)
Control(__UI_NewID).HasBorder = False
Control(__UI_NewID).Align = __UI_Right
Control(__UI_NewID).VAlign = __UI_Middle
END SUB
SUB __UI_AssignIDs
DEMOZAPPER = __UI_GetID("DEMOZAPPER")
DEMOZAPPERPX = __UI_GetID("DEMOZAPPERPX")
BT2 = __UI_GetID("BT2")
BT = __UI_GetID("BT")
FIREBT = __UI_GetID("FIREBT")
MessageBoxTB = __UI_GetID("MessageBoxTB")
SCORELB = __UI_GetID("SCORELB")
ScoreT = __UI_GetID("ScoreT")
POWERLB = __UI_GetID("POWERLB")
ScoreT2 = __UI_GetID("ScoreT2")
HULLLB = __UI_GetID("HULLLB")
ScoreT3 = __UI_GetID("ScoreT3")
END SUB