+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://staging.qb64phoenix.com/forumdisplay.php?fid=9)
+---- Thread: ClipScribble (/showthread.php?tid=1011)
ClipScribble - James D Jarvis - 10-28-2022
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 FunctionRE: ClipScribble - James D Jarvis - 10-28-2022
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 SubRE: ClipScribble - James D Jarvis - 10-28-2022
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