ClipScribble

[James D Jarvis]

the main program. Call it what you like. I'm calling it clipscribble32

Code: (Select All)

'clipscribble is  a paint program that uses a multipel programs to create multiple window program in qb64
'clipboard communcation sample
'an ascii doodle pad that opens a control panel app in another window
'
Screen _NewImage(600, 480, 32)
_Title "ClipScribble32"
Cls
_Clipboard$ = "ClipScribble32" ' "clears" clipboard for use
Shell _DontWait "colorpickmix.exe" ' Open the color picker control panel
Shell _DontWait "clipbrush.exe" ' Open the bruhs size control panel

_ControlChr Off
rr = 127: gg = 127: bb = 127: bsize = 2
Do
    _Limit 100
    If kk$ = "f" Then
        Paint (x, y), _RGB32(rr, gg, bb)
        kk$ = ""
    End If
    Do While _MouseInput 'mouse status changes only
        _Limit 2000
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            fcirc x, y, bsize, _RGB32(rr, gg, bb)
        End If
    Loop
    kk$ = InKey$
    ik$ = _Clipboard$
    If Left$(ik$, 3) = "CMX" Then
        rt$ = Mid$(ik$, 4, 3): rr = Val(rt$)
        gt$ = Mid$(ik$, 7, 3): gg = Val(gt$)
        bt$ = Mid$(ik$, 10, 3): bb = Val(bt$)
    End If
    If Left$(ik$, 3) = "CBS" Then
        bt$ = Mid$(ik$, 4, 3): bsize = Val(bt$)
    End If
Loop Until kk$ = Chr$(27)
_Clipboard$ = "QUITCOLORMIX"
Sleep 1
_Clipboard$ = "QUITCLIPBRUSH"
System

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