+- 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: drawing to clipboard (/showthread.php?tid=726)
drawing to clipboard - James D Jarvis - 08-04-2022
a very minimal program designed to draw an image and directly encode it for use with the DRAW command.
Write what you draw with mouse to the clipboard to copy and past in another program or data file.
Code: (Select All)
'Mininmal absolute Pen draw
'
'this simple program allows the user to draw an image using a mouse and write a string that can be used by the draw command
'in another program.
'
'this uses color 15 as the line color and color 12 as the fill color.
'
' I whipped this up because I was getting darned sick and tired of plotting out draw images coordinates ahead of time
_Title "pen_draw ABSOLUTE <esc> to quit" '
maxx = 640 'just change these two if you want to draw larger pictures
maxy = 480
Screen _NewImage(maxx, maxy, 256)
'$DYNAMIC
Dim dc$(60000) 'this is a big string array, I haven't drawn anything that fills this yet but i suppose it is indeed very possible
Dim DW$(60000)
p = 0
ox = 0
oy = 0
nx = 0
ny = 0
DD$ = ""
Draw "c15"
Do
_Limit 60
Do While _MouseInput
If _MouseButton(1) Then
p = p + 1
Locate 1, 1: Print p
nx = _MouseX
ny = _MouseY
If ox = 0 And oy = 0 Then 'if the pen is up the line will be plotted by blind move but not drawn
dc$(p) = "bm" + Str$(nx) + "," + Str$(ny)
Draw dc$(p)
ox = nx
oy = ny
Else 'elsewise the pen is down and a visible line will be plotted f
PSet (ox, oy)
dc$(p) = "m" + Str$(nx) + "," + Str$(ny)
Draw dc$(p)
ox = nx
oy = ny
End If
End If
Loop
ask$ = InKey$
Select Case ask$
Case " " 'pen up and pen down
'this clears old X and old Y so the user can create non-contiguos points
If ox = 0 And oy = 0 Then
ox = nx
oy = ny
Else
ox = 0
oy = 0
End If
Case "f" 'fill, it works best if you press the space bar before and after using this command
p = p + 1
fx = _MouseX
fy = _MouseY
dc$(p) = "bm" + Str$(fx) + "," + Str$(fy) + " P12,15 c15"
ox = 0
oy = 0
Draw dc$(p)
ask$ = " "
Case "u" 'undo, it mostly sorta works...
' do not hold the u key down too long or a whole lot of work is getting undone
' if the image yuo are drawing has a lot of redundant points that haven't been cleaned up yet it will take a while
' to notice the results of this command as it steps back through the draw commands
p = p - 1 'step back one point
Cls
PSet (0, 0)
Draw "c15"
For D = 1 To p 'redraw the image after stepping back
DD$ = DD$ + dc$(D)
Next D
Draw DD$
DD$ = ""
ask$ = " "
Case "w" 'write to clipboard also clean up duplicate entries
'this writes a single string holding the draw command for the image to the clipbaord
'it does a simple pass to eliminate consecutive redundant points that can be generated while drawing with the mouse
DD$ = ""
DW$(1) = dc$(1)
w = 1
For D = 2 To p
If dc$(D) <> DW$(w) Then
w = w + 1
DW$(w) = dc$(D)
End If
Next D
For D = 1 To w
DD$ = DD$ + DW$(D)
dc$(D) = DW$(D)
Next D
p = w
ox = 0
oy = 0
_Clipboard$ = DD$ 'this slaps the string on the clipboard
End Select
Loop Until ask$ = Chr$(27)
Cls
For D = 1 To p
DD$ = DD$ + dc$(D)
Next D
Draw DD$
Input "Enter anything to quit ", aa$