b+ Beginners Corner - Printable Version

Code: (Select All)

Option _Explicit '                          Get into this habit and save yourself grief from Typos



_Title "Missile Command EnRitchied" '     another b+ mod 2023-06-24, replace distance with _Hypot.

'                                   I probably picked up this game at the JB forum some years ago.



'    Get Constants, Shared Variables and Arrays() declared. These Will Start with Capital Letters.

'        Get Main module variables and arrays declared with starting lower case letters for local.

'         This is what Option _Explicit helps, by forcing us to at least declare these before use.

'       While declaring, telling QB64 the Type we want to use, we can also give brief description.





Const ScreenWidth = 800, ScreenHeight = 600 '                     for our custom screen dimensions

Dim As Integer bombX, bombY '                          incoming bomb screen position to shoot down

Dim As Single bombDX, bombDY '                  DX and DY mean change in X position and Y position

Dim As Integer missileX, missileY '                                               missile position

Dim As Single missileDX, missileDY '                            change X and Y of Missile position

Dim As Integer hits, misses '                                                score hits and misses

Dim As Integer mouseDistanceX, mouseDistanceY '       for calculations of missile DX, DY direction

Dim As Single distance '                                                                     ditto

Dim As Integer radius '                                      drawing hits with target like circles

Dim As Integer boolean '                         to shorten the code line with a bunch of OR tests



Screen _NewImage(ScreenWidth, ScreenHeight, 32) ' sets up a graphics screen with custom dimensions

'                                          the 32 is for _RGB32(red, green, blue, alpha) coloring.

'

_ScreenMove 250, 60 '             this centers screen in my laptop, you may need different numbers



InitializeForRound: '                             reset game and start a round with a bomb falling

Cls

bombX = Rnd * ScreenWidth '                                starts bomb somewhere across the screen

bombY = 0 '                                                           starts bomb at top of screen

bombDX = Rnd * 6 - 3 '                                  pick rnd dx = change in x between -3 and 3

bombDY = Rnd * 3 + 3 '                 pick rnd dy = change in y between 3 and 6,  > 0 for falling

missileX = ScreenWidth / 2 '                                  missile base at middle across screen

missileY = ScreenHeight - 4 '   missile launch point at missile base is nearly at bottom of screen

missileDX = 0 '                           missile is not moving awaiting mouse click for direction

missileDY = 0 '                                                                              ditto

distance = 0 '                                             distance of mouse click to missile base



Do

    'what's the score?

    _Title "Click mouse to intersect incoming   Hits:" + Str$(hits) + ", misses:" + Str$(misses)

    _PrintString (400, 594), "^" '                                 draw missle base = launch point

    While _MouseInput: Wend '                                             poll mouse to get update

    If _MouseButton(1) Then '               the mouse was clicked calc the angle from missile base

        mouseDistanceX = _MouseX - missileX

        mouseDistanceY = _MouseY - missileY



        'distance = (mouseDistanceX ^ 2 + mouseDistanceY ^ 2) ^ .5

        '                   rewrite the above line using _Hypot() which is hidden distance forumla

        distance = _Hypot(mouseDistanceX, mouseDistanceY)



        missileDX = 5 * mouseDistanceX / distance

        missileDY = 5 * mouseDistanceY / distance

    End If



    missileX = missileX + missileDX '                                      update missile position

    missileY = missileY + missileDY '                                                        ditto

    bombX = bombX + bombDX '                                                  update bomb position

    bombY = bombY + bombDY '                                                                 ditto



    '                     I am about to use a boolean variable to shorten a very long IF code line

    '                                 boolean is either 0 or -1 when next 2 statements are execued

    '                                            -1/0 or True/False is everything still in screen?

    boolean = missileX < 0 Or missileY < 0 Or bombX < 0 Or bombY < 0

    boolean = boolean Or missileX > ScreenWidth Or bombX > ScreenWidth Or bombY > ScreenHeight

    If boolean Then '                                                       done with this boolean

        '   reuse boolean to shorten another long code line checking if bomb and missile in screen

        boolean = bombY > ScreenHeight Or missileX < 0 Or missileY < 0 Or missileX > ScreenWidth

        If boolean Then misses = misses + 1

        GoTo InitializeForRound

    End If



    '     if the distance between missle and bomb < 20 pixels then the missile got the bomb, a hit

    'If ((missileX - bombX) ^ 2 + (missileY - bombY) ^ 2) ^ .5 < 20 Then '  show  strike as target

    '                       rewrite the above line using _Hypot() which is hidden distance forumla

    If _Hypot(missileX - bombX, missileY - bombY) < 20 Then



        For radius = 1 To 20 Step 4 '                        draw concetric circles to show strike

            Circle ((missileX + bombX) / 2, (missileY + bombY) / 2), radius

            _Limit 60

        Next

        hits = hits + 1 '                                                    add hit to hits score

        GoTo InitializeForRound

    Else

        Circle (missileX + 4, missileY), 2, &HFFFFFF00 '+4 center on ^ base  draw    missle yellow

        Circle (bombX, bombY), 2, &HFF0000FF '                                      draw bomb blue

    End If

    _Limit 20

Loop

Option _Explicit ' no typos for variables if you please _Title "Drop Menu more! function test" ' b+ 2023-06-26 ' Instigated by Dimster here: ' https://qb64phoenix.com/forum/showthread.php?tid=1693&pid=17117#pid17117 ' More! = 1. Highlite mouse overs 2. Handle extra long menu descriptions up to .5 screen width ' So sorry Ultraman, no tool tips but extra long descriptions is better than nutt'n. Const ButtonW = 100, ButtonH = 20 ' basic rectangle size for title of menu panel Type BoxType ' to be used for MouseZone click checking As String Label ' menu title As Long LeftX, TopY, BoxW, BoxH ' left most, top most , box width, box height End Type Dim Shared As Integer NBoxes ' setting up a demo in main NBoxes = 72 ' exorbinant amount of menu titles Dim Shared Boxes(1 To NBoxes) As BoxType ' data array for positions and labels Dim As Integer i, x, y, mz, nItems, choice ' index, positions, menu count, choice selected ReDim menu$(1 To 1) ' dynamic array to store quick menu's into Dim s$ ' a string variable Screen _NewImage(800, 600, 32) ' screen stuff _ScreenMove 250, 50 ' somewhere in middle of my laptop, you may prefer to change for your screen _PrintMode _KeepBackground ' preserve background when printing stuff Cls ' so we have solid black background for image saving x = 0: y = 0 ' set up boxes x, y for top left box corner For i = 1 To NBoxes Boxes(i).Label = "Box" + Str$(i) ' quick menu title Boxes(i).LeftX = x: Boxes(i).TopY = y ' top left corner Boxes(i).BoxW = ButtonW ' width to constant set for all Boxes(i).BoxH = ButtonH ' height to constant set for all If (x + 2 * ButtonW) > _Width Then ' spread out the menu titles left right, top down x = 0: y = y + ButtonH ' next title didn't fit across so start new row Else x = x + ButtonW ' fits going across End If DrawTitleBox i ' draw the menu title panel Next Do mz = MouseZone% ' reports which menu panel has been clicked and mouse If mz Then ' quick make up a list of items for the menu title box nItems = Int(Rnd * 10) + 1 ' pick random 1 to 10 inclusive ReDim menu$(1 To nItems) ' resize menu$ by nItems For i = 1 To nItems ' menu option and description s$ = "Box" + Str$(mz) + " Menu Item:" + Str$(i) ' still needs to be less s$ = s$ + " with extra, extra, long description." ' than .5 screen width menu$(i) = s$ ' item is described with fairly good width to it Next ' his was alternate to tool tips choice = getButtonNumberChoice%(Boxes(mz).LeftX, Boxes(mz).TopY, menu$()) If choice = 0 Then s$ = "You quit menu by clicking outside of it." Else s$ = menu$(choice) _MessageBox "Drop Menu Test", "Your Menu Choice was: " + s$, "info" End If _Limit 30 Loop Until _KeyDown(27) Sub DrawTitleBox (i) ' draw a box according to shared Boxes array then print label Line (Boxes(i).LeftX + 1, Boxes(i).TopY + 1)-Step(ButtonW - 2, ButtonH - 2), &HFF550088, BF Color &HFFFFFFFF _PrintString (Boxes(i).LeftX + (ButtonW - _PrintWidth(Boxes(i).Label)) / 2, _ Boxes(i).TopY + ButtonH / 2 - 8), Boxes(i).Label End Sub Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$) ' draw menu items for menu title If highliteTF% Then ' reverse colors as mouse is over this item Line (leftX, topY)-Step(BoxW, ButtonH), &HFFAAAAAA, BF Color &HFF333333 _PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$ Else Line (leftX, topY)-Step(BoxW, ButtonH), &HFF333333, BF Color &HFFAAAAAA _PrintString (leftX + (BoxW - _PrintWidth(S$)) / 2, topY + ButtonH / 2 - 8), S$ End If Line (leftX, topY)-Step(BoxW, ButtonH), &HFF000000, B ' draw black box around item End Sub Function MouseZone% ' returns the Shared Boxes() index clicked or 0 none clicked ' Set the following up in your Main code of app 'Type BoxType ' to be used for mouse click checking ' As Long LeftX, TopY, BoxW, BoxH ' left most, top most, box width, box height 'End Type 'Dim Shared As Integer NBoxes 'Dim Shared Boxes(1 To NBoxes) As BoxType Dim As Integer i, mb, mx, my While _MouseInput: Wend ' poll mouse mb = _MouseButton(1) ' looking for left click If mb Then _Delay .25 mx = _MouseX: my = _MouseY ' get the mouse position For i = 1 To NBoxes ' see if its in a menu tile box from data in Shared Boxes array If mx > Boxes(i).LeftX And mx < Boxes(i).LeftX + Boxes(i).BoxW Then If my > Boxes(i).TopY And my < Boxes(i).TopY + Boxes(i).BoxH Then MouseZone% = i: Exit Function ' yes a click in this box index End If End If Next End If End Function Function getButtonNumberChoice% (BoxX As Integer, BoxY As Integer, choice$()) ' This fucion uses Sub DrawChoiceBox (highliteTF%, leftX, topY, BoxW As Integer, S$) ' BoxX, BoxY are top left corner from the Menu Title Panel ' We will be drawing our Menu Items below that panel Dim As Integer ub, lb, b ' choice$() boundaries and an index, b, to run through items Dim As Integer longest ' find the longest string length in choices Dim As Integer menuW, menuX ' use menuWidth and menuX start box side so long menu strings fit Dim As Integer mx, my, mb ' mouse status of position and left button Dim As Long Save ' we are saving the whole screen before drop down to redraw after click ub = UBound(choice$): lb = LBound(choice$) ' array boundaries For b = lb To ub ' find longest string in choice If Len(choice$(b)) > longest Then longest = Len(choice$(b)) Next If (longest + 2) * 8 > ButtonW Then ' don't use default button Width string too long menuW = (longest + 2) * 8 ' calculate the needed width, up to half screen fits If BoxX < _Width / 2 - 3 Then ' -3 ?? wouldn't work right until took 3 off middle menuX = BoxX ' use the same left side of box to start Else menuX = BoxX + ButtonW - menuW ' right side box align minus menu width = x start box End If Else menuW = ButtonW ' use default sizes that fit nicely under menu title panel menuX = BoxX End If Save = _NewImage(_Width, _Height, 32) ' save our beautiful screen before dropping menu _PutImage , 0, Save Do ' until a mouse click occurs For b = lb To ub ' clear any previous highlites DrawChoiceBox 0, menuX, BoxY + b * ButtonH, menuW, choice$(b) Next While _MouseInput: Wend ' poll mouse mx = _MouseX: my = _MouseY: mb = _MouseButton(1) For b = lb To ub ' scan through the box dimension to see if mouse is in one If mx > menuX And mx <= menuX + menuW Then If my >= BoxY + b * ButtonH And my <= BoxY + b * ButtonH + ButtonH Then If mb Then ' item is clicked! _PutImage , Save, 0 ' put image of screen back _FreeImage Save ' throw out screen image so no memory leak ' delay before exit to give user time to release mouse button ' set function, restore autodisplay and exit getButtonNumberChoice% = b: _Delay .25: _AutoDisplay: Exit Function Else ' indicate mouse over this menu item! draw highlight in box = -1 DrawChoiceBox -1, menuX, BoxY + b * ButtonH, menuW, choice$(b) End If End If End If Next If mb Then ' there was a click outside the menu = cancel _PutImage , Save, 0 ' put image before dropdown draw back up _FreeImage Save ' leaving sub avoid memory leak, dump image ' delay before exit to give user time to release mouse button ' set function, restore autodisplay and exit getButtonNumberChoice% = 0: _Delay .25: _AutoDisplay: Exit Function End If _Display ' display was needed here to avoid blinking when redrawing the highlited item _Limit 60 Loop ' until a mouse click occurs End Function

Code: (Select All)

+-------------------------------------------+

+__value% = buttoncheck%(buttonhandle%)_____+

+___________________________________________+

+_"buttoncheck%" function returns the state_+

+_of the button that was previously_________+

+_allocated in "buttonhandle%"._____________+

+___________________________________________+

+_Example:__________________________________+

+___________________________________________+

+__screen _newimage(640, 480, 32)___________+

+__mybut% = initbutton%("switch.jpeg", _ ___+

+___________64, 64, 0, 64)__________________+

+__locatebutton% 100, 100, mybut%___________+

+__do_______________________________________+

+_ _limit 600_______________________________+

+__thisbut% = buttoncheck%(mybut%)__________+

+__loop until thisbut%______________________+

+__system___________________________________+

+-------------------------------------------+



LOL but this is for something I wrote not Terry...