QBJS Paint

[boxgaming]

Here's a simple paint program that demonstrates the ability to use rich HTML controls and events with your QBJS program. It supports several different drawing tools, a color picker and supports a single level of undo.

View in QBJS

Dim Shared tool, cp, btnUndo
InitControls

Dim fimage, cimage
fimage = _NewImage(640, 400)
cimage = _NewImage(640, 400)

Dim Shared drawing, lastX, lastY, startX, startY, radius

Sub OnMouseMove
    If _MouseButton(1) Then
        If Not drawing Then
            _PutImage , cimage, fimage
            _FreeImage cimage
            cimage = _NewImage(640, 400)
            lastX = _MouseX
            lastY = _MouseY
            startX = lastX
            startY = lastY
            drawing = -1
            btnUndo.disabled = false
        Else
            If tool.value = "Freehand" Then
                _Dest cimage
                Line (lastX, lastY)-(_MouseX, _MouseY), SelectedColor
                lastX = _MouseX
                lastY = _MouseY
                _Dest 0
                
            ElseIf tool.value = "Line" Then
                _FreeImage cimage
                cimage = _NewImage(640, 400)
                _Dest cimage
                Line (startX, startY)-(_MouseX, _MouseY), SelectedColor
                _Dest 0

            ElseIf tool.value = "Rectangle" Then
                _FreeImage cimage
                cimage = _NewImage(640, 400)
                _Dest cimage
                Line (startX, startY)-(_MouseX, _MouseY), SelectedColor, B
                _Dest 0

            ElseIf tool.value = "Filled Rectangle" Then
                _FreeImage cimage
                cimage = _NewImage(640, 400)
                _Dest cimage
                Line (startX, startY)-(_MouseX, _MouseY), SelectedColor, BF
                _Dest 0

            ElseIf tool.value = "Circle" Then
                _FreeImage cimage
                cimage = _NewImage(640, 400)
                If Abs(_MouseX - startX) > Abs(_MouseY - startY) Then
                    radius = Abs(_MouseX - startX)
                Else
                    radius = Abs(_MouseY - startY)
                End If
                _Dest cimage
                Circle (startX, startY), radius, SelectedColor
                _Dest 0

            ElseIf tool.value = "Filled Circle" Then
                _FreeImage cimage
                cimage = _NewImage(640, 400)
                If Abs(_MouseX - startX) > Abs(_MouseY - startY) Then
                    radius = Abs(_MouseX - startX)
                Else
                    radius = Abs(_MouseY - startY)
                End If
                _Dest cimage
                Dim r
                For r = 0 To radius Step .3
                    Circle (startX, startY), r, SelectedColor
                Next r
                _Dest 0
            End If
        End If
    Else 
        drawing = 0
    End If
    Cls
    _PutImage , fimage
    _PutImage , cimage
End Sub    

Sub OnBtnUndo
    _FreeImage cimage
    cimage = _NewImage(640, 400)
    btnUndo.disabled = true
    OnMouseMove
End Sub

Sub InitControls
    DomGetImage(0).style.cursor = "crosshair"
    DomEvent DomGetImage(0), "mousemove", sub_OnMouseMove
    
    Dim panel
    panel = DomCreate("div")
    DomCreate "span", panel, "Tool: "
    tool = DomCreate("select", panel)
    DomCreate "span", panel, "Color: "
    cp = DomCreate("input", panel)
    cp.type = "color"
    cp.value = "#ffffff"
    
    btnUndo = DomCreate("button", panel, "Undo")
    btnUndo.style.float = "right"
    btnUndo.style.padding = "5px 10px"
    btnUndo.disabled = true
    DomEvent btnUndo, "click", sub_OnBtnUndo

    panel.style.textAlign = "left"
    panel.style.width = "640px"
    panel.style.margin = "0 auto"
    panel.style.padding = "5px"
    panel.style.fontFamily = "Arial, helvetica, sans-serif"
    panel.style.fontSize = ".85em"
    panel.style.border = "1px solid #666"
    panel.style.backgroundColor = "#333"
    panel.style.verticalAlign = "middle"

    InitToolList
End Sub
    
Sub InitToolList
    tool.style.marginRight = "15px"
    tool.style.padding = "5px"
    tool.style.verticalAlign = "top"
    DomCreate "option", tool, "Freehand"
    DomCreate "option", tool, "Line"
    DomCreate "option", tool, "Rectangle"
    DomCreate "option", tool, "Filled Rectangle"
    DomCreate "option", tool, "Circle"
    DomCreate "option", tool, "Filled Circle"
End Sub
    
Function SelectedColor    
    Dim r, g, b, c
    c = cp.value

    $If Javascript
        r = parseInt(c.substr(1,2), 16)
        g = parseInt(c.substr(3,2), 16)
        b = parseInt(c.substr(5,2), 16)
    $End If
        
    SelectedColor = _RGB(r, g, b)
End Function

[aurelVZ]

Very well dBox...i simply forget that github have discussion board

Aurel - basic4All

[boxgaming]

This example is a bit obsolete at this point. The Dom methods have now been moved into their own module. An up-to-date version can be found on the Samples page.