ClipScribble

[James D Jarvis]

A paint program with control panels in sperate windows. This uses the clipboard method to communicate between the different programs.

This piece of code is the color picker. The control has a simple slide bar for the red, green, and blue channels.
This will need to be saved and compiled as colorpickmix to be called by the clipscribble main program. 

compile the main program and the control panels. Keep all the exe files in the same folder and it's a multi-window program in QB64.  If you close a control panel by accident just manually open it again, it'll work fine.

colorpickmix

Code: (Select All)

Screen _NewImage(240, 160, 32)
_ScreenMove 600, 50
_Title "colorpickmix"
'a color mixer that sends it's out put to the clipboard
rr = 127
gg = 127
bb = 127
rx = rr / 2 + 50
gx = gg / 2 + 50
bx = bb / 2 + 50
_PrintMode _KeepBackground
Line (10, 10)-(229, 40), _RGB32(rr, gg, bb), BF
_PrintString (1, 60), "[<]": _PrintString (215, 60), "[>]"
_PrintString (1, 90), "[<]": _PrintString (215, 90), "[>]"
_PrintString (1, 120), "[<]": _PrintString (215, 120), "[>]"
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            If y >= 59 And y <= 77 Then
                If x <= rx + 8 Then rr = rr - 1 Else rr = rr + 1
                If rr < 1 Then rr = 0
                If rr > 255 Then rr = 255
            End If
            If y >= 89 And y <= 107 Then
                If x <= gx + 8 Then gg = gg - 1 Else gg = gg + 1
                If gg < 1 Then gg = 0
                If gg > 255 Then gg = 255

            End If
            If y >= 119 And y <= 137 Then
                If x <= bx + 8 Then bb = bb - 1 Else bb = bb + 1
                If bb < 1 Then bb = 0
                If bb > 255 Then bb = 255
            End If
            rt$ = packnum$(rr)
            gt$ = packnum$(gg)
            bt$ = packnum$(bb)
            pp$ = "CMX" + rt$ + gt$ + bt$
            _Clipboard$ = pp$
        End If
    Loop
    rx = rr / 2 + 50
    gx = gg / 2 + 50
    bx = bb / 2 + 50
    Line (50, 60)-(202, 76), _RGB32(rr, 0, 0), BF
    _PrintString (rx, 60), _Trim$(Str$(rr))
    Line (50, 90)-(202, 106), _RGB32(0, gg, 0), BF
    _PrintString (gx, 90), _Trim$(Str$(gg))
    Line (50, 120)-(202, 136), _RGB32(0, 0, bb), BF
    _PrintString (bx, 120), _Trim$(Str$(bb))
    Line (10, 10)-(229, 40), _RGB32(rr, gg, bb), BF

    kk$ = InKey$
    inx$ = _Clipboard$
    If inx$ = "QUITCOLORMIX" 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

[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

[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