Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
drawing to clipboard
#1
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$
Reply




Users browsing this thread: 1 Guest(s)