' Copy and paste into your program 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=7 '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 DIM mNew AS QMenuItem mNew.Caption = "New" mNew.OnClick = Restart DIM mExit AS QMenuItem mExit.Caption = "Exit" mExit.OnClick = AppEnd 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="&Game" ' create mExit as qmenuitem ' caption="Exit Game" ' onclick=AppEnd ' end create end create end create create counter as qlabel top=20 left=unit*width+15 width=90 height=20 ' font=myfont ' alignment=tacenter end create CREATE CANVAS AS QCanvas Top = 20 width=Form.Clientwidth height=form.clientheight Color=colours(7) OnPaint = Paint OnMouseup=BlockClick END CREATE END CREATE mOpt.AddItems mNew, mExit 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) if MouseX < 0 OR MouseY < 0 then exit sub end if coordx=int(MouseX\unit)+1 coordy=int((vertoffs-MouseY+20)\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