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

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
Reply
#2
OOOPS. Right after posting this I discover all but the most simple images unravels due to how I tracked the relative positions of coordinates.
Reply
#3
Fixed one of the bugs. The relative coordinates when moving from shape to shape seem to be more reliable now.
(that's what I get for overloading the use of variables)

Code: (Select All)
'Minimal relative Pen draw
'
'this simple program that 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 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 cokpletely figure out at this point so...uh, goo 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 - lx
                dy = ny - ly
                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
                    lx = nx
                    ly = 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
                    lx = nx
                    ly = 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 dommand itself to move the image along
    Draw dt$
    Draw DD$
    _Display
Next
_Delay 2
Reply




Users browsing this thread: 1 Guest(s)