RokCoder's Drop Slicer game has been added to the games section of the tutorial.

https://www.qb64tutorial.com/games

I think I asked this once before, but I can't find the post now, or the programme where I used it, so apologies to those who helped.
How can I display a Unicode character in PE? 
I can use _MapUnicode for Unicode characters up to 127,  (as in _MapUnicode 127 to 97) but not beyond. I don't want to access all of Unicode, just one character so I just want a simple way to map this to my character set.

UPDATE: I renamed all asset file names to lower case to work with Linux (thanks for the heads-up Dav). I also made a small change to the source code fixing an issue.
UPDATE: The ZIP below contains the new code and renamed asset files.

I took the arcade spinner code I wrote in another post and converted it to a library. Here is a demo program using that spinner code to control a spaceship around a perimeter on the screen.

Use the mouse to spin the ship around and the left mouse button to fire a bullet.

This is just a demo to see how well the spinner code works but is a good start to a game if someone wants to expand upon it. Someone in another thread was discussing a game that utilized enemy ships coming out of a worm hole or time tunnel. This would be a good start. I would continue work on it but I have way too much to work on with the game library currently.

The ZIP file below contains the assets (sound and image), libraries needed, and demo code.

Attached Files

Thumbnail(s)
   

  SpinnerGameDemo.zip (Size: 55.82 KB / Downloads: 17)

Probably my last QB64pe project for a while but I'm sure I'll be back for more at some point in the future...

This is a very simple game. All you do is click the mouse button to drop the block on to the blocks below. Try to align it with the topmost block if you want to last long!

   

  drop-slicer.zip (Size: 176.25 KB / Downloads: 28)

Hello
How to write this line so that the result is in degrees.
I# = ASIN(F# * SIN(H#))

Chris

I found this little gem on an archived qb64.net forum post and cleaned it up for QB64-PE. There is still a lot of room for optimizations to make the code more performant.

' The Lord of the Julia Rings

' The Fellowship of the Julia Ring

' Free Basic

' Relsoft

' Rel.BetterWebber.com

' Converted to QB64 format by Galleon

' Optimized for QB64-PE by a740g



_DEFINE A-Z AS LONG

OPTION _EXPLICIT



CONST FALSE = 0, TRUE = NOT FALSE

CONST SCR_WIDTH = 320 * 3

CONST SCR_HEIGHT = 200 * 3

CONST SCR_MAXX = SCR_WIDTH - 1

CONST SCR_MAXY = SCR_HEIGHT - 1

CONST SCR_MIDX = SCR_WIDTH \ 2

CONST SCR_MIDY = SCR_HEIGHT \ 2

CONST MAXITER = 20

CONST MAXSIZE = 4

CONST XMIN! = -1! * 2.0!

CONST XMAX! = 2.0!

CONST YMIN! = -1! * 1.5!

CONST YMAX! = 1.5!

CONST DELTAX! = (XMAX - XMIN) / SCR_MAXX

CONST DELTAY! = (YMAX - YMIN) / SCR_MAXY



$RESIZE:SMOOTH

SCREEN _NEWIMAGE(SCR_WIDTH, SCR_HEIGHT, 32)

_ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH

_TITLE "QB64-PE Julia (Relsoft)"



DIM px AS LONG, py AS LONG

DIM p AS SINGLE, q AS SINGLE

DIM theta AS SINGLE

DIM x AS SINGLE, y AS SINGLE

DIM xsquare AS SINGLE, ysquare AS SINGLE

DIM ytemp AS SINGLE

DIM i AS LONG, pixel AS LONG

DIM frame AS _UNSIGNED LONG

DIM ty AS SINGLE

DIM red AS LONG, grn AS LONG, blu AS LONG

DIM tmp AS LONG, i_last AS LONG

DIM cmag AS SINGLE

DIM cmagsq AS SINGLE

DIM zmag AS SINGLE

DIM drad AS SINGLE

DIM ztot AS SINGLE

DIM drad_l AS SINGLE, drad_h AS SINGLE

DIM lx(0 TO SCR_MAXX) AS SINGLE, ly(0 TO SCR_MAXY) AS SINGLE



FOR i = 0 TO SCR_MAXX

    lx(i) = XMIN + i * DELTAX

NEXT i



FOR i = 0 TO SCR_MAXY

    ly(i) = YMAX - i * DELTAY

NEXT i



DIM stime AS LONG, fps AS SINGLE, fps2 AS SINGLE



stime = TIMER



DO

    frame = (frame + 1) AND &H7FFFFFFF

    theta = frame * _PI(0.01!)



    p = COS(theta) * SIN(theta * 0.7!) * 0.6!

    q = (SIN(theta) + SIN(theta)) * 0.6!

    cmagsq = p * p + q * q

    cmag = SQR(cmagsq)

    drad = 0.04!

    drad_l = (cmag - drad) * (cmag - drad)

    drad_h = (cmag + drad) * (cmag + drad)



    FOR py = 0 TO SCR_MIDY - 1

        ty = ly(py)

        FOR px = 0 TO SCR_MAXX

            x = lx(px)

            y = ty

            xsquare = 0!

            ysquare = 0!

            ztot = 0!

            i = 0

            i_last = 0



            WHILE (i < MAXITER) _ANDALSO ((xsquare + ysquare) < MAXSIZE)

                xsquare = x * x

                ysquare = y * y

                ytemp = 2! * x * y

                x = xsquare - ysquare + p

                y = ytemp + q

                zmag = x * x + y * y



                IF zmag < drad_h _ANDALSO zmag > drad_l _ANDALSO i > 0 THEN

                    ztot = ztot + (1! - (ABS(zmag - cmagsq) / drad))

                    i_last = i

                END IF



                i = i + 1



                IF zmag > 4.0! THEN EXIT WHILE

            WEND



            IF ztot > 0! THEN

                i = SQR(ztot) * 500!

            ELSE

                i = 0

            END IF



            IF i < 256 THEN

                red = i

            ELSE

                red = 255

            END IF



            IF i >= 256 _ANDALSO i < 512 THEN

                grn = i - 256

            ELSEIF i >= 512 THEN

                grn = 255

            ELSE

                grn = 0

            END IF



            IF i >= 512 _ANDALSO i <= 768 THEN

                blu = i - 512

            ELSEIF i > 768 THEN

                blu = 255

            ELSE

                blu = 0

            END IF



            tmp = ((red + grn + blu) \ 3)

            red = ((red + grn + tmp) \ 3)

            grn = ((grn + blu + tmp) \ 3)

            blu = ((blu + red + tmp) \ 3)



            tmp = red

            SELECT CASE (i_last MOD 3)

                CASE 1

                    red = grn: grn = blu: blu = tmp

                CASE 2

                    red = blu: blu = grn: grn = tmp

            END SELECT



            pixel = _RGB32(red, grn, blu)

            PSET (px, py), pixel

            PSET (SCR_MAXX - px, SCR_MAXY - py), pixel

        NEXT px

    NEXT py



    fps = fps + 1

    IF stime + 1 < TIMER THEN

        fps2 = fps

        fps = 0

        stime = TIMER

    END IF



    LOCATE 1, 1: PRINT "FPS:" + STR$(fps2);



    _DISPLAY



    _LIMIT 60

LOOP UNTIL _KEYHIT = 27



SYSTEM

This is a standalone version of the Physac 2D physics engine ripped straight out of raylib-64. This version does not have any raylib dependencies (i.e. you can use the engine with vanilla QB64 graphics commands). As a bonus, it also contains the reasings library (Robert Penner's easing equations) and raymath (raylib math library).

There are some support functions as well. See include/support.bi for documentation.

There are 6 examples. 5 of them are for Physac and 1 for reasings.

Documentation:

• Physac
  
• reasings
  
• raymath
  
• Support
  

$INCLUDE:'include/physac.bi'

$INCLUDE:'include/reasings.bi'

$INCLUDE:'include/raymath.bi'

Hi.

When I was working on the free-select image program, I didn't know that it would have consequences. An idea came during development.

And so this game was born. It's meant to be a relaxing puzzle. It contains 19 photos, some are from my private collection, but there is nothing personal, some are downloaded from the Internet. The principle of the game is simple.

The program uses the photo as if it were a painting on glass and breaks it like you break glass. The resulting pieces  then player put together to create the original image. No score, nothing like that, it's not a competition. Really small parts are banned because no one wants to mouse hunt a 4x3 pixel piece...

Tell us what you think about it.

Finally.... you know how a relaxing game turns into a hellish game? Quite simply, I could write a novel about memory leak detection.
But of course it is fixed in this version.

'Puzzle / Relax Game writed Petr Preclik 09-27-2024 to 09-29-2024





Dim As Long Img, Mask '          Img is image (from directory images), Mask is NewImage image





'                                  easyest loader...too lasy to implant here direntry...





'                                +---------------------------------------+

'                                | Create images names to array ImaArray |

'                                +---------------------------------------+



Dim ImaArray(19) As String '            19 images in images folder

imgIndex = 0 '                          start from zero (0.jpg)

For fillIma = 19 To 0 Step -1

    Path$ = ".\images\" + LTrim$(Str$(fillIma)) + ".jpg"

    ImaArray(fillIma) = Path$

Next 





Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

Mask& = _NewImage(_DesktopWidth, _DesktopHeight, 32)



'                                +-----------------------------------------+

'                                |My Screen and Mask virtual screen declare|

'                                +-----------------------------------------+



restart: '                        here is used.... GoTo if player's chioce is try next image

Cls

_FullScreen

ReDim Shared G(0) As Long '        Graphic array (contains indexes array P and this set images order on screen. Ubound is always visible (get to screen as last)

'                                  previous image IMG is deleted from memory in row 316 and IMG is set to 0 if next image is played

Img = _LoadImage(ImaArray(imgIndex), 32)

Text1$ = "Generating Puzzle, please wait..."

CenterX = _Width \ 2 - _PrintWidth(Text1$) \ 2

CenterY = _Height \ 2 - 16

_PrintString (CenterX, CenterY), Text1$

'



'                                1) Mask border is painted as white line

_Dest Mask&

Cls '                                mask must have black background

Line (0, 1)-(_Width(Mask&) - 1, _Height(Mask&) - 1), _RGB32(255), B



'                                2) To mask is genereated some random form in white color

Dim f As _Unsigned _Byte

For form = 0 To 3

    Randomize Timer

    f = 1 + Rnd * 7

    PlaceForm f, Mask&, _RGB32(255) 'PlaceForm create some white forms

Next form

PlaceForm 7, Mask&, _RGB32(255)

PlaceForm 7, Mask&, _RGB32(255)





'                                +-----------------------------------------+

'                                |  My game declare, arrays and variables  |

'                                +-----------------------------------------+







'                                3) define the Puzzle type, scan the screen, write the shapes in the field and color the individual shapes.



Type Puzz

    As Integer X, Y, pX, pY '    X, Y is real position in image (left upper corner which contains non zero pixel), pX, pY is position on the screen

    As _Unsigned _Byte R, G, B ' mask color - used in program begining (row 83)

    As Long Handle '            image handle (part of complete image)

    As _Byte Locked '          if is image moved to correct place, is this 1 else is 0. If is set to 1, player can't moving this part

    '                          default angle is always 0 in this version, rotation is not used in this first version

End Type



ReDim Shared P(0) As Puzz '    Game array



'                              4) searching and coloring individual parts of the mask

_Source Mask&

_Dest Mask& '                      Part image size is not set here, but on row  528, 529 in SUB GiveForm

B = 150

R = 127

For Y = 0 To _Height(Mask&)

    For X = 0 To _Width(Mask&)

        p~& = Point(X, Y)

        If p~& = _RGB32(0) Then

            B = B + 1

            If B > 255 Then B = 0: G = G + 1

            If G > 255 Then G = 0: R = R + 1

            Paint (X, Y), _RGB32(R, G, B), _RGB32(255)

            UbP = UBound(P)

            P(UbP).R = R

            P(UbP).G = G

            P(UbP).B = B

            UbP = UbP + 1

            ReDim _Preserve P(UbP) As Puzz

        End If

    Next X

Next Y

_Dest 0



'                                +---------------------+

'                                |  Call GiveForm SUB  |

'                                +---------------------+





'                                5) the GiveForm SUB does all of the above:

'                                  1) place one concrete shape on the virtual screen

'                                  2) find the dimensions of the shape (width and height)

'                                  3) create a suitable virtual screen and copies the shape onto it and then closes the original virtual screen

'                                  4) return the image descriptor of this shape in P().handle

GiveForm Mask&, Img, P()

'                                  GiveForm (Mask image contains colored parts, always one part = one color; IMG is loaded image file, P() is game array)





'                                +---------------------+

'                                |    Level logic    |

'                                +---------------------+



'                                5b) calculate how many pieces will be generated (small pieces are not generated) - i try it, but.... move part 1x3 pixels.... NO! NO! NO!

'                                    not all .Handle contains image descriptor. If is image too small, here is 0, this image is not used in game and therefore must be real number calculated.

TotalPieces = 0

For a = 0 To UBound(P) - 1

    If P(a).Handle < -1 Then TotalPieces = TotalPieces + 1

Next a





'                                6) Generate parts start position on the screen - you can delete it, then all parts in game are in left upper corner

For s = 0 To UBound(P)

    imgX = Rnd * _Width

    If imgX > _Width(0) - _Width(P(s).Handle) Then imgX = _Width(0) - _Width(P(s).Handle)

    imgY = Rnd * _Height

    If imgY > _Height(0) - _Height(P(s).Handle) Then imgY = _Height(0) - _Height(P(s).Handle)

    P(s).pX = imgX

    P(s).pY = imgY

Next s

'                                +---------------------+

'                                |      Sort Sub      |

'                                +---------------------+





Sort '                        It calculates the area of ??individual images according to the width and height in the P().Handle array and

'                            arranges them in the G array so that the largest are below and the smallest above. The smallest part is then

'                            rendered last. But.... (keep reading it)

Cls , _RGB32(200)

Show

'                            Show displays parts by field G. Image in UBOUND field G is shown last



Completed = 0 '              Number parts placed to correct image area

Do Until k& = 27

    Show

    k& = _KeyHit '          You read source code? You are doing good, keep it up!

    While _MouseInput: Wend

    MX = _MouseX

    MY = _MouseY

    LB = _MouseButton(1)





    For T = UBound(P) - 1 To 0 Step -1



        Id = T

        If P(Id).Handle < 0 Then '                          if Handle is valid,

            If LB = -1 Then '                                if left mouse button is pressed,

                s = _Source

                _Source P(Id).Handle

                sc~& = Point(MX - P(Id).pX, MY - P(Id).pY)

                If _Alpha32(sc~&) > 0 Then '                if mouse is placed on visible area on the part,



                    Xs = P(Id).pX

                    Ys = P(Id).pY

                    Xe = Xs + _Width(P(Id).Handle) - 1

                    Ye = Ys + _Height(P(Id).Handle) - 1



                    If MX >= Xs And MX <= Xe Then

                        If MY >= Ys And MY <= Ye Then

                            If P(T).Locked = 0 Then '        if part is not moved on the screen in correct place (if locked is 1, is not possible moving it)



                                Do Until LB = 0 '            LOOP until left mouse button is pressed



                                    While _MouseInput

                                    Wend

                                    MX = _MouseX

                                    MY = _MouseY

                                    LB = _MouseButton(1)



                                    If P(T).Locked = 0 Then 'if part is not moved on the screen in correct place (if locked is 1, is not possible moving it)

                                        MyT = T



                                        If posX = 0 Then '  calculate and memorize mouse position and part left upper corner position - for moving on the screen

                                            posX = MX - Xs

                                            PosY = MY - Ys

                                            oMX = MX

                                            oMY = MY

                                        End If



                                        P(T).pX = MX - posX 'write to array new part position on the screen

                                        P(T).pY = MY - PosY



                                        '                  if we go to the correct position with a tolerance of 10 pixels, it will lock the part

                                        If Abs(P(T).X - P(T).pX) < 10 Then

                                            If Abs(P(T).Y - P(T).pY) < 10 Then

                                                P(T).pX = P(T).X

                                                P(T).pY = P(T).Y

                                                P(T).Locked = 1 'ok

                                                _SetAlpha 220, _RGB32(0) To _RGB32(255), P(T).Handle

                                                Completed = Completed + 1 '                              this is counter for correct placed parts

                                                Sound 250, .5

                                                LB = 0

                                                Exit Do

                                            End If

                                        End If

                                    End If

                                    _Display

                                    MoveShow T ' If the part is moved, the display is done by this SUB. The only difference is that it ensures that the piece being moved is always visible.





                                    MovedImage = T '                                      note which piece was moved last

                                    '                                                      congrats, if you study source code: program small hack (move piece to 10, 10 or less)

                                    Hck& = _KeyDown(100303) '                                                                  press and hold right shift for hack

                                    If Hck& Then '                                                                            use if you don't see correct target position for part when is moved!

                                        Locate 3

                                        Print "Move to 10, 10 or less: "; Abs(P(T).X - P(T).pX), Abs(P(T).Y - P(T).pY)

                                    End If



                                    _Display

                                    _Limit 30

                                Loop





                                If Completed = TotalPieces Then '                              if all parts are in correct position,

                                    _PrintMode _FillBackground

                                    For a = 0 To UBound(P) - 1

                                        _SetAlpha 255, _RGB32(0) To _RGB32(255), P(a).Handle ' set for all parts full alpha

                                    Next a

                                    Show '                                                    diplay it

                                    _Display

                                    Sleep 3

                                    _AutoDisplay

                                    msg = _MessageBox("Puzzle", "Try next image?", "yesno", "question", 1)

                                    Select Case msg

                                        Case 0 '                                                if player doesn't want continue,

                                            Screen 0

                                            Print "Good bye..." '                              print message

                                            For a = 0 To UBound(P)

                                                If P(a).Handle < 0 Then _FreeImage P(a).Handle 'erase all images from memory

                                            Next a

                                            _FreeImage Mask& '                                  erase mask

                                            _FreeImage Img& '                                  erase image loaded in begin

                                            System '                                            exit to system

                                        Case 1

                                            _FreeImage Img& '                                  if player continue to next image,

                                            Img = 0 '                                          erase previous image loaded in begin from memory,

                                            For a = 0 To UBound(P)

                                                If P(a).Handle < 0 Then _FreeImage P(a).Handle 'arase all parts images

                                            Next a

                                            ReDim G(0) As Long '                              reset graphic array to 0

                                            ReDim P(0) As Puzz '                              reset game array to 0

                                            Erase P '                                          delete game array

                                            Erase G '                                          delete graphic array





                                            imgIndex = imgIndex + 1 '                          images counter up to 1 (used in begin)

                                            If imgIndex > UBound(ImaArray) Then imgIndex = LBound(ImaArray)

                                            GoTo restart '                                    skip to program begin

                                    End Select

                                End If



                                '                                +-------------------------------------------------------------------------------+

                                '                                |the program only goes to this area once every time the mouse button is released|

                                '                                +-------------------------------------------------------------------------------+

                                posX = 0 '                        this variable now reset mouse settings used on row 189

                                _Dest 0



                                If MovedImage > -1 Then '        see row 217

                                    MyIndexP = MovedImage '      this block shift images in graphic array so, when you click to part, this is placed to UBOUND,

                                    ShiftIndex = 0 '            se when is mouse button released, is not last moved piece "in backround" behind the other pieces

                                    For srt = 0 To UBound(G) - 1

                                        If G(srt) = MyIndexP Then ShiftIndex = 1

                                        G(srt) = G(srt + ShiftIndex)

                                    Next srt

                                    ubG = UBound(G)

                                    G(ubG) = MyIndexP

                                    MovedImage = -1

                                End If

                            End If

                        End If

                    End If

                End If

                _Source s

            End If

        End If

    Next T



    '                                                        small program for on-screen text in left upper corner

    Locate 1 '                                                and help - show parts which are not placed when H is pressed

    _PrintMode _KeepBackground

    Print "Done: "; Completed; " / "; TotalPieces; "["; Int((Completed / TotalPieces) * 100); "%]"

    Print "Can't find part? Press H!"

    Kbd$ = InKey$

    If UCase$(Kbd$) = "H" Then

        D = _Dest

        _Dest 0

        For a = 0 To UBound(P)

            If P(a).Handle < -1 And P(a).Locked = 0 Then

                MiddleX = (P(a).pX + _Width(P(a).Handle) \ 2)

                MiddleY = (P(a).pY + _Height(P(a).Handle) \ 2)



                _AutoDisplay

                For h = 1 To 5

                    For Circl = 10 To 30

                        Circle (MiddleX, MiddleY), Circl, _RGB32(255 - 128 / circ, 10, 210 / circ)

                    Next

                    _Delay .01

                    For Circl = 30 To 10 Step -1

                        Circle (MiddleX, MiddleY), Circl, _RGB32(255 - 128 / circ, 10, 210 / circ)

                    Next

                    _Delay .01

                Next h

            End If

        Next a

        _Dest D

    End If

    _Display

Loop







End





Sub Show

    _Dest 0

    Cls , _RGB32(200)

    For s = 0 To UBound(G)

        '                                                                  SUB contains two steps: First - display correct placed parts,

        If P(G(s)).Handle < 0 Then

            If P(G(s)).Locked = 1 Then

                imgX = P(G(s)).pX

                If imgX > _Width(0) + _Width(P(G(s)).Handle) Then imgX = _Width(0) - _Width(P(G(s)).Handle)

                imgY = P(G(s)).pY

                If imgY > _Height(0) + _Height(P(G(s)).Handle) Then imgY = _Height(0) - _Height(P(G(s)).Handle)

                _PutImage (imgX, imgY), P(G(s)).Handle

            End If

        End If

    Next s



    For s = 0 To UBound(G)

        '                                                                  Second - then show all others parts - so is not possible "hide" free parts

        If P(G(s)).Handle < 0 Then

            If P(G(s)).Locked = 0 Then

                imgX = P(G(s)).pX

                If imgX > _Width(0) + _Width(P(G(s)).Handle) Then imgX = _Width(0) - _Width(P(G(s)).Handle)

                imgY = P(G(s)).pY

                If imgY > _Height(0) + _Height(P(G(s)).Handle) Then imgY = _Height(0) - _Height(P(G(s)).Handle)

                _PutImage (imgX, imgY), P(G(s)).Handle

                ' _Delay .1

            End If

        End If

    Next s

End Sub





Sub MoveShow (id)

    Show

    If P(id).Handle < 0 Then

        imgX = P(id).pX '                                                  the same as show, but moved part is always displayed on top

        imgY = P(id).pY '                                                  (sub is used when part is moved with mouse)

        _PutImage (imgX, imgY), P(id).Handle

    End If

End Sub





Sub Sort '                                                                  according to the area of ??the picture, place the indexes of the P field

    '                                                                      for rendering in the G field. The largest area will be the first (index 0)



    '                                                                  1) Create array P2 and write here area (width * height) for image the same index in array P

    ubP = UBound(P) '                                                    this is not very good method, because transparency pixels are here calculated as full pixels...

    ReDim p2(ubP) As Long

    For copy = 0 To ubP

        p2(copy) = _Width(P(copy).Handle) * _Height(P(copy).Handle)

    Next



    '                                                                  go through field P2, find the largest area, write it in field G and then set it to zero in field P2

    ReDim G(ubP) As Long



    Do Until All = ubP

        i = 0

        max = 0

        Rec = 0

        Do Until i = ubP

            If p2(i) > 0 Then

                If max < p2(i) Then max = p2(i): Rec = i

            End If

            i = i + 1

        Loop



        If max Then

            p2(Rec) = 0

            G(iG) = Rec '                                              set the value of the index of the field P in field G

            iG = iG + 1

        End If



        All = All + 1

    Loop

    ReDim p2(0) As Long

    Erase p2

End Sub





Sub GiveForm (source As Long, img As Long, images() As Puzz) '            returns individual tiles as individual images

    '                                                                    source is MASK source image, img is input image, images() is array for image parts



    ReDim As Long X, Y, MinX, MinY, MaxX, maxY, Virtual, V2, Allimages, Ui

    Cls

    For Allimages = 0 To UBound(P) - 1

        Kolor~& = _RGB32(P(Allimages).R, P(Allimages).G, P(Allimages).B) 'read mask color for THIS part

        X = 0

        Y = 0

        MinX = _Width(source)

        MaxX = 0

        MinY = _Height(source)

        maxY = 0



        '                                                                find image size and copy element to virtual screen in 1 step

        Virtual = _NewImage(_Width(source), _Height(source), 32)

        _Source source

        _Dest Virtual

        Cls '                                                            Background color in Virtual must be set as black

        Do Until Y = _Height(source) - 1

            X = 0

            Do Until X = _Width(source) - 1

                CC~& = Point(X, Y)

                If CC~& = Kolor~& Then

                    If MinY > Y Then MinY = Y

                    If maxY < Y Then maxY = Y

                    If MinX > X Then MinX = X

                    If MaxX < X Then MaxX = X

                    PSet (X, Y), Kolor~& '                              draw 1 part to virtual screen (which use the same size as mask image)

                End If '                                                and measure real image width and height

                X = X + 1 '                                            (you draw here only 1 mask for 1 part image to Virtual)

            Loop

            Y = Y + 1

        Loop



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

        P(Allimages).X = MinX '                                        put left upper corner position for this 1 part to array P

        P(Allimages).Y = MinY

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



        If MaxX - MinX < 10 Or maxY - MinY < 10 Then '                  this condition block creating really very small parts (10x10 pixels and less)                                                                              '

            _FreeImage Virtual '                                        HERE WAS memory leak - miss _freeimage before... - _continue skip _freeimage...

            _Continue '                                                do not create really small pieces

        End If



        _SetAlpha 0, Kolor~&, Virtual '                                set color in mask image as transparent

        V2 = _NewImage(_Width(source), _Height(source), 32) '          create image the same size as mask

        d = _Dest

        _Dest V2

        Cls , _RGB32(50) '                                              set this image background color (also set colors intensity on the game screen)

        _Dest d



        RatioX = _DesktopWidth / _Width(img&) '                        RotioX, RatioY - calculate the aspect ratio of the image

        RatioY = _DesktopHeight / _Height(img&) '                      relative to the aspect ratio of the screen so that the placed image is not stretched

        If RatioX < RatioY Then Ratio = RatioX Else Ratio = RatioY '    and distorted, but reduced (or enlarged) in the aspect ratio, without its deformation

        ImageX = (_DesktopWidth - _Width(img&) * Ratio) \ 2 '                                calculate image position in middle

        MyImage& = _NewImage(_Width(img&) * Ratio, _Height(img&) * Ratio) '                  output image  -  create it in ratio

        _PutImage (0, 0)-(_Width(img&) * Ratio, _Height(img&) * Ratio), img&, MyImage& '      place original image to empty image MyImage - in ratio

        _PutImage (ImageX, 0), MyImage&, V2 '                                                place centered image (complete image) in ratio to V2

        _PutImage , Virtual, V2 '                                                            place mask image to complete centered image in correct ratio



        Ui = UBound(images)

        P(Allimages).Handle = _NewImage(MaxX - MinX + 1, maxY - MinY + 1, 32) '              create image in real size (big as part)

        _PutImage (0, 0), V2, P(Allimages).Handle, (MinX, MinY)-(MaxX, maxY) '                place this part image from V2 to P().handle

        _SetAlpha 0, _RGB32(0), P(Allimages).Handle '                                        set transparent background to P().handle



        _FreeImage V2 '                                                                      clear ram

        _FreeImage Virtual

        _FreeImage MyImage&

        Virtual = 0





        R = 16 / 9 '                                                                        this is for preview only, when parts are created, i show image on the screen

        PreviewWDTH = 150 * R

        PreviewHGHT = 150

        _PutImage (100 + PreviewWDTH, 50 + PreviewHGHT)-(400 + PreviewWDTH * R, 350 + PreviewHGHT), img&

        Text1$ = "Generating Puzzle, please wait..."

        Text2$ = Str$(Allimages) + "/" + LTrim$(Str$(UBound(P)))

        CenterX = _Width(0) \ 2 - _PrintWidth(Text1$) \ 2

        CenterX2 = _Width(0) \ 2 - _PrintWidth(Text2$) \ 2

        CenterY = _Height(0) \ 2 - 16

        Centery2 = CenterY + 20

        _PrintString (CenterX, CenterY), Text1$, 0

        _PrintString (CenterX2, Centery2), Text2$, 0



    Next Allimages

End Sub







Sub PlaceForm (typ As Integer, dest As Long, kolor As _Unsigned Long) '                        generate some parts to mask image in white color. Se easy, so comment here is not needed.

    D = _Dest

    _Dest dest

    W = _Width(dest)

    H = _Height(dest)



    Select Case typ

        Case 1

            Circle (-W / 2 + Rnd * W, -H / 2 + Rnd * H), -W / 4 + Rnd * W / 8, kolor



        Case 2

            Line (-W / 2 + Rnd * W, -H / 2 + Rnd * H)-(-W / 2 + Rnd * W, -H / 2 + Rnd * H), kolor, B



        Case 3, 4, 5, 6

            Dim X(typ) As Integer

            Dim Y(typ) As Integer

            'vygeneruju cilove body

            For Rand = 0 To typ

                X(Rand) = Rand + Rnd * W

                Y(Rand) = Rand + Rnd * H

            Next



            PReset (X(0), Y(0))

            For Drw = 0 To typ

                Line -(X(Drw), Y(Drw)), kolor

            Next

            Line -(X(0), Y(0)), kolor



        Case 7

            cX = -W / 2 * Rnd + W * Rnd

            cY = -H / 2 * Rnd + H * Rnd

            For a = 0 To 300 Step 60

                PReset (cX, cY)

                For s = 0 To W Step 50

                    aR = _D2R(a)

                    If s < 100 Then noise = 0 Else noise = Rnd * 20

                    nX = cX + Cos(aR) * 2 * s + noise

                    ny = cY + Sin(aR) * 2 * s + noise

                    Line -(nX, ny), kolor

                Next s

            Next a

    End Select

End Sub

Attached Files

  puzzle.zip (Size: 19.73 MB / Downloads: 22)

I want to add arcade spinner control (think Tempest) to the game library I'm working on. I whipped up this proof of concept code to see if emulating a spinner with a mouse was possible. It works fairly well.

Has anyone else approached this? If so please share your code so I can see how you implemented this.

The ZIP below contains the demo code and libraries needed to run the code.

Attached Files

  Spinner.zip (Size: 7.48 KB / Downloads: 20)

Find attached the file FormatX5.zip which contains FormatX.bas and is a library of format functions.

They are not a Print Using replicants but contain certain FormatX$ functions similar to the ones in QB 7.1

The functions allow for parsing formatted strings and unique to QB64 which has no Format$ functions.

  Year between 1753 and 2078 increased to 0001 and 9999.

NOT backwards compatible with QB 4.5 because format date/time is stored in float Now## precision.

Read on! ejo

Attached Files

  FORMATX5.ZIP (Size: 20.83 KB / Downloads: 33)