'' Here's a quick hack of the good 'ol columns game.
'' It's not quite playable, yet. It will only check for vertical matches.

DECLARE SUB Paint
DECLARE SUB PaintNextGem

CONST False = 0
CONST True = 1
CONST NumFieldX = 6
CONST NumFieldY = 13

TYPE GemType
  Color1 AS INTEGER
  Color2 AS INTEGER
  Color3 AS INTEGER
END TYPE

DIM Form AS QForm
DIM Field AS QCanvas, NextField AS QCanvas
DIM Timer1 AS QTimer
DIM X AS INTEGER, Y AS INTEGER
DIM Interval AS INTEGER
DIM Grid(-2 TO NumFieldY+1, 1 TO NumFieldX) AS INTEGER
DIM Colours(1 TO 7) AS INTEGER
DIM Gem AS GemType, NextGem AS GemType

'' NOTE: If you're using 256 colors as your default Windows display,
''       Try modifying these values, they may not display correctly.

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

SUB ChooseNextGem
  NextGem.Color1 = Colours(RND(7) + 1)
  NextGem.Color2 = Colours(RND(7) + 1)
  NextGem.Color3 = Colours(RND(7) + 1)
END SUB

SUB ChooseGem
  Gem.Color1 = NextGem.Color1
  Gem.Color2 = NextGem.Color2
  Gem.Color3 = NextGem.Color3
  ChooseNextGem
  PaintNextGem
END SUB

SUB InitGrid
  FOR I = -2 TO NumFieldY+1
    FOR J = 1 TO NumFieldX
      Grid(I, J) = 0
    NEXT
  NEXT
END SUB

FUNCTION MatchVertical (GridX AS INTEGER) AS INTEGER
'' Checks for vertical matches relative to GridX

  MatchVertical = False
  Correct = Grid(-2, GridX)
  IF Correct = 0 THEN
    Correct = -1
  END IF
  Match = 0
  StartMatch = 0

  FOR Y1 = -2 TO NumFieldY              '' Simple up/down search
    IF Grid(Y1, GridX) = Correct THEN
      IF Match = 0 THEN
        StartMatch = Y1
      END IF
      Match = Match + 1
    ELSE                                '' Not correctly matching
      IF Match < 3 THEN
        Match = 1
        StartMatch = Y1
        Correct = Grid(Y1, GridX)
        IF Correct = 0 THEN
          Correct = -1
        END IF
      ELSE
        GOSUB VertMatched
        EXIT FUNCTION
'        Match = 1
'        StartMatch = Y1
'        Correct = Grid(Y1, GridX)
'        IF Correct = 0 THEN
'          Correct = -1
'        END IF
      END IF
    END IF
  NEXT
  IF Match > 2 THEN
    GOSUB VertMatched
  END IF
  EXIT FUNCTION

  VertMatched:
    FOR I = StartMatch TO StartMatch + Match - 1
      Grid(I, GridX) = -1
      Field.Paint((GridX-1)*20+5,(I-1)*20+18, 0, &HFFFFFF)
    NEXT
    FOR I = StartMatch+Match-1 TO -2+Match STEP -1
      Grid(I, GridX) = Grid(I-Match, GridX)
    NEXT
    FOR I = -2+Match TO -2 STEP -1
      Grid(I, GridX) = 0
    NEXT
    Paint
    MatchVertical = True
  RETURN
END FUNCTION

FUNCTION MatchHorizontal (GridY AS INTEGER) AS INTEGER
'' Checks for horizontal matches relative to GridY

  MatchHorizontal = False
  Correct = Grid(GridY, 1)
  IF Correct = 0 THEN
    Correct = -1
  END IF
  Match = 0
  StartMatch = 0

  FOR X1 = 1 TO NumFieldX              '' Simple up/down search
    IF Grid(GridY, X1) = Correct THEN
      IF Match = 0 THEN
        StartMatch = X1
      END IF
      Match = Match + 1
    ELSE                                '' Not correctly matching
      IF Match < 3 THEN
        Match = 1
        StartMatch = X1
        Correct = Grid(GridY, X1)
        IF Correct = 0 THEN
          Correct = -1
        END IF
      ELSE
        GOSUB HorzMatched
        EXIT FUNCTION
'        Match = 1
'        StartMatch = Y1
'        Correct = Grid(Y1, GridX)
'        IF Correct = 0 THEN
'          Correct = -1
'        END IF
      END IF
    END IF
  NEXT
  IF Match > 2 THEN
    GOSUB HorzMatched
  END IF
  EXIT FUNCTION

  HorzMatched:
    FOR I = StartMatch TO StartMatch + Match-1
      Grid(GridY, I) = 0
      Field.Paint((I-1)*20+5,(GridY-1)*20+18, 0, &HFFFFFF)
    NEXT
    FOR I = GridY TO -1 STEP -1
      FOR J = StartMatch TO Match+StartMatch -1
        SWAP Grid(I, J), Grid(I-1, J)
      NEXT
    NEXT
'    FOR I = -2+Match TO -2 STEP -1
'      Grid(GridY, I) = 0
'    NEXT
    Paint
    MatchHorizontal = True
  RETURN
END FUNCTION

SUB DrawGem
  Field.Rectangle(X,Y,X+20,Y+20,&HFFFFFF)
  Field.Paint(X+5,Y+18, Gem.Color1, &HFFFFFF)
  Field.Rectangle(X,Y+20,X+20,Y+40,&HFFFFFF)
  Field.Paint(X+5,Y+38, Gem.Color2, &HFFFFFF)
  Field.Rectangle(X,Y+40,X+20,Y+60,&HFFFFFF)
  Field.Paint(X+5,Y+58, Gem.Color3, &HFFFFFF)
END SUB

SUB Timer1Over
  IF (Y MOD 20 = 0) AND Grid(Y/20+4, X/20+1) <> 0 THEN
      Grid(Y / 20+3, X / 20+1) = Gem.Color3
      Grid(Y / 20+2, X / 20+1) = Gem.Color2
      Grid(Y / 20+1, X / 20+1) = Gem.Color1
      MatchVertical(X/20+1)
      MatchHorizontal(Y/20+3)
      MatchHorizontal(Y/20+2)
      MatchHorizontal(Y/20+1)
      IF Grid(0, X/20+1) <> 0 THEN
        Timer1.Enabled = False
        ShowMessage("Game Over")
      ELSE
        Y = -50
        X = 40
        ChooseGem
      END IF
  ELSE
    IF Y < 20*(NumFieldY-3) THEN
      Field.Rectangle(X,Y,X+20,Y+60, 0)
      Field.Paint(X+5,Y+55, 0, 0)
      Y = Y + 10
    ELSE
      Grid(Y / 20+3, X / 20+1) = Gem.Color3
      Grid(Y / 20+2, X / 20+1) = Gem.Color2
      Grid(Y / 20+1, X / 20+1) = Gem.Color1
      MatchVertical(X/20+1)
      MatchHorizontal(Y/20+3)
      MatchHorizontal(Y/20+2)
      MatchHorizontal(Y/20+1)
      Y = -50
      X = 40
      ChooseGem
    END IF
  END IF
    
  Timer1.Interval = Interval
  DrawGem
END SUB

SUB KeyDown (Key AS BYTE, Shift AS INTEGER)
  SELECT CASE Key
    CASE 27    '' ESC
      Form.Close
    CASE IS = 37 AND X > 0   '' Left
      IF Grid(INT((Y-10)/20)+4, X/20) = 0 THEN
        Field.Rectangle(X,Y,X+20,Y+60, 0)
        Field.Paint(X+5,Y+55, 0, 0)
        X=X-20
        DrawGem
      END IF
    CASE 38    '' Up
      Field.Rectangle(X,Y,X+20,Y+60, 0)
      Field.Paint(X+5,Y+55, 0, 0)
      C = Gem.Color1
      Gem.Color1 = Gem.Color3
      Gem.Color3 = Gem.Color2
      Gem.Color2 = C
      DrawGem
    CASE IS = 39 AND X < 20*(NumFieldX-1)   '' Right
      IF Grid(INT((Y-10)/20)+4, X/20+2) = 0 THEN
        Field.Rectangle(X,Y,X+20,Y+60, 0)
        Field.Paint(X+5,Y+55, 0, 0)
        X=X+20
        DrawGem
      END IF
    CASE IS = 40 AND Y < 20*(NumFieldY-3)   '' Down
      Timer1Over
'      Field.Get(0,0,100,100)
'      Field.Put(0,0,100,100,2)
  END SELECT
END SUB

SUB Paint
  '' Whenever the form gets hidden, we have to repaint the form once
  '' it's visible again.

'  Field.Rectangle(0,0,NumFieldX*20,NumFieldY*20,3)
'  Field.Paint (10,10,0,0)
  FOR I = 0 TO NumFieldY * 20 STEP 20
    FOR J = 0 TO NumFieldX*20 STEP 20
      IF Grid(I/20+1,J/20+1) <> 0 THEN
        Field.Rectangle(J,I,J+20,I+20,&HFFFFFF)
        Field.Paint(J+5,I+18, Grid(I/20+1,J/20+1), &HFFFFFF)
      ELSE
        Field.Rectangle(J,I,J+20,I+20,0)
        Field.Paint(J+5,I+18, 0, 0)
      END IF
    NEXT
  NEXT
END SUB

SUB PaintNextGem
  NextField.Paint (1,1,0,0)
  NextField.Rectangle(5,5,25,25,&HFFFFFF)
  NextField.Paint(10,10, NextGem.Color1, &HFFFFFF)
  NextField.Rectangle(5,25,25,45,&HFFFFFF)
  NextField.Paint(10,30, NextGem.Color2, &HFFFFFF)
  NextField.Rectangle(5,45,25,65,&HFFFFFF)
  NextField.Paint(10,50, NextGem.Color3, &HFFFFFF)
END SUB

Form.Center
Form.ClientWidth = NumFieldX * 20 + 100
Form.ClientHeight = NumFieldY * 20

Interval = 300
Y = -50
X = 40
InitGrid

Field.Parent = Form
Field.Color = 0
Field.Width = NumFieldX * 20
Field.Height = NumFieldY * 20
Field.OnPaint = Paint

NextField.Parent = Form
NextField.Color = 0
NextField.Left = Field.Width + 20
NExtField.Top = 20
NextField.Width = 30
NextField.Height = 20*4-10
NextField.OnPaint = PaintNextGem

RANDOMIZE

ChooseNextGem
ChooseGem

Timer1.Interval = Interval
Timer1.OnTimer = Timer1Over

Form.Caption = "Columns Game"
Form.OnKeyDown = KeyDown
Form.ShowModal