TheGameCreators - CodeBase

Category: 2D

Version: 1.0

Information

Uploaded: 16th Feb 2008 22:11

Modified: 16th Feb 2008 22:20

Author: Mortus

Summary

A version of connect four with source code and attached media (for download or on compiled excutable). Includes cool button code!

Full Description

A form of connect four that can be played trivially. In this version, say you ask a question to two teams and whichever answers first gets to drop a token, a team can win twice and drop two tokens in a row (unlike normal). The code is editable and the images can be downloaded.

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: Connect Four

Rem Created: 2/15/2008 4:36:00 PM

`Set Sync On

Sync On

`Load Images

Set Image Colorkey 0,255,255

Load Image "Board.bmp",1,1

Load Image "Black.bmp",2,1

Load Image "Red.bmp",3,1

Load Image "Screen.bmp",4,1

`Add Arrays For Tokens

Dim Piece(7,6)

Dim Filled(7,6)

Dim Row(8)

`Set Font Parameters

Set Text Font "Times New Roman"

Set Text Size 72

`Main Loop

`Reset The Board's Tokens

For Reset = 1 to 7

Row(Reset) = 0

For R2 = 1 to 6

Piece(Reset,R2) = 0

Next R2

Next Reset

`Reset The Columb Data

Row(8) = 6

`Reset Miscellanious Variables

ClickedLast = 0

Turn = 0

Color = 0

Loops = 0

FourInARow = 0

Winner$ = ""

`Game Loop

While FourInARow = 0

`Add To Loop Counter

Loops = Loops + 1

`Clear Screen For Loop

Cls

`Color Background

Box 0,0,701,701,RGB(0,128,255),RGB(0,128,255),RGB(0,128,255),RGB(0,128,255)

`Calculate Current Token

X = Int(Mousex() / 100) + 1

If Mouseclick() = 0 Then MLock = 0

TempX = (X * 100) - 50

TempY = 750 - (7 * 100)

`Draw Current Token

If Color > 0 Then Paste Image Color + 1,TempX - 45,TempY - 45,1

`Draw Drop Process

If Mouseclick() = 1 And MLock = 0 And Row(X) < 6 And ButtonClick(400,0,700,40) = 0

`Update First Varibles

Row(X) = Row(X) + 1

TempX# = (X * 100) - 50

TempY# = 50

FallY# = 0

`Drop

While Int(TempY#) <> Int(750 - (Row(X) * 100))

`Update Token Variables

FallY# = FallY# + 0.105

TempY# = TempY# + FallY#

`Draw Falling Token

Paste Image Color + 1,TempX#-45,TempY#-45,1

`Check For End Of The Drop

If TempY# > (750 - (Row(X) * 100)) Then TempY# = (750 - (Row(X) * 100))

`Draw Tokens For The Drop

For DrawX = 1 To 7

For DrawY = 1 To 6

If Piece(DrawX,DrawY)

TempX = (DrawX * 100) - 50

TempY = 750 - (DrawY * 100)

Paste Image Piece(DrawX,DrawY) + 1,TempX - 45,TempY - 45,1

Endif

Next DrawY

Next DrawX

`Draw Board For The Drop

Paste Image 1,0,0,1

`Refresh For The Drop

Sync

`Clear The Screen For The Drop

Cls

`Color The Background For The Drop

Box 0,0,701,701,RGB(0,128,255),RGB(0,128,255),RGB(0,128,255),RGB(0,128,255)

`Set The 'Start Next Turn Variable'

Turn = 0

EndWhile

`Update Last Variables

Piece(X,Row(X)) = Color

MLock = 1

Endif

`Draw The Tokens

For DrawX = 1 To 7

For DrawY = 1 To 6

If Piece(DrawX,DrawY)

TempX = (DrawX * 100) - 50

TempY = 750 - (DrawY * 100)

Paste Image Piece(DrawX,DrawY) + 1,TempX - 45,TempY - 45,1

Endif

Next DrawY

Next DrawX

`Draw The Board

Paste Image 1,0,0,1

`Check For A Win

For C = 1 To 2

For DrawX = 1 To 7

For DrawY = 1 To 6

Filled(DrawX,DrawY) = 0

If Piece(DrawX,DrawY) = C Then Filled(DrawX,DrawY) = 1

Next DrawY

Next DrawX

`Check Horizontal

For TY = 1 To 6

For TX = 1 To 4

If Filled(TX + 0,TY) And Filled(TX + 1,TY) And Filled(TX + 2,TY) And Filled(TX + 3,TY)

FourInARow = 1

If C = 1 Then Winner$ = "Black"

If C = 2 Then Winner$ = "Red"

Line ((TX + 0) * 100) - 50,750 - ((TY + 0) * 100),((TX + 3) * 100) - 50,750 - ((TY + 0) * 100)

Endif

Next TX

Next TY

`Check Vertical

For TX = 1 To 7

For TY = 1 To 3

If Filled(TX,TY + 0) And Filled(TX,TY + 1) And Filled(TX,TY + 2) And Filled(TX,TY + 3)

FourInARow = 1

If C = 1 Then Winner$ = "Black"

If C = 2 Then Winner$ = "Red"

Line ((TX + 0) * 100) - 50,750 - ((TY + 0) * 100),((TX + 0) * 100) - 50,750 - ((TY + 3) * 100)

Endif

Next TY

Next TX

`Check Diagonals

For TX = 1 To 4

For TY = 1 To 3

If Filled(TX + 0,TY + 0) And Filled(TX + 1,TY + 1) And Filled(TX + 2,TY + 2) And Filled(TX + 3,TY + 3)

FourInARow = 1

If C = 1 Then Winner$ = "Black"

If C = 2 Then Winner$ = "Red"

Line ((TX + 0) * 100) - 50,750 - ((TY + 0) * 100),((TX + 3) * 100) - 50,750 - ((TY + 3) * 100)

Endif

Next TY

Next TX

For TX = 4 To 7

For TY = 1 To 3

If Filled(TX - 0,TY + 0) And Filled(TX - 1,TY + 1) And Filled(TX - 2,TY + 2) And Filled(TX - 3,TY + 3)

FourInARow = 1

If C = 1 Then Winner$ = "Black"

If C = 2 Then Winner$ = "Red"

Line ((TX + 0) * 100) - 50,750 - ((TY + 0) * 100),((TX - 3) * 100) - 50,750 - ((TY + 3) * 100)

Endif

Next TY

Next TX

Next C

`Draw 'Back' Button

Button(400,0,700,40,"Wrong Color?")

If ButtonClick(400,0,700,40) = 2

If ClickedLast = 1 Then Turn = 0

ClickedLast = 1

Endif

`Refresh Screen

Sync

`Choose Color When Needed

If Turn = 0 And Loops > 2 And FourInARow = 0

Color = 0

While (Color = 0 Or Mouseclick() = 1) And Loops > 2

Paste Image 4,0,0,1

If Mouseclick() = 1

If MouseX() > 205 And MouseY() > 245 And MouseX() < 345 And Mousey() < 438 Then Color = 2

If MouseX() > 355 And MouseY() > 245 And MouseX() < 495 And Mousey() < 438 Then Color = 1

Endif

Sync

If Color > 0 Then Turn = 1

EndWhile

ClickedLast = 0

Endif

EndWhile

`Confirm Victory

While ButtonClick(50,0,350,85) <> 2

Button(50,1,350,86,Winner$ + " Wins!")

Sync

EndWhile

While MouseClick() = 1

EndWhile

Loop

Function Button(Left,Top,Right,Bottom,Text$)

Clicked = 0

If MouseX() > Left And MouseX() < Right And MouseY() > Top And MouseY() < Bottom Then Clicked = 1

If Clicked = 1 And MouseClick() = 1 Then Clicked = 2

If Clicked = 0

Border = RGB(255,255,255)

First = RGB(200,201,202)

Second = RGB(241,241,239)

Third = RGB(239,239,239)

Fourth = RGB(253,253,253)

Endif

If Clicked = 1

Border = RGB(255,173,91)

First = RGB(200,201,202)

Second = RGB(241,241,239)

Third = RGB(239,239,239)

Fourth = RGB(253,253,253)

Endif

If Clicked = 2

Border = RGB(128,128,128)

First = RGB(253,253,253)

Second = RGB(239,239,239)

Third = RGB(241,241,239)

Fourth = RGB(200,201,202)

Endif

Dot Left,Top

InkColor = Point(Left,Top)

Box Left-1,Top-1,Right+1,Bottom+1,Border,Border,Border,Border

Box Left,Top,Right,Bottom,First,Second,Third,Fourth

Ink RGB(0,0,0),0

Set Text Size 48

Center Text ((Left+Right)/2),((Top+Bottom)/2)-24,Text$

Set Text Size 24

Ink InkColor,0

Endfunction Clicked

Function ButtonClick(Left,Top,Right,Bottom)

Clicked = 0

If MouseX() > Left And MouseX() < Right And MouseY() > Top And MouseY() < Bottom Then Clicked = 1

CodeBase - Connect Four

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Mortus
CodeBase Entries:	4