Memory-Spiel

Für alles, was in den übrigen Lazarusthemen keinen Platz, aber mit Lazarus zutun hat.
Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Memory-Spiel

Beitrag von Sadde »

Hallo Leute,

Ich bin gerade dabei ein Memory-Spiel zu programmieren. Das ganze wird ein Programmentwurf für mein Studium. Hier ist Informatik kein Hauptfach, wesshalb ich mich eventuell auch manchmal etwas ungeschickt anstelle, also schonmal entschuldigung falls ich noch einmal nachfragen muss.
Problem 1:
Der Spieler soll auswählen wie viele Karten er auf seinem Spielfeld haben möchte. Hierfür habe ich ein Array erstellt, dass so viele Images erstellt wie gewünscht. Jetzt brauch ich aber eine Funktion die das ganze auch wieder löscht, bzw die überschüssigen images löscht, wenn der spieler nun statts anfänglichen 40 z.B. nur 30 Karten haben möchte.
Problem 2
Wie schaffe ich es nun, dass die einzelnen Karten immer in einem Quadrat angeordnet werden? Bislang bin ich soweit dass immer eine Reihe mit 10 Stück gelegt wird und dann eine Reihe nach unten gesprungen wird und da wieder das gleiche.
Problem 3
Wie ordne ich nun 2 Imagekomponenten ein gleiches Bild zu, so dass ich nachher schauen kann ob die richtigen Bilder gefunden wurden?
Hier mein Quellcode:

Code: Alles auswählen

var
  Form1: TForm1;
  i,links,oben,kartenanzahl, gelegte_karten,imagezahl:integer;
  arr_Karte:array of TImage ;
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Btn_kartenlegenClick(Sender: TObject);
begin
 
 
 //Karten auslegen
 kartenanzahl:=Strtoint(edt_kartenanzahl.text);
 SetLength(arr_karte, kartenanzahl);
 imagezahl:=0;
  links:=100;
 oben:=100;
  if kartenanzahl mod 2 = 0 then begin
 //Images auslegen
 
   repeat
          arr_Karte[imagezahl]:=Timage.Create(Self);
          arr_Karte[imagezahl].Parent := Self;
          arr_Karte[imagezahl].name := 'Bild_'+ inttostr(imagezahl);
          arr_Karte[imagezahl].Left := links;
          arr_Karte[imagezahl].Top := oben;
          arr_Karte[imagezahl].canvas.pixels[10,10]:=clblack;
          imagezahl:=imagezahl+1;
          links:=links+100;
          if imagezahl mod 10 =0 then begin
           oben:=oben+100;
           links:=100;
          end;
   until imagezahl=kartenanzahl ;
 end
 else begin
  //Anzahl der Memorykarten ungerade
   showmessage('Anzahl der Memorykarten muss gerade sein!(Pärchen)');
 end;
end;
 
end.
 
Ich bin für alle Tips und Tricks offen.
Wir dürfen auch Programme oder Teile des Programms von anderen Programmierern benützen, sofern jemand schon ein ähnliches Programm erstellt hat und es mir zur Verfügung stellt.
Gruß Sadde

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

Memory mit Zahlen - als Bsp., habe mal die Zeilengrößeänderung entsprechend angepasst, hatte gerade Zeit. Viel Erfolg!
Dateianhänge
Memory.zip
(127.41 KiB) 151-mal heruntergeladen

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

herzlichen Dank, ich schau mir das ganze nachher mal genau an und melde mich wieder falls ich nicht mehr weiter komme. :)

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

Hallo Forum,
kam nun dazu mir das Programm von dir anzuschauen. Gar nicht so einfach als "Anfänger" jede Zeile zu verstehen :wink: .
Ich habe nun noch einen Zähler für die benötigten Züge hinzugefügt. Nun möchte ich gerne eine Highscore Liste hinzufügen. Hierfür habe ich nun eine TStringList gewählt. Wenn ich nun einen neuen Eintrag einfügen will bringt er im "spiel" dann eine SIGSEGV Fehlermeldung. in Zeile 132. und ich weiß mir nichtmehr zu helfen :(

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Edit1: TEdit;
    edt_zaehler: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
  Spielfeld:array of integer;   //Spielfeld
  Gleich:array of boolean;      //Wenn Gleich, dann beim zeichnen des Feldes diese Karten aufdecken
  position1,position2:integer;  //Positionen zum Mausklick1 und Mausklick2
  zaehler : integer;            // zählvariable der benötigten Züge
  Kartenpaare:integer;
  sl : TstringList;             // Stringlist für highscore
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure zeichnefeld;
var
  zeilen,spalten,i,j,pos:integer;
begin
  zeilen:=trunc(sqrt(high(spielfeld)));                    //im Idealfall ein quadratisches Feld -> Wurzel aus Karten ziehen
  spalten:=zeilen;
 
  if spalten*zeilen<=high(spielfeld) then inc(Spalten);     //Falls keine quadratische Form, muss zusätzlich eine Spalte eingefügt werden
  if spalten*zeilen<=high(spielfeld) then inc(Zeilen);      //Falls Spielfeld noch nicht reicht, muss zusätzlich eine Zeile eingefügt werden
 
  Form1.Stringgrid1.RowCount:=Zeilen;
  Form1.Stringgrid1.ColCount:=Spalten;
 
//  for i:=0 to Form1.Stringgrid1.RowCount-1 do
//    for j:=0 to Form1.Stringgrid1.ColCount-1 do
//      if i*Form1.Stringgrid1.ColCount+j<=high(Spielfeld) then Form1.Stringgrid1.Cells[j,i]:=inttostr(Spielfeld[i*Form1.Stringgrid1.ColCount+j]);
 
  for i:=0 to Zeilen-1 do
    for j:=0 to Spalten-1 do begin
      pos:=i*Spalten+j;
      if pos<=high(spielfeld) then
        if Gleich[pos] then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos])
                       else Form1.Stringgrid1.Cells[j,i]:='O';
 
      if position1=pos then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos]);
      if position2=pos then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos]);
 
    end;
end;
 
procedure vergibKarten;
var
  i,j:integer;
begin
  for i:=0 to high(Spielfeld) do Spielfeld[i]:=-1; //Erstmal alle Felder auf "neutral" stellen
  for i:=0 to high(spielfeld) do begin             //Jetzt per Zufall jeweils zwei Karten (in diesem Fall Zahlen) im Spielfeld verstecken
 
    j:=random(high(Spielfeld)+1);
    while Spielfeld[j]>-1 do if j>=high(Spielfeld) then j:=0
                                                   else inc(j);
    Spielfeld[j]:=i div 2 + 1;                     //Ab der 1 beginnen, immer paarweise Karten per Zufall vergeben!
  end;
 
  for i:=0 to high(Spielfeld) do Gleich[i]:=false; //bisher gleicht kein Feld dem andern
 
  Position1:=-1;                                   //keine Position vergeben
  Position2:=-1;
end;
 
 
procedure TForm1.Edit1Change(Sender: TObject);
var
  i:integer;
begin
  TryStrToInt(edit1.Text,i);
  if i<2 then i:=2;
  Setlength(Spielfeld,i*2);
  Setlength(Gleich,i*2);
  kartenpaare:=i;
  VergibKarten;
  Zeichnefeld;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
//  Randomize;
  edit1.Text:='8';
  Setlength(Spielfeld,16);
  Setlength(Gleich,16);
  VergibKarten;
  Zeichnefeld;
  zaehler:=0;
end;
 
procedure highscore;
 
begin
 
sl:=TstringList.Create;
 
try
 sl.LoadFromFile(ExtractFileDir('project1.exe')
 +'Kartenpaare'+inttostr(kartenpaare)+'.txt');
finally
  sl.free;
end;
try
([b][u]Hier Fehler[/u][/b])
  sl.Add(Form1.edt_zaehler.text);                     
  sl.Sorted:=true;
  sl.savetofile(ExtractFileDir('project1.exe')
     +'Kartenpaare'+inttostr(kartenpaare)+'.txt');
 finally
  sl.free;
end;
  showmessage('fertig');                 //zur kontrolle
 end;
procedure TForm1.StringGrid1Click(Sender: TObject);
var
  pos,i:integer;
begin
  pos:=Stringgrid1.Row*Form1.Stringgrid1.ColCount+Stringgrid1.Col;
  if pos>high(Spielfeld) then pos:=-1;             //Geht nicht zu nehmen, da Position größer als Spielfeld!
  if pos=position1 then pos:=-1;                   //Geht nicht zu nehmen, da schon geklickt!
  if pos=position2 then pos:=-1;                   //Geht nicht zu nehmen, da schon geklickt!
  if pos>-1 then if Gleich[Pos] then Pos:=-1;      //Geht nicht zu nehmen, da bereits aufgedeckt!
 
  if Pos>-1 then begin
    Form1.Caption:='Pos['+inttostr(pos)+'] - Wert['+inttostr(Spielfeld[pos])+']';
    if position1=-1 then Position1:=Pos
    else begin
      Position2:=Pos;
      zaehler:=zaehler+1;
      edt_zaehler.text:=inttostr(zaehler);
      if Spielfeld[Position2]=Spielfeld[Position1] then begin
        Gleich[Position1]:=true;
        Gleich[Position2]:=true;
 
        i:=0;
        while (i<high(Gleich)) and (Gleich[i]) do inc(i);
        if i=high(Gleich) then begin
              highscore;
          for i:=0 to 19 do begin
            Form1.Caption:='! ! ! Gewonnen ! ! !';
            Form1.Refresh;
            sleep(50);
            Form1.Caption:=' ! !  Gewonnen  ! ! ';
            Form1.Refresh;
            sleep(50);
          end;
          Form1.Edit1Change(nil);
 
        end;
 
      end else begin
        Zeichnefeld;
        Stringgrid1.Refresh;
        sleep(500);
      end;
 
      Position1:=-1;
      Position2:=-1;
    end;
  end else Form1.Caption:='Pos['+inttostr(pos)+'] - geht nicht';
  Zeichnefeld;
end;
 
 
 
end.
 

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

Folgender Code:

Code: Alles auswählen

procedure highscore;
 
begin
 
sl:=TstringList.Create;
 
try
 sl.LoadFromFile(ExtractFileDir('project1.exe')
 +'Kartenpaare'+inttostr(kartenpaare)+'.txt');
finally
  sl.free;  //!!! Achtung hier gibst du den reservierten Speicher von "sl" frei !!!
end;
try
//([b][u]Hier Fehler[/u][/b])
  sl.Add(Form1.edt_zaehler.text);  //!!! Hier greifst du wieder auf "sl" zu, obwohl "sl" jetzt ins Nirgendwo zeigt !!!
kann nicht funktionieren, da "sl" erst frei gegeben werden darf, wenn keine Zugriffe mehr darauf erfolgen!

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

Danke !

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

Hi Leute, nochmal ein kleines Problem:

gerne hätte ich den Schließen Button im Style von Windows in meinem Programm, ist dies möglich?
Zudem einen Button mit dem Hilfe Fragezeichen drauf, mit dem sich die Spieleanleitung aufrufen lässt.
Das Aussehen vom TButtonPanel gefällt mir nur leider finde ich keine Anleitung mit den entsprechenden Funktionen hierfür

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

Sadde hat geschrieben:gerne hätte ich den Schließen Button im Style von Windows in meinem Programm, ist dies möglich?
Das könntest du mittels einem TSpeedbutton lösen und das entsprechende Symbol ins Glyph laden (Schließenbutton z.B. Speedbutton1: Eigenschaft Glyph: Bild laden von... -> Lazarus/Images/Menue/menue_close.png). Fragezeichen analog!
Sadde hat geschrieben:Das Aussehen vom TButtonPanel gefällt mir nur leider finde ich keine Anleitung mit den entsprechenden Funktionen hierfür
Einfach auf Form plazieren und im gewünschten Ereignis reagieren (z.B. ButtonPanel1 -> OKButton.onClick -> ...)

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

Hei Leute, ich melde mich mal wieder;)

Ich sollte in meinem Programm nun noch einen anderen Spielemodus unterbringen. Die top Lösung wäre die Möglichlkeit mit richtigen Bilderpärchen zu spielen.
Die einfachere Lösung wäre wohl andere Zeichentypen wie Buchstaben zu sein. Die Bilder haben aber eigentlich Vorrang. habt ihr mir eine Idee wie ich das ganze Löse. Kann ich in das Stringgrid Bilder einfügen, wie vergleiche ich die Bilder etc...Um Ideen, Lösungsmöglichkeiten wär ich sehr dankbar!

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

Dazu würde ich nicht die Stringrid verwenden, würde das Ganze nur unnötig komplizierter machen.

Mein Ansatz wäre:
- x Bilder (möglichst alle eine Größe) in einer TImageList laden und vorhalten (ein Array of TBitmap würde z.B. auch gehen)
- Spielfeldgröße analog jetzigem Spiel definieren
- 2 Array of (z.B. boolean oder byte oder..), eins für dein Spielfeld, wo welches Bild liegt (jedes Bild musst du ja von irgendwo laden, diese Stelle im Array oder so, kann geich für den Vergleich genutzt werden) und eins für aufgedeckt/verdeckt
- Spielfeld ist aber kein Stringgrid mehr sondern ein Canvas (Paintbox oder Form1) (müsstest dann aus den x- und y- Koordinaten die jeweilige Bildposition berechnen)
- im onPaint-Ereignis der Form entsprechend deiner "Array of" die Bilder aufs Canvas zeichnen
- im onMouseDown-Ereignis der Form anhand der x- und y-Koordinaten die Spielfeldstelle errechnen und aufdecken

So, nun hab ich aber genug Hausaufgaben gemacht...

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Benutzeravatar
m.fuchs
Lazarusforum e. V.
Beiträge: 2811
Registriert: Fr 22. Sep 2006, 19:32
OS, Lazarus, FPC: Winux (Lazarus 2.0.10, FPC 3.2.0)
CPU-Target: x86, x64, arm
Wohnort: Berlin
Kontaktdaten:

Re: Memory-Spiel

Beitrag von m.fuchs »

Warum wird eigentlich so häufig die Nutzung von Canvas empfohlen? Besser wäre für so ein Spiel doch ein DrawGrid.

ImageList und ein Array zum Halten der Daten ist schon eine gute Idee. Beim DrawGrid kann man OnDrawCell dazu benutzen für jedes Feld das passende Bild auszugeben. Abhängig davon ob es gerade aufgedeckt ist oder nicht.
Die Position kann man dann mit MouseToCell direkt auf ein Feld umrechnen lassen.
Software, Bibliotheken, Vorträge und mehr: https://www.ypa-software.de

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

m.fuchs hat geschrieben:Besser wäre für so ein Spiel doch ein DrawGrid.
+1

Ist in diesem Fall besser und auf das bisherige Bsp sehr einfach umsetzbar, hatte ich nicht dran gedacht :roll: !

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Benutzeravatar
m.fuchs
Lazarusforum e. V.
Beiträge: 2811
Registriert: Fr 22. Sep 2006, 19:32
OS, Lazarus, FPC: Winux (Lazarus 2.0.10, FPC 3.2.0)
CPU-Target: x86, x64, arm
Wohnort: Berlin
Kontaktdaten:

Re: Memory-Spiel

Beitrag von m.fuchs »

Sollte auch gar nicht als scharfe Kritik herüberkommen. Mich wundert es halt, dass häufig kein Grid benutzt/empfohlen wird wo eines sinnvoll wäre. Entweder ist es zu wenig bekannt oder die Einstiegshürde zu hoch.
Software, Bibliotheken, Vorträge und mehr: https://www.ypa-software.de

Sadde
Beiträge: 9
Registriert: Fr 14. Jun 2013, 15:59

Re: Memory-Spiel

Beitrag von Sadde »

So nun bin ich schon ein ganzes Stück weiter. Mein Programm hat erfolgreich compiliert, jedoch tut es nicht das was es soll und ich weiß nicht warum.
Sobald ich den Modus mit den Bildern auswähle erscheint das drawgrid mit den entsprechenden Voreinstellungen. Wenn ich drauf Klicke passiert garnichts :(
Die Bilder werden aber scheinbar im Hintergrund geladen, daran kann es nicht liegen.
Ich hoffe ihr könnt mir nochmals helfen.

Code: Alles auswählen

 
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Windows, Messages,Classes, Variants,SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ExtCtrls, Buttons, Menus;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
 
    btn_zahlenmodus: TButton;
    Btn_Bildermodus: TButton;
    DrawGrid: TDrawGrid;
 
    Edit1: TEdit;
    edt_zaehler: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    MainMenu1: TMainMenu;
    itemNewGame: TMenuItem;
    MenuItem_neuesspiel: TMenuItem;
    MenuItem_Hilfe: TMenuItem;
    MenuItem3_platzhalter: TMenuItem;
    MenuItem_schliesen: TMenuItem;
 
    StringGrid1: TStringGrid;
 
    procedure Btn_BildermodusClick(Sender: TObject);
 
    procedure btn_zahlenmodusClick(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure itemNewGameClick(Sender: TObject);
    procedure MenuItem_HilfeClick(Sender: TObject);
    procedure MenuItem_neuesspielClick(Sender: TObject);
    procedure MenuItem_schliesenClick(Sender: TObject);
 
    procedure StringGrid1Click(Sender: TObject);
 
 
 
     procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DrawGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end;
type
  TCellMode = (ALREADY_MATCHED, CELL_VISIBLE, CELL_INVISIBLE);
const
        MAX_IMAGES = 10;
var
  Form1: TForm1;
  Spielfeld:array of integer;   //Spielfeld
  Gleich:array of boolean;      //Wenn Gleich, dann beim zeichnen des Feldes diese Karten aufdecken
  position1,position2:integer;  //Positionen zum Mausklick1 und Mausklick2
  zaehler : integer;            // zählvariable der benötigten Züge
  Kartenpaare:integer;
  sl : TstringList;             // Stringlist für highscore
 
 
 
    Images : array [0..MAX_IMAGES-1] of TImage;
  RandomPermutationArray : array [0..19] of integer;
  PartnerOf : array [0..19] of integer;
  ImageOfCell : array [0..19] of integer;
  ModeOfCell : array [0..19] of TCellMode;
  FirstCell, SecondCell : integer;
  NumberOfVisibleCells : integer;
 
  ImagePaths : array [0..MAX_IMAGES-1] of string
 
  = ('img0.bmp', 'img1.bmp', 'img2.bmp', 'img3.bmp', 'img4.bmp', 'img5.bmp',
        'img6.bmp', 'img7.bmp', 'img8.bmp', 'img9.bmp');
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure RedrawCell (index : integer);
var
  Col, Row : integer;
begin
  Row := index div 5;
  Col := index mod 5;
 
  Form1.DrawGridDrawCell(Form1, Col, Row, Form1.DrawGrid.CellRect(Col,Row), [])
end;
 
procedure LoadImages;
var
  i : integer;
begin
  for i := 0 to MAX_IMAGES-1 do
  begin
    Images[i] := TImage.Create(nil);
    Images[i].Picture.LoadFromFile(ExtractFileDir('project1.exe')+ImagePaths[i])
  end
end;
 
function LinearIndexOf (Row, Column : integer) : integer;
begin
  Result := 5 * Row + Column
end;
 
procedure RandomizeThePermutationArray;
var
  i, RandomPosition, Temp : integer;
begin
  for i := 0 to 18 do
  begin
    RandomPosition := i + Random(19 - i) + 1;
 
    Temp := RandomPermutationArray[i];
    RandomPermutationArray[i] := RandomPermutationArray[RandomPosition];
    RandomPermutationArray[RandomPosition] := Temp
  end;
end;
 
procedure AssignPartnerships;
var
  i : integer;
begin
  for i := 0 to 19 do
    if i mod 2 = 0 then
      PartnerOf[RandomPermutationArray[i]] := RandomPermutationArray[i + 1]
    else
      PartnerOf[RandomPermutationArray[i]] := RandomPermutationArray[i - 1]
end;
 
procedure AssignImagesToCells;
var
  i : integer;
begin
  for i := 0 to 19 do
    ImageOfCell[RandomPermutationArray[i]] := i div 2
end;
 
procedure InitializeCellModes;
var
  i : integer;
begin
  for i := 0 to 19 do
    ModeOfCell[i] := CELL_INVISIBLE
end;
 
procedure TForm1.itemNewGameClick(Sender: TObject);
var
  i : integer;
begin
  RandomizeThePermutationArray;
  AssignPartnerships;
  AssignImagesToCells;
  InitializeCellModes;
 
  NumberOfVisibleCells := 0;
 
  for i := 0 to 19 do
    RedrawCell(i);
end;
 
procedure TForm1.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  index : integer;
begin
  index := LinearIndexOf(ARow, ACol);
 
  if ModeOfCell[index] = CELL_INVISIBLE then
  begin
    DrawGrid.Canvas.Brush.Color := clBlack;
    DrawGrid.Canvas.FillRect(Rect)
  end
  else if ModeOfCell[index] = ALREADY_MATCHED then
  begin
    DrawGrid.Canvas.Brush.Color := clWhite;
    DrawGrid.Canvas.FillRect(Rect)
  end
  else begin
    DrawGrid.Canvas.StretchDraw(Rect, Images[ImageOfCell[index]].Picture.Graphic);
  end
end;
 
procedure TForm1.DrawGridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
var
  index : integer;
begin
  index := LinearIndexOf(ARow, ACol);
 
  if ModeOfCell[index] = ALREADY_MATCHED then
    exit;
 
  if NumberOfVisibleCells = 0 then
  begin
    FirstCell := index;
    ModeOfCell[FirstCell] := CELL_VISIBLE;
    RedrawCell(FirstCell);
    inc(NumberOfVisibleCells)
  end
  else if (NumberOfVisibleCells = 1) and (FirstCell <> index) then
  begin
    SecondCell := index;
 
    ModeOfCell[SecondCell] := CELL_VISIBLE;
    RedrawCell(SecondCell);
 
    if PartnerOf[SecondCell] = FirstCell then
    begin
      Sleep(100);
 
      ModeOfCell[FirstCell] := ALREADY_MATCHED;
      RedrawCell(FirstCell);
 
      ModeOfCell[SecondCell] := ALREADY_MATCHED;
      RedrawCell(SecondCell);
 
      NumberOfVisibleCells := 0
    end
    else
    inc(NumberOfVisibleCells)
  end
  else begin
   if (FirstCell <> index) and (SecondCell <> index) then
   begin
     ModeOfCell[index] := CELL_VISIBLE;
     RedrawCell(index);
   end;
 
   if FirstCell <> index then
   begin
     ModeOfCell[FirstCell] := CELL_INVISIBLE;
     RedrawCell(FirstCell);
   end;
 
   if SecondCell <> index then
   begin
     ModeOfCell[SecondCell] := CELL_INVISIBLE;
     RedrawCell(SecondCell);
   end;
 
 
   FirstCell := index;
 
   NumberOfVisibleCells := 1
  end
end;
 
 
 
procedure modiwahl_aus;
 
begin
  form1.label1.Visible:=true;
  form1.edit1.Visible:=true;
  form1.label2.Visible:=true;
  form1.edt_zaehler.Visible:=true;
 
  form1.stringgrid1.Visible:=true;
  Form1.btn_zahlenmodus.visible:=false;
  Form1.Btn_Bildermodus.visible:=false;
end;
 
procedure modiwahl_an;
 
begin
 form1.label1.Visible:=false;
  form1.edit1.Visible:=false;
  form1.label2.Visible:=false;
  form1.edt_zaehler.Visible:=false;
  form1.DrawGrid.visible:=false;
  form1.stringgrid1.Visible:=false;
  Form1.btn_zahlenmodus.visible:=true;
  Form1.Btn_Bildermodus.visible:=true;
end;
 
procedure zeichnefeld;
var
  zeilen,spalten,i,j,pos:integer;
begin
  Form1.Caption:= 'Memory v 1.0';
  zeilen:=trunc(sqrt(high(spielfeld)));                    //im Idealfall ein quadratisches Feld -> Wurzel aus Karten ziehen
  spalten:=zeilen;
 
  if spalten*zeilen<=high(spielfeld) then inc(Spalten);     //Falls keine quadratische Form, muss zusätzlich eine Spalte eingefügt werden
  if spalten*zeilen<=high(spielfeld) then inc(Zeilen);      //Falls Spielfeld noch nicht reicht, muss zusätzlich eine Zeile eingefügt werden
 
  Form1.Stringgrid1.RowCount:=Zeilen;
  Form1.Stringgrid1.ColCount:=Spalten;
 
//  for i:=0 to Form1.Stringgrid1.RowCount-1 do
//    for j:=0 to Form1.Stringgrid1.ColCount-1 do
//      if i*Form1.Stringgrid1.ColCount+j<=high(Spielfeld) then Form1.Stringgrid1.Cells[j,i]:=inttostr(Spielfeld[i*Form1.Stringgrid1.ColCount+j]);
 
  for i:=0 to Zeilen-1 do
    for j:=0 to Spalten-1 do begin
      pos:=i*Spalten+j;
      if pos<=high(spielfeld) then
        if Gleich[pos] then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos])
                       else Form1.Stringgrid1.Cells[j,i]:='O';
 
      if position1=pos then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos]);
      if position2=pos then Form1.Stringgrid1.Cells[j,i]:=inttostr(spielfeld[pos]);
 
    end;
 
end;
 
 
 
procedure vergibKarten;
var
  i,j:integer;
begin
  for i:=0 to high(Spielfeld) do Spielfeld[i]:=-1; //Erstmal alle Felder auf "neutral" stellen
  for i:=0 to high(spielfeld) do begin             //Jetzt per Zufall jeweils zwei Karten (in diesem Fall Zahlen) im Spielfeld verstecken
 
    j:=random(high(Spielfeld)+1);
    while Spielfeld[j]>-1 do if j>=high(Spielfeld) then j:=0
                                                   else inc(j);
    Spielfeld[j]:=i div 2 + 1;                     //Ab der 1 beginnen, immer paarweise Karten per Zufall vergeben!
  end;
 
  for i:=0 to high(Spielfeld) do Gleich[i]:=false; //bisher gleicht kein Feld dem andern
 
  Position1:=-1;                                   //keine Position vergeben
  Position2:=-1;
end;
 
procedure TForm1.Edit1Change(Sender: TObject);
var
  i:integer;
begin
  TryStrToInt(edit1.Text,i);
  if i<2 then i:=2;
  Setlength(Spielfeld,i*2);
  Setlength(Gleich,i*2);
  kartenpaare:=i;
  VergibKarten;
  Zeichnefeld;
  form1.edt_zaehler.text:=inttostr(0);
  end;
 
 
procedure TForm1.Btn_BildermodusClick(Sender: TObject);
begin
     form1.label1.Visible:=false;
  form1.edit1.Visible:=false;
  form1.label2.Visible:=false;
  form1.edt_zaehler.Visible:=false;
 
  form1.drawgrid.Visible:=true;
  Form1.btn_zahlenmodus.visible:=false;
  Form1.Btn_Bildermodus.visible:=false;
end;
 
procedure TForm1.btn_zahlenmodusClick(Sender: TObject);           // Modiauswahl zu Beginn
begin
  modiwahl_aus;
end;
 
 
 
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
     LoadImages;
 
  for i := 0 to 19 do
    RandomPermutationArray[i] := i;
 
  Randomize;
 
  itemNewGame.Click ;
 
 
  //  Randomize;
  edit1.Text:='8';
  Setlength(Spielfeld,16);
  Setlength(Gleich,16);
  VergibKarten;
  Zeichnefeld;
  zaehler:=0;
end;
 
procedure TForm1.MenuItem_HilfeClick(Sender: TObject);
begin
   showmessage('Dies ist ein klassisches Memory-Spiel.'+
   'Der Spieler klickt nacheinander zwei verdeckte Felder an, die darunter versteckten Zahlen erscheinen. Ziel ist es Kartenpaare zu finden.'+
   'Dabei soll der Spieler möglichst wenig Züge hierfür benötigen. Die benötigten Züge werden rechts oben angezeigt.');
end;
 
procedure TForm1.MenuItem_neuesspielClick(Sender: TObject);
begin
 modiwahl_an;
end;
 
procedure TForm1.MenuItem_schliesenClick(Sender: TObject);
begin
   application.terminate;
end;
 
 
 
procedure highscore;
 
begin
 
sl:=TstringList.Create;
 
try
  if FileExists((ExtractFileDir('project1.exe')
 +'Kartenpaare'+inttostr(kartenpaare)+'.txt'))then begin
  sl.LoadFromFile(ExtractFileDir('project1.exe')
 +'Kartenpaare'+inttostr(kartenpaare)+'.txt'); end
  else begin
   sl.savetofile(ExtractFileDir('project1.exe')
     +'Kartenpaare'+inttostr(kartenpaare)+'.txt');
  end;
  sl.Add(Form1.edt_zaehler.text +' benötigte Züge..........'+datetostr(now)+','+timetostr(now));
 
  sl.Sorted:=true;
  application.MessageBox(PChar(sl.Text),'Highscoreliste',0);
  sl.savetofile(ExtractFileDir('project1.exe')
     +'Kartenpaare'+inttostr(kartenpaare)+'.txt');
finally
   sl.free;
end;
 
 end;
procedure TForm1.StringGrid1Click(Sender: TObject);
var
  pos,i:integer;
begin
 
  pos:=Stringgrid1.Row*Form1.Stringgrid1.ColCount+Stringgrid1.Col;
  if pos>high(Spielfeld) then pos:=-1;             //Geht nicht zu nehmen, da Position größer als Spielfeld!
  if pos=position1 then pos:=-1;                   //Geht nicht zu nehmen, da schon geklickt!
  if pos=position2 then pos:=-1;                   //Geht nicht zu nehmen, da schon geklickt!
  if pos>-1 then if Gleich[Pos] then Pos:=-1;      //Geht nicht zu nehmen, da bereits aufgedeckt!
 
  if Pos>-1 then begin
 // Form1.Caption:='Pos['+inttostr(pos)+'] - Wert['+inttostr(Spielfeld[pos])+']';
    if position1=-1 then Position1:=Pos
    else begin
      Position2:=Pos;
      zaehler:=zaehler+1;
      edt_zaehler.text:=inttostr(zaehler);
      if Spielfeld[Position2]=Spielfeld[Position1] then begin
        Gleich[Position1]:=true;
        Gleich[Position2]:=true;
        i:=0;
        while (i<high(Gleich)) and (Gleich[i]) do inc(i);
        if i=high(Gleich) then begin
 
          for i:=0 to 5 do begin
            Form1.Caption:='! ! ! Gewonnen ! ! !';
            Form1.Refresh;
            sleep(50);
            Form1.Caption:=' ! !  Gewonnen  ! ! ';
            Form1.Refresh;
            sleep(50);
          end;
          highscore;
          Form1.Caption:=' ! !  Neuer Versuch  ! ! ';
          Form1.Edit1Change(nil);
          edt_zaehler.text:=inttostr(0);
          zaehler:=0;
          modiwahl_an;
        end;
 
      end else begin
        Zeichnefeld;
        Stringgrid1.Refresh;
 
        sleep(500);
 
 
      end;
 
      Position1:=-1;
      Position2:=-1;
    end;
  end else Form1.Caption:='Pos['+inttostr(pos)+'] - geht nicht';
  Zeichnefeld;
end;
 
 
 
end.
 
 
 

Michl
Beiträge: 2511
Registriert: Di 19. Jun 2012, 12:54

Re: Memory-Spiel

Beitrag von Michl »

Kannst du das Problem eingrenzen oder das Projekt als .zip posten, glaube nicht, dass sich jemand durch den kompletten Code liest...

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection;  

Antworten