ClipScribble

[James D Jarvis]

this part is the brush size control panel.

compile as clipbrush so it can be opened by the main program

clipbrush

Code: (Select All)

Screen _NewImage(240, 160, 32)
_ScreenMove 600, 300
_Title "Brush"
'sets the size of a brush for a simple drawing program
rr = 200
gg = 200
bb = 200
bsize = 2
bx = bsize * 3 + 50
_PrintMode _KeepBackground
fcirc 120, 50, bsize, _RGB32(rr, gg, bb)
_PrintString (1, 120), "[<]": _PrintString (215, 120), "[>]"
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            Cls
            If y >= 119 And y <= 137 Then
                If x <= bx + 8 Then bsize = bsize - 0.5 Else bsize = bsize + 0.5
                If bsize < 0.5 Then bsize = 0.5
                If bsize > 50 Then bsize = 50
            End If
            fcirc 120, 50, bsize, _RGB32(rr, gg, bb)
            bt$ = packnum$(bsize)
            pp$ = "CBS" + bt$
            _Clipboard$ = pp$
        End If
    Loop
    bx = bsize * 3 + 50

    Line (50, 119)-(200, 137), _RGB32(1, 1, 1), BF
    _PrintString (bx, 120), _Trim$(Str$(bsize))
    _PrintString (1, 120), "[<]": _PrintString (215, 120), "[>]"
    kk$ = InKey$
    inx$ = _Clipboard$
    If inx$ = "QUITCLIPBRUSH" Then kk$ = Chr$(27)
Loop Until kk$ = Chr$(27)
_Clipboard$ = "colorpickmix quit"
System



Function packnum$ (num)
    pad$ = "000"
    nn$ = _Trim$(Str$(num))
    Select Case Len(nn$)
        Case 1
            Mid$(pad$, 3, 1) = nn$
        Case 2
            Mid$(pad$, 2, 2) = nn$
        Case 3
            pad$ = nn$
    End Select
    packnum$ = pad$
End Function
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, 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