08-04-2022, 12:40 PM
(This post was last modified: 08-04-2022, 02:49 PM by James D Jarvis.)
This very minimal drawing program alllows a user to draw an image with a mouse and write a string to the clipboard to be used with the draw command in another program.
The image is drawn using relative coordinates so it may be positioned anywhere on the screen when used later.
EDIT: check the latest version in the thread for the corrections (of course)
The image is drawn using relative coordinates so it may be positioned anywhere on the screen when used later.
EDIT: check the latest version in the thread for the corrections (of course)
Code: (Select All)
'Mininmal relative Pen draw
'
'this simple program that allows the user to draw an image using a mouse and write the a string that can be used by the draw command
'in another program to the clipboard to be copy and pasted as the user needs.
'
' each coordinate position in the image is recorded as a relative coordinate, this allows the image to be drawn in a later program with
' a different origin on the display screen
'
'this uses color 15 as the line color and color 12 as the fill color.
' it is possible to cycle through the stroke color by pressing the c key and the fill color by pressing the b key
' there is some odd behavior if the fills I have not completely figure out at this point so...uh, good luck
'
' I whipped this up because I was getting darned sick and tired of plotting out draw images coordinates ahead of time
' this version makes it easier to use the draw command to make a "sprite" of sorts.
'
_Title "pen_draw RELATIVE <esc> to quit"
imgx = 640 'just change these two if you want to draw larger pictures or smaller pictures (without using all the screen space)
imgy = 480
Screen _NewImage(imgx + 200, imgy + 120, 256)
'leaving room for buttons and visual aids outside draw area for future program development
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)
' this relatively simple program uses a whole lot of RAM becasue of those two arrays, any modern system will not even notice
p = 0
ox = 0
oy = 0
nx = 0
ny = 0
DD$ = ""
fklr = 12
sklr = 15
Draw "c" + Str$(sklr)
Do
_Limit 60
Do While _MouseInput
'check for the mouse pointer in the image drawing area, if it is start drawing
If _MouseButton(1) Then
If _MouseX <= imgx And _MouseY <= imgy Then
p = p + 1
nx = _MouseX
ny = _MouseY
'deterimine the difference from this coordinate and the last one and save the resultign relative positions as a string
dx = nx - ox
dy = ny - oy
If dx < 0 Then
ddx$ = _Trim$(Str$(dx))
Else
ddx$ = "+" + _Trim$(Str$(dx)) 'have to add a + so the realtive posion is properly drawn with the draw command
End If
If dy < 0 Then
ddy$ = _Trim$(Str$(dy))
Else
ddy$ = "+" + _Trim$(Str$(dy)) 'have to add a + so the realtive posion is properly drawn with the draw command
End If
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" + ddx$ + "," + ddy$
Draw "c" + Str$(sklr)
Draw dc$(p)
ox = nx
oy = ny
Else 'elsewise the pen is down and a visible line will be plotted
PSet (ox, oy)
dc$(p) = "m" + ddx$ + "," + ddy$
Draw "c" + Str$(sklr)
Draw dc$(p)
ox = nx
oy = ny
End If
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 ...it's a little rough
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 once or twice before and after using this command...
'unless you want to keep drawing lines through the filled area
p = p + 1
fx = _MouseX
fy = _MouseY
dx = fx - nx
dy = fy - ny
If dx < 0 Then
ddx$ = _Trim$(Str$(dx))
Else
ddx$ = "+" + _Trim$(Str$(dx))
End If
If dy < 0 Then
ddy$ = _Trim$(Str$(dy))
Else
ddy$ = "+" + _Trim$(Str$(dy))
End If
dc$(p) = "bm" + ddx$ + "," + ddy$ + " P" + Str$(fklr) + "," + Str$(sklr) + " c" + Str$(sklr)
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
Cls
PSet (0, 0)
Draw "c" + Str$(sklr)
For d = 1 To p
DD$ = DD$ + dc$(d)
Next d
Draw DD$
DD$ = ""
ask$ = " "
Case "w" 'write to clipboard also clean up duplicate entries
'even with the one pass cleanup to clear out redundant points the string for all but the simplest images can still be very large
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
Case "b" 'cycle fill color b is for background?
fklr = fklr + 1
If fklr > 255 Then fklr = 0
Line (imgx + 30, 20)-(imgx + 36, 40), fklr, BF
ask$ = " "
Case "c" 'cycle stroke color
'results of changing the stroke color is still pretty iffy and odd but here's the code for now
sklr = sklr + 1
If sklr > 255 Then sklr = 0
Line (imgx + 20, 20)-(imgx + 26, 40), sklr, B
Draw "c" + Str$(sklr)
dc$(p) = dc$(p) + "c" + Str$(sklr)
ask$ = " "
End Select
Loop Until ask$ = Chr$(27)
Cls
For d = 1 To p
DD$ = DD$ + dc$(d)
Next d
Input "Enter anyhting to quit", AA$
'an example on how to use the draw command to make a "sprite" for use elsewhere in a program
For x = 0 To 300 Step 10
_Limit 30
Cls
Line (100, 100)-(200, 200), 13, BF 'fancy background you didn't draw before
dt$ = "c15 bm" + Str$(x) + ",100" 'just using the draw command itself to move the image along
Draw dt$
Draw DD$
_Display
Next
_Delay 2