declare sub MarkForDelete(col,row,carac$,subst$)
declare sub paint
declare sub blockclick
declare sub deletesel(inicol)
declare sub killcol(y)
declare sub restart
declare sub AppEnd
declare sub cntrupdate
declare sub msgabout
const width =25
const height=22
const unit=20
const vertoffs=height*unit
const horoffs=width*unit
const level=5   'change it
$include "rapidq.inc"
REdim a (1 to width) as string
dim res as word
dim colours(8) as long

colours(0) = &h000000 '' black
Colours(1) = &HFF0000  '' Blue
Colours(2) = &H00FF00  '' Green
Colours(3) = &H0000FF  '' Red
Colours(4) = &HFF00FF  '' Purple
Colours(5) = &H30FFFF  '' Yellow
Colours(6) = &HFFFF30  '' Cyan
Colours(7) = &H2099FF  '' Orange
colours(8) = &hffffff  '' white
create myfont as qfont
	name="Verdana"
	size=20
end create

CREATE Form AS QFORM
	Caption = "Blocks"
	ClientWidth = unit*width+100
	ClientHeight = unit*(height+1)
	Center
	Borderstyle=bssingle
	onshow=restart
	CREATE MENU AS QMAINMENU
		CREATE mOpt as QMENUITEM
			CAPTION="Options"
			create mNew as qmenuitem
				caption="New game"
				onclick=restart
			end create
			create  mExit as qmenuitem
				caption="Exit Game"
				onclick=AppEnd
			end create
		end create
		create mAbout as qmenuitem
			caption="About"
			onclick=Msgabout
		end create
	end create
	create counter as qlabel
		top=0
		left=unit*width+5
		width=90
		height=10
		font=myfont
		alignment=tacenter
	end create
	CREATE CANVAS AS QCanvas
		width=Form.Clientwidth
		height=form.clientheight
		Color=colours(7)
		OnPaint = Paint
		OnMouseup=BlockClick
	END CREATE
END CREATE

sub displaycol(kol)
	canvas.fillrect((kol-1)*unit,0,kol*unit,vertoffs,clappworkspace)
	if kol<=ubound(a) then
		for i=1 to len(a(kol))
			CANVAS.FillRect((kol-1)*unit,vertoffs-(i-1)*unit,kol* _
				unit,vertoffs-i*unit,colours(asc(mid$(a(kol),i,1))))
		next
	end if
end sub

sub msgabout
    Messagedlg("Blocks, by Antoni Gual"+chr$(13)+"agual@eic.ictnet.es",mtcustom,mbOK,0)
end sub

sub blockclick(but,x,y,shift)
	coordx=int(MouseX\unit)+1
	coordy=int((vertoffs-MouseY)\unit)+1
	TXT$=str$(coordx)+" "+str$(coordy)
	if coordx<=ubound(a) then
	if len(a(coordx))>=coordy then
		res=0:prescol$=mid$(a(coordx),coordy,1)
		markfordelete(coordx,coordy,prescol$,chr$(8))
		if res>1 then
			deletesel(coordx)
		else
			markfordelete(coordx,coordy,chr$(8),prescol$)
		end if
	end if
	end if
end sub

sub paint
for i=1 to width
displaycol(i)
next
end sub

sub initstr(lev)
	for i=1 to width 
		a(i)=""
		for j = 1 to rnd(height)+1:a(i)=a(i)+chr$(rnd(lev)+1):next
		displaycol(i)
	next
end sub

sub deletesel(inicol)
	Col=ubound(a)
	while col>0
		I=0:j=len(a(col))
		while j>0
			if mid$(a(col),j,1)=chr$(8) then 
				a(col)=delete$(a(col),j,1):inc i
			end if
			dec j
		wend 
		if i then
			if len(a(col)) then
				displaycol(col)
			else
				killcol(col)
			end if
		end if
		dec col
	wend
	cntrupdate
end sub

sub killcol(y)
	temp=ubound(a)-1
	for k=y to temp :swap a(k),a(k+1):displaycol(k):next
	displaycol(temp+1)
	redim a(1 TO temp)AS STRING
end sub 

sub MarkForDelete(col,row,carac$,subst$)
	if carac$=subst$ then
		exit sub
	end if
	a(col)=replace$(a(col),subst$, row):res = res + 1
	displaycol(col)

	IF row < len(a(col)) THEN
		IF MID$(a(col), row + 1, 1) = carac$ THEN 
			MarkForDelete col,row + 1,  carac$,subst$
		end if
	END if
	IF row > 1 THEN
		IF MID$(a(col), row - 1, 1) = carac$ THEN 
			MarkForDelete col,row - 1,  carac$,Subst$
		end if
	end if
	IF col < ubound(a) THEN
		IF MID$(a(col+1), row, 1) = carac$ THEN
			MarkForDelete col+1,row,  carac$,subst$
		end if
	END if
	IF col > 1 THEN
		IF MID$(a(col-1), row, 1) = carac$ THEN 
			MarkForDelete col-1,row,carac$,subst$
		end if
	END if
eND SUB
sub cntrupdate
	cnt=0
	for i=1 to ubound(a)
		cnt=cnt+len(a(i))
	next
	counter.caption=str$(cnt)
end sub			
sub restart
	randomize
	REdim a (1 to width) as string
	initstr(level)
	cntrupdate
end sub
sub AppEnd
	form.close
end sub

Form.ShowModal