Sorry your browser is not supported!

Rem Dark Basic Classic Project: Line
Rem Created: 03/01/2007 17:06:11
Rem Author: TDK_Man
Rem Company: Computech Tenerife
Rem E-Mail: tdk_man@computechtenerife.com
Rem Web Site: http://www.computechtenerife.com/db.htm

Rem ***** Main Source File *****

Set Display Mode 800,600,16
Sync On: Sync Rate 0: CLS 0
Do
  Mx = MouseX(): My = MouseY(): Mc = MouseClick()
  If Mc = 1
    StartX = Mx: StartY = My
    Get Image 1,0,0,800,600
    Repeat
      Mx = MouseX(): My = MouseY()
      If Mx<>OldMx Or My<>OldMy
        Paste Image 1,0,0
        Line StartX,StartY,Mx,My
        OldMx=Mx: OldMy=My
      Endif
      Sync
    Until MouseClick() = 0
    Line StartX,StartY,Mx,My
  Endif
  Sync
Loop

sync on

global w
global h

w=screen width()
h=screen height()

create bitmap 1,w,h
set current bitmap 0

do

   if mouseclick()=1 and hold=0

      ax=mousex()
      ay=mousey()
      hold=1

   endif


   if mouseclick()=1 and hold=1

      copy bitmap 1,0,0,w,h,0,0,0,w,h
      bx=mousex()
      by=mousey()
      line ax,ay,bx,by

   endif

   if mouseclick()=0 and hold=1 then hold=0 : copy bitmap 0,1

   sync

loop

sync on

global w
global h
global vx
global vy
global hold

w=screen width()
h=screen height()

create bitmap 1,w,h
set current bitmap 0

do

   MouseInPut()

   sync

loop

Function MouseInPut()

   if mouseclick()=1

      if hold=0
         vx=mousex()
         vy=mousey()
         hold=1
      endif

      if hold=1 then DrawLine(mousex(),mousey())

   endif

   if mouseclick()=0 and hold=1 then hold=0 : Refresh(2)

endfunction

Function DrawLine(x,y)

      Refresh(1)
      line vx,vy,x,y

endfunction

Function Refresh(num)

   if num=1 then copy bitmap 1,0,0,w,h,0,0,0,w,h
   if num=2 then copy bitmap 0,1

endfunction