Sorry your browser is not supported!

Rem Project: WindowsExample
Rem Created: Saturday, November 03, 2007

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

sync off
sync rate 0

Type Window
   x as integer
   y as integer
   width as integer
   height as integer
   barcol1 as integer
   barcol2 as integer
   scrcol1 as integer
   scrcol2 as integer
   edgecol as integer
   caption as string
   textcol as integer
EndType

Global Dim Window(0) as Window
Global wingrab as Integer = 0
Global mx as integer
Global my as integer
Global lmx as integer
Global lmy as integer
Global wingrab as integer = 0
Global lregrab as integer = 0
Global rregrab as integer = 0
Global uregrab as integer = 0

NewWindow(0,RGB(255,255,0),RGB(128,128,0),RGB(128,128,128),RGB(128,128,128),RGB(255,255,255),0,0,100,100,"Window",RGB(0,0,0))

Do
   cls
   Box 0,0,Screen Width(),Screen Height(),RGB(100,0,100),RGB(100,0,100),RGB(100,0,100),RGB(100,0,100)
   Text 0,0,str$(screen fps())
   DrawWindow(0)
   MoveWindow(0)
   ResizeWindow(0)
   lmx = MouseX()
   lmy = MouseY()
Loop

End

Function NewWindow(windown,barcol1,barcol2,wincol1,wincol2,edgecol,xpos,ypos,width,height,caption$,textcol)
   Window(windown).x = xpos
   Window(windown).y = ypos
   Window(windown).width = width
   Window(windown).height = height
   Window(windown).barcol1 = barcol1
   Window(windown).barcol2 = barcol2
   Window(windown).scrcol1 = wincol1
   Window(windown).scrcol2 = wincol2
   Window(windown).edgecol = edgecol
   Window(windown).caption = caption$
   Window(windown).textcol = textcol
EndFunction

Function DrawWindow(windown)
   wx = Window(windown).x
   wy = Window(windown).y
   ww = Window(windown).width
   wh = Window(windown).height
   wcol1 = Window(windown).scrcol1
   wcol2 = Window(windown).scrcol2
   bcol1 = Window(windown).barcol1
   bcol2 = Window(windown).barcol2
   ecol = Window(windown).edgecol
   capt$ = Window(windown).caption
   textcol = Window(windown).textcol
   Box wx,wy,wx+ww,wy+wh,wcol1,wcol1,wcol2,wcol2
   Box wx,wy,wx+ww,wy+16,bcol1,bcol1,bcol2,bcol2
   Ink ecol,ecol
   Line wx,wy+16,wx,wy+wh-1
   Line wx+1,wy+16,wx+1,wy+wh-1
   Line wx+ww-1,wy+16,wx+ww-1,wy+wh-1
   Line wx+ww-2,wy+16,wx+ww-2,wy+wh-1
   Line wx,wy+wh,wx+ww-1,wy+wh
   Line wx,wy+wh-1,wx+ww-1,wy+wh-1
   Ink textcol,textcol
   If Window(windown).width >= 8*len(capt$)
      Text wx,wy+1,capt$
   Else
      Create Bitmap 31,ww,16
      Set Current Bitmap 31
      Box 0,0,ww,16,bcol1,bcol1,bcol2,bcol2
      Text 0,1,capt$
      Get Image 255,0,0,ww,Bitmap Height(31),1
      Set Current Bitmap 0
      Paste Image 255,wx,wy
      Delete Image 255
      Delete Bitmap 31
   Endif
   Ink RGB(255,255,255),RGB(255,255,255)
EndFunction

Function MoveWindow(windown)
   wx = Window(windown).x
   wy = Window(windown).y
   ww = Window(windown).width
   If MouseX() >= wx and MouseX() <= wx+ww and MouseY() >= wy and MouseY() <= wy+14 and MouseClick()=1 and uregrab = 0 and lregrab = 0 and rregrab = 0
      wingrab = 1
   Endif
   If wingrab = 1
      Window(windown).x = MouseX()-(lmx-Window(windown).x)
      Window(windown).y = MouseY()-(lmy-Window(windown).y)
   Endif
   If MouseClick() = 0
      wingrab = 0
   Endif
EndFunction

Function ResizeWindow(windown)
   wx = Window(windown).x
   wy = Window(windown).y
   ww = Window(windown).width
   wh = Window(windown).height
   If MouseX() >= wx and MouseX() <= wx+1 and MouseY() >= wy+16 and MouseY() <= wy+wh and MouseClick()=1
      lregrab = 1
   Endif
   If MouseX() >= wx+ww-2 and MouseX() <= wx+ww-1 and MouseY() >= wy+16 and MouseY() <= wy+wh and MouseClick()=1
      rregrab = 1
   Endif
   If MouseX() >= wx and MouseX() <= wx+ww-1 and MouseY() >= wy+wh-2 and MouseY() <= wy+wh and MouseClick()=1
      uregrab = 1
   Endif
   If lregrab = 1
      Window(windown).x = MouseX()-(lmx-Window(windown).x)
      Window(windown).width = Window(windown).width-(MouseX()-lmx)
   Endif
   If rregrab = 1
      Window(windown).width = Window(windown).width+(MouseX()-lmx)
   Endif
   If uregrab = 1
      Window(windown).height = Window(windown).height+(MouseY()-lmy)
   Endif
   If MouseClick() = 0
      lregrab = 0
   Endif
   If MouseClick() = 0
      rregrab = 0
   Endif
   If MouseClick() = 0
      uregrab = 0
   Endif
   If Window(windown).width < 16
      Window(windown).width = 16
      lregrab = 0
      rregrab = 0
   Endif
   If Window(windown).height < 16
      Window(windown).height = 16
      uregrab = 0
   Endif
EndFunction