Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 326
» Latest member: hafsahomar
» Forum threads: 1,758
» Forum posts: 17,919

Full Statistics

Latest Threads
MBA Assignment Help in Du...
Forum: General Discussion
Last Post: hafsahomar
06-11-2025, 07:05 AM
» Replies: 0
» Views: 12
лучшие песни медляки слуш...
Forum: Petr
Last Post: WillieTop
06-08-2025, 02:21 AM
» Replies: 0
» Views: 27
пинк слушать онлайн беспл...
Forum: SMcNeill
Last Post: WillieTop
06-08-2025, 02:20 AM
» Replies: 0
» Views: 22
скачать музыку российскую...
Forum: madscijr
Last Post: WillieTop
06-08-2025, 02:18 AM
» Replies: 0
» Views: 23
нежная музыка mp3 скачать
Forum: Keybone
Last Post: WillieTop
06-08-2025, 02:17 AM
» Replies: 0
» Views: 23
лучшая песня слушать онла...
Forum: bplus
Last Post: WillieTop
06-08-2025, 02:16 AM
» Replies: 0
» Views: 27
пикник слушать онлайн луч...
Forum: Spriggsy
Last Post: WillieTop
06-08-2025, 02:15 AM
» Replies: 0
» Views: 22
какая сейчас популярная м...
Forum: RhoSigma
Last Post: WillieTop
06-08-2025, 02:14 AM
» Replies: 0
» Views: 18
хит лета 2019 музыка на т...
Forum: Christmas Code
Last Post: WillieTop
06-08-2025, 02:12 AM
» Replies: 0
» Views: 29
бесплатная музыка mp3 рег...
Forum: Works in Progress
Last Post: WillieTop
06-08-2025, 02:11 AM
» Replies: 0
» Views: 18

 
  Compiler setting for accurate math?
Posted by: James D Jarvis - 11-30-2022, 07:49 PM - Forum: Help Me! - Replies (12)

Why does this happen?   

[Image: image.png]

when this is the code?

Code: (Select All)
Dim x
For x = 1 To .05 Step -.05
    Print x
    _Delay x
Next x


Is there a complier setting to keep this from happening?

Print this item

  Simple GUI example
Posted by: James D Jarvis - 11-30-2022, 07:20 PM - Forum: Programs - Replies (3)

all the cool kids are doing it so why not?

A simple gui example to demonstrate a scheme for button handling and menu selection.
This makes use of a couple of the new dialog controls in version 3.4

Menu selections return input from the selection, there's a little but of button manipulation shown, you cna quit from a menu or the big red quit button. Menu2 uses the new dialog controls, the hello menu selection wlil have a different message if the user has enters a username.

This is fairly barebones and hopefully straightforward enough someone may find this useful.

Code: (Select All)
'a relatively simple gui example by James D. Jarvis
'QB64 PE 3.4 or later needed to compile
'text screen mode 0 program that uses the mouse button to track gui input
'the scheme in this program allows for up to 255 buttons to be used in a program
'
'a mouse is used to click on button and menu selections that are shown in a text screen
'the position of buttons that are active is recorded in a button image
'$dynamic
Dim Shared ts&
Dim Shared bt&
Dim Shared forek, backk
ts& = _NewImage(80, 25, 0) 'the main text screen  for the program
Screen ts&
bt& = _NewImage(_Width + 1, _Height + 1, 256) 'the button tracking image needed for the gui
Type button_type
    txt As String 'the button label
    style As String 'what type of button to use : TEXTONLY,BTEXT,MENU,LBAR,CBAR,BBOX1,BBOX2
    bxx As Integer 'button x coordinate
    byy As Integer 'button y coordinate
    bwid As Integer 'button width in pixels. button height is determined by style and text size
    tklr As Integer 'text color
    bklr As Integer 'background color
    fklr As Integer 'foreground color
    state As String 'is button on or off
    container As String 'doesn't do anything in the demo but I like to plan ahead
End Type
Dim Shared btn(0) As button_type
Dim tempb As button_type
Dim Shared button_count
button_count = 0
Print "Building GUI";
forek = 15: backk = 0
menu_on = 0
'creating buttosn for the demo code
tempb.bxx = 3: tempb.byy = 3: tempb.bwid = 8: tempb.style = "TEXTONLY"
tempb.txt = "Button 1": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 5: tempb.bwid = 8: tempb.style = "BTEXT"
tempb.txt = "Button 2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 7: tempb.bwid = 12: tempb.style = "BBOX2"
tempb.txt = "Button 3": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 3: tempb.byy = 15: tempb.bwid = 52: tempb.style = "BBOX1"
tempb.txt = "QUIT": tempb.tklr = 0: tempb.bklr = 12: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
'creating the menus for the demo code.
'note: menu selections are just buttons that are only active when the menu is selected
tempb.bxx = 1: tempb.byy = 1: tempb.bwid = 8: tempb.style = "MENU"
tempb.txt = "MENU": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 2: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Select1": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 3: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Select2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 4: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "--------": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 1: tempb.byy = 5: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "QUIT": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb

tempb.bxx = 9: tempb.byy = 1: tempb.bwid = 8: tempb.style = "MENU"
tempb.txt = "MENU2": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "ON": tempb.container = ""
addbutton tempb
tempb.bxx = 9: tempb.byy = 2: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Hello": tempb.tklr = 15: tempb.bklr = 7: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
tempb.bxx = 9: tempb.byy = 3: tempb.bwid = 8: tempb.style = "LBAR"
tempb.txt = "Name?": tempb.tklr = 15: tempb.bklr = 5: tempb.fklr = 15
tempb.state = "OFF": tempb.container = ""
addbutton tempb
Dim Shared username$
username$ = ""


Cls
draw_allbuttons 'have to draw them if you want the user to see them
Locate 3, 16: Print "Will Show Button 3 if it is hiding"
Locate 5, 16: Print "Changes Text Color of this button"
Locate 8, 16: Print "Will hide itself"
Do ' main program loop
    _Limit 1000

    bkk = 0

    Do While _MouseInput
        pbx = _MouseX
        pby = _MouseY
        If _MouseButton(1) Then
            _Source bt& 'checking the button tracking image
            bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
            _Source ts&
            'uncomment following lines if you wish to see the demo echoing the button click
            ' If bkk > 0 Then
            ' Locate 1, 1: Print "Clicked "; bkk
            ' Else
            '     Locate 1, 1: Print "                 "
            ' End If
        End If
    Loop

    Select Case bkk 'a handler for each button
        Case 1
            Beep
            flash_button 1
            If btn(3).state = "HIDE" Then show_button 3
            draw_button 1
        Case 2
            flash_button 2
            btn(2).tklr = Int(Rnd * 32)
            draw_button 2
        Case 3
            flash_button 3
            hide_button 3
        Case 4
            flash_button 4
            draw_button 4
            Exit Do
        Case 5 'menu1
            menu1 mchoice$
            Locate 12, 16
            If mchoice$ <> "" Then Print "Selected "; mchoice$
            If mchoice$ = "QUIT" Then Exit Do
        Case 6 'this is a menu selection and tracked in the sub menu1
        Case 7 'this is a menu selection and tracked in the sub menu1
        Case 8 'this is a menu selection and tracked in the sub menu1
        Case 9 'this is a menu selection and tracked in the sub menu1
        Case 10 'menu2
            mchoice$ = ""
            menu2 mchoice$
            If mchoice$ = "hello" Then
                If username$ = "" Then
                    _MessageBox "Hello", "Hello stranger.", "info"
                Else
                    un$ = "HELLO THERE " + username$ + "!"
                    _MessageBox "HELLO", un$, "info"
                End If
            End If
            If mchoice$ = "name?" Then
                username$ = _InputBox$("Name?", "Enter your name:", "anonymous")
            End If
        Case 11 'this is a menu selection and tracked in the sub menu2
        Case 12 'this is a menu selection and tracked in the sub menu2

    End Select
Loop Until InKey$ = Chr$(27)
_FreeImage bt&
System

'=========================================================================
' button routines for gui
'=========================================================================

Sub menu1 (mchoice$)
    'menu handling has to be hardcoded as is, this needs to change.
    show_button 6
    show_button 7
    show_button 8
    show_button 9
    menu_on = 1
    mchoice$ = ""
    Do 'menu takes over mouse handling only recognizing clicks in the menu or pressing the escape key
        _Limit 60
        Do While _MouseInput
            pbx = _MouseX
            pby = _MouseY
            If _MouseButton(1) Then
                _Source bt& 'checking the button tracking image
                bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
                _Source ts&
            End If
        Loop
        Select Case bkk 'a handler for each button
            Case 6
                flash_button 6
                mchoice$ = "m1a"
                menu_on = 0
            Case 7
                flash_button 7
                mchoice$ = "m1b"
                menu_on = 0
                'case 8
                'there is no entry for button 8. it's just a line separator
            Case 9
                flash_button 9
                mchoice$ = "QUIT"
                menu_on = 0
        End Select
        mk$ = InKey$
    Loop Until menu_on = 0 Or mk$ = Chr$(27)
    'hide all the menu entries
    hide_button 6
    hide_button 7
    hide_button 8
    hide_button 9
    'draw all the buttons now that the menu entries are hidden
    draw_allbuttons
End Sub
Sub menu2 (mchoice$)
    'menu handling has to be hardcoded as is
    show_button 11
    show_button 12
    menu_on = 1
    mchoice$ = ""
    Do 'menu takes over mouse handling only recognizing clicks in the menu or pressing the escape key
        _Limit 60
        Do While _MouseInput
            pbx = _MouseX
            pby = _MouseY
            If _MouseButton(1) Then
                _Source bt& 'checking the button tracking image
                bkk = Point(pbx, pby) 'get the button clicked if there is one at those coordinates
                _Source ts&
            End If
        Loop
        Select Case bkk 'a handler for each button
            Case 11
                flash_button 11
                mchoice$ = "hello"
                menu_on = 0
            Case 12
                flash_button 7
                mchoice$ = "name?"
                menu_on = 0
        End Select
        mk$ = InKey$
    Loop Until menu_on = 0 Or mk$ = Chr$(27)
    'hide the menu entries
    hide_button 11
    hide_button 12
    'draw all the buttons now that the menu entries are hidden
    draw_allbuttons
End Sub
Sub addbutton (newbtn As button_type)
    If button_count < 255 Then
        button_count = button_count + 1
        ReDim _Preserve btn(button_count) As button_type
        Swap btn(button_count), newbtn
        Select Case btn(button_count).style
            Case "TEXTONLY", "BTEXT"
                'correct bwid to be equal to text length for these styles
                btn(button_count).bwid = Len(btn(button_count).txt)
        End Select
    End If
End Sub

Sub draw_button (bnum)
    'draw alll the buttons on the mainscreen and on the button tracking image
    If bnum < 1 Or bnum > button_count GoTo enddrawb
    ds& = _Dest
    If btn(bnum).state = "ON" Then
        _Dest bt&
        Select Case btn(bnum).style
            Case "TEXTONLY"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
                _Dest ds&
                Color btn(bnum).tklr, backk
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                Color forek
            Case "BTEXT", "MENU"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
                _Dest ds&
                Color btn(bnum).tklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                Color forek, backk
            Case "LBAR"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
                _Dest ds&
                Color btn(bnum).tklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                Color forek, backk
            Case "CBAR"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), bnum, BF
                _Dest ds&
                Color btn(bnum).tklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy), btn(bnum).txt
                Color forek, backk
            Case "BBOX1"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), bnum, BF
                _Dest ds&
                Color btn(bnum).fklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(196))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(196))
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(218))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(179))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(192))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(191))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(179))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(217))
                Color btn(bnum).tklr, btn(bnum).bklr
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
                Color forek, backk
            Case "BBOX2"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), bnum, BF
                _Dest ds&
                Color btn(bnum).fklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(205))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(205))
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(201))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(186))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(200))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(187))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(186))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(188))
                Color btn(bnum).tklr, btn(bnum).bklr
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
                Color forek, backk
        End Select
    End If
    enddrawb:
End Sub

Sub hide_button (bnum)
    'blacks out a button on the mainscreen and the button tracking image
    If bnum < 1 Or bnum > button_count Then GoTo endhide
    ds& = _Dest
    If btn(bnum).state = "ON" Then
        btn(bnum).state = "HIDE"
        _Dest bt&
        Select Case btn(bnum).style
            Case "TEXTONLY"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
                _Dest ds&
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(Len(btn(bnum).txt), " ")
            Case "BTEXT", "MENU"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
                _Dest ds&
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(Len(btn(bnum).txt), " ")
                Color forek, backk
            Case "LBAR"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
                _Dest ds&
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")

            Case "CBAR"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), 0, BF
                _Dest ds&
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
            Case "BBOX1", "BBOX2"
                Line (btn(bnum).bxx, btn(bnum).byy)-(btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), 0, BF
                _Dest ds&
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, " ")
        End Select
    End If
    endhide:
End Sub

Sub show_button (bnum)
    'chnage a buttons state and draw it on the main screen and button tracking image
    If bnum > 0 And bnum <= button_count Then
        btn(bnum).state = "ON"
        draw_button bnum
    End If
End Sub
Sub draw_allbuttons
    'draw all the buttons
    For b = 1 To button_count
        draw_button b
    Next b
End Sub

Sub flash_button (bnum)
    'have the button flash to show it has been selected
    If bnum < 1 Or bnum > button_count GoTo endflashb
    If btn(bnum).state = "ON" Then
        Select Case btn(bnum).style
            Case "TEXTONLY"
                Color backk, btn(bnum).tklr \ 2
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                _Delay 0.3
                Color forek
            Case "BTEXT", "MENU"
                Color backk, btn(bnum).tklr \ 2
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                _Delay 0.3
                Color forek, backk
            Case "LBAR"
                Color backk, btn(bnum).tklr, btn(bnum).bklr
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy), btn(bnum).txt
                _Delay 0.3
                Color forek, backk
            Case "CBAR"
                Color backk, btn(bnum).tklr \ 2
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, " ")
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy), btn(bnum).txt
                _Delay 0.3
                Color forek, backk
            Case "BBOX1"
                Color backk, btn(bnum).fklr \ 2
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(196))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(196))
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(218))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(179))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(192))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(191))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(179))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(217))
                Color backk, btn(bnum).tklr
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
                _Delay 0.3
                Color forek, backk
            Case "BBOX2"
                Color backk, btn(bnum).fklr \ 2
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(btn(bnum).bwid, Chr$(205))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(btn(bnum).bwid, " ")
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(btn(bnum).bwid, Chr$(205))
                _PrintString (btn(bnum).bxx, btn(bnum).byy), String$(1, Chr$(201))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 1), String$(1, Chr$(186))
                _PrintString (btn(bnum).bxx, btn(bnum).byy + 2), String$(1, Chr$(200))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy), String$(1, Chr$(187))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 1), String$(1, Chr$(186))
                _PrintString (btn(bnum).bxx + btn(bnum).bwid - 1, btn(bnum).byy + 2), String$(1, Chr$(188))
                Color backk, btn(bnum).tklr
                tpx = btn(bnum).bxx + (Int(btn(bnum).bwid / 2) - Int(Len(btn(bnum).txt) / 2))
                _PrintString (tpx, btn(bnum).byy + 1), btn(bnum).txt
                _Delay 0.3
                Color forek, backk
        End Select
    End If
    endflashb:
End Sub

Print this item

  IsNum
Posted by: SMcNeill - 11-30-2022, 04:00 PM - Forum: Utilities - Replies (4)

A quick little routine to tell you if a string is a number, or not.

Code: (Select All)
Function IsNum%% (PassedText As String)
    text$ = PassedText
    special$ = UCase$(Left$(text$, 2))
    Select Case special$
        Case "&H", "&B", "&O"
            'check for symbols on right side of value
            r3$ = Right$(text$, 3)
            Select Case r3$
                Case "~&&", "~%%", "~%&" 'unsigned int64, unsigned byte, unsigned offset
                    text$ = Left$(text$, Len(text$) - 3)
                Case Else
                    r2$ = Right$(text$, 2)
                    Select Case r2$
                        Case "~&", "##", "%&", "%%", "~%", "&&" 'unsigned long, float, offset, byte, unsigned integer, int64
                            text$ = Left$(text$, Len(text$) - 2)
                        Case Else
                            r$ = Right$(text$, 1)
                            Select Case r$
                                Case "&", "#", "%", "!" 'long, double, integer, single
                                    text$ = Left$(text$, Len(text$) - 1)
                            End Select
                    End Select
            End Select
            check$ = "0123456789ABCDEF"
            If special$ = "&O" Then check$ = "01234567"
            If special$ = "&B" Then check$ = "01"
            temp$ = Mid$(UCase$(text$), 2)
            For i = 1 To Len(temp$)
                If InStr(check$, Mid$(temp$, i, 1)) = 0 Then Exit For
            Next
            If i <= Len(temp$) Then IsNum = -1
        Case Else
            If _Trim$(Str$(Val(text$))) = text$ Then IsNum = -1
    End Select
End Function


Note that this may fail if you're dealing with values that are so large they translate into scientific notation on you.   "1234567890123456788901234567890" is NOT going to be counted as a number, as QB64 would expect to see this written as "1.234567E30", and your string definitely isn't going to compare to that string.  (And the values probably won't match either, as you lost multiple digits to rounding when it became a scientific notation value.) 

If you look close, you'll see that this function is basically one line of code, unless you happen to be passing it &H, &B, &O values -- in which case it has to work much harder to see if the string you passed it is a valid number, or not.  Wink

Print this item

  Amazing Grace to test out Web Audio API
Posted by: CharlieJV - 11-30-2022, 03:09 AM - Forum: QBJS, BAM, and Other BASICs - No Replies

BTW: at the end of the song, or after you stop the song, you'll have the option to play the song again.  Choose "Y", and then you can alter the tempo of the song and the waveform applied to the sounds.

Print this item

  Borderless window? RESIZE THIS!
Posted by: Pete - 11-29-2022, 11:46 PM - Forum: General Discussion - No Replies

Hey if you like borderless windows but want a way to resize them forget about using $RESIZE. It has no border to grab on to. Oh, if you don't mind ugly, or want an all black window, you can add a WS_THICKBORDER element to your API call, which Steve discovered, but it's ugly. (It leaves a thin black row just below the top white border in any window that has a colored background.) Anyway, if you don't mind that, you can use it with QB64 $RESIZE. If you want an alternative to $RESIZE, try something like this...

Try a mouse drag at any side or any corner to enlarge or shrink the borderless window. Esc to quit.

Code: (Select All)
DIM SHARED WinMse AS POINTAPI
TYPE POINTAPI
    X_Pos AS LONG
    Y_Pos AS LONG
END TYPE

DECLARE DYNAMIC LIBRARY "user32"
    FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
    FUNCTION GetAsyncKeyState% (BYVAL vkey AS LONG)
    FUNCTION GetCursorPos (lpPoint AS POINTAPI)
    FUNCTION FindWindowA& (BYVAL ClassName AS _OFFSET, WindowName$) 'handle by title
    REM FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG) 'maximize process
    FUNCTION GetForegroundWindow& 'Find currently focused process handle
    FUNCTION SetWindowPos& (BYVAL hWnd AS LONG, BYVAL hWndInsertAfter AS _OFFSET, BYVAL X AS INTEGER, BYVAL Y AS INTEGER, BYVAL cx AS INTEGER, BYVAL cy AS INTEGER, BYVAL uFlags AS _OFFSET)
    FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
    FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
    FUNCTION SetLayeredWindowAttributes& (BYVAL hwnd AS LONG, BYVAL crKey AS LONG, BYVAL bAlpha AS _UNSIGNED _BYTE, BYVAL dwFlags AS LONG)
    FUNCTION SetCursorPos% (BYVAL cx AS INTEGER, BYVAL cy AS INTEGER)
    SUB SENDKEYS ALIAS keybd_event (BYVAL bVk AS LONG, BYVAL bScan AS LONG, BYVAL dwFlags AS LONG, BYVAL dwExtraInfo AS LONG)
END DECLARE
DIM AS INTEGER setcurx, setcury, sizeit, oldmx, oldmy, x, y, fw, fh
x = _SCREENX
y = _SCREENY
w = _WIDTH
h = _HEIGHT
fw = _FONTWIDTH
fh = _FONTHEIGHT
DIM hWnd AS LONG
hWnd = _WINDOWHANDLE
_DELAY .1
GWL_STYLE = -16
WS_POPUP = &H4800000 ' Can be used to make a razor thin border but is not resizable.
ws_border = &H800000
WS_VISIBLE = &H10000000
DO
    winstyle& = GetWindowLongA&(hWnd, GWL_STYLE)
LOOP UNTIL winstyle&
DO
    a& = SetWindowLongA&(hWnd, GWL_STYLE, winstyle& AND WS_VISIBLE)
LOOP UNTIL a&
a& = SetWindowPos&(hWnd&, 0, 0, 0, 0, 0, 39) ' Required to allow printing where title bar used to be.
_DELAY .1
wintp = _SCREENY \ fh: winbt = _SCREENY \ fh + _HEIGHT: winlt = _SCREENX \ fw: winrt = _SCREENX \ fw + _WIDTH

DO
    _LIMIT 60
    WHILE _MOUSEINPUT: WEND
    IF _MOUSEBUTTON(1) THEN lb = 1 ELSE IF lb = 1 AND _MOUSEBUTTON(1) = 0 THEN lb = 0: side$ = "": enl = 0
    z& = GetCursorPos(WinMse)
    setcurx = WinMse.X_Pos: setcury = WinMse.Y_Pos
    WinMse.X_Pos = WinMse.X_Pos \ fw
    WinMse.Y_Pos = WinMse.Y_Pos \ fh

    IF lb THEN
        IF LEN(side$) THEN
            IF oldmx <> WinMse.X_Pos OR oldmy <> WinMse.Y_Pos THEN
                DO ' Falx loop.
                    SELECT CASE side$
                        CASE "left-top"
                            sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB topsize
                            sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB leftsize
                        CASE "right-top"
                            sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB topsize
                            sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB rightsize
                        CASE "left-bottom"
                            sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB leftsize
                            sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB bottomsize
                        CASE "right-bottom"
                            sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB rightsize
                            sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB bottomsize
                        CASE "top" ' up/down
                            sizeit = -SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB topsize
                        CASE "bottom"
                            sizeit = SGN(oldmy - WinMse.Y_Pos) * ABS(oldmy - WinMse.Y_Pos)
                            IF sizeit THEN GOSUB bottomsize
                        CASE "left"
                            sizeit = SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB leftsize
                        CASE "right"
                            sizeit = -SGN(oldmx - WinMse.X_Pos) * ABS(oldmx - WinMse.X_Pos)
                            IF sizeit THEN GOSUB rightsize
                    END SELECT
                    wintp = y \ fh: winbt = y \ fh + _HEIGHT: winlt = x \ fw: winrt = x \ fw + _WIDTH
                    EXIT DO
                LOOP
            END IF
        END IF
    ELSE
        IF WinMse.X_Pos = winlt AND WinMse.Y_Pos = wintp THEN
            _MOUSESHOW "TOPLEFT_BOTTOMRIGHT": side$ = "left-top"
        ELSEIF WinMse.X_Pos = winlt AND WinMse.Y_Pos = winbt THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "left-bottom"
        ELSEIF WinMse.X_Pos = winrt AND WinMse.Y_Pos = wintp THEN _MOUSESHOW "TOPRIGHT_BOTTOMLEFT": side$ = "right-top"
        ELSEIF WinMse.X_Pos = winrt AND WinMse.Y_Pos = winbt THEN _MOUSESHOW "TOPleft_BOTTOMRIGHT": side$ = "right-bottom"
        ELSEIF WinMse.X_Pos = winlt THEN _MOUSESHOW "HORIZONTAL": side$ = "left"
        ELSEIF WinMse.X_Pos = winrt THEN _MOUSESHOW "HORIZONTAL": side$ = "right"
        ELSEIF WinMse.Y_Pos = wintp THEN _MOUSESHOW "VERTICAL": side$ = "top"
        ELSEIF WinMse.Y_Pos = winbt THEN _MOUSESHOW "VERTICAL": side$ = "bottom"
        ELSE
            IF LEN(side$) THEN side$ = "": _MOUSESHOW "default"
        END IF
    END IF
    oldmx = WinMse.X_Pos: oldmy = WinMse.Y_Pos
    IF INKEY$ = CHR$(27) THEN SYSTEM
LOOP

topsize:
IF h - sizeit < 5 THEN RETURN
h = h - sizeit
x = _SCREENX
y = _SCREENY + sizeit * fh
WIDTH w, h
_FONT 16
_SCREENMOVE x, y
z% = SetCursorPos%(setcurx, setcury)
RETURN

leftsize:
IF w + sizeit < 15 THEN RETURN
w = w + sizeit
x = _SCREENX - sizeit * fw
y = _SCREENY
WIDTH w, h
_FONT 16
_SCREENMOVE x, y
z% = SetCursorPos%(x, setcury)
RETURN

rightsize:
IF w + sizeit < 15 THEN RETURN
w = w + sizeit
x = _SCREENX - sizeit * fw
y = _SCREENY
WIDTH w, h
_FONT 16
x = _SCREENX: y = _SCREENY
z% = SetCursorPos%(x + _WIDTH * fw, setcury)
RETURN

bottomsize:
IF h - sizeit < 5 THEN RETURN
h = h - sizeit
WIDTH w, h
_FONT 16
x = _SCREENX: y = _SCREENY
z% = SetCursorPos%(setcurx, y + _HEIGHT * fh)
RETURN

Something I may try later is using the _NEWIMAGE equivalent of SCREEN 0. I'd like to see if that would eliminate the need to load QB64 default 16 size font. One problem with window sizing in SCREEN 0 is that 16 size font gets traded out at different sizes with what I think is the 8 size square font. Anyway, that causes irregular resizing results. Specifying _FONT 16 prevents that occurrence.

As always, if anyone has any improvement suggestions, go ahead and post them. A nice perk to sharing code is more minds often results in more performance.

Pete

Print this item

  3d, maptriangle, fps...ect
Posted by: MasterGy - 11-29-2022, 06:55 PM - Forum: MasterGy - Replies (3)

Finally everything works properly. A system that can be easily extended from non-source code. I created a structure that allows us to parameterize everything with a simple notepad. Add new maps, terrain, and textures quickly.
I want to make a game that I haven't made before. I deleted the shooting part. There is already such a game. An adventure game with missions and characters would be nice. If you have any ideas, I'd love to read them. even if it seems funny at first. I'm interested in any ideas! moreover, if we could collectively build a game in some form, where more people could take part, that would be wonderful.
It can be tried for now. there is no task, but you can walk around the huge space. There is a lot of garbage among the files, that's why it was 240 Mb, so sorry!


download:
https://drive.google.com/file/d/1yWJ4S9h...sp=sharing


[Image: v25-01-2022-11-29-19-49-47-24.jpg]

[Image: v25-01-2022-11-29-19-50-06-69.jpg]

[Image: v25-01-2022-11-29-19-50-54-33.jpg]

Print this item

  Wiki Code Error on _PRINTIMAGE
Posted by: NasaCow - 11-29-2022, 01:44 PM - Forum: Wiki Discussion - Replies (5)

FYI

_printimage first code set throws a syntax error on line 24
_PRINTIMAGE - QB64 Phoenix Edition Wiki

[Image: image.png]

Changed the offending line from:
_PUTIMAGE Page&, Prev&

To:
_PUTIMAGE (0, 0), Page&, Prev&

And all good!

Print this item

Question Formatting Text File Output
Posted by: NasaCow - 11-29-2022, 12:39 PM - Forum: Help Me! - Replies (7)

Not sure what I really can do as a report printer to file. Does QB64 have any functions that deal with formatting text to file? I poked around the board and the wiki and haven't really found anything. Any thoughts or leads? Ideally, I would like to center lines on a page (without having to manually space things), maybe some font or styles. Do we have any support for RTF (or PDF, if I may be bold Confused ) in QB64 itself or a library that we can use?

Any help would be appreciative, other than report output. The student database is up and running. It is time to start thinking about the gradebook side as well!

Thanks y'a11!

Print this item

  QIX
Posted by: james2464 - 11-29-2022, 02:36 AM - Forum: Works in Progress - Replies (13)

Making my way through this game, thought I'd share what I have done so far.

For those not familiar, it's an old arcade game from 1981.   The idea is to fill in 75% of the screen to complete a level.   (So far no scores yet, and unlimited lives)

Still some things missing (like those sparks) and there are some bugs to sort out.   No sound either - not sure how I'll do that because the original game had bad sound effects.

One thing I'd like to do eventually is learn a flood fill algorithm.   I struggled with that and decided to just use paint for now.   Flood fill in this case was more complicated than I was expecting it to be.   But it'd be nice to do it like the original game does.

Code: (Select All)
'QB64 Qix
'james2464 - November 2022

'controls : arrow keys to move
'        : left CTRL for fast draw (blue)
'        : left ALT for slow draw (red)


_FullScreen
Option _Explicit

Dim Shared scx, scy
scx = 610: scy = 500

Screen _NewImage(scx, scy, 32)

Const PI = 3.141592654#
Randomize Timer

Dim Shared bg&, dbg&, logo1
bg& = _NewImage(scx, scy, 32)
dbg& = _NewImage(scx, scy, 32)

Dim Shared xx, yy, t, olddir, x, y, h, hd, fl, fl2, ct
Dim Shared sdinprocess, fdinprocess As Integer
Dim Shared qpath, flag, n, movepermit, flagrestart As Integer
Dim Shared qixtot, qxv, qyv, f, pmove, pfast, pslow, oldpx, oldpy, ps, drawoldx, drawoldy
Dim Shared j, k, checkx1, checkx2, checky1, checky2, totpct, btot, rtot
Dim Shared bluetot, redtot As _Integer64

'origin
xx = 320: yy = 240

Dim Shared c(50) As Long
c(0) = _RGB(0, 0, 0)
c(1) = _RGB(200, 200, 210) 'outside border
c(2) = _RGB(255, 255, 255) 'cursor white dot
c(3) = _RGB(200, 100, 100)
c(4) = _RGB(50, 120, 150) 'fast zone (fill)
c(5) = _RGB(180, 60, 30) 'slow zone (fill)
c(6) = _RGB(0, 255, 0)
c(7) = _RGB(255, 0, 0) 'cursor red
c(44) = _RGB(50, 120, 155) 'fast zone (drawing lines)
c(45) = _RGB(185, 60, 30) 'slow zone (drawing lines)



Type player
    x As Single
    y As Single
End Type
Dim Shared pl As player



Type qix
    dir As Single
    x1 As Integer
    x2 As Integer
    y1 As Integer
    y2 As Integer
    xx As Single
    yy As Single
    len1 As Single
    c1 As Integer
    c2 As Integer
    c3 As Integer
End Type
Dim Shared q(7) As qix
Dim Shared qd(7) As qix


qixtot = 7: qpath = 0: f = 1
ps = 5


Do
    'start
    pl.x = 320: pl.y = 440
    flagrestart = 0

    For t = 1 To qixtot
        q(t).xx = xx: q(t).yy = yy: q(t).len1 = 40
    Next t

    '_MouseHide

    Cls

    'screen setup
    Line (120, 40)-(520, 440), c(1), B 'outer border

    '_PutImage (500, 50), logo1

    bluetot = 0: redtot = 0

    _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen

    Do

        _Limit 20



        'player cursor                =======================================================================================

        'get keyboard input
        pmove = arrowkey
        pfast = fastdraw
        pslow = slowdraw

        oldpx = pl.x: oldpy = pl.y

        If pfast + pslow = 0 Then normalmove
        If pfast > pslow Then fastdrawmove
        If pfast < pslow Then slowdrawmove




        'ok so about that qix thing....=======================================================================================


        'heading and direction  -----------------------------------------------------
        If qpath < 1 Then
            If qpath = 0 Then
                '_Delay 1.
                qpath = Int(Rnd * 11) + 1: qxv = Rnd * 30 - 15: qyv = Rnd * 30 - 15
                olddir = q(1).dir: q(1).dir = olddir + Rnd * PI - PI / 2
            End If
            If qpath = -1 Then
                '_Delay .5
                qpath = (Rnd * 22) + 1: qxv = Rnd * 30 - 15: qyv = Rnd * 30 - 15
                olddir = q(1).dir
                If olddir > PI Then
                    q(1).dir = olddir - PI
                Else
                    q(1).dir = olddir + PI
                End If
            End If
        End If

        qpath = Int(qpath - 1)

        'update trailing lines -----------------------------------------------------
        For t = 7 To 2 Step -1
            q(t).xx = q(t - 1).xx: q(t).yy = q(t - 1).yy
            q(t).x1 = q(t - 1).x1: q(t).x2 = q(t - 1).x2
            q(t).y1 = q(t - 1).y1: q(t).y2 = q(t - 1).y2
            q(t).len1 = q(t - 1).len1
            q(t).c1 = q(t - 1).c1: q(t).c2 = q(t - 1).c2: q(t).c3 = q(t - 1).c3
        Next t


        'collision detection -------------------------------------------------------

        flag = 0 'collision - assume none to start

        q(1).xx = q(1).xx + qxv
        q(1).yy = q(1).yy + qyv



        q(1).dir = q(1).dir + Rnd * .9 - .45
        q(1).len1 = q(1).len1 + Rnd * 10 - 4.4
        If q(1).len1 > 40 Then q(1).len1 = 40
        If q(1).len1 < 5 Then q(1).len1 = 5

        x = Cos(q(1).dir) * q(1).len1
        y = Sin(q(1).dir) * q(1).len1
        q(1).x1 = q(1).xx + x: q(1).x2 = q(1).xx - x
        q(1).y1 = q(1).yy - y: q(1).y2 = q(1).yy + y


        'scan background colour along line
        For j = 0 To q(1).len1
            x = Cos(q(1).dir) * j: y = Sin(q(1).dir) * j
            checkx1 = q(1).xx + x: checkx2 = q(1).xx - x
            checky1 = q(1).yy - y: checky2 = q(1).yy + y
            c(19) = Point(checkx1, checky1)
            c(20) = Point(checkx2, checky2)
            If c(19) <> c(0) Then
                Select Case c(19)
                    Case c(1)
                        flag = 1
                    Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
                        flag = 1
                    Case c(44), c(7)
                        If fdinprocess = 1 Then
                            flag = 2
                        End If
                    Case c(45), c(7)
                        If sdinprocess = 1 Then
                            flag = 2
                        End If
                End Select
            End If
            If c(20) <> c(0) Then
                Select Case c(20)
                    Case c(1)
                        flag = 1
                    Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
                        flag = 1
                    Case c(44), c(7)
                        If fdinprocess = 1 Then
                            flag = 2
                        End If
                    Case c(45), c(7)
                        If sdinprocess = 1 Then
                            flag = 2
                        End If
                End Select
            End If
        Next j

        'check for skipped/crossed line
        h = _Hypot(qyv, qxv)
        hd = _Atan2(-qxv, -qyv)

        For j = 0 To Int(h) Step .5
            x = Sin(-hd) * j: y = Cos(hd) * j
            checkx2 = q(1).xx - x
            checky2 = q(1).yy + y
            c(20) = Point(checkx2, checky2)
            If c(20) <> c(0) Then
                Select Case c(20)
                    Case c(1)
                        flag = 1
                    Case q(2).c1, q(3).c1, q(4).c1, q(5).c1, q(6).c1, q(7).c1
                        flag = 1
                    Case c(4), c(7)
                        If fdinprocess = 1 Then
                            flag = 2
                        End If
                    Case c(5), c(7)
                        If sdinprocess = 1 Then
                            flag = 2
                        End If
                End Select
            End If
        Next j


        'changing colour
        q(1).c1 = q(1).c1 + Rnd * 60 - 30
        If q(1).c1 < 80 Then q(1).c1 = 80
        If q(1).c1 > 255 Then q(1).c1 = 255
        q(1).c2 = q(1).c2 + Rnd * 60 - 30
        If q(1).c2 < 80 Then q(1).c2 = 80
        If q(1).c2 > 255 Then q(1).c2 = 255
        q(1).c3 = q(1).c3 + Rnd * 60 - 30
        If q(1).c3 < 80 Then q(1).c3 = 80
        If q(1).c3 > 255 Then q(1).c3 = 255


        'if collision detected...
        If flag = 1 Then
            qpath = -1 'new path needed - reverse direction
            q(1).xx = q(3).xx: q(1).yy = q(3).yy
            q(1).x1 = q(3).x1: q(1).x2 = q(3).x2
            q(1).y1 = q(3).y1: q(1).y2 = q(3).y2
            q(1).len1 = q(3).len1 - 3 'shorter line
        End If

        If flag = 2 Then
            youdead
            _PutImage (1, 1)-(scx, scy), dbg&, bg&, (1, 1)-(scx, scy)
        End If


        '====================================================================================================
        '====================================================================================================
        '====================================================================================================
        '====================================================================================================



        Cls

        _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background


        For t = 1 To qixtot
            c(9) = _RGB(q(t).c1, q(t).c2, q(t).c3)
            Line (q(t).x1, q(t).y1)-(q(t).x2, q(t).y2), c(9)
        Next t

        Line (pl.x - ps, pl.y)-(pl.x, pl.y - ps), c(7)
        Line (pl.x, pl.y - ps)-(pl.x + ps, pl.y), c(7)
        Line (pl.x + ps, pl.y)-(pl.x, pl.y + ps), c(7)
        Line (pl.x, pl.y + ps)-(pl.x - ps, pl.y), c(7)
        Line (pl.x - 1, pl.y)-(pl.x + 1, pl.y), c(2)
        Line (pl.x, pl.y - 1)-(pl.x, pl.y + 1), c(2)


        btot = Int(bluetot / 1570)
        rtot = Int(redtot / 1570)
        totpct = Int(btot + rtot)

        Locate 29, 20
        Print "BLUE:"; btot; "%"
        Locate 29, 36
        Print "RED:"; rtot; "%"
        Locate 29, 52
        Print "TOTAL:"; totpct; "%"





        _Display

        If sdinprocess < 0 Then
            _Delay .8
            sdinprocess = 0
        End If

        If fdinprocess < 0 Then
            _Delay .8
            fdinprocess = 0
        End If

        If totpct > 75 Then
            endlevel
            flagrestart = 1
        End If

        If _KeyDown(15104) Then
            endlevel
            flagrestart = 1
        End If


    Loop Until flagrestart = 1

Loop

Function arrowkey
    arrowkey = 0
    If _KeyDown(18432) Then '                                IF up arrow key was pressed
        arrowkey = 1 '
    End If
    If _KeyDown(20480) Then '                                IF down arrow key was pressed
        arrowkey = 2 '
    End If
    If _KeyDown(19200) Then '                                IF left arrow key was pressed
        arrowkey = 3 '
    End If
    If _KeyDown(19712) Then '                                IF right arrow key was pressed
        arrowkey = 4 '
    End If
End Function

Function fastdraw
    fastdraw = 0
    If _KeyDown(100306) Then '                                  IF L-CTRL key was pressed
        fastdraw = 1 '
    End If
End Function

Function slowdraw
    slowdraw = 0
    If _KeyDown(100308) Then '                                  IF L-ALT key was pressed
        slowdraw = 1 '
    End If
End Function

'-----------------------------------------------------------------------------------------------------------------



Sub normalmove
    Select Case pmove
        Case 1
            pl.y = pl.y - 4
            c(19) = Point(pl.x, pl.y)
            c(20) = Point(pl.x + 1, pl.y)
            c(21) = Point(pl.x - 1, pl.y)
            c(22) = Point(pl.x, pl.y + 1)
            c(23) = Point(pl.x, pl.y - 1)
            c(24) = Point(pl.x + 1, pl.y + 1)
            c(25) = Point(pl.x - 1, pl.y - 1)
            c(26) = Point(pl.x - 1, pl.y + 1)
            c(27) = Point(pl.x + 1, pl.y - 1)
            fl2 = 0
            For fl = 20 To 27 Step 1
                If c(fl) = c(0) Then fl2 = 1
            Next fl
            movepermit = 0
            While movepermit = 0
                If c(19) = c(1) And fl2 > 0 Then
                    movepermit = 1
                Else
                    pl.y = pl.y + 2
                    c(19) = Point(pl.x, pl.y)
                    c(20) = Point(pl.x + 1, pl.y)
                    c(21) = Point(pl.x - 1, pl.y)
                    c(22) = Point(pl.x, pl.y + 1)
                    c(23) = Point(pl.x, pl.y - 1)
                    c(24) = Point(pl.x + 1, pl.y + 1)
                    c(25) = Point(pl.x - 1, pl.y - 1)
                    c(26) = Point(pl.x - 1, pl.y + 1)
                    c(27) = Point(pl.x + 1, pl.y - 1)
                    fl2 = 0
                    For fl = 20 To 27 Step 1
                        If c(fl) = c(0) Then fl2 = 1
                    Next fl
                    If c(19) = c(1) And fl2 > 0 Then
                        movepermit = 1
                    Else
                        pl.y = pl.y + 2
                        movepermit = -1
                    End If
                End If
            Wend

        Case 2
            pl.y = pl.y + 4
            c(19) = Point(pl.x, pl.y)
            c(20) = Point(pl.x + 1, pl.y)
            c(21) = Point(pl.x - 1, pl.y)
            c(22) = Point(pl.x, pl.y + 1)
            c(23) = Point(pl.x, pl.y - 1)
            c(24) = Point(pl.x + 1, pl.y + 1)
            c(25) = Point(pl.x - 1, pl.y - 1)
            c(26) = Point(pl.x - 1, pl.y + 1)
            c(27) = Point(pl.x + 1, pl.y - 1)
            fl2 = 0
            For fl = 20 To 27 Step 1
                If c(fl) = c(0) Then fl2 = 1
            Next fl
            movepermit = 0
            While movepermit = 0
                If c(19) = c(1) And fl2 > 0 Then
                    movepermit = 1
                Else
                    pl.y = pl.y - 2
                    c(19) = Point(pl.x, pl.y)
                    c(20) = Point(pl.x + 1, pl.y)
                    c(21) = Point(pl.x - 1, pl.y)
                    c(22) = Point(pl.x, pl.y + 1)
                    c(23) = Point(pl.x, pl.y - 1)
                    c(24) = Point(pl.x + 1, pl.y + 1)
                    c(25) = Point(pl.x - 1, pl.y - 1)
                    c(26) = Point(pl.x - 1, pl.y + 1)
                    c(27) = Point(pl.x + 1, pl.y - 1)
                    fl2 = 0
                    For fl = 20 To 27 Step 1
                        If c(fl) = c(0) Then fl2 = 1
                    Next fl
                    If c(19) = c(1) And fl2 > 0 Then
                        movepermit = 1
                    Else
                        pl.y = pl.y - 2
                        movepermit = -1
                    End If
                End If
            Wend

        Case 3
            pl.x = pl.x - 4
            c(19) = Point(pl.x, pl.y)
            c(20) = Point(pl.x + 1, pl.y)
            c(21) = Point(pl.x - 1, pl.y)
            c(22) = Point(pl.x, pl.y + 1)
            c(23) = Point(pl.x, pl.y - 1)
            c(24) = Point(pl.x + 1, pl.y + 1)
            c(25) = Point(pl.x - 1, pl.y - 1)
            c(26) = Point(pl.x - 1, pl.y + 1)
            c(27) = Point(pl.x + 1, pl.y - 1)
            fl2 = 0
            For fl = 20 To 27 Step 1
                If c(fl) = c(0) Then fl2 = 1
            Next fl

            movepermit = 0
            While movepermit = 0
                If c(19) = c(1) And fl2 > 0 Then
                    movepermit = 1
                Else
                    pl.x = pl.x + 2
                    c(19) = Point(pl.x, pl.y)
                    c(20) = Point(pl.x + 1, pl.y)
                    c(21) = Point(pl.x - 1, pl.y)
                    c(22) = Point(pl.x, pl.y + 1)
                    c(23) = Point(pl.x, pl.y - 1)
                    c(24) = Point(pl.x + 1, pl.y + 1)
                    c(25) = Point(pl.x - 1, pl.y - 1)
                    c(26) = Point(pl.x - 1, pl.y + 1)
                    c(27) = Point(pl.x + 1, pl.y - 1)
                    fl2 = 0
                    For fl = 20 To 27 Step 1
                        If c(fl) = c(0) Then fl2 = 1
                    Next fl
                    If c(19) = c(1) And fl2 > 0 Then
                        movepermit = 1
                    Else
                        pl.x = pl.x + 2
                        movepermit = -1
                    End If
                End If
            Wend

        Case 4
            pl.x = pl.x + 4
            c(19) = Point(pl.x, pl.y)
            c(20) = Point(pl.x + 1, pl.y)
            c(21) = Point(pl.x - 1, pl.y)
            c(22) = Point(pl.x, pl.y + 1)
            c(23) = Point(pl.x, pl.y - 1)
            c(24) = Point(pl.x + 1, pl.y + 1)
            c(25) = Point(pl.x - 1, pl.y - 1)
            c(26) = Point(pl.x - 1, pl.y + 1)
            c(27) = Point(pl.x + 1, pl.y - 1)
            fl2 = 0
            For fl = 20 To 27 Step 1
                If c(fl) = c(0) Then fl2 = 1
            Next fl
            movepermit = 0
            While movepermit = 0
                If c(19) = c(1) And fl2 > 0 Then
                    movepermit = 1
                Else
                    pl.x = pl.x - 2
                    c(19) = Point(pl.x, pl.y)
                    c(20) = Point(pl.x + 1, pl.y)
                    c(21) = Point(pl.x - 1, pl.y)
                    c(22) = Point(pl.x, pl.y + 1)
                    c(23) = Point(pl.x, pl.y - 1)
                    c(24) = Point(pl.x + 1, pl.y + 1)
                    c(25) = Point(pl.x - 1, pl.y - 1)
                    c(26) = Point(pl.x - 1, pl.y + 1)
                    c(27) = Point(pl.x + 1, pl.y - 1)
                    fl2 = 0
                    For fl = 20 To 27 Step 1
                        If c(fl) = c(0) Then fl2 = 1
                    Next fl
                    If c(19) = c(1) And fl2 > 0 Then
                        movepermit = 1
                    Else
                        pl.x = pl.x - 2
                        movepermit = -1
                    End If
                End If
            Wend

    End Select
End Sub



Sub fastdrawmove
    Select Case pmove

        Case 1
            pl.y = pl.y - 4
            If pl.y < 40 Then pl.y = 40
            c(19) = Point(pl.x, pl.y)
            c(18) = Point(pl.x, pl.y + 2)
            movepermit = 0
            While movepermit = 0
                If c(18) = c(0) Then
                    movepermit = 1
                Else
                    pl.y = pl.y + 2
                    If c(18) = c(1) Then
                        movepermit = 1
                    Else
                        pl.y = pl.y + 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 2
            pl.y = pl.y + 4
            If pl.y > 440 Then pl.y = 440
            c(19) = Point(pl.x, pl.y)
            c(18) = Point(pl.x, pl.y - 2)
            movepermit = 0
            While movepermit = 0
                If c(18) = c(0) Then
                    movepermit = 1
                Else
                    pl.y = pl.y - 2
                    If c(18) = c(1) Then
                        movepermit = 1
                    Else
                        pl.y = pl.y - 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 3
            pl.x = pl.x - 4
            If pl.x < 120 Then pl.x = 120
            c(19) = Point(pl.x, pl.y)
            c(18) = Point(pl.x + 2, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(18) = c(0) Then
                    movepermit = 1
                Else
                    pl.x = pl.x + 2
                    If c(18) = c(1) Then
                        movepermit = 1
                    Else
                        pl.x = pl.x + 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 4
            pl.x = pl.x + 4
            If pl.x > 520 Then pl.x = 520
            c(19) = Point(pl.x, pl.y)
            c(18) = Point(pl.x - 2, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(18) = c(0) Then
                    movepermit = 1
                Else
                    pl.x = pl.x - 2
                    If c(18) = c(1) Then
                        movepermit = 1
                    Else
                        pl.x = pl.x - 2
                        movepermit = -1
                    End If
                End If
            Wend
    End Select


    c(19) = Point(pl.x, pl.y)
    If c(19) = c(0) Then
        Cls
        _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
        If fdinprocess = 0 Then
            drawoldx = oldpx: drawoldy = oldpy
            _PutImage (1, 1)-(scx - 1, scy - 1), 0, dbg&, (1, 1)-(scx, scy) 'take snapshot of screen - in case of death
        End If
        Line (oldpx, oldpy)-(pl.x, pl.y), c(44)
        If fdinprocess = 0 Then
            PSet (oldpx, oldpy), c(1)
        End If
        fdinprocess = 1
        _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
    End If

    If fdinprocess = 1 Then
        c(19) = Point(pl.x, pl.y)
        If c(19) = c(1) Then 'fast draw completed
            Cls
            _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
            Line (oldpx, oldpy)-(pl.x, pl.y), c(44)
            PSet (pl.x, pl.y), c(1)
            fdinprocess = -1
            claimlinefast
            claimfillfast
            _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
        End If
    End If

End Sub


Sub slowdrawmove
    Select Case pmove
        Case 1
            pl.y = pl.y - 2
            If pl.y < 40 Then pl.y = 40
            c(19) = Point(pl.x, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(19) = c(0) Then
                    movepermit = 1
                Else
                    If c(19) = c(1) Then
                        movepermit = 1
                    Else
                        pl.y = pl.y + 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 2
            pl.y = pl.y + 2
            If pl.y > 440 Then pl.y = 440
            c(19) = Point(pl.x, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(19) = c(0) Then
                    movepermit = 1
                Else
                    If c(19) = c(1) Then
                        movepermit = 1
                    Else
                        pl.y = pl.y - 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 3
            pl.x = pl.x - 2
            If pl.x < 120 Then pl.x = 120
            c(19) = Point(pl.x, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(19) = c(0) Then
                    movepermit = 1
                Else
                    If c(19) = c(1) Then
                        movepermit = 1
                    Else
                        pl.x = pl.x + 2
                        movepermit = -1
                    End If
                End If
            Wend


        Case 4
            pl.x = pl.x + 2
            If pl.x > 520 Then pl.x = 520
            c(19) = Point(pl.x, pl.y)
            movepermit = 0
            While movepermit = 0
                If c(19) = c(0) Then
                    movepermit = 1
                Else
                    If c(19) = c(1) Then
                        movepermit = 1
                    Else
                        pl.x = pl.x - 2
                        movepermit = -1
                    End If
                End If
            Wend
    End Select



    c(19) = Point(pl.x, pl.y)
    If c(19) = c(0) Then
        Cls
        _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
        If sdinprocess = 0 Then
            drawoldx = oldpx: drawoldy = oldpy
            _PutImage (1, 1)-(scx - 1, scy - 1), 0, dbg&, (1, 1)-(scx, scy) 'take snapshot of screen - in case of death
        End If
        Line (oldpx, oldpy)-(pl.x, pl.y), c(45)
        If sdinprocess = 0 Then
            PSet (oldpx, oldpy), c(1)
        End If
        sdinprocess = 1
        _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
    End If

    If sdinprocess = 1 Then
        c(19) = Point(pl.x, pl.y)
        If c(19) = c(1) Then 'slow draw completed
            Cls
            _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen
            Line (oldpx, oldpy)-(pl.x, pl.y), c(45)
            PSet (pl.x, pl.y), c(1)
            sdinprocess = -1
            claimlineslow
            claimfillslow
            _PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx, scy) 'take snapshot of screen
        End If
    End If

End Sub



Sub claimlinefast
    'scan board for blue line
    For j = 41 To 439
        For k = 121 To 519
            c(19) = Point(k, j)
            n = 0
            If c(19) = c(44) Then 'blue pixel found
                c(20) = Point(k - 1, j)
                c(21) = Point(k + 1, j)
                c(22) = Point(k, j - 1)
                c(23) = Point(k, j + 1)
                c(24) = Point(k, j + 2)
                c(25) = Point(k, j - 2)
                c(26) = Point(k + 2, j)

                'horizontal line
                If c(22) = c(0) Then 'look above
                    If c(23) = c(0) Then n = Int(2) 'look below
                End If

                'upper left corner
                If n = 0 Then
                    'look below 2 pixels
                    If c(23) = c(44) Then
                        If c(24) = c(44) Then
                            If c(20) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If

                'upper right corner
                If n = 0 Then
                    'look below 2 pixels
                    If c(23) = c(44) Then
                        If c(24) = c(44) Then
                            If c(21) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If


                'lower left corner
                If n = 0 Then
                    'look to the right 2 pixels
                    If c(21) = c(44) Then
                        If c(26) = c(44) Then
                            If c(23) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If


                'lower right corner
                If n = 0 Then
                    'look above 2 pixels
                    If c(22) = c(1) Then
                        If c(25) = c(1) Then
                            If c(23) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If


                'if part of vertical line
                If c(20) = c(0) Then
                    If c(21) = c(0) Then n = Int(2)
                End If


                If n = 2 Then
                    PSet (k, j), c(1) 'change blue pixel to white
                End If
            End If
        Next k
    Next j
End Sub


Sub claimlineslow
    'scan board for red line
    For j = 41 To 439
        For k = 121 To 519
            c(19) = Point(k, j)
            n = 0
            If c(19) = c(45) Then 'red pixel found
                c(20) = Point(k - 1, j)
                c(21) = Point(k + 1, j)
                c(22) = Point(k, j - 1)
                c(23) = Point(k, j + 1)
                c(24) = Point(k, j + 2)
                c(25) = Point(k, j - 2)
                c(26) = Point(k + 2, j)

                'horizontal line
                If c(22) = c(0) Then 'look above
                    If c(23) = c(0) Then n = Int(2) 'look below
                End If

                'upper left corner
                If n = 0 Then
                    'look below 2 pixels
                    If c(23) = c(45) Then
                        If c(24) = c(45) Then
                            If c(20) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If

                'upper right corner
                If n = 0 Then
                    'look below 2 pixels
                    If c(23) = c(45) Then
                        If c(24) = c(45) Then
                            If c(21) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If



                'if lower left corner
                If n = 0 Then
                    'look to the right 2 pixels
                    If c(21) = c(45) Then
                        If c(26) = c(45) Then
                            If c(23) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If

                'if lower right corner
                If n = 0 Then
                    'look above 2 pixels
                    If c(22) = c(1) Then
                        If c(25) = c(1) Then
                            If c(23) = c(0) Then
                                n = Int(2)
                            End If
                        End If
                    End If
                End If

                'if part of vertical line
                If c(20) = c(0) Then
                    If c(21) = c(0) Then n = Int(2)
                End If


                If n = 2 Then
                    PSet (k, j), c(1) 'change red pixel to white
                End If
            End If
        Next k
    Next j
End Sub



Sub claimfillfast 'using paint for flood fills
    'start at qix
    c(14) = _RGB(30, 30, 30)
    k = q(1).xx: j = q(1).yy
    Paint (k, j), c(14), c(1)

    'fill black with blue
    For j = 41 To 439
        For k = 121 To 519
            c(16) = Point(k, j)
            If c(16) = c(0) Then
                PSet (k, j), c(4)
                bluetot = bluetot + 1
            End If
        Next k
    Next j

    'fill gray with black
    k = q(1).xx: j = q(1).yy
    Paint (k, j), c(0), c(1)
End Sub


Sub claimfillslow 'using paint for flood fills

    'start at qix
    c(14) = _RGB(30, 30, 30)
    k = q(1).xx: j = q(1).yy
    Paint (k, j), c(14), c(1)

    'fill black with red
    For j = 41 To 439
        For k = 121 To 519
            c(16) = Point(k, j)
            If c(16) = c(0) Then
                PSet (k, j), c(5)
                redtot = redtot + 1
            End If
        Next k
    Next j

    'fill gray with black
    k = q(1).xx: j = q(1).yy
    Paint (k, j), c(0), c(1)
End Sub



Sub endlevel
    'fill black
    For j = 121 To 519
        For k = 439 To 41 Step -1
            PSet (j, k), c(0)
        Next k
        _Display
        _Delay .005
    Next j
End Sub



Sub youdead
    Dim ct2, ct3, ct4, basedir, tx, ty, dist, d2, rp

    basedir = .785
    dist = 15
    d2 = 10
    qd(1).xx = pl.x + 5: qd(1).yy = pl.y - 5
    qd(1).len1 = 10
    qd(1).dir = basedir



    For ct = 1 To 35
        Cls
        _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background screen

        dist = dist + 10
        rp = ct
        If rp > 7 Then rp = 7


        qd(1).dir = basedir
        qd(1).len1 = qd(1).len1 + 1.5

        If rp > 1 Then
            For ct4 = 2 To rp
                qd(ct4).len1 = qd(ct4 - 1).len1 - 1.5
                qd(ct4).dir = basedir
            Next ct4
        End If

        For ct2 = 1 To rp
            For ct3 = 1 To 4
                Select Case ct3
                    Case 1
                        qd(ct2).xx = pl.x + (dist - ct2 * d2): qd(ct2).yy = pl.y - (dist - ct2 * d2)
                    Case 2
                        qd(ct2).xx = pl.x + (dist - ct2 * d2): qd(ct2).yy = pl.y + (dist - ct2 * d2)
                    Case 3
                        qd(ct2).xx = pl.x - (dist - ct2 * d2): qd(ct2).yy = pl.y + (dist - ct2 * d2)
                    Case 4
                        qd(ct2).xx = pl.x - (dist - ct2 * d2): qd(ct2).yy = pl.y - (dist - ct2 * d2)
                End Select

                qd(ct2).dir = qd(ct2).dir + (PI / 2)
                x = Cos(qd(ct2).dir) * qd(ct2).len1
                y = Sin(qd(ct2).dir) * qd(ct2).len1
                qd(ct2).x1 = qd(ct2).xx + x: qd(ct2).x2 = qd(ct2).xx - x
                qd(ct2).y1 = qd(ct2).yy - y: qd(ct2).y2 = qd(ct2).yy + y
                Line (qd(ct2).x1, qd(ct2).y1)-(qd(ct2).x2, qd(ct2).y2), c(1)
            Next ct3
        Next ct2


        _Display
        _Delay .04
    Next ct



    _Delay 1.
    sdinprocess = 0
    fdinprocess = 0
    pl.x = drawoldx: pl.y = drawoldy

End Sub

Print this item

  Christmas Game find the missing presents
Posted by: Gadgetjack - 11-29-2022, 01:55 AM - Forum: Programs - Replies (1)



Attached Files Thumbnail(s)
   

.zip   XmasGame.zip (Size: 734.69 KB / Downloads: 47)
Print this item