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

 
  Anyone know how frostbite thresholds are calculated?
Posted by: SMcNeill - 02-04-2023, 08:46 AM - Forum: Help Me! - Replies (13)

Something small I was working on to go with my home weather system:

Code: (Select All)
SCREEN _NEWIMAGE(800, 600, 32)
$COLOR:32
PRINT "  ";
count = 1
FOR temp = 40 TO -45 STEP -5
    LOCATE , 4 * count
    PRINT temp;
    count = count + 1
NEXT
PRINT


FOR windspeed = 5 TO 60 STEP 5
    COLOR White, Black
    PRINT windspeed;
    COLOR Black, SkyBlue
    count = 1
    FOR temp = 40 TO -45 STEP -5
        wc& = WindChill(temp, windspeed)
        LOCATE , 4 * count
        count = count + 1
        SELECT CASE wc&
            CASE IS > -18: COLOR Black, LightBlue
            CASE IS > -32: COLOR White, SkyBlue
            CASE IS > -48: COLOR White, Blue
            CASE ELSE: COLOR White, Purple
        END SELECT

        PRINT wc&; " ";
    NEXT
    PRINT
NEXT

COLOR White, Black


FUNCTION WindChill& (temp AS _FLOAT, windspeed AS _FLOAT)
    WindChill = 35.74 + 0.6215 * temp - 35.75 * windspeed ^ 0.16 + 0.427 * temp * windspeed ^ 0.16
END FUNCTION


Now, as you can see, my chart matches the values from the chart here: WindChill (weather.gov)


[Image: image.png]

Only issue is my color values don't match.  Anyone know why -62 windchills are light blue at the top of the chart, but then are purple at the bottom?  If the implied temperature is -52 in both cases, shouldn't frostbite occur at the same time?  Isn't that basically what windchill is for -- to give an equal representation of what the temperature would feel like it the wind wasn't blowing?

How's that frostbite time calculated?  Anyone have a clue, just so I can get my color scheme to match?

Print this item

  Where's Pete?
Posted by: bplus - 02-03-2023, 12:28 AM - Forum: Programs - Replies (3)

Code: (Select All)
'Option _Explicit
_Title "Signal" 'b+ 2023-01-23
Randomize Timer
Screen _NewImage(800, 600, 32)
Dim As Long d, spot, back, i, x, y, w, h, r, mx, my
Dim dx, dy
d = _LoadFont("ARIALBD.ttf", 64) ' <<<<  easy for Windows probably no one else sorry

spot = _NewImage(200, 200, 32)
_Dest spot
_Font d
_PrintMode _KeepBackground
Color _RGB32(0, 0, 0, 60)
_PrintString ((200 - _PrintWidth("Pete")) / 2, (200 - _FontHeight(d)) / 2 + 10), "Pete"
_Dest 0

back = _NewImage(800, 600, 32)
_Dest back
For y = 0 To 600
    Line (0, y)-(800, y), _RGB32(50, 0, y / 600 * 128)
Next
For i = 1 To 20
    w = Rnd * 100 + 30: y = Rnd * 200 + 400: x = Rnd * (800 - w)
    Line (x, y)-(x + w, 600), &HFF000000, BF
Next
Line (0, 550)-(800, 600), &HFF000000, BF
_Dest 0
r = 100
Do
    _PutImage , back, 0
    10 If _MouseInput Then GoTo 10
    mx = _MouseX: my = _MouseY
    For i = r To 0 Step -1
        fcirc mx, my, i, _RGB32(255, 255, 255, 1)
    Next
    h = ((mx + 10) ^ 2 + (my - 550) ^ 2) ^ .5
    dx = (mx + 10) / h: dy = (my - 550) / h
    For i = 0 To h Step 2
        fcirc -10 + i * dx, 550 + i * dy, i / h * 100, _RGB32(255, 255, 255, 1)
    Next
    _PutImage (mx - 100, my - 100), spot, 0
    _Display
    _Limit 30
Loop Until _KeyDown(27)

Sub fcirc (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
    Line (CX - X, CY)-(CX + X, CY), C
    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
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C
    Wend
End Sub

Print this item

  Exit Sub from inner loop?
Posted by: PhilOfPerth - 02-02-2023, 09:32 AM - Forum: Help Me! - Replies (9)

Is it "safe" to exit  a subroutine while in a While/Wend loop inside the Sub, or does this cause problems with things like the Stack or "memory leak" etc?  Undecided

Print this item

  a simple Palette Builder
Posted by: James D Jarvis - 02-01-2023, 04:42 PM - Forum: Programs - Replies (7)

Needed a palette editor for another 256 color mode program screen so I wrote this program.  This makes use of dialog commands, the mouse, and simple keyboard commands.  Loads and save the palette files as a simple data file. Also saves out the palette as lines of basic code.   

EDIT: added commands to copy and paste individual colors cells.

Code: (Select All)
'Palette_Builder
'by James D. Jarvis , Feb 2/1/2023
'
'a simple 256 color palette builder for QB64 PE
' saves and loads simple palette data files or basic source code to build a palette
Dim klr(0 To 255) As _Unsigned Long
Dim tklr As _Unsigned Long
Screen _NewImage(1100, 400, 256)
_Title "Palette_Builder"
Dim Shared showpalnos
showpalnos = 0
klr(0) = _RGB32(0, 0, 0)
klr(1) = _RGB32(0, 0, 255)
klr(2) = _RGB32(0, 128, 0)
klr(3) = _RGB32(0, 217, 217)
klr(4) = _RGB32(255, 0, 0)
klr(5) = _RGB32(193, 0, 193)
klr(6) = _RGB32(149, 5, 5)
klr(7) = _RGB32(192, 192, 192)
klr(8) = _RGB32(100, 100, 100)
klr(9) = _RGB32(0, 128, 255)
klr(10) = _RGB32(128, 255, 128)
klr(11) = _RGB32(128, 255, 255)
klr(12) = _RGB32(255, 128, 0)
klr(13) = _RGB32(255, 128, 255)
klr(14) = _RGB32(255, 255, 128)
klr(15) = _RGB32(250, 250, 250)
klr(255) = _RGB32(250, 250, 250)
For k = 16 To 254
    klr(k) = _RGB32(k, Int(k * .8), Int(k * .4))
Next k
klr(101) = _RGB32(100, 100, 100)
For k = 16 To 255
    _PaletteColor k, klr(k)
Next k
Color 255, 0
drawgrid

Do
    _Limit 500
    kk$ = InKey$
    Mouser mx, my, mb
    If mb = -1 And lb = 0 Then 'open color dialog on left button mouse click over grid position for color
        If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
            px = mx \ 32
            py = my \ 32
            pk = py * 32 + px
            Line (10, 310)-(800, 340), klr(0), BF
            pm$ = "Color #: " + Str$(pk) + " R,G,B: " + Str$(_Red32(klr(pk))) + "," + Str$(_Green32(klr(pk))) + "," + Str$(_Blue32(klr(pk)))
            _PrintString (10, 312), pm$
        End If
    End If
    If mb = 0 And lb = -2 Then 'open color dialog on right button mouse release over grid position for color
        If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
            px = mx \ 32
            py = my \ 32
            pk = py * 32 + px
            If pk > -1 And pk < 256 Then
                klr(pk) = _ColorChooserDialog("Choose Color", _RGB32(_Red32(klr(pk)), _Green32(klr(pk)), _Blue32(klr(pk))))
                _PaletteColor pk, klr(pk)
            End If
        End If
    End If
    lb = mb 'record mouse button just clicked as last button clicked
    Select Case kk$
        Case "s", "S" 'save palette
            savefile$ = _SaveFileDialog$("Save File", "", "*.*", "")
            If savefile$ <> "" Then
                _MessageBox "Information", "File will be saved to " + savefile$
                Open savefile$ For Output As #1
                For k = 0 To 255
                    Print #1, klr(k)
                Next k
                Close #1
            End If
        Case "l", "L" 'load palette
            loadfile$ = _OpenFileDialog$("Open File", "", "*.*", "*.*", -1)
            If loadfile$ <> "" Then
                _MessageBox "Information", "You selected " + loadfile$
                k = 0
                Open loadfile$ For Input As #1
                Do Until EOF(1)
                    Input #1, klr(k)
                    _PaletteColor k, klr(k)
                    k = k + 1
                Loop
                Close #1
                drawgrid
            End If
        Case "b", "B" 'save basic code for palette to a file
            savefile$ = _SaveFileDialog$("Save Basic Code to File", "", "*.*", "")
            If savefile$ <> "" Then
                _MessageBox "Information", "File will be saved to " + savefile$
                Open savefile$ For Output As #1
                Print #1, "'256 color palette uncomment lines as needed for use"
                Print #1, "'Screen _NewImage(600, 400,256) "
                Print #1, "'dim shared klr(0 to 255) as _unsigned long"
                For k = 0 To 255
                    bc$ = ""
                    bc$ = "klr(" + _Trim$(Str$(k)) + ") = _rgb32(" + _Trim$(Str$(_Red32(klr(k)))) + "," + _Trim$(Str$(_Green32(klr(k)))) + "," + _Trim$(Str$(_Blue32(klr(k)))) + ")"
                    Print #1, bc$
                Next k
                Print #1, "'For k = 0 To 255 "
                Print #1, "' _PaletteColor k, klr(k) "
                Print #1, "' Next k"
                Close #1
            End If
        Case "n", "N" 'toggle display of color numbers on palette grid
            If showpalnos = 0 Then showpalnos = 1 Else showpalnos = 0
            drawgrid
        Case "c", "C"
            Mouser mx, my, mb
            If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
                px = mx \ 32
                py = my \ 32
                pk = py * 32 + px
                Line (10, 310)-(800, 340), klr(0), BF
                pm$ = "Color #: " + Str$(pk) + " R,G,B: " + Str$(_Red32(klr(pk))) + "," + Str$(_Green32(klr(pk))) + "," + Str$(_Blue32(klr(pk)))
                _PrintString (10, 312), pm$
                If pk > 0 And pk < 256 Then tklr = klr(pk)
            End If
        Case "p", "P"
            Mouser mx, my, mb
            If mx > -1 And mx < 1024 And my > -1 And my < 256 Then
                px = mx \ 32
                py = my \ 32
                pk = py * 32 + px
                If pk > 0 And pk < 256 Then klr(pk) = tklr
                _PaletteColor pk, klr(pk)
            End If


    End Select
Loop Until kk$ = Chr$(27)
System

'draw the palette grid
Sub drawgrid
    _PrintMode _KeepBackground
    For y = 0 To 7
        For x = 0 To 31
            yy = y * 32
            xx = x * 16
            dk = yy + x
            xx = xx * 2
            Line (xx, yy)-(xx + 30, yy + 30), dk, BF
            If showpalnos = 1 Then
                _PrintString (xx + 2, yy + 6), _Trim$(Str$(dk))
            End If
    Next x, y
    _PrintString (10, 257), "S - Save File   L - Load File   B - Save Basic Code  N - show color #'s <ESC> -QUIT "
    _PrintString (10, 275), "Left Click - show RGB values    Right Click - change RGB values "
    _PrintString (10, 293), "C - Copy color    P - Paste color"
End Sub
'mouse sub from wiki with added check for mouse(2)
Sub Mouser (x, y, b)
    mi = _MouseInput
    b = _MouseButton(1)
    If _MouseButton(2) = -1 Then b = -2
    x = _MouseX
    y = _MouseY
End Sub

Print this item

  Collapsible functions in IDE
Posted by: RokCoder - 02-01-2023, 09:48 AM - Forum: General Discussion - Replies (29)

I'm really enjoying the QB64pe IDE but do have one request/suggestion. Hopefully this is the correct forum for this.

I'm working on quite a big project. Not a HUGE project but quite a large one nevertheless. It's just crept over 3000 lines and is becoming quite cumbersome to navigate. I've experimented with splitting sections off into BM/BI files but it feels quite a clunk way of handling things when I'm working on the codebase as a whole and it isn't really suitable to be segmented into standalone libraries.

What would make life a lot easier would be if I could collapse functions, sections, regions, etc.

Anyway, that would be my suggestions but I would also like to comment that it really is a very nice IDE to use. My original intention had been to look for Notepad++, VS Code, etc. plug-ins but there really is no need as it does exactly what's needed as is. Congrats to all the devs involved.

Print this item

  Frame rate within a frame rate - Better!
Posted by: TerryRitchie - 02-01-2023, 06:09 AM - Forum: Utilities - Replies (1)

A while back I started a discussion on determining frames rates within other frame rates here:

https://staging.qb64phoenix.com/showthread.php?tid=1107

The method I came up with for Pac-Man I thought was quite clever. Turns out not so much. Not only is it ugly (string manipulation) but it only worked for one global frame rate. If another global rate was needed the entire set of strings need to be recreated. Ugly, yes, but functional for the game.

I have a project I'm working on that needs the ability to have the global FPS change at any time but still have the ability to know when lower frame rates change within that global frame rate, in real time. So, while investigating (and pulling my hair out for an hour) my son walks up and asks, "What ya doing?"

I explain to him what I'm trying to accomplish. He listens, says "huh?", then wanders off. Ten minutes later he came back with a super simple solution! (He's autistic on the Asperger's scale and his mind amazes me)

The code below contains a function called FrameChange that can report lower frame rates within a global frame in real time, even if the global frame rate changes. Now I have to go back to my Pac-Man code and put this in place of my ugly solution. His solution is so freaking simple.

Code: (Select All)
' A better frame counter
' By Brandon Ritchie
' 01/31/23

' The function FrameChange determines lower frame rates within a global frame rate.
' The function will return -1 when a lower frame rate increases to the next frame number.

DIM GlobalFPS AS INTEGER
DIM Frame AS INTEGER
DIM FPS(23) AS INTEGER
DIM Count(23) AS INTEGER
DIM i AS INTEGER

GlobalFPS = 60 ' change to any value above 45 - the individual frame rates will remain constant
'                (above 45 simply because example rates below are from 2 to 46)

DO '             begin proof of concept demo
    _LIMIT 10 '  or use GlobalFPS (10 used to slow things down)
    CLS
    Frame = Frame + 1
    IF Frame = GlobalFPS THEN Frame = 0 ' reset global frame counter when last frame reached
    LOCATE 1, 2: PRINT "Global "; _TRIM$(STR$(GlobalFPS)); " FPS >"; Frame
    FOR i = 1 TO 23
        IF Frame = 0 THEN Count(i) = 0 '  reset count when frame resets
        IF FrameChange(GlobalFPS, i * 2, Frame) THEN Count(i) = Count(i) + 1
        LOCATE i + 1, 2
        PRINT _TRIM$(STR$(i * 2)); " FPS >"; Count(i);
    NEXT i
LOOP UNTIL _KEYDOWN(27) ' press ESC to exit

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

FUNCTION FrameChange (Global AS INTEGER, Target AS INTEGER, Frame AS INTEGER)

    ' Global = global frame rate
    ' Target = target frame rate
    ' Frame  = the current global frame (0 to Global-1)
    ' Returns -1 (true) if target frame changes within the global frame rate

    DIM Fraction AS SINGLE
    DIM x AS SINGLE '

    FrameChange = 0
    Fraction = Target / Global
    x = Frame * Fraction
    IF INT(x) <> INT(x - Fraction) THEN FrameChange = -1

END FUNCTION

Print this item

  Angle difference
Posted by: bplus - 01-31-2023, 05:04 PM - Forum: Help Me! - Replies (8)

I was working collisions of spiders and 2 spiders going in same direction or nearly so needed collision code different from spiders coming head on or perpendicular to each other.

So how do I tell if spiders are going in same direction or nearly so, say their headings are within 30 degrees of each other or not?

Just subtract the angles right? Or take the ABS of the difference right?

Well what if one has a heading of 0 degrees and the other a heading of 350 degrees the difference is 350, I am wanting 10 degrees so make 0 360 instead, easy right?

So now what if one was x and the other y when do I know to add 360? like with 0.

I came up with a function AngleDifference to handle this because this issue has come up before but it seems kind of clunky. I think the time before I used Major and Minor arc differences, two answers to angle difference. This time one answer but again seems cluncky.

I won't show my code because I don't want to bias someone coming up with maybe a more elegant solution which I suspect exists.

So if you can do it in a line or 2 I'd be interested.

Print this item

  A faster way to scale images?
Posted by: johannhowitzer - 01-31-2023, 02:14 PM - Forum: Help Me! - Replies (13)

Recently, I added a level editor to my game project.  In this level editor, I included a "playhead" tool, similar to what you would see in a video or audio editing program - so when you hit "play level" from the editor, with the playhead set, it would invisibly simulate the level up to that point as fast as possible, then you'd start playing from the playhead.  This is a very useful thing in my level design process, since it means I don't have to watch minutes of level go by while I'm tweaking a later part.

However, I noticed the simulation was taking almost as long as actually playing the level up to where the playhead was.  I ran a visible frame counter during the simulation and discovered it was only about 30% faster.

At the time I chalked this up to poor design on my part, maybe some inefficiencies in my code, and looked into it a little bit, but didn't find anything conclusive.  To boost the simulation speed a bit, I copied the main gameplay loop and stripped it down to bare essentials, only what the simulation would need.  To my surprise, it was now running EVEN SLOWER than before.

So I started commenting out pieces of the simulation loop, to see how it affected the time.  Nothing made a difference - the position updates, the level script check, collision detection, background scrolling, very mysterious.  So I took the loop, with everything but the actual frame counter commented out, and still, no difference, it was running just as slowly.  Good news - those chunks of code are actually super fast!  But how could the frame counter be causing so much slowdown that it was running under 60 loops per second?  It's just a PRINT statement with a variable plugged in.

Well, when you've eliminated every other possibility, whatever remains, however unlikely, must be true.  Below the PRINT statement was a SUB call: display_screen.  Here it is:


Code: (Select All)
sub display_screen
putimage(0, 0)-((screenw * option_window_size) - 1, (screenh * option_window_size) - 1), full_screen, scaled_screen(option_window_size), (0, 0)-(screenw - 1, screenh - 1)
display
end sub


I had recently added a screen scaling option to the option menu.  Players can choose to run the game at x1, x2, or x3; since it's a pixelart game, the window size options are doubling or tripling the pixels.  The x1 resolution is 640x360 (16:9 ratio), so x2 is 1280x720 and x3 is 1920x1080.

So it's that PUTIMAGE statement; more specifically, the scaling.  Apparently using PUTIMAGE, in any situation where the output size and input size are different, is a massive resource hog.  I was running the playhead 1643 frames into the level in each case... at x2 scaling, this took 37.14 seconds, which is about 44 frames per second.  Running x1 scaling took 4.56 seconds, or 360 fps.  Removing the multiplier from the PUTIMAGE statement, curiously, took 7.8 seconds, or 210 fps.  And finally, commenting out the display_screen call entirely (including the DISPLAY statement) caused it to take 1.42 seconds, which is 1157 fps.

I have some workarounds in mind, such as pre-processing all source images into three size versions, and toggling between them based on the player's chosen size option.  But that's a lot of work, so first I have to know, is there a way to speed this up without such a huge overhaul to the code?  I've seen games do this exact kind of window size option before, although they weren't made in QB64.

Print this item

Lightbulb Pipecom for FreeBASIC!
Posted by: SpriggsySpriggs - 01-30-2023, 09:56 PM - Forum: QBJS, BAM, and Other BASICs - Replies (7)

Here is my FreeBASIC port of Pipecom! Right now, I've only converted the Windows portion. The Linux portion will be a bit tougher to do. I am a newbie with FreeBASIC as I just got started so the code might be not that great. However, it works just the same as the QB64 code.

Code: (Select All)
#define UNICODE
#include once "windows.bi"

type PIPE_STRUCT
   as DWORD exitCode
   as string _stdout, _stderr
end type

declare function pipecom overload (cmd as string) as PIPE_STRUCT
declare function pipecom (cmd as string, byref _stdout as string, byref _stderr as string) as DWORD
declare function StrRemove (byref s as string, ch as ubyte) as string

dim as string cmd = "PowerShell -NoProfile Add-Type -AssemblyName System.Windows.Forms;$FileBrowser = New-Object System.Windows.Forms.OpenFileDialog -Property @{ Title = '" +_
Chr(34) + "Select a FreeBASIC file" + Chr(34) +_
"'; InitialDirectory = '" + Chr(34) + ".\" +_
  Chr(34) + "'; Filter = '" + Chr(34) + "FreeBASIC Files (*.bas, *.bi)|*.BAS;*.BI|All Files (*.*)|*.*" + Chr(34) +_
   "'; FilterIndex = '" + Chr(34) + LTrim(Str(0)) + Chr(34) +_
    "'; };$null = $FileBrowser.ShowDialog();$FileBrowser.FileName;exit $LASTEXITCODE"

with pipecom(cmd)
   print .exitCode
   print ._stdout
end with

sleep

function pipecom (cmd as string, byref _stdout as string, byref _stderr as string) as DWORD
   dim as PIPE_STRUCT piped = pipecom(cmd)
   _stdout = piped._stdout
   _stderr = piped._stderr
   return piped.exitCode
end function

function pipecom (cmd as string) as PIPE_STRUCT
   
   dim as PIPE_STRUCT piped
   
   dim as SECURITY_ATTRIBUTES sa
   with sa
      .nLength = sizeof(SECURITY_ATTRIBUTES)
      .lpSecurityDescriptor = null
      .bInheritHandle = true
   end with

   dim as HANDLE hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError

   if CreatePipe(@hStdOutPipeRead, @hStdOutPipeWrite, @sa, null) = false then
      piped.exitCode = -1
   end if

   if createpipe(@hStdReadPipeError, @hStdOutPipeError, @sa, null) = false then
      piped.exitCode = -1
   end if

   dim as STARTUPINFO si
   with si
      .cb = sizeof(STARTUPINFO)
      .dwFlags = STARTF_USESTDHANDLES
      .hstdError = hStdOutPipeError
      .hStdOutput = hStdOutPipeWrite
      .hStdInput = null
   end with

   dim as PROCESS_INFORMATION procinfo
   dim as string lpCommandLine = "cmd /c " + cmd

   if CreateProcess(null, lpCommandLine, null, null, true, CREATE_NO_WINDOW, null, null, @si, @procinfo) = false then
      piped.exitCode = -1
   end if

   CloseHandle(hStdOutPipeWrite)
   CloseHandle(hStdOutPipeError)

   dim as string buf = string(4096 + 1, 0)
   dim as string _stdout, _stderr
   dim as DWORD dwRead

   while ReadFile(hStdOutPipeRead, strptr(buf), 4096, @dwRead, null) andAlso dwRead > 0
      buf = mid(buf, 1, dwRead)
      _stdout += buf
      buf = string(4096 + 1, 0)
   wend

   while readfile(hStdReadPipeError, strptr(buf), 4096, @dwRead, null) andalso dwRead > 0
      buf = mid(buf, 1, dwRead)
      _stderr += buf
      buf = string(4096 + 1, 0)
   wend

   if instr(_stdout, chr(13)) then
      _stdout = StrRemove(_stdout, 13)
   end if

   if instr(_stderr, chr(13)) then
      _stderr = StrRemove(_stderr, 13)
   end if

   dim as DWORD exit_code, ex_stat
   
   piped._stderr = _stderr
   piped._stdout = _stdout

   if WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED then
      if GetExitCodeProcess(procinfo.hProcess, @exit_code) then
         ex_stat = 1
      end if
   end if

   closehandle(hStdOutPipeRead)
   closehandle(hStdReadPipeError)

   if ex_stat = 1 then
      piped.exitCode = exit_code
   else
      piped.exitCode = -1
   end if

   return piped
end function

function StrRemove (byref s as string, ch as ubyte) as string

   if (0 = strptr(s)) then return ""

   '' Get the trimmed string length
   ''
   dim new_length as integer = len(s)
   for i as integer = 0 to len(s) - 1
      if (ch = s[i]) then
         new_length -= 1
         exit for
      end if
   next

   '' Allocate an appropriately sized string
   ''
   dim result as string = string(new_length, 0)
     
   '' Copy the non-matching ubytes to the new string
   ''
   dim it as ubyte ptr = @result[0]
   for i as integer = 0 to len(s) - 1
      if (ch <> s[i]) then
         *it = s[i]
         it += 1
      end if
   next
   
   return result

end function

Print this item

Photo Input box got ugly
Posted by: James D Jarvis - 01-30-2023, 02:56 PM - Forum: General Discussion - Replies (3)

So following recent updates of Windows, the inpubox$ command still functions but it got ugly:

[Image: image.png]

The system doesn't draw the input box neatly and it hides the values in the input box. 

Is there a way to fix this from inside a QB64 program or at a higher level in windows?  I'm not using the latest released build of QB64 has this already been addressed?

Print this item