QB64 Phoenix Edition
Portal

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

Username/Email:
  

Password
  

Search Forums

(Advanced Search)

Forum Statistics
» Members: 583
» Latest member: Paulo Afonso
» Forum threads: 3,081
» Forum posts: 28,046

Full Statistics

Latest Threads
TOTP 100% qb64 Yup - sort...
Forum: Help Me!
Last Post: Ra7eN
1 hour ago
» Replies: 3
» Views: 37
Be warned, I'm back!
Forum: General Discussion
Last Post: doppler
3 hours ago
» Replies: 3
» Views: 118
InForm-PE
Forum: a740g
Last Post: Kernelpanic
4 hours ago
» Replies: 99
» Views: 13,022
Clearing mouse input
Forum: Help Me!
Last Post: PhilOfPerth
11 hours ago
» Replies: 4
» Views: 84
32 vs 64 bit math
Forum: Help Me!
Last Post: FCS_coder
Yesterday, 11:01 PM
» Replies: 7
» Views: 256
computer artist John Whit...
Forum: General Discussion
Last Post: madscijr
Yesterday, 07:51 PM
» Replies: 0
» Views: 39
More QB64PE at work
Forum: Programs
Last Post: bobalooie
Yesterday, 07:25 PM
» Replies: 13
» Views: 209
Deep Basic
Forum: QBJS, BAM, and Other BASICs
Last Post: aurel
Yesterday, 02:57 PM
» Replies: 3
» Views: 66
Patterns Board Game
Forum: Games
Last Post: madscijr
Yesterday, 12:12 PM
» Replies: 1
» Views: 41
Word Search Maker
Forum: Programs
Last Post: euklides
Yesterday, 08:33 AM
» Replies: 25
» Views: 1,044

 
  Keybone's GUI (04/07/2022)
Posted by: Keybone - 04-19-2022, 02:42 PM - Forum: Keybone - Replies (6)

This is the latest rewrite of my GUI.
It is not complete by any means, as always work-in-progress.

What's working:
Restore window from Icon
Move window
Move Icon
Minimize window to icon
Maximize window to screen size

Not working:
Restore window from maximized
Minimize window from maximized
Close window
Z-order focus (windows do not rise to the top of z-order when clicked (yet).)

Also, unlike some of my previous versions, there is no background implemented yet.

Here for the obligatory screenshots:

All windows minimized:
[Image: allminimized.png]


One window restored from minimized:

[Image: one-restored.png]


Window resizing:

[Image: resizing.png]


Window resized (and z-order bug):

[Image: resized-zorderni.png]


Window maximized (and z-order bug):

[Image: maximized.png]

Installing:
Copy and paste k-win-upload.bas and blank.png into your qb64 folder. Compile and run k-win-upload.bas.

blank.png :

[Image: blank.png]


k-win-upload.bas :

Code: (Select All)
Type aSize
    restoredSizeX As _Unsigned Integer
    restoredSizeY As _Unsigned Integer
    maximizedSizeX As _Unsigned Integer
    maximizedSizeY As _Unsigned Integer
End Type

Type aProperty
    isMinimizable As _Byte
    isRestorable As _Byte
    isMaximizable As _Byte
    isMovable As _Byte
    isResizable As _Byte
End Type

Type aStatus
    isMinimized As _Byte
    isRestored As _Byte
    isMaximized As _Byte
    isMoving As _Byte
    isResizing As _Byte
End Type

Type aWindow
    positionX As Integer
    positionY As Integer
    Size As aSize
    restoredImageHandle As _Unsigned Long
    maximizedImageHandle As _Unsigned Long
    Properties As aProperty
    Status As aStatus
    isActive As _Byte
End Type

Type anIcon
    positionX As Integer
    positionY As Integer
    sizeX As _Unsigned Integer
    sizeY As _Unsigned Integer
    imageHandle As _Unsigned Long
End Type

Type anObject
    Title As String
    Identifier As String
    Windows As aWindow
    Icons As anIcon
End Type

Type aMouse
    positionX As Integer
    positionY As Integer
    buttonLeft As _Byte
    buttonCenter As _Byte
    buttonRight As _Byte
End Type

Type aZone
    parentIdentifier As _Unsigned Integer
    Identifier As _Unsigned Integer
    positionX As Integer
    positionY As Integer
    sizeX As _Unsigned Integer
    sizeY As _Unsigned Integer
    Purpose As String
End Type

Type aLimit
    Minimum As _Unsigned Integer
    Current As _Unsigned Integer
    Maximum As _Unsigned Integer
End Type

Dim Shared limitObjects As aLimit
limitObjects.Minimum = 0
limitObjects.Current = limitObjects.Minimum
limitObjects.Maximum = 0 - 1

Dim Shared limitZones As aLimit
limitZones.Minimum = 0
limitZones.Current = limitZones.Minimum
limitZones.Maximum = 0 - 1

ReDim Shared Objects(limitObjects.Current) As anObject
ReDim Shared Zones(limitZones.Current) As aZone

Dim Shared ZoneMatched As _Unsigned Integer
Dim Shared WindowMatched As _Unsigned Integer
Dim Shared Purpose As String

Dim Shared Mouse As aMouse

' BAS on down BI on up

Screen _NewImage(800, 600, 32)
'_FullScreen _SquarePixels

Dim Shared gray25 As _Unsigned Long: gray25 = _RGBA32(63, 63, 63, 255)
Dim Shared gray50 As _Unsigned Long: gray50 = _RGBA32(127, 127, 127, 255)
Dim Shared gray75 As _Unsigned Long: gray75 = _RGBA32(191, 191, 191, 255)

objectInit 100, 100, 200, 200, "Window 1", "Window Title 1"
'objectDisableMaximization limitObjects.Current

objectInit 200, 200, 200, 200, "Window 2", "Window Title 2"
'objectDisableMaximization limitObjects.Current

objectInit 300, 300, 200, 200, "Window 3", "Window Title 3"
'objectDisableMaximization limitObjects.Current

Do
    Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(63, 0, 63, 255), BF

    For i = 0 To limitObjects.Current
        If Objects(i).Windows.Status.isMinimized Then
            _PutImage (Objects(i).Icons.positionX, Objects(i).Icons.positionY), Objects(i).Icons.imageHandle
        ElseIf Objects(i).Windows.Status.isRestored Then
            _PutImage (Objects(i).Windows.positionX, Objects(i).Windows.positionY), Objects(i).Windows.restoredImageHandle
        ElseIf Objects(i).Windows.Status.isMaximized Then
            _PutImage (0, 0), Objects(i).Windows.maximizedImageHandle
        End If
    Next i

    mouseProbe

    If Mouse.buttonLeft Then
        For i = 0 To limitObjects.Current
            WindowMatched = isObject~%(i)
            If WindowMatched Then
                If Objects(WindowMatched).Windows.Status.isMinimized Then
                    _Delay .125
                    mouseProbe
                    If Mouse.buttonLeft Then
                        objectMove WindowMatched
                    Else
                        objectRestore WindowMatched
                    End If
                ElseIf Objects(WindowMatched).Windows.Status.isRestored Then
                    If Mouse.positionX > Objects(WindowMatched).Windows.positionX + 4 And Mouse.positionX < Objects(WindowMatched).Windows.positionX + 24 Then
                        If Mouse.positionY > Objects(WindowMatched).Windows.positionY + 3 And Mouse.positionY < Objects(WindowMatched).Windows.positionY + 23 Then
                            ' Close
                        End If
                    End If
                    If Mouse.positionX > Objects(WindowMatched).Windows.positionX + 24 And Mouse.positionX < Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 69) Then
                        If Mouse.positionY > Objects(WindowMatched).Windows.positionY + 3 And Mouse.positionY < Objects(WindowMatched).Windows.positionY + 23 Then
                            objectMove WindowMatched
                        End If
                    End If
                    If Mouse.positionX > Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 46) And Mouse.positionX < Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 23) Then
                        If Mouse.positionY > Objects(WindowMatched).Windows.positionY + 3 And Mouse.positionY < Objects(WindowMatched).Windows.positionY + 23 Then
                            objectMinimize WindowMatched
                        End If
                    End If
                    If Mouse.positionX > Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 23) And Mouse.positionX < Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 3) Then
                        If Mouse.positionY > Objects(WindowMatched).Windows.positionY + 3 And Mouse.positionY < Objects(WindowMatched).Windows.positionY + 23 Then
                            objectMaximize WindowMatched
                        End If
                    End If
                    If Mouse.positionX > Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 23) And Mouse.positionX < Objects(WindowMatched).Windows.positionX + (_Width(Objects(WindowMatched).Windows.restoredImageHandle) - 3) Then
                        If Mouse.positionY > Objects(WindowMatched).Windows.positionY + (_Height(Objects(WindowMatched).Windows.restoredImageHandle) - 23) And Mouse.positionY < Objects(WindowMatched).Windows.positionY + (_Height(Objects(WindowMatched).Windows.restoredImageHandle) - 3) Then
                            objectResize WindowMatched
                        End If
                    End If
                End If
            End If
        Next i
    End If
    _Limit 60
    _Display
Loop Until Len(InKey$)

Sub objectAdd
    limitObjects.Current = limitObjects.Current + 1
    ReDim _Preserve Objects(limitObjects.Current) As anObject
End Sub

Sub objectRemove (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Icons.imageHandle Then
        _FreeImage Objects(inIdentifier).Icons.imageHandle
    End If
    If Objects(inIdentifier).Windows.restoredImageHandle Then
        _FreeImage Objects(inIdentifier).Windows.restoredImageHandle
    End If
    If Objects(inIdentifier).Windows.maximizedImageHandle Then
        _FreeImage Objects(inIdentifier).Windows.maximizedImageHandle
    End If
    For i = inIdentifier To limitObjects.Current - 1 Step 1
        Objects(i) = Objects(i + 1)
    Next i

    If limitObjects.Current > limitObjects.Minimum Then ' redim array
        limitObjects.Current = limitObjects.Current - 1
        ReDim _Preserve Objects(limitObjects.Current) As anObject
    End If
End Sub

Sub objectInit (inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer, inIdentifier As String, inTitle As String)
    objectAdd
    Objects(limitObjects.Current).Title = inTitle
    Objects(limitObjects.Current).Identifier = inIdentifier
    Objects(limitObjects.Current).Windows.positionX = inPositionX
    Objects(limitObjects.Current).Windows.positionY = inPositionY
    Objects(limitObjects.Current).Windows.Size.restoredSizeX = inSizeX
    Objects(limitObjects.Current).Windows.Size.restoredSizeY = inSizeY
    Objects(limitObjects.Current).Windows.Size.maximizedSizeX = _Width
    Objects(limitObjects.Current).Windows.Size.maximizedSizeY = _Height
    Objects(limitObjects.Current).Windows.restoredImageHandle = _NewImage(Objects(limitObjects.Current).Windows.Size.restoredSizeX, Objects(limitObjects.Current).Windows.Size.restoredSizeY, 32)
    Objects(limitObjects.Current).Windows.maximizedImageHandle = _NewImage(Objects(limitObjects.Current).Windows.Size.maximizedSizeX, Objects(limitObjects.Current).Windows.Size.maximizedSizeY, 32)
    Objects(limitObjects.Current).Windows.Properties.isMinimizable = -1
    Objects(limitObjects.Current).Windows.Properties.isRestorable = -1
    Objects(limitObjects.Current).Windows.Properties.isMaximizable = -1
    Objects(limitObjects.Current).Windows.Properties.isMovable = -1
    Objects(limitObjects.Current).Windows.Properties.isResizable = -1
    Objects(limitObjects.Current).Windows.Status.isMinimized = -1
    Objects(limitObjects.Current).Windows.Status.isRestored = 0
    Objects(limitObjects.Current).Windows.Status.isMaximized = 0
    Objects(limitObjects.Current).Windows.Status.isMoving = 0
    Objects(limitObjects.Current).Windows.Status.isResizing = 0
    Objects(limitObjects.Current).Windows.isActive = 0
    Objects(limitObjects.Current).Icons.positionX = Objects(limitObjects.Current).Windows.positionX + (Objects(limitObjects.Current).Windows.Size.restoredSizeX / 2)
    Objects(limitObjects.Current).Icons.positionY = Objects(limitObjects.Current).Windows.positionY + (Objects(limitObjects.Current).Windows.Size.restoredSizeY / 2)
    Objects(limitObjects.Current).Icons.imageHandle = _LoadImage("blank.png")
    Objects(limitObjects.Current).Icons.sizeX = _Width(Objects(limitObjects.Current).Icons.imageHandle)
    Objects(limitObjects.Current).Icons.sizeY = _Height(Objects(limitObjects.Current).Icons.imageHandle)
    objectDraw limitObjects.Current, "Restored"
    objectDraw limitObjects.Current, "Maximized"
End Sub

Sub objectDraw (inIdentifier As _Unsigned Integer, inMode As String)
    inMode = LTrim$(RTrim$(UCase$(inMode)))
    Select Case inMode
        Case "RESTORED"
            _Dest Objects(inIdentifier).Windows.restoredImageHandle
            Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(127, 127, 127, 255), BF
            box 0, 0, _Width - 1, _Height - 1, 1
            box 0, 0, _Width - 1, _Height - 1, 1
            If Objects(Identifier).Windows.isActive = -1 Then
                Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 255, 255, 255)
            Else
                Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 127, 127, 255)
            End If
            box2 _Width - 48, 3, 20, 20, 1, 7
            box2 _Width - 25, 3, 20, 20, 1, 2
            box3 4, 3, 20, 20, 1, 1, 7
            _Dest 0
        Case "MAXIMIZED"
            _Dest Objects(inIdentifier).Windows.maximizedImageHandle
            Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(127, 127, 127, 255), BF
            box 0, 0, _Width - 1, _Height - 1, 1
            box 0, 0, _Width - 1, _Height - 1, 1
            If Objects(Identifier).Windows.isActive = -1 Then
                Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 255, 255, 255)
            Else
                Titlebar 2, 2, _Width - 5, 23, _RGBA32(0, 127, 127, 255)
            End If
            box2 _Width - 48, 3, 20, 20, 1, 7
            box2 _Width - 25, 3, 20, 20, 1, 2
            box3 4, 3, 20, 20, 1, 1, 7
            _Dest 0
    End Select
End Sub

Sub objectMinimize (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Properties.isMinimizable = -1 Then
        Objects(inIdentifier).Windows.Status.isMinimized = -1
        Objects(inIdentifier).Windows.Status.isRestored = 0
        Objects(inIdentifier).Windows.Status.isMaximized = 0
    End If
End Sub

Sub objectRestore (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Properties.isRestorable = -1 Then
        Objects(inIdentifier).Windows.Status.isMinimized = 0
        Objects(inIdentifier).Windows.Status.isRestored = -1
        Objects(inIdentifier).Windows.Status.isMaximized = 0
    End If
End Sub

Sub objectMaximize (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Properties.isMaximizable = -1 Then
        Objects(inIdentifier).Windows.Status.isMinimized = 0
        Objects(inIdentifier).Windows.Status.isRestored = 0
        Objects(inIdentifier).Windows.Status.isMaximized = -1
    End If
End Sub

Sub objectMove (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Properties.isMovable Then
        Objects(inIdentifier).Windows.Status.isMoving = -1
        Dim previousPositionX As _Unsigned Integer, previousPositionY As _Unsigned Integer
        If Objects(inIdentifier).Windows.Status.isMinimized Then
            previousPositionX = Objects(inIdentifier).Icons.positionX - Mouse.positionX
            previousPositionY = Objects(inIdentifier).Icons.positionY - Mouse.positionY
            While Mouse.buttonLeft
                Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(63, 0, 63, 255), BF
                mouseProbe
                Objects(inIdentifier).Icons.positionX = Mouse.positionX + previousPositionX
                Objects(inIdentifier).Icons.positionY = Mouse.positionY + previousPositionY
                For i = 1 To limitObjects.Current
                    If Objects(i).Windows.Status.isMinimized Then
                        _PutImage (Objects(i).Icons.positionX, Objects(i).Icons.positionY), Objects(i).Icons.imageHandle
                    ElseIf Objects(i).Windows.Status.isRestored Then
                        _PutImage (Objects(i).Windows.positionX, Objects(i).Windows.positionY), Objects(i).Windows.restoredImageHandle
                    End If
                Next i
                _Display
            Wend
        ElseIf Objects(inIdentifier).Windows.Status.isRestored Then
            previousPositionX = Objects(inIdentifier).Windows.positionX - Mouse.positionX
            previousPositionY = Objects(inIdentifier).Windows.positionY - Mouse.positionY
            While Mouse.buttonLeft
                Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(63, 0, 63, 255), BF
                mouseProbe
                Objects(inIdentifier).Windows.positionX = Mouse.positionX + previousPositionX
                Objects(inIdentifier).Windows.positionY = Mouse.positionY + previousPositionY
                For i = 1 To limitObjects.Current
                    If Objects(i).Windows.Status.isMinimized Then
                        _PutImage (Objects(i).Icons.positionX, Objects(i).Icons.positionY), Objects(i).Icons.imageHandle
                    ElseIf Objects(i).Windows.Status.isRestored Then
                        _PutImage (Objects(i).Windows.positionX, Objects(i).Windows.positionY), Objects(i).Windows.restoredImageHandle
                    End If
                Next i
                _Display
            Wend
        End If
        Objects(inIdentifier).Windows.Status.isMoving = 0
    End If
End Sub

Sub objectResize (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Properties.isResizable Then
        Objects(inIdentifier).Windows.Status.isResizing = -1
        Dim positionX As Integer, positionY As Integer
        Dim sizeX As _Unsigned Integer, sizeY As _Unsigned Integer
        positionX = Objects(inIdentifier).Windows.positionX
        positionY = Objects(inIdentifier).Windows.positionY
        While Mouse.buttonLeft
            Line (0, 0)-(_Width - 1, _Height - 1), _RGBA32(63, 0, 63, 255), BF
            mouseProbe
            For i = 1 To limitObjects.Current
                If Objects(i).Windows.Status.isMinimized Then
                    _PutImage (Objects(i).Icons.positionX, Objects(i).Icons.positionY), Objects(i).Icons.imageHandle
                ElseIf Objects(i).Windows.Status.isRestored Then
                    _PutImage (Objects(i).Windows.positionX, Objects(i).Windows.positionY), Objects(i).Windows.restoredImageHandle
                End If
            Next i
            sizeX = (Mouse.positionX - Objects(inIdentifier).Windows.positionX)
            sizeY = (Mouse.positionY - Objects(inIdentifier).Windows.positionY)
            Line (Objects(inIdentifier).Windows.positionX, Objects(inIdentifier).Windows.positionY)-(Objects(inIdentifier).Windows.positionX + sizeX, Objects(inIdentifier).Windows.positionY + sizeY), _RGBA32(255, 255, 255, 255), B
            _Display
        Wend
        sizeX = (Mouse.positionX - Objects(inIdentifier).Windows.positionX)
        sizeY = (Mouse.positionY - Objects(inIdentifier).Windows.positionY)
        _FreeImage Objects(inIdentifier).Windows.restoredImageHandle
        Objects(indentifier).Windows.restoredImageHandle = _NewImage(sizeX, sizeY, 32)
        objectDraw inIdentifier, "Restored"
        _PutImage (positionX, positionY), inIdentifier
        Objects(inIdentifier).Windows.positionX = positionX
        Objects(inIdentifier).Windows.positionY = positionY
        Objects(inIdentifier).Windows.Size.restoredSizeX = sizeX
        Objects(inIdentifier).Windows.Size.restoredSizeY = sizeY
        Objects(inIdentifier).Windows.Status.isResizing = 0
    End If
End Sub

Sub objectDisableMinimization (inIdentifier As _Unsigned Integer)
    Objects(inIdentifier).Windows.Properties.isMinimizable = 0
End Sub

Sub objectDisableRestoration (inIdentifier As _Unsigned Integer)
    Objects(inIdentifier).Windows.Properties.isRestorable = 0
End Sub

Sub objectDisableMaximization (inIdentifier As _Unsigned Integer)
    Objects(inIdentifier).Windows.Properties.isMaximizable = 0
End Sub

Sub objectDisableMoving (inIdentifier As _Unsigned Integer)
    Objects(inIdentifier).Windows.Properties.isMovable = 0
End Sub

Sub objectDisableResizing (inIdentifier As _Unsigned Integer)
    Objects(inIdentifier).Windows.Properties.isResizable = 0
End Sub

Sub mouseProbe
    While _MouseInput
        Mouse.positionX = _MouseX
        Mouse.positionY = _MouseY
        Mouse.buttonLeft = _MouseButton(1)
        Mouse.buttonCenter = _MouseButton(3)
        Mouse.buttonRight = _MouseButton(2)
    Wend
End Sub

Function isObject~% (inIdentifier As _Unsigned Integer)
    If Objects(inIdentifier).Windows.Status.isMinimized Then
        If Mouse.positionX >= Objects(inIdentifier).Icons.positionX Then
            If Mouse.positionY >= Objects(inIdentifier).Icons.positionY Then
                If Mouse.positionX <= Objects(inIdentifier).Icons.positionX + Objects(inIdentifier).Icons.sizeX Then
                    If Mouse.positionY <= Objects(inIdentifier).Icons.positionY + Objects(inIdentifier).Icons.sizeY Then
                        isObject~% = inIdentifier
                    End If
                End If
            End If
        End If
    ElseIf Objects(inIdentifier).Windows.Status.isRestored Then
        If Mouse.positionX >= Objects(inIdentifier).Windows.positionX Then
            If Mouse.positionY >= Objects(inIdentifier).Windows.positionY Then
                If Mouse.positionX <= Objects(inIdentifier).Windows.positionX + Objects(inIdentifier).Windows.Size.restoredSizeX Then
                    If Mouse.positionY <= Objects(inIdentifier).Windows.positionY + Objects(inIdentifier).Windows.Size.restoredSizeY Then
                        isObject~% = inIdentifier
                    End If
                End If
            End If
        End If
    End If
End Function

Sub Titlebar (titlebarPositionX As _Unsigned Integer, titlebarPositionY As _Unsigned Integer, titlebarWidth As _Unsigned Integer, titlebarHeight As _Unsigned Integer, titlebarColor As _Unsigned Long)
    Line (titlebarPositionX, titlebarPositionY)-(titlebarPositionX + titlebarWidth, titlebarPositionY + titlebarHeight), titlebarColor, BF
End Sub

Sub box (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer)
    Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray75, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray25, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), gray50, BF
End Sub

Sub box2 (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer, interiorDepth As _Unsigned Integer)
    interiorDepth = interiorDepth * boxDepth
    Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray25, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray75, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), gray50, BF
    Line (boxPositionX + boxDepth + interiorDepth, boxPositionY + boxDepth + interiorDepth)-(boxPositionX + boxWidth - boxDepth - interiorDepth, boxPositionY + boxHeight - boxDepth - interiorDepth), gray75, BF
    Line (boxPositionX + (boxDepth * 2) + interiorDepth, boxPositionY + (boxDepth * 2) + interiorDepth)-(boxPositionX + boxWidth - boxDepth - interiorDepth, boxPositionY + boxHeight - boxDepth - interiorDepth), gray25, BF
    Line (boxPositionX + (boxDepth * 2) + interiorDepth, boxPositionY + (boxDepth * 2) + interiorDepth)-(boxPositionX + boxWidth - (boxDepth * 2) - interiorDepth, boxPositionY + boxHeight - (boxDepth * 2) - interiorDepth), gray50, BF
End Sub

Sub box3 (boxPositionX As _Unsigned Integer, boxPositionY As _Unsigned Integer, boxWidth As _Unsigned Integer, boxHeight As _Unsigned Integer, boxDepth As _Unsigned Integer, interiorDepthX As _Unsigned Integer, interiorDepthY As _Unsigned Integer)
    interiorDepthX = interiorDepthX * boxDepth
    interiorDepthY = interiorDepthY * boxDepth
    Line (boxPositionX, boxPositionY)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray25, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-(boxPositionX + boxWidth, boxPositionY + boxHeight), gray75, BF
    Line (boxPositionX + boxDepth, boxPositionY + boxDepth)-((boxPositionX + boxWidth) - boxDepth, (boxPositionY + boxHeight) - boxDepth), gray50, BF
    Line (boxPositionX + boxDepth + interiorDepthX, boxPositionY + boxDepth + interiorDepthY)-(boxPositionX + boxWidth - boxDepth - interiorDepthX, boxPositionY + boxHeight - boxDepth - interiorDepthY), gray75, BF
    Line (boxPositionX + (boxDepth * 2) + interiorDepthX, boxPositionY + (boxDepth * 2) + interiorDepthY)-(boxPositionX + boxWidth - boxDepth - interiorDepthX, boxPositionY + boxHeight - boxDepth - interiorDepthY), gray25, BF
    Line (boxPositionX + (boxDepth * 2) + interiorDepthX, boxPositionY + (boxDepth * 2) + interiorDepthY)-(boxPositionX + boxWidth - (boxDepth * 2) - interiorDepthX, boxPositionY + boxHeight - (boxDepth * 2) - interiorDepthY), gray50, BF
End Sub
Print this item

  Last QB64 win x-64 dev download?
Posted by: Richard - 04-19-2022, 12:55 PM - Forum: General Discussion - Replies (1)

What was the last dev package?

I have 6e385df originally downloaded March 11 (but was apparently the same as that downloaded on March 30).

Print this item

  GUI..sort...of.....
Posted by: Abacus - 04-19-2022, 09:23 AM - Forum: Works in Progress - Replies (2)

Found my old code that I wrote back in 1996 on QBASIC...figured I share it.

Code: (Select All)
'old code for a GUI that I was working on back in 1996
'By: Abacus

1 Cls
2
Screen 12
3 Rem This is the main box
4 Draw "C8 BM0,0 R639 D479 L639 U479"
5 Paint (2, 2), 8, 8
6 Draw "c0 bm4,46 r630 d398 l629 u398"
7 Draw "C0 BM4,45 R631 D400 L631 U400"
8 Paint (10, 60), 7, 0
9 Draw "C0 BM5,474 R59 U24"
10 Draw "C0 BM5,450 R60 D25 L60 U25"
11 Paint (8, 455), 8, 0
12 Draw "C1 BM4,4 R631 D20 L631 U20"
13 Paint (5, 5), 1, 1
14 Draw "C0 BM4,24 R631 U20"
15 Draw "C0 BM4,23 R630 U19"

16 Rem This draws the icon face
17 Draw "c7 bm9,6 r15 d14 l15 u14"
18 Paint (10, 8), 7, 7
19 Circle (16, 13), 6, 0
20 Paint (13, 17), 14, 0
21 Circle (16, 13), 5, 0
22 PSet (13, 13), 0
23 PSet (14, 13), 0
24 PSet (18, 13), 0
25 PSet (19, 13), 0
26 Draw "c0 bm14,16 r4"

27 Rem This draws the exit box
28 Draw "c7 bm613,6 r15 d14 l15 u14"
29 Paint (614, 7), 7, 7
30 Draw "c4 bm617,8 d10 r6 l6 u5 r6 l6 u5 r6"
31 Draw "c0 bm616,9 d10 r6"
32 Draw "c0 bm618,14 r4"
33 Draw "c0 bm618,9 r4"
34 Rem This is the word OPEN
35 Draw "c0 bm8,454 r10 d15 l10 u15" 'Out line of the leter O
36 Draw "c0 bm10,457 r6 d9 l6 u9" 'In line of the leter O
37 Paint (12, 456), 4, 0
38 Draw "c0 bm21,454 r9 d8 l6 d7 l3 u14 " 'Out line of the leter P
39 Draw "c0 bm24,456 r4 d4 l4 u4" 'In line of the leter P
40 Paint (23, 459), 4, 0
41 Draw "c0 bm34,454 r9  d3 l7 d3 r7 d3 l7 d3 r7 d3 l10 u15 r2"
42 'The full leter E
43 Paint (35, 456), 4, 0
44 Draw "c0 bm46,454 r5 ta30 d10 ta0 u10 r4 d16 l4 ta40 u10 ta0 d8 l4 u14 "
45 'leter N
46 Paint (47, 455), 4, 0
47 Draw "c0 bm45,471 r16 " 'underline
48 Rem End of the word OPEN

49 Rem This is the word GUI
50 Draw "c0 bm30,6 r12 d3 l3 u1 l6 d10 r10 u4 l7 u2 r10 d9 l18 u15 r2" 'Leter G
51 Paint (31, 8), 4, 0
52 Draw "c0 bm50,6 d4 r3 d11 r16 u11 r3 u4 l10 d4 r2 d7 l6 u7 r2 u4 l10"
53 'Leter U
54 Paint (51, 8), 4, 0
55 Draw "c0 bm77,6 d4 r5 d6 l5 d5 r14 u5 l5 u6 r5 u4 l13 " 'Leter I
56 Paint (79, 7), 4, 0

57 Rem The Leters GUI on the other side
58 Draw "c0 bm547,6 r12 d3 l3 u1 l6 d10 r10 u4 l7 u2 r10 d9 l18 u15 r2" 'Leter G
59 Paint (548, 8), 4, 0
60 Draw "c0 bm567,6 d4 r3 d11 r16 u11 r3 u4 l10 d4 r2 d7 l6 u7 r2 u4 l10"
61 'Leter U
62 Paint (568, 8), 4, 0
63 Draw "c0 bm594,6 d4 r5 d6 l5 d5 r14 u5 l5 u6 r5 u4 l13 " 'Leter I
64 Paint (595, 7), 4, 0


65 Rem This is the option, about, and help list.
66 'word option
67 Draw "c15 bm30,29 r7 d10 l7 u10"
68 Draw "c15 bm40,29 r7 d5 l7 u5 d10"
69 Draw "c15 bm50,29 r8 l4 d10 "
70 Draw "c15 bm60,29 r8 l4 d10 l4 r8"
71 Draw "c15 bm70,29 r7 d10 l7 u10"
72 Draw "c15 bm81,39 u10 ta30 d11 ta0 u10"
73 Draw "c15 bm29,42 r9" 'underline

74 'word about
75 'leter A
78 Draw "c15 bm290,29 ta-20 d11 ta-20 u11 ta0 r4 ta20 d11 ta20 u6 ta0 l7"
79 ' leter B
80 Draw "c15 bm301,29 r8 d4 l8 u4 d10 r8 u10 "
81 'leter O
82 Draw "c15 bm312,29 r7 d10 l7 u10"
83 'leter U
84 Draw "c15 bm322,29 d10 r7 u10"
85 'leter T
86 Draw "c15 bm332,29 r8 l4 d10"
87 Draw "c15 bm284,42 r16 " 'underline

88 'word help
89 Draw "c15 bm525,29 d10 u5 r7 u5 d10" 'leter H
90 Draw "c15 bm535,29 d10 r5 l5 u5 r5 l5 u5 r5" 'E
91 Draw "c15 bm543,29 d10 r5" 'leter L
92 Draw "c15 bm551,29 d10 u4 r7 u6 l7" 'leter P
93 Draw "c15 bm524,42 r9"


Do
    check$ = InKey$
Loop While check$ = ""
Select Case check$
    Case Chr$(79)
        GoTo 94
    Case Chr$(111)
        GoTo 94
    Case Chr$(101)
        GoTo 200
    Case Chr$(69)
        GoTo 200
    Case Chr$(65)
        GoTo 97
    Case Chr$(97)
        GoTo 97
    Case Chr$(104)
        GoTo 104
    Case Chr$(72)
        GoTo 104
    Case Chr$(110)
        GoTo 108
    Case Chr$(78)
        GoTo 108
    Case Else
        GoTo 2
End Select

94 Rem This is the option box
95 Draw "c0 bm26,27 r70 d20 l70 u20 d300 r200 u280 l200 r201 d281 l199"
96 Paint (27, 90), 8, 0

Do
    check$ = InKey$
Loop While check$ = ""
Select Case check$
    Case Chr$(27)
        GoTo hold
    Case Else
        GoTo 94
End Select

hold:
Rem This is the option box
Draw "c7 bm26,27 r70 d20 l70 u20 d300 r200 u280 l200 r201 d281 l199"
Paint (27, 90), 7, 7
Draw "c8 bm26,27 r70 d17 u17 l70 d17"
GoTo 2


97 Rem this is the about box
99 Draw "c0 bm279,27 r70 d20 l70 u20 d140 r210 u120 l210"
100 Draw "c0 bm490,47 d121 l209"
101 Paint (281, 128), 8, 0
Do
    check$ = InKey$
Loop While check$ = ""
Select Case check$
    Case Chr$(27)
        GoTo hold2
    Case Else
        GoTo 97
End Select

hold2:
Draw "c7 bm279,27 r70 d20 l70 u20 d140 r210 u120 l210"
Draw "c7 bm490,47 d121 l209"
Paint (281, 128), 7, 7
Draw "c8 bm279,27 r70 d17 u17 l70 d17"
GoTo 2

103 Rem this is the help box
104 Draw "c8 bm519,27 r50 d20 l50 u20 d20 l150 d110 r200 u130"
107 Paint (519, 156), 8, 8
105 Draw "c0 bm519,158 l150 u111 d111 r201 u112 l1 u19 l50 d19"
106 Draw "bm521,159 l150 r200 u112"

Do
    check$ = InKey$
Loop While check$ = ""
Select Case check$
    Case Chr$(27)
        GoTo hold3
    Case Else
        GoTo 104
End Select
hold3:
Draw "c7 bm519,27 r50 d20 l50 u20 d20 l150 d110 r200 u130"
Paint (519, 156), 7, 7
Draw "c7 bm519,158 l150 u111 d111 r201 u112 l1 u19 l50 d19"
Draw " c7 bm521,159 l150 r200 u112"
Draw "c8 bm519,27 r50 d17 u17 l50 d17"
GoTo 2

108 Rem This is the open box
109 Draw "c8 bm2,450 u100 r150 d100 l150"
110 Paint (9, 438), 8, 8
111 Draw "c0 bm2,450 u100 r150 d100 l150"
112 Draw "c0 bm1,449 u100 r152 d102 l149"
Do
    check$ = InKey$
Loop While check$ = ""
Select Case check$
    Case Chr$(27)
        GoTo hold4
    Case Else
        GoTo 108
End Select
hold4:
Draw "c7 bm2,450 u100 r150 d100 l150"
Paint (9, 438), 7, 7
Draw "c7 bm2,450 u100 r150 d100 l150"
Draw "c7 bm1,449 u100 r152 d102 l149"
Draw "c8 bm1,450 u101 r2 d97 r150 d5 l89 u2 l60 d2 l2"
Paint (100, 449), 8, 8
Draw "c8 bm5,451 r60"
GoTo 2
200 End
Print this item

  Old Modem Program
Posted by: Abacus - 04-19-2022, 08:59 AM - Forum: Programs - Replies (7)

Posting an old program from my 2006 backup disk of archived files. I hope someone will find it interesting. 

Code: (Select All)
Cls
Print "Simple Qbasic communications program."
Print "What COM port does your modem use?"
Input ">", port$
baud$ = "9600" '9600 should work fine with most modems. If you have
'an older one use 2400.
'Open up that com port.
Open "COM" + port$ + ":" + baud$ + ",N,8,1,RB2048,TB2048" For Random As #1

Print "OPTIONS:"
Print "1-Dial up to another computer"
Print "2-Wait for a call"
Print "3-Quit"
Do
    a = Val(InKey$)
Loop Until a >= 1 And a <= 3
If a = 3 Then Close: System
If a = 2 Then GoTo waitfor

Print "Number to call?"
Input ">", number$
Print #1, "ATDT" + number$ 'Tell the modem to dial the number.
GoTo chat

waitfor:
Print #1, "ATS0=1" 'Tell modem to connect after 1 ring.

'When a modem connects it returns "CONNECT ####"
'The next hunk of code waits until the modem connects before moving on

a$ = ""
Do
    If Loc(1) Then a$ = a$ + Input$(1, 1) 'if anything in modem add it to a$
Loop Until InStr(a$, "CONNECT") 'Wait until modem have connected.

chat:
'If you where waiting for a call, a lot of ASCII characters will be printed
'on the screen. Don't worry, that's just the computers getting in sync and
'talking. You also will not see what you type.

Cls
Print "You are now ready to chat, press ESC to quit."
Do
    t$ = InKey$
    If Len(t$) Then Print #1, t$ 'if you typed something send it to the modem
    'this will be send by the modem to the other
    'computer
    If Loc(1) Then r$ = Input$(1, 1) 'if the is something to get, get it and save
    'it as r$
    If Len(r$) Then Print r$; 'if r$ <> "" then print it. the ";" means a
    'line is not started
Loop Until t$ = Chr$(27) 'keep doing this until ESC is pressed
Print #1, "ATZ" 'tell the modem to hang up
Close 'close the open com statement
Print this item

  What Happened?
Posted by: Tim - 04-19-2022, 04:12 AM - Forum: General Discussion - Replies (53)

So, obviously something major has happened to qb64.org. And I just started to use qb64--and very happily. My question is, what did happen? I am completely out of the loop.

Print this item

  QB64 Independence Day by Not Really Martina McBride
Posted by: Pete - 04-19-2022, 02:48 AM - Forum: General Discussion - Replies (2)

I could have told ya this guy R C Cola
Would turn out to be a dangerous man
But when Fell found out, in a Discord rout
It was too late to come up with a plan

Now the forum's down, Youtube is not around
And the Odin's went their separate way
So Steve started up a revolution, it's Independence Day

Let Free Speech ring, let your posts be heard
Let everyone have a ton of fun and help spread the word
Good to be a part, of this brand new start
Throw dot org away, Phoenix is here to stay, It's Independence Day
Throw dot org away
It's Independence Day

-------------------------------

So no, despite the appearance o my avatar, I'm not really a big country music fan, but who couldn't love listening to Martina McBride?

https://www.youtube.com/watch?v=4VPpAZ9_qAw

You may want to fast forward the 30sec preamble.

Pete

Print this item

  qbs_str my mod
Posted by: Jack - 04-19-2022, 01:18 AM - Forum: General Discussion - Replies (9)

as seen here https://qb64phoenix.com/forum/showthread...114#pid114 I worked on changing the qbs_str function for double and float
I went ahead and incorporated the changes in libqb.cpp and built QB64, here's a sample

Code: (Select All)
$Console:Only
_Dest _Console

Print Factorial_Recursive(1000)

Function Factorial_Recursive## (n As Integer)
    If n = 0 Then Factorial_Recursive## = 1: Exit Function
    Factorial_Recursive## = n * Factorial_Recursive##(n - 1)
End Function
output
Quote:4.02387260077093773F+2567

Press any key to continue
even though I did some testing for bugs some may have slipped trough
looks like I found a bug, not ready for prime-time
it has a strange effect on print using
Code: (Select All)
$Console:Only
_Dest _Console
Dim As _Float f

f = Factorial_Recursive(50)
Print Using "##.##################"; f
Print f

Function Factorial_Recursive## (n As Integer)
    If n = 0 Then Factorial_Recursive## = 1: Exit Function
    Factorial_Recursive## = n * Factorial_Recursive##(n - 1)
End Function
Quote:%30414093201713378039796484017234741538658648106343392576177963008.000000000000000000
3.0414093201713378F+64

Press any key to continue
Print this item

  QBJS - QBasic for the Web
Posted by: dbox - 04-18-2022, 07:10 PM - Forum: Programs - Replies (2)

Hi all,

Just wanted to share (again) the QBJS project that I've been working on.

Here is the original post from the qb64.org forum: https://qb64forum.alephc.xyz/index.php?topic=4670.0

What is QBJS?
It is an answer to the question, "What would it be like if QBasic and Javascript had a child together?"

It is an effort to bring the fun and accessibility of the classic QBasic syntax to the modern web browser.  The project is, of course, heavily inspired by both QBasic and QB64.  The main QB-to-Javascript converter is written in QB64 and compiles itself to Javascript for use on the web.  There is a simple IDE with a stripped-down, classic QB look-and-feel.

   

I'll plan to post updates here as new releases are available and/or advances of note are made with the project.

Try it out here:
https://boxgm.itch.io/qbjs

Learn More:
If you are interested to learn more I'm trying to document as much as I can on the project wiki on github.  Here are a few pages of note:

  • QBasic Language Support
    This page describes the overall approach, what differences exist to QBasic/QB64 and features unique to QBJS
  • Supported Keywords
    Lists the set of keywords supported by the current stable release and the level of compatibility with QBasic/QB64
    Keyword links are currently broken which pointed back to the QB64 wiki
  • Roadmap
    The place to document what fixes and enhancements are being worked on for the in-progress release as well as some general planning for the future.
  • Samples
    A centralized place for QBJS code samples.
    Many of these were shared on the previous forum. This page was put together hastily, it should improve in format and organization with time.

As always I am very interested in any and all feedback!

Print this item

  C code sanity check
Posted by: Jack - 04-18-2022, 04:39 PM - Forum: Help Me! - Replies (1)

would you guys test the following code for logic errors?
the goal here is to replace the current double to string conversion that's faulty in QB64
I must have concluded at least a dozen times that all was ok only to discover a bug
[edit1]
restricted the maximum digits to 15, with 16 digits there are too many cases that suffer from floating-point inaccuracies, like trying to print 1d-21 would give 9.999999999999999d-22
[edit2]
added a test program, let me know what you think
[edit3]
added another test

Code: (Select All)
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <time.h>

#define QB64_MINGW

int str(double value){
    char buf[64];
    char buf2[64];
    int32_t i, j, lsd, exp;
    //double value=.000000000000000000001; //3.141592653589e3; //3.141592653589793e-10;
    #ifdef QB64_MINGW
        __mingw_sprintf((char*)&buf,"% .14Le",(long double) value);
    #else
        sprintf((char*)&buf,"% .14Le",(long double) value);
    #endif
    exp=atoi(&buf[18]);
    lsd=16;
    while((buf[lsd]=='0')&&(lsd>0)) lsd--;
    buf2[0]=buf[0]; // copy sign
    if(exp==0){
        for(i=1;i<=(lsd);i++){
            buf2[i]=buf[i];
        }
        if(buf2[lsd]=='.') // if no digits after . then nip it
            buf2[lsd]=0;   // by zero terminating
        else
            buf2[lsd+1]=0; // zero terminate
    }
    else if(exp<0){
        if((lsd-exp)>=19){ // use sci format
            for(i=1;i<=lsd;i++){
                buf2[i]=buf[i];
            }
            if(buf2[lsd]=='.'){
                buf2[lsd]='D';
                sprintf(&buf2[lsd+1],"%+03d", exp);
            }
            else{
                buf2[lsd+1]='D';
                sprintf(&buf2[lsd+2],"%+03d", exp);
            }
        }
        else{
            buf2[1]='.';
            for(i=2;i<=abs(exp);i++){
                buf2[i]='0';
            }
            buf2[abs(exp)+1]=buf[1]; // first non-zero digit
            j=3;                     // skip decimal point
            for(i=abs(exp)+2;i<(abs(exp)+lsd);i++){
                buf2[i]=buf[j];
                j++;
            }
            buf2[abs(exp)+lsd]=0; // zero terminate
        }
    }
    else if(exp>0){
        if((lsd<17)&&(exp<15)){
            buf2[1]=buf[1]; // first digit
            j=3;            // skip over .
            for(i=2;i<=(exp+1);i++){
                buf2[i]=buf[j];
                j++;
            }
            if((lsd>exp)&&(lsd>(j-1))){
                buf2[exp+2]='.';
                for(i=exp+3;i<=(lsd);i++){
                    buf2[i]=buf[j];
                    j++;
                }
                buf2[lsd+1]=0;
            }
            else{
                buf2[exp+2]=0;
            }
    }
    else{
        for(i=0;i<=lsd;i++){
            buf2[i]=buf[i];
        }
        if(buf2[lsd]=='.'){
            buf2[lsd]='D';
            sprintf(&buf2[lsd+1],"%+03d", exp);
        }
        else{
            buf2[lsd+1]='D';
            sprintf(&buf2[lsd+2],"%+03d", exp);
        }
    }
}
    printf("%s", buf2);
    return 0;
}

int main(void){
    time_t t;
    double x;
    char* ptr;
    char strx[50]="3141592653589793";
    char c;
    int i, j, k;
    srand((unsigned) time(&t));
    for(i=1;i<3;i++){
        for(j=1;j<15;j++){
            k=rand() %j;
            c=strx[k];
            strx[k]='.';
            x=strtod(strx,&ptr);
            str(x); printf("% .14e   %s\n",x,strx);
            strx[k]=c;
        }
    }
    printf("%s\n","====================================================");
    char stry[50]="3.141592653589793e";
    for(i=1;i<3;i++){
        for(j=1;j<15;j++){
            k=rand() %j;
            k=k * (13 - (-13)) + (-13);
            sprintf(&stry[18],"%d", k);
            x=strtod(stry,&ptr);
            str(x); printf("% .14e   %s\n",x,stry);
        }
    }
    printf("%s\n","====================================================");
    strx[0]='1';
    for(j=1;j<41;j++){
        for(i=1;i<=j;i++){
            strx[i]='0';
        }
        strx[i]=0;
        x=strtod(strx,&ptr);
        str(x); printf("% .14e   %s\n",x,strx);
    }
    printf("%s\n","====================================================");
    strx[0]='.';
    for(j=1;j<41;j++){
        for(i=1;i<=j;i++){
            strx[i]='0';
        }
        strx[i]='1';
        strx[i+1]=0;
        x=strtod(strx,&ptr);
        str(x); printf("% .14e   %s\n",x,strx);
    }
    return 0;
}
Print this item

  libtommath bignum for Win-64
Posted by: Jack - 04-18-2022, 02:31 PM - Forum: One Hit Wonders - Replies (1)

this is header translation for 64-bit QB64 on Windows x64 of LibTomMath https://www.libtom.net/
LibTomMath is in the public domain, no strings attached

LibTomMath.bi

Code: (Select All)
$If 64BIT Then
    Const MP_28BIT = 0
    Const MP_64BIT = 1
    '    Type _unsigned _integer64
    '        As _Unsigned _Integer64 mpdigit
    '    End Type
    Type private_mp_word
        As String * 128 mpword
    End Type
    Const MP_DIGIT_BIT = 60
$Else
        Type _unsigned _integer64
        mpdigit As _Unsigned Long
        End Type
        Type private_mp_word
        mpword As _Unsigned _Integer64
        End Type
        Const _unsigned _integer64_BIT = 28
        Const MP_28BIT = 1
        Const MP_64BIT = 0
$End If

Type mp_int
    used As Long
    alloc As Long
    sign As Long
    dp As _Offset
End Type

Declare Dynamic Library "libtommath"
    Function mp_init& (a As mp_int) ' as mp_err
    Function mp_init_size& (a As mp_int, Byval size As Long) ' as mp_err
    Function mp_init_i32& (a As mp_int, Byval b As Long) ' as mp_err
    Function mp_init_l& (a As mp_int, Byval b As Long) ' ' as mp_err
    Function mp_init_u32& (a As mp_int, Byval b As _Unsigned Long) ' as mp_err
    Function mp_init_ul& (a As mp_int, Byval b As _Unsigned Long) ' as mp_err
    Function mp_init_i64& (a As mp_int, Byval b As _Integer64) ' as mp_err
    Function mp_init_ll& (a As mp_int, Byval b As _Integer64) ' as mp_err
    Function mp_init_u64& (a As mp_int, Byval b As _Unsigned _Integer64) ' as mp_err
    Function mp_init_ull& (a As mp_int, Byval b As _Unsigned _Integer64) ' as mp_err
    Function mp_init_set& (a As mp_int, Byval b As _Unsigned _Integer64) ' as mp_err
    Function mp_init_set_int& (a As mp_int, Byval b As _Unsigned Long) ' as mp_err
    Function mp_init_copy (a As mp_int, b As mp_int) ' as mp_err
    Sub mp_clear (a As mp_int)
    Sub mp_exch (a As mp_int, b As mp_int)
    Function mp_shrink& (a As mp_int) ' as mp_err
    Function mp_grow& (a As mp_int, Byval size As Long) ' as mp_err
    Function mp_iseven& (a As mp_int) ' as long
    Function mp_isodd& (a As mp_int) ' as long
    Sub mp_zero (a As mp_int)
    Function mp_get_double# (a As mp_int) ' as double
    Function mp_set_double& (a As mp_int, Byval b As Double) ' as mp_err
    Function mp_get_i32& (a As mp_int) ' as long
    Function mp_get_l& (a As mp_int) ' as long
    Function mp_get_int~& (a As mp_int) ' as ulong
    Function mp_get_long~& (a As mp_int) ' as ulong
    Function mp_get_i64&& (a As mp_int) ' as longint
    Function mp_get_ll&& (a As mp_int) ' as longint
    Function mp_get_long_long~&& (a As mp_int) ' as ulongint
    Sub mp_set_i32 (a As mp_int, Byval b As Long)
    Sub mp_set_l (a As mp_int, Byval b As Long)
    Function mp_set_long& (a As mp_int, Byval b As _Unsigned Long) ' as mp_err
    Sub mp_set_u32 (a As mp_int, Byval b As _Unsigned Long)
    Sub mp_set_ul (a As mp_int, Byval b As _Unsigned Long)
    Function mp_set_int& (a As mp_int, Byval b As _Unsigned Long) ' as mp_err
    Sub mp_set_i64 (a As mp_int, Byval b As _Integer64)
    Function mp_set_long_long& (a As mp_int, Byval b As _Unsigned _Integer64) ' as mp_err
    Sub mp_set_ll (a As mp_int, Byval b As _Integer64)
    Sub mp_set_u64 (a As mp_int, Byval b As _Unsigned _Integer64)
    Sub mp_set_ull (a As mp_int, Byval b As _Unsigned _Integer64)
    Sub mp_set (a As mp_int, Byval b As _Unsigned _Integer64)
    Function mp_get_mag_u32~& (a As mp_int) ' as ulong
    Function mp_get_mag_ul~& (a As mp_int) ' as ulong
    Function mp_get_mag_u64~&& (a As mp_int) ' as ulongint
    Function mp_get_mag_ull~&& (a As mp_int) ' as ulongint
    Function mp_copy (a As mp_int, b As mp_int) ' as mp_err
    Sub mp_clamp (a As mp_int)
    Function mp_export& (rop As _Offset, countp As _Unsigned Long, Byval order As Long, Byval size As _Unsigned Long, Byval endian As Long, Byval nails As _Unsigned Long, op As mp_int) ' as mp_err
    Function mp_import& (rop As mp_int, Byval count As _Unsigned Long, Byval order As Long, Byval size As _Unsigned Long, Byval endian As Long, Byval nails As _Unsigned Long, Byval op As _Offset) ' as mp_err
    Function mp_unpack& (rop As mp_int, Byval count As _Unsigned Long, Byval order As Long, Byval size As _Unsigned Long, Byval endian As Long, Byval nails As _Unsigned Long, op As _Offset) ' as mp_err
    Function mp_pack_count~& (a As mp_int, Byval nails As _Unsigned Long, Byval size As _Unsigned Long) ' as uinteger
    Function mp_pack& (rop As _Offset, Byval maxcount As _Unsigned Long, written As _Unsigned Long, Byval order As Long, Byval size As _Unsigned Long, Byval endian As Long, Byval nails As _Unsigned Long, op As mp_int) ' as mp_err
    Sub mp_rshd (a As mp_int, Byval b As Long)
    Function mp_lshd& (a As mp_int, Byval b As Long) ' as mp_err
    Function mp_div_2d& (a As mp_int, Byval b As Long, c As mp_int, d As mp_int) ' as mp_err
    Function mp_div_2& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_div_3& (a As mp_int, c As mp_int, d As _Unsigned _Integer64) ' as mp_err
    Function mp_mul_2d& (a As mp_int, Byval b As Long, c As mp_int) ' as mp_err
    Function mp_mul_2& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_mod_2d& (a As mp_int, Byval b As Long, c As mp_int) ' as mp_err
    Function mp_2expt& (a As mp_int, Byval b As Long) ' as mp_err
    Function mp_cnt_lsb& (a As mp_int) ' as long
    Function mp_rand& (a As mp_int, Byval digits As Long) ' as mp_err
    Function mp_rand_digit& (r As _Unsigned _Integer64) ' as mp_err
    Function mp_get_bit& (a As mp_int, Byval b As Long) ' as long
    Function mp_tc_xor& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_xor& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_tc_or& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_or& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_tc_and& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_and& (a As mp_int, b As mp_int, c As mp_int) 'as mp_err
    Function mp_complement& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_tc_div_2d& (a As mp_int, Byval b As Long, c As mp_int) ' as mp_err
    Function mp_signed_rsh& (a As mp_int, Byval b As Long, c As mp_int) ' as mp_err
    Function mp_neg (a As mp_int, b As mp_int) ' as mp_err
    Function mp_abs& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_cmp& (a As mp_int, b As mp_int) 'as mp_ord
    Function mp_cmp_mag& (a As mp_int, b As mp_int) ' as mp_ord
    Function mp_add& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_sub& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_mul& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_sqr& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_div& (a As mp_int, b As mp_int, c As mp_int, d As mp_int) ' as mp_err
    Function mp_mod& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_incr& (a As mp_int) ' as mp_err
    Function mp_decr& (a As mp_int) ' as mp_err
    Function mp_cmp_d& (a As mp_int, Byval b As _Unsigned _Integer64) ' as mp_ord
    Function mp_add_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int) ' as mp_err
    Function mp_sub_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int) ' as mp_err
    Function mp_mul_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int) ' as mp_err
    Function mp_div_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int, d As _Unsigned _Integer64) ' as mp_err
    Function mp_mod_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As _Unsigned _Integer64) ' as mp_err
    Function mp_addmod& (a As mp_int, b As mp_int, c As mp_int, d As mp_int) ' as mp_err
    Function mp_submod& (a As mp_int, b As mp_int, c As mp_int, d As mp_int) ' as mp_err
    Function mp_mulmod& (a As mp_int, b As mp_int, c As mp_int, d As mp_int) ' as mp_err
    Function mp_sqrmod& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_invmod& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_gcd& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_exteuclid& (a As mp_int, b As mp_int, U1 As mp_int, U2 As mp_int, U3 As mp_int) ' as mp_err
    Function mp_lcm& (a As mp_int, b As mp_int, c As mp_int) ' as mp_err
    Function mp_root_u32& (a As mp_int, Byval b As _Unsigned Long, c As mp_int) ' as mp_err
    Function mp_n_root& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int) ' as mp_err
    Function mp_n_root_ex& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int, Byval fast As Long) ' as mp_err
    Function mp_sqrt& (arg As mp_int, ret As mp_int) ' as mp_err
    Function mp_sqrtmod_prime& (n As mp_int, prime As mp_int, ret As mp_int) ' as mp_err
    Function mp_is_square& (arg As mp_int, ret As Long) ' as mp_err
    Function mp_jacobi& (a As mp_int, n As mp_int, c As Long) ' as mp_err
    Function mp_kronecker& (a As mp_int, p As mp_int, c As Long) ' as mp_err
    Function mp_reduce_setup& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_reduce& (x As mp_int, m As mp_int, mu As mp_int) ' as mp_err
    Function mp_montgomery_setup& (n As mp_int, rho As _Unsigned _Integer64) ' as mp_err
    Function mp_montgomery_calc_normalization& (a As mp_int, b As mp_int) ' as mp_err
    Function mp_montgomery_reduce& (x As mp_int, n As mp_int, Byval rho As _Unsigned _Integer64) ' as mp_err
    Function mp_dr_is_modulus& (a As mp_int) ' as mp_bool
    Sub mp_dr_setup (a As mp_int, d As _Unsigned _Integer64)
    Function mp_dr_reduce& (x As mp_int, n As mp_int, Byval k As _Unsigned _Integer64) ' as mp_err
    Function mp_reduce_is_2k& (a As mp_int) ' as mp_bool
    Function mp_reduce_2k_setup& (a As mp_int, d As _Unsigned _Integer64) ' as mp_err
    Function mp_reduce_2k& (a As mp_int, n As mp_int, Byval d As _Unsigned _Integer64) ' as mp_err
    Function mp_reduce_is_2k_l& (a As mp_int) ' as mp_bool
    Function mp_reduce_2k_setup_l& (a As mp_int, d As mp_int) ' as mp_err
    Function mp_reduce_2k_l& (a As mp_int, n As mp_int, d As mp_int) ' as mp_err
    Function mp_exptmod& (G As mp_int, X As mp_int, P As mp_int, Y As mp_int) ' as mp_err
    Function mp_prime_is_divisible& (a As mp_int, result As Long) ' as mp_err
    Function mp_prime_fermat& (a As mp_int, b As mp_int, result As Long) ' as mp_err
    Function mp_prime_miller_rabin& (a As mp_int, b As mp_int, result As Long) ' as mp_err
    Function mp_prime_rabin_miller_trials& (ByVal size As Long) ' as long
    Function mp_prime_strong_lucas_selfridge& (a As mp_int, result As Long) ' as mp_err
    Function mp_prime_frobenius_underwood& (N As mp_int, result As Long) ' as mp_err
    Function mp_prime_is_prime& (a As mp_int, Byval t As Long, result As Long) ' as mp_err
    Function mp_prime_next_prime& (a As mp_int, Byval t As Long, Byval bbs_style As Long) ' as mp_err
    Function mp_prime_rand& (a As mp_int, Byval t As Long, Byval size As Long, Byval flags As Long) ' as mp_err
    Function mp_log_u32& (a As mp_int, Byval base As _Unsigned Long, c As _Unsigned Long) ' as mp_err
    Function mp_expt_u32& (a As mp_int, Byval b As _Unsigned Long, c As mp_int) ' as mp_err
    Function mp_expt_d& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int) ' as mp_err
    Function mp_expt_d_ex& (a As mp_int, Byval b As _Unsigned _Integer64, c As mp_int, Byval fast As Long) ' as mp_err
    Function mp_count_bits& (a As mp_int) ' as long
    Function mp_unsigned_bin_size& (a As mp_int) ' as long
    Function mp_read_unsigned_bin& (a As mp_int, Byval b As _Offset, Byval c As Long) ' as mp_err
    Function mp_to_unsigned_bin& (a As mp_int, Byval b As _Offset) ' as mp_err
    Function mp_to_unsigned_bin_n& (a As mp_int, Byval b As _Offset, outlen As _Unsigned Long) ' as mp_err
    Function mp_signed_bin_size& (a As mp_int) ' as long
    Function mp_read_signed_bin& (a As mp_int, Byval b As _Offset, Byval c As Long) ' as mp_err
    Function mp_to_signed_bin& (a As mp_int, Byval b As _Offset) ' as mp_err
    Function mp_to_signed_bin_n& (a As mp_int, Byval b As _Offset, outlen As _Unsigned Long) ' as mp_err
    Function mp_ubin_size~&& (a As mp_int) ' as uinteger
    Function mp_from_ubin& (a As mp_int, Byval buf As _Offset, Byval size As _Unsigned _Integer64) ' as mp_err
    Function mp_to_ubin& (a As mp_int, Byval buf As _Offset, Byval maxlen As _Unsigned _Integer64, written As _Unsigned _Integer64) ' as mp_err
    Function mp_sbin_size~&& (a As mp_int) ' as uinteger
    Function mp_from_sbin& (a As mp_int, Byval buf As _Offset, Byval size As _Unsigned _Integer64) ' as mp_err
    Function mp_to_sbin& (a As mp_int, Byval buf As _Offset, Byval maxlen As _Unsigned _Integer64, written As _Unsigned _Integer64) ' as mp_err
    Function mp_to_radix& (a As mp_int, str As String, Byval maxlen As _Unsigned _Integer64, written As _Unsigned _Integer64, Byval radix As Long) ' as mp_err
    Function mp_radix_size& (a As mp_int, Byval radix As Long, size As Long) ' as mp_err
    Function mp_read_radix& (a As mp_int, str As String, Byval radix As Long) ' as mp_err
    Function mp_toradix (a As mp_int, str As String, Byval radix As Long) ' as mp_err
    Function mp_toradix_n& (a As mp_int, str As String, Byval radix As Long, Byval maxlen As Long) ' as mp_err
End Declare

LibTomMath.bm
Code: (Select All)
Function mp_str$ (n As mp_int, radix As Long)
    Dim sresult As String
    Dim As Long status, size
    status = mp_radix_size&(n, radix, size)
    sresult = Space$(size) + Chr$(0)
    status = mp_toradix_n(n, sresult, radix, size)
    If status = 0 Then
        mp_str$ = _Trim$(sresult)
    Else
        mp_str$ = "error in mp_toradix"
    End If
End Function

Sub mp_val (s As String, n As mp_int, radix As Long)
    Dim value As String
    Dim status As Long
    Dim As Long ok
    value = s + Chr$(0)
    status = mp_read_radix(n, value, radix)
    If status <> 0 Then Print "could not read number"
End Sub

testTomMath.bas
Code: (Select All)
'$include: 'LibTomMath.bi'

Dim As mp_int n, m, r
Dim As Long ok
If mp_init(n) <> 0 Then Print "failed to initialize"
If mp_init(m) <> 0 Then Print "failed to initialize"
If mp_init(r) <> 0 Then Print "failed to initialize"
mp_val "2" + String$(100, "0"), n, 10
ok = mp_n_root&(n, 2, r)
Print mp_str(r, 10)
ok = mp_sqrt&(n, m)
Print mp_str(m, 10)


mp_clear r
mp_clear m
mp_clear n

'$include: 'LibTomMath.bm'

get the 64-bit dll
.zip   libtommath.zip (Size: 59.37 KB / Downloads: 168)

Print this item