unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
BGRAVirtualScreen, BGRABitmap,BGRABitmapTypes,mmsystem;
const
GridCols = 4; // 4*4 = 16 cartes
GridRows = 4; //
CardWidth = 64;
CardHeight = 64;
CardSpacing = 10;
CardColors: array[0..7] of TBGRAPixel = ( // packed record of tbgrapixel ;
(blue: 0; green: 0; red: 255; alpha: 255), // Rouge
(blue: 0; green: 255; red: 0; alpha: 255), // Vert
(blue: 255; green: 0; red: 0; alpha: 255), // Bleu
(blue: 0; green: 255; red: 255; alpha: 255), // Jaune
(blue: 255; green: 0; red: 255; alpha: 255), // Magenta
(blue: 255; green: 255; red: 0; alpha: 255), // Cyan
(blue: 128; green: 0; red: 128; alpha: 255), // Violet
(blue: 0; green: 165; red: 255; alpha: 255) // Orange
);
soundsflag = snd_Async; // one shot !!
type
TCard = record
ImageIndex: Integer;
IsFlipped: Boolean;
IsMatched: Boolean;
Rect: TRect;
end;
type
{ TForm1 }
TForm1 = class(TForm)
BGRAVirtualScreen1: TBGRAVirtualScreen;
Memo1: TMemo;
Timer1: TTimer;
procedure BGRAVirtualScreen1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Reset;
private
public
end;
var
Form1: TForm1;
Cards: array[0..GridCols-1, 0..GridRows-1] of TCard;
CardImages: array of TBGRABitmap;
BackImage: TBGRABitmap;
FirstCardX, FirstCardY: Integer;
SecondCardX, SecondCardY: Integer;
CardsFlipped: Integer = 0;
Score : Integer = 0;
Coup : integer = 0;
Reste : Integer = 0;
Partie : Integer = 0;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Reset; // ResetAll & start game
BGRAVirtualScreen1.OnMouseDown := @BGRAVirtualScreen1MouseDown;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
// associe les couleurs 2 par deux et teste le resultat
if (FirstCardX >= 0) and (FirstCardY >= 0) and (SecondCardX >= 0) and (SecondCardY >= 0) then
begin
if Cards[FirstCardX, FirstCardY].ImageIndex = Cards[SecondCardX, SecondCardY].ImageIndex then
begin
Cards[FirstCardX, FirstCardY].IsMatched := True;
Cards[SecondCardX, SecondCardY].IsMatched := True;
playsound('snds/hit.wav',0, soundsflag);// play sound if Matched !!
Inc(Score); // score !
Dec(Reste);
end
else
begin
playsound('snds/lost.wav',0, soundsflag);// play sound if Lost !!
Cards[FirstCardX, FirstCardY].IsFlipped := False;
Cards[SecondCardX, SecondCardY].IsFlipped := False;
end;
end;
Inc(coup); // coup !
if Reste =0 then
begin
inc(partie);
Memo1.Lines.Add('Round : '+IntToStr(Partie)+ ' Move : ' + IntToStr(Coup));
Sleep(2000); // wait 2 sec to restart and reset all variables !!
reset;
end;
// Reset pour un nouveau tour ;
FirstCardX := -1;
FirstCardY := -1;
SecondCardX := -1;
SecondCardY := -1;
CardsFlipped := 0;
BGRAVirtualScreen1.DiscardBitmap;
end;
// affichage permanent
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
var
i, j: Integer;
card: TCard;
begin
//Bitmap.Fill(BGRAWhite);
for i := 0 to GridCols-1 do
for j := 0 to GridRows-1 do
begin
card := Cards[i,j];
if card.IsFlipped or card.IsMatched then
Bitmap.PutImage(card.Rect.Left, card.Rect.Top, CardImages[card.ImageIndex], dmSet)
else
Bitmap.PutImage(card.Rect.Left, card.Rect.Top, BackImage, dmSet);
end;
// le score inutile !
Bitmap.FontHeight := 20;
Bitmap.FontStyle := [];
Bitmap.TextOut(0, GridRows*(CardHeight+CardSpacing) + 10, 'Score : ' + IntToStr(Score), BGRA(0,0,0));
// les coups
Bitmap.FontHeight := 20;
Bitmap.FontStyle := [];
Bitmap.TextOut(100, GridRows*(CardHeight+CardSpacing) + 10, 'Draw : ' + IntToStr(Coup), BGRA(0,0,0));
// le restant des paires
Bitmap.FontHeight := 20;
Bitmap.FontStyle := [];
Bitmap.TextOut(200, GridRows*(CardHeight+CardSpacing) + 10, 'Remain : ' + IntToStr(Reste), BGRA(0,0,0));
end;
procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i, j: Integer;
begin
if CardsFlipped = 2 then Exit;
for i := 0 to GridCols-1 do
for j := 0 to GridRows-1 do
begin
if (X >= Cards[i,j].Rect.Left) and (X < Cards[i,j].Rect.Right) and
(Y >= Cards[i,j].Rect.Top) and (Y < Cards[i,j].Rect.Bottom) and
(not Cards[i,j].IsFlipped) and (not Cards[i,j].IsMatched) then
begin
Cards[i,j].IsFlipped := True;
if CardsFlipped = 0 then
begin
FirstCardX := i;
FirstCardY := j;
end
else if CardsFlipped = 1 then
begin
SecondCardX := i;
SecondCardY := j;
Timer1.Enabled := True; // une fois pour test resultat si ok or Not !
end;
Inc(CardsFlipped);
BGRAVirtualScreen1.DiscardBitmap;
Exit;
end;
end;
end;
// start game and Reset All
procedure TForm1.Reset;
var
i, j, k: Integer;
indexList: array of Integer;
begin
SetLength(CardImages, 8); // 8 paires pour une grille 4x4 , 16/2=8
// Couleurs à la place des cartes !
for i := 0 to 7 do
begin
CardImages[i] := TBGRABitmap.Create(CardWidth, CardHeight, CardColors[i]);
end;
// back color of all cards
BackImage := TBGRABitmap.Create(CardWidth, CardHeight, BGRA(155, 155, 100));
// JS to pascal code
SetLength(indexList, 16);
for i := 0 to 15 do
indexList[i] := i div 2;
for i := 0 to 15 do
begin
j := Random(16);
k := indexList[i];
indexList[i] := indexList[j];
indexList[j] := k;
end;
// fill cells 4*4
k := 0;
for i := 0 to GridCols-1 do
for j := 0 to GridRows-1 do
begin
Cards[i,j].ImageIndex := indexList[k];
Cards[i,j].IsFlipped := False;
Cards[i,j].IsMatched := False;
Cards[i,j].Rect := Rect(i*(CardWidth+CardSpacing), j*(CardHeight+CardSpacing),
i*(CardWidth+CardSpacing)+CardWidth,
j*(CardHeight+CardSpacing)+CardHeight);
Inc(k);
end;
// reset vars and start game !
playsound('snds/restart.wav',0, soundsflag); // play start sound
FirstCardX := -1;
FirstCardY := -1;
SecondCardX := -1;
SecondCardY := -1;
Reste := 8 ;
Coup := 0;
Score := 0;
end;
end.
Recent
