forum.vdsworld.com Forum Index forum.vdsworld.com
Visit VDSWORLD.com
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 


Draw lines...

 
Post new topic   Reply to topic    forum.vdsworld.com Forum Index -> Visual DialogScript 3 Source Code
View previous topic :: View next topic  
Author Message
Skit3000
Admin Team


Joined: 11 May 2002
Posts: 2166
Location: The Netherlands

PostPosted: Fri Oct 18, 2002 4:11 pm    Post subject: Draw lines... Reply with quote

Hi all,

A time ago, I saw the example Mac posted of how to draw squares. I started thinking of how to make a line that not only has a X, but also has an Y. So I made this example that can draw lines from topleft to bottomright and viceversa. I'm not done with it, but I thought that it can be useful already, cause it isn't to hard to see how it works. That will be if it is completely finished...

Code:

  DIALOG CREATE,New Dialog,-1,0,240,160
  DIALOG ADD,STYLE,BLACKSTYLE,,6,,BLACK,FOREGROUND
  DIALOG SHOW
rem          name |x1|y1|x2|y2
%%Makeline = line1|10|10|10|100
gosub Makeline

:Evloop
wait event
goto @event()

:Close
exit
 
:Makeline
parse "%%name;%%top1;%%left1;%%top2;%%left2",%%makeline
rem Makes sure the line can be draw from right to left and viceversa.
rem Example : %%makeline = line1|100|100|10|10
if @greater(%%top1,%%top2)@greater(%%left1,%%left2)
  %z = %%top1
  %%top1 = %%top2
  %%top2 = %z
  %z = %%left1
  %%left1 = %%left2
  %%left2 = %z
  end

%%width = @div(%%left2,%%top2)
%%height = 0
%q = @div(@diff(%%left2,%%left1),%%width)
%z = 0

repeat
dialog add,text,%%name"LINE"%z,@fadd(%%top1,%%height),%%left1,%%width,1,,,BLACKSTYLE
%%left1 = @fadd(%%left1,%%width)
%%height = @succ(%%height)
%z = @succ(%z)
until @equal(%z,@succ(%q))
exit
Back to top
View user's profile Send private message
Mac
Professional Member
Professional Member


Joined: 08 Jul 2000
Posts: 1585
Location: Oklahoma USA

PostPosted: Fri Oct 18, 2002 9:34 pm    Post subject: Reply with quote

Here's routines to draw lines, circles, ellipses and
rectangles
in pure VDS.

I converted the Bresenham line and circle routines to
VDS a while back, but it's kinda slow to be practical
(that's why I wrote DRAW.DLL, and later DRAW3.DLL).

Stretching text elements for horizontal and/or vertical
lines is faster than these routines. Also, the more stuff
you add, the slower these get. It's faster to draw one
item, then clear it before drawing another.
Code:

OPTION SCALE, 96
OPTION DECIMALSEP, "."
TITLE By Mac
DIALOG CREATE,"Bresenham Line/Circle Routines",-1,0,300,200
  DIALOG ADD,STYLE,BGStyle,,,,WHITE
  DIALOG ADD,STYLE,DotStyle,,,,BLACK
  DIALOG ADD,TEXT,BkGrnd,0,0,300,200,,,BGStyle
  DIALOG ADD,BUTTON,Line,5,5,50,22
  DIALOG ADD,BUTTON,Circle,5,60,50,22
  DIALOG ADD,BUTTON,Ellipse,5,115,50,22
  DIALOG ADD,BUTTON,Rectangle,5,170,70,22
  DIALOG ADD,BUTTON,Clear,5,245,50,22
DIALOG SHOW

rem -- To store line and circle element names so we can erase them --
LIST CREATE, 1

rem -- Var to set line thickness --
%%linesize = 2

rem -- For element names --
%n = 0

:EVLOOP
  WAIT EVENT
  goto @event()

:LineBUTTON
  rem -- Draw a line from any X1 Y1 to any X2 Y2 --
  %%x1 = 5
  %%y1 = 50
  %%x2 = 295
  %%y2 = 150
  GOSUB Drawline
  goto EVLOOP

:CircleBUTTON
  rem -- %x and %y is center, %r is radius, %%ve and %%he affect ellipse --
  %%ve = 2
  %%he = 2
  %x = 150
  %y = 100
  %r = 40
  GOSUB DrawCircle
  goto EVLOOP

:EllipseBUTTON
  rem -- %x and %y is center, %r is radius, %%ve and %%he affect ellipse --
  %%ve = 6
  %%he = 2
  %x = 150
  %y = 100
  %r = 50
  GOSUB DrawCircle
  goto EVLOOP

:RectangleBUTTON
  rem -- %%x1 and %%y1 = upper left - %%x2 and %%y2 = lower right --
  %%x1 = 50
  %%y1 = 40
  %%x2 = 250
  %%y2 = 160
  GOSUB DrawRect
  goto EVLOOP

:ClearBUTTON
  GOSUB ClearAll
  goto EVLOOP

:CLOSE
  EXIT

rem ------------ SUB -------------

:DrawRect
  %%tmp1 = %%x1
  %%tmp2 = %%y1
  %%tmp3 = %%x2
  %%tmp4 = %%y2
  %%y2 = %%y1
  GOSUB DrawLine
  %%x1 = %%tmp3
  %%y1 = %%tmp2
  %%x2 = %%tmp3
  %%y2 = %%tmp4
  GOSUB DrawLine
  %%x1 = %%tmp1
  %%y1 = %%tmp2
  %%x2 = %%tmp1
  %%y2 = %%tmp4
  GOSUB DrawLine
  %%x1 = %%tmp1
  %%y1 = %%tmp4
  %%x2 = %%tmp3
  %%y2 = %%tmp4
  GOSUB DrawLine
  exit

:DrawLine
  rem -- Draw line from x1,y1 to x2,y2 --
  if @greater(%%x2, %%x1)
     %%dx = @diff(%%x2, %%x1)
     %%sx = 1
  else
     %%dx = @diff(%%x1, %%x2)
     %%sx = -1
  end
  if @greater(%%y2, %%y1)
     %%dy = @diff(%%y2, %%y1)
     %%sy = 1
  else
     %%dy = @diff(%%y1, %%y2)
     %%sy = -1
  end
  %%steep = ""
  if @greater(%%dy, %%dx)
     %%steep = 1
     rem -- swap x1 y1, dx dy, sx sy --
     %z = %%x1
     %%x1 = %%y1
     %%y1 = %z
     %z = %%dx
     %%dx = %%dy
     %%dy = %z
     %z = %%sx
     %%sx = %%sy
     %%sy = %z
  end
  %e = @diff(@prod(2, %%dy), %%dx)
  %i = 0
  REPEAT
    if %%steep
       %%xd = %%y1
       %%yd = %%x1
    else
       %%xd = %%x1
       %%yd = %%y1
    end
    GOSUB Dot
    if @greater(%e, -1)
       REPEAT
         %%y1 = @sum(%%y1, %%sy)
         %e = @diff(%e, @prod(2, %%dx))
       UNTIL @greater(0, %e)
    end
    %%x1 = @sum(%%x1, %%sx)
    %e = @sum(%e, @prod(2, %%dy))
    %i = @succ(%i)
  UNTIL @equal(%i, %%dx)
  %%xd = %%x2
  %%yd = %%y2
  GOSUB Dot
  exit

:DrawCircle
  rem -- Draw circle at x, y with approx radius of r --
  %%xc = %x
  %%yc = %y
  %x = 0
  %y = %r
  %d = @prod(2, @diff(1, %r))
  REPEAT
    %%xd = @sum(%%xc, %x)
    %%yd = @sum(%%yc, %y)
    GOSUB Dot
    %%xd = @sum(%%xc, %x)
    %%yd = @diff(%%yc, %y)
    GOSUB Dot
    %%xd = @diff(%%xc, %x)
    %%yd = @sum(%%yc, %y)
    GOSUB Dot
    %%xd = @diff(%%xc, %x)
    %%yd = @diff(%%yc, %y)
    GOSUB Dot
    if @greater(@sum(%d, %y), 0)
       %y = @pred(%y)
       rem -- %%ve adjusts vertical ellipse --
       %d = @diff(%d, @pred(@prod(%%ve, %y)))
    end
    if @greater(%x, %d)
       %x = @succ(%x)
       rem -- %%he adjusts horizontal ellipse --
       %d = @sum(%d, @succ(@prod(%%he, %x)))
    end
  UNTIL @greater(0, %y)
  exit

:Dot
  %n = @succ(%n)
  rem -- Draw dot at xd, yd --
  DIALOG ADD,TEXT,Dot%n,%%yd,%%xd,%%linesize,%%linesize,,,DotStyle
  LIST ADD,1,Dot%n
  exit

:ClearAll
  if @greater(@count(1), 0)
     %x = 0
     REPEAT
       DIALOG REMOVE, @item(1, %x)
       %x = @succ(%x)
     UNTIL @equal(%x, @count(1))
     LIST CLEAR, 1
     %n = 0
  end
  exit

EDIT1 - Added var to adjust line thickness.
EDIT2 - Fixed some typos in remarks.

Cheers, Mac

_________________
VDSug.dll does file IO, check/disable menu items,
non-VDS dlls, draw functions and more...
Free download (30k dll size) at:
http://www.vdsworld.com/download.php?id=361


Last edited by Mac on Sun Oct 20, 2002 7:45 am; edited 2 times in total
Back to top
View user's profile Send private message Send e-mail
Skit3000
Admin Team


Joined: 11 May 2002
Posts: 2166
Location: The Netherlands

PostPosted: Sat Oct 19, 2002 1:27 pm    Post subject: Reply with quote

That's pretty cool! And way better then mine... Wink
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forum.vdsworld.com Forum Index -> Visual DialogScript 3 Source Code All times are GMT
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You can attach files in this forum
You can download files in this forum

Twitter@vdsworld       RSS

Powered by phpBB © 2001, 2005 phpBB Group