Support Forum / Форум поддержки

Code: Select all

' Functions for using window objects
' Use multiple windows, identified bij an object-id.
' The "commands" are:
'   window(id$,title$,xt,yt,width,height) defines & opens a window
'   winclear(id$) clears the content of the indicated window
'   windelete(id$) deletes the indicated window and restores the 
'      original background
' Use of the commands is shown in the following demo program.
' As you may notice, there are still some very minor flaws in
' the graphics. They will be adressed in a next (and final) version,
' unless mr. K. comes up with a nice windows package.
'
' To use the window commands, insert the following two lines in
' your main program (and add the functions somewhere, or use the 
' include mechanism {} for them)
' If you need more than 10 windows at the same time, you have
' raise the variabele "maxwin"
'
' If you only need one or two windows in your app, you could use
' the "low-level" function w_open. The maxwin variable and the arrays
' are not needed in that case. The function does not restore the
' original background. Deletion must be done by filling a rectangle
' over the window surface
'
option base 1
maxwin=10 ! dim w_id$(maxwin),w_title$(maxwin),w_dat(maxwin,4)
'
randomize
graphics ! graphics clear .8,.8,.8
draw color 0,0,0 ! fill color .8,.8,.8
graphics lock
for s=10 to 700 step 20
  draw color rnd(1),rnd(1),rnd(1) ! draw line 10,s to 700,s
  draw color rnd(1),rnd(1),rnd(1) ! draw line s,10 to s,700
  next s
graphics unlock
sw=screen_width() ! sh=screen_height()
window("win1","Activa",15,25,120,200) ! pause 1
window("win2","Liabilities",150,25,160,300) ! pause 1
windelete("win1") ! pause 1
window("win3","balance",300,400,200,200) ! pause 1
for i=0 to 160 step 20
  window("win2","Liabilities",150+i,25+2*i,400,350) ! pause .2
  next i
windelete("win2") ! pause 1
windelete("win3") ! pause 1
window("ww","blahblah",15,35,400,400) ! pause 1
for i=1 to 100
  draw color rnd(1),rnd(1),rnd(1) 
  draw line 17,61+rnd(374) to 413,61+rnd(374)
  next i ! pause 2
winclear("ww") ! pause 1
windelete("ww")
end

def window(id$,title$,xt,yt,wid,hgt)
if .nwin=.maxwin then ! windef=0 ! return ! end if
if .nwin=0 then ! k=1 ! .nwin=1 ! goto labwin1 ! end if
for i=1 to .nwin
  if id$=.w_id$(i) then
    spr_id$="sprite" & id$ ! fil$="fil" & id$
    sprite spr_id$ load fil$ ! xts=.w_dat(i,1) ! yts=.w_dat(i,2)
    sprite spr_id$ at xts-2,yts-2 ! sprite spr_id$ stamp
    sprite spr_id$ delete ! file fil$ delete
    k=i ! goto labwin1
    end if
  next i
.nwin+=1 ! k=.nwin
labwin1: windef=1
.w_id$(k)=id$ ! .w_title$(k)=title$
.w_dat(k,1)=xt ! .w_dat(k,2)=yt ! .w_dat(k,3)=wid ! .w_dat(k,4)=hgt
spr_id$="sprite" & id$ ! fil$="fil" & id$
sprite spr_id$ scan xt-2,yt-2,wid+4,hgt+4
sprite spr_id$ save fil$
w_open(title$,xt,yt,xt+wid,yt+hgt)
end def

def windelete(id$)
windelete=0 ! if .nwin=0 then return
for i=1 to .nwin ! if id$=.w_id$(i) then break i ! next i
if i=.nwin+1 then return else windelete=1
spr_id$="sprite" & id$ ! fil$="fil" & id$
sprite spr_id$ load fil$ ! xts=.w_dat(i,1) ! yts=.w_dat(i,2)
sprite spr_id$ at xts-2,yts-2 ! sprite spr_id$ stamp
sprite spr_id$ delete ! file fil$ delete
if i=.nwin then 
  .nwin-=1
  else
  for j=i to .nwin-1
    .w_id$(j)=.w_id$(j+1) ! .w_title$(j)=.w_title$(j+1)
    for k=1 to 4 ! .w_dat(j,k)=.w_dat(j+1,k) ! next k
    next j
  .nwin-=1
  end if
end def

def winclear(id$)
winclear=0 ! if .nwin=0 then return
for i=1 to .nwin ! if id$=.w_id$(i) then break i ! next i
if i=.nwin+1 then return else winclear=1
yt=.w_dat(i,2)+2 ! yb=yt+.w_dat(i,4)-4
if .w_title$(i)>"" then yt+=24
xt=.w_dat(i,1)+2 ! xb=xt+.w_dat(i,3)-4 ! 
fill rect xt,yt to xb,yb
end def

def w_open (title$,xtop,ytop,xbot,ybot)
r=10 ! graphics lock
draw color 0,0,0 ! draw size 4
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
  l=(xbot-xtop-12*len(title$))/2
  draw line xtop,ytop+24 to xbot,ytop+24
  draw color 0,0,1
  draw text title$ at xtop+l,ytop+3
  draw color 0,0,0
end if
graphics unlock ! draw size 1
end def