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

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

Latest Threads
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155

 
  QB64 Practical Sceince use
Posted by: doppler - 01-20-2023, 02:28 PM - Forum: Programs - Replies (4)

Code: (Select All)
_Title "Parallel Reciprocal"
Dim r1, r2, rt As Double
top:
Cls

Print "Enter 0 to find unknown number"

Input "Resistor R1 "; r1
If r1 = 0 Then
    Input "r1 can not be 0 "; q
    GoTo top
End If

Input "Resistor R2 "; r2
Input "Total r1 parallel to r2 "; rt

If rt = 0 And r2 = 0 Then
    Input "Are you an idiot only 1 unknown "; q
    GoTo top
End If

If rt = 0 Then
    r1 = 1 / r1
    r2 = 1 / r2
    rt = r1 + r2

End If

If r2 = 0 Then
    r1 = 1 / r1
    rt = 1 / rt
    r2 = rt - r1

End If

Print
Print "for the values of "
Print "R1";: Print 1 / r1
Print "R2";: Print 1 / r2
Print "RT";: Print 1 / rt
Print

Input "0 to end else I will run again"; q
If q = 0 Then System
GoTo top

In electronics to find a value of a Resistor in parallel or a Capacitor in series.  The following formula is used (X1 x X2) / (X1 + X2).
To find an unknown value to use would be hard, except when using reciprocals (shortcut for the formula).  Must know two values to find the third.

This is so basic, you can use as you please.

Print this item

  Rotozoom without the skew
Posted by: James D Jarvis - 01-19-2023, 02:50 AM - Forum: Utilities - Replies (16)

I was using rotozoom2 when I noticed it was skewing the image it was rotating when xscale and yscale were not identical values.  (I also adjusted it to used degrees as opposed to radians, but that has nothing to do with the skew). 
The change was in multiplying px(0) to px(3) and py(0) to py(3) by the scale factors prior to rotation.

Code: (Select All)
Sub RotoZoom_jan23 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2 * xScale: py(0) = -H& / 2 * yScale: px(1) = -W& / 2 * xScale: py(1) = H& / 2 * yScale
    px(2) = W& / 2 * xScale: py(2) = H& / 2 * yScale: px(3) = W& / 2 * xScale: py(3) = -H& / 2 * yScale
    sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

Print this item

  Smokemotes
Posted by: James D Jarvis - 01-18-2023, 10:16 PM - Forum: Programs - Replies (9)

Code: (Select All)
'smokemotes
'playing with circlefill
'
'key presses to stimulate chnages
'R,r, G,g , B,b change colore channels
'w,a,s,d  directs the flow of particles
'M,m change the magnifcation on the motes
'<,> change the count of motes displayed
'V,v  change the velocity chnages will be applied
'

Screen _NewImage(600, 500, 32)
Type motetype
    x As Integer
    y As Integer
    gx As Integer
    gy As Integer
    r As Single
    tr As Integer
    kr As Integer
    kg As Integer
    kb As Integer
    v As Integer
End Type
Randomize Timer
Dim smoke(60000) As motetype
For m = 1 To 60000
    smoke(m).x = Int(1 + Rnd * _Width)
    smoke(m).y = Int(1 + Rnd * _Height)
    smoke(m).gx = Int(Rnd * 3) - Int(Rnd * 3)
    smoke(m).gy = Int(Rnd * 3) - Int(Rnd * 3)
    smoke(m).r = Int(.5 + Rnd * 3)
    smoke(m).tr = Int(6 + Rnd * 10 + Rnd * 10)
    smoke(m).kr = 100 + Int(Rnd * 12) - Int(Rnd * 12)
    smoke(m).kg = 100 + Int(Rnd * 12) - Int(Rnd * 12)
    smoke(m).kb = 200 + Int(Rnd * 20) - Int(Rnd * 20)
    smoke(m).v = Int(30 + Rnd * 12 - Rnd * 12)
Next m
mm = 30000
_FullScreen
Do
    _Limit 30
    Cls
    For m = 1 To mm
        _Limit 1000000
        CircleFill smoke(m).x, smoke(m).y, smoke(m).r, _RGB32(smoke(m).kr, smoke(m).kg, smoke(m).kb, smoke(m).tr)
        If Rnd * 100 < 3 Then smoke(m).gx = smoke(m).gx + Int(Rnd * 2) - Int(Rnd * 2)
        If Rnd * 100 < 3 Then smoke(m).gy = smoke(m).gy + Int(Rnd * 2) - Int(Rnd * 2)
        If Rnd * 100 < smoke(m).v Then smoke(m).x = smoke(m).x + smoke(m).gx
        If Rnd * 100 < smoke(m).v Then smoke(m).y = smoke(m).y + smoke(m).gy
        If smoke(m).x > _Width Or smoke(m).x < 0 Then smoke(m).x = Int(1 + Rnd * _Width)
        If smoke(m).y > _Height Or smoke(m).y < 0 Then smoke(m).y = Int(1 + Rnd * _Width)
        Select Case kk$
            Case "w"
                smoke(m).gy = smoke(m).gy - Int(Rnd * 4)
            Case "a"
                smoke(m).gx = smoke(m).gx - Int(Rnd * 4)
            Case "s"
                smoke(m).gy = smoke(m).gy + Int(Rnd * 4)
            Case "d"
                smoke(m).gx = smoke(m).gx + Int(Rnd * 4)
            Case "R"
                If Rnd * 100 < 66 Then
                    smoke(m).kr = smoke(m).kr + Int(Rnd * 3)
                    If smoke(m).kr > 255 Then smoke(m).kr = 0
                End If
            Case "G"
                If Rnd * 100 < 66 Then
                    smoke(m).kg = smoke(m).kg + Int(Rnd * 3)
                    If smoke(m).kg > 255 Then smoke(m).kg = 0
                End If
            Case "B"
                If Rnd * 100 < 66 Then
                    smoke(m).kb = smoke(m).kb + Int(Rnd * 3)
                    If smoke(m).kb > 255 Then smoke(m).kb = 0
                End If
            Case "r"
                If Rnd * 100 < 66 Then
                    smoke(m).kr = smoke(m).kr - Int(Rnd * 3)
                    If smoke(m).kr < 0 Then smoke(m).kr = 255
                End If
            Case "g"
                If Rnd * 100 < 66 Then
                    smoke(m).kg = smoke(m).kg - Int(Rnd * 3)
                    If smoke(m).kg < 0 Then smoke(m).kg = 255
                End If
            Case "b"
                If Rnd * 100 < 66 Then
                    smoke(m).kb = smoke(m).kb - Int(Rnd * 3)
                    If smoke(m).kb < 0 Then smoke(m).kb = 255
                End If
            Case "v"
                If Rnd * 100 < 66 Then
                    smoke(m).v = smoke(m).v - Int(Rnd * 3)
                    If smoke(m).v < 1 Then smoke(m).v = 1
                End If
            Case "V"
                If Rnd * 100 < 66 Then
                    smoke(m).v = smoke(m).v + Int(Rnd * 3)
                    If smoke(m).v > 98 Then smoke(m).v = 98
                End If
            Case "m"
                If Rnd * 100 < 66 Then
                    smoke(m).r = smoke(m).r * .95
                End If
            Case "M"
                If Rnd * 100 < 66 Then
                    smoke(m).r = smoke(m).r * 1.1
                End If
            Case "t"
                If Rnd * 100 < 66 Then
                    smoke(m).tr = smoke(m).tr * .95
                End If
            Case "T"
                If Rnd * 100 < 66 Then
                    smoke(m).tr = smoke(m).tr * 1.1
                End If


        End Select
    Next m
    Select Case kk$
        Case "<"
            mm = mm - Int(1 + Rnd * 100)
            If mm < 10 Then mm = 10
        Case ">"
            mm = mm + Int(1 + Rnd * 100)
            If mm > 60000 Then mm = 60000
    End Select

    _Display
    kk$ = InKey$
Loop Until kk$ = Chr$(27)
Sub CircleFill (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend

End Sub

Print this item

  PALETTE: why does it take "BGR" colour instead of "RGB"?
Posted by: CharlieJV - 01-17-2023, 03:59 AM - Forum: Help Me! - Replies (8)

It just seems a little odd that you can't apply colours that you would get via _RGB32() in the PALETTE statement.

Is there some history to explain the second parameter for colour?

Print this item

  Mod'ing a classic- partial circle fill
Posted by: OldMoses - 01-17-2023, 12:25 AM - Forum: Utilities - Replies (6)

Something that I've needed for one of my projects for a long time. A modification of the circle fill algorithm that restricts the draw to the limits of a bounding box. I'm not sure why it took me so long to get around to this, but here it is, in case someone can make use of it or are inspired to wow us with a better solution.

Left button click to place the center of the box, mousewheel to change the box size.


Code: (Select All)
'OldMoses' mod of Steve's circle fill
'drawing only those portions that fit the bounding box

'e% = 128
sz% = 50
ls% = 300
rs% = 400
t% = 100
b% = 200
SCREEN _NEWIMAGE(1024, 512, 32)
DO
    WHILE _MOUSEINPUT
        osz% = wsz%
        wsz% = SGN(_MOUSEWHEEL) * 3
        IF osz% <> sz% THEN
            ls% = ls% - wsz%: rs% = rs% + wsz%
            t% = t% - wsz%: b% = b% + wsz%
            sz% = sz% + wsz%
        END IF
    WEND
    IF _MOUSEBUTTON(1) THEN
        ls% = _MOUSEX - sz%: rs% = _MOUSEX + sz%
        t% = _MOUSEY - sz%: b% = _MOUSEY + sz%
    END IF

    CLS
    'LINE (512 - e%, 256 - e%)-(512 + e%, 256 + e%)
    'LINE (512 + e%, 256 - e%)-(512 - e%, 256 + e%)
    LINE (ls%, t%)-(rs%, b%), , B '                             Bounding box

    'CIRCLE (512, 256), 128, &H7FFF0000
    FCirc 512, 256, 128, &H7FFF0000 '                           Steve's unmodified circle fill
    FCircPart 512, 256, 128, &H7F00FF00, ls%, rs%, t%, b% '     modified partial circle fill

    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END



SUB FCircPart (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG, lt AS LONG, rt AS LONG, t AS LONG, b AS LONG) 'modified circle fill
    IF rt < CX - RR OR lt > CX + RR OR t > CY + RR OR b < CY - RR THEN EXIT SUB 'leave if box not intersecting circle
    DIM AS LONG R, RError, X, Y
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    IF CY >= t AND CY <= b THEN LINE (MinOf&(CX - X, lt), CY)-(MaxOf&(CX + X, rt), CY), C, BF 'draw equatorial line if applicable
    WHILE X > Y
        RError = RError + Y * 2 + 1 '
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                IF CY - X >= t AND CY - X <= b AND CX - Y <= rt AND CX + Y >= lt THEN
                    LINE (MinOf&(CX - Y, lt), CY - X)-(MaxOf&(CX + Y, rt), CY - X), C, BF ' draw lines for south polar latitudes
                END IF
                IF CY + X <= b AND CY + X >= t AND CX - Y <= rt AND CX + Y >= lt THEN
                    LINE (MinOf&(CX - Y, lt), CY + X)-(MaxOf&(CX + Y, rt), CY + X), C, BF ' draw lines for north polar latitudes
                END IF
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        IF CY - Y >= t AND CY - Y <= b AND CX - X <= rt AND CX + X >= lt THEN
            LINE (MinOf&(CX - X, lt), CY - Y)-(MaxOf&(CX + X, rt), CY - Y), C, BF '         draw lines north equatorial latitudes
        END IF
        IF CY + Y <= b AND CY + Y >= t AND CX - X <= rt AND CX + X >= lt THEN
            LINE (MinOf&(CX - X, lt), CY + Y)-(MaxOf&(CX + X, rt), CY + Y), C, BF '         draw lines south equatorial latitudes
        END IF
    WEND
END SUB 'FCircPart


SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'Steve's circle fill unmodified
    DIM AS LONG R, RError, X, Y
    R = ABS(RR) '                                               radius value along positive x
    RError = -R '                                               opposite side of circle? negative x
    X = R '                                                     point along positive x position
    Y = 0 '                                                     starting at the equator
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB '                  zero radius is point, not circle
    LINE (CX - X, CY)-(CX + X, CY), C, BF '                     draw equatorial line
    WHILE X > Y
        RError = RError + Y * 2 + 1 '
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw lines for south polar latitudes
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw lines for north polar latitudes
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF '         draw lines north equatorial latitudes
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF '         draw lines south equatorial latitudes
    WEND
END SUB 'FCirc


FUNCTION MaxOf& (value AS LONG, max AS LONG)
    MaxOf& = -value * (value <= max) - max * (value > max)
END FUNCTION 'MaxOf%

FUNCTION MinOf& (value AS INTEGER, minimum AS INTEGER)
    MinOf& = -value * (value >= minimum) - minimum * (value < minimum)
END FUNCTION 'MinOf%

Print this item

  Hi CPU Usage even at rest
Posted by: daivdW2 - 01-16-2023, 12:05 PM - Forum: General Discussion - Replies (11)

Hello. 

First, I would like to say how much I am enjoying using QB64PE - This is my first post. 

I have installed QB64PE it on a Linux VM but I have noticed that it takes my CPU up beyond 90% even when only the IDE is open and no code is running (the fan screaming lets me know!)

I have included two graphs below. The first with the larger area is QB64PE running a small program and then sitting in the IDE only. 

The second with the smaller area, is the same small program in QB64. 

Is there a known issue I should be aware of? 



[Image: msedge-gy-Pqk3lokl.png]
[Image: bmsedge-gy-Pqk3lokl.png]

Print this item

  Rotating Sphere in Visual Basic
Posted by: eoredson - 01-16-2023, 01:31 AM - Forum: QBJS, BAM, and Other BASICs - Replies (1)

Speaking of other basics and 3-d arrays for rotating sphere:

Code: (Select All)
Sphere is v9.0a of the rotating stereoscopic sphere integral.

Program Sphere displays a rotating real-time integral of the sphere which
can be modified over x/y/z axis, +/- radius, and switch to mono mode. This
red/blue output can be visualized with 'stage' glasses to simulate 3-D
views.

Stage glasses contain a red filter on the left lens and a blue filter
on the right lens.

Sphere v7.0a upgrades include movable/restorable buttons in freeze mode.

Sphere v8.0a upgrades add PictureBox & TextBox movable objects, and
corrects a small divide by zero error. Also allows any of 21 buttons
to be Drag 'n' Dropped onto any other of the 21 buttons, including
TextBox and PictureBox dropping..

Sphere v9.0a updates the install procedure to include all missing .ocx files.

Complete source and executable for VB 5.0 are included. Compiled with
VB 5.0 Enterprise w/ Service Pack 3.

This shareware product is public domain and can be distributed freely.

-end-

Here are 2 of them.

Sphere5.zip - original source
Sphere9.zip - latest source.

Erik.


[Image: sphere.png]



these should work in VB5 and VB6..

.zip   sphere5.zip (Size: 25.11 KB / Downloads: 30)
.zip   sphere9.zip (Size: 2.26 MB / Downloads: 29)

Print this item

  Select All
Posted by: Dimster - 01-15-2023, 04:58 PM - Forum: General Discussion - Replies (2)

I don't seem to be able to click, or right click, on the "Code:Select All" option any more whether I'm logged on or not. It's been a while since I tried to Select All so now I'm wondering if I ever did have the option to just click on Select All and all the code was highlighted. Have we lost that ability? It's not a big deal, I am able to just highlight it all by dragging my mouse to the end of code but as I age I continue to fear I'm fantasying a digital world that never existed.

Print this item

  Hardware Images
Posted by: SMcNeill - 01-14-2023, 02:43 PM - Forum: Learning Resources and Archives - Replies (11)

Someone on Discord sent me a couple of messages asking what the big deal was with hardware images, and why anyone would ever bother with them.   I hope the little demo below here will be sufficient enough to showcase why folks might want to make use of hardware images in their programs.

Code: (Select All)
DIM count AS _INTEGER64
displayScreen = _NEWIMAGE(1024, 720, 32)
workScreen = _NEWIMAGE(512, 360, 32)

SCREEN displayScreen
_DEST workScreen
FOR i = 1 TO 100 'draws something on the drawscreen
    LINE (RND * _WIDTH, RND * _HEIGHT)-(RND * _WIDTH, RND * _HEIGHT), _RGB32(RND * 256, RND * 256, RND * 256), BF
NEXT
hardwareScreen = _COPYIMAGE(workScreen, 33)

_DEST displayScreen

PRINT "For this demo, we're going to be scaling and placing a premade image onto the screen."
PRINT "For ease of output, our FPS count is going to be placed up in the TITLE area."
PRINT
PRINT "First, we'll do a FPS cound of simple software images."
PRINT "Let it run a few seconds, and then press <ANY KEY> when you'd like to move on."
PRINT
PRINT "After that, we'll use hardware images AND software images, and see how things compare."
PRINT "As before, watch the TITLE area for updates, and press <ANY KEY> when ready to move on."
PRINT
PRINT "And finally, we'll JUST use hardware images for our display."
PRINT "Once again, our FPS second count will be in the TITLE area, and you can press <ANY KEY> to"
PRINT "move to our final resulsts screen for ease of comparison."
PRINT
PRINT
PRINT "Press <ANY KEY> to begin."
SLEEP

_DELAY .5
_KEYCLEAR 'time to release any key


time# = TIMER + 1
DO
    CLS , 0
    scount = scount + 1
    IF TIMER > time# THEN
        _TITLE "Software FPS:" + STR$(scount)
        IF scount > smax THEN smax = scount
        scount = 0
        time# = TIMER + 1
    END IF
    _PUTIMAGE , workScreen
    _DISPLAY
LOOP UNTIL _KEYHIT

_DELAY .5
_KEYCLEAR 'time to release any key

time# = TIMER + 1
DO
    CLS , 0
    mcount = mcount + 1
    IF TIMER > time# THEN
        _TITLE "Mixed FPS:" + STR$(mcount)
        IF mcount > mmax THEN mmax = mcount
        mcount = 0

        time# = TIMER + 1
    END IF
    _PUTIMAGE , hardwareScreen
    _DISPLAY
LOOP UNTIL _KEYHIT

_DELAY .5
_KEYCLEAR 'time to release any key

time# = TIMER + 1
_DISPLAYORDER _HARDWARE
CLS , 0
DO
    hcount = hcount + 1
    IF TIMER > time# THEN
        _TITLE "Hardware FPS:" + STR$(hcount)
        IF hcount > hmax THEN hmax = hcount
        hcount = 0
        time# = TIMER + 1
    END IF
    _PUTIMAGE , hardwareScreen
    _DISPLAY
LOOP UNTIL _KEYHIT

_DISPLAYORDER _SOFTWARE , _HARDWARE
CLS , 0
_AUTODISPLAY

PRINT USING "###,###,### FPS with Software Images"; smax
PRINT USING "###,###,### FPS with Software and Hardware Images"; mmax
PRINT USING "###,###,### FPS with Hardware Images only"; hmax
PRINT
PRINT
PRINT "I would think the figures here alone, would showcase why one might want to use hardware images over other types, when possible."






[Image: image.png]

Print this item

  Trying out some old programs from QB45.org
Posted by: CharlieJV - 01-14-2023, 04:09 AM - Forum: QBJS, BAM, and Other BASICs - Replies (13)

These are programs from the (previously) "QB45.org" site that I find particularly interesting.  In the BAM version of the source code, you'll find the details of the original source code that you can grab for QB64pe. 

From "Graphics Demos" file category:


(More to come from the qb45.org site.)

Print this item