CSANecromancer
Erfahrenes Mitglied
Tja, sorry, aber nur explizit den Part mit der Berechnung der Zahlenwerte extrahieren funktioniert leider nicht, da ich den Generator komplett selber gebastelt habe und von daher auch ganz andere Algorithmen benutzt habe. Aber ich kann dir den Source von mir posten.
Das Formular dazu sieht ganz einfach aus:
Fomular selbst:
Name: Main
Darauf ein TImage:
Name: Image
Und ein TButton:
Name: btGenerate
Caption: "Generate..."
Und hier der Source dazu:
Damit kannst du mal vergleichen und schauen, wo dann bei dir den Haken war.
Das Formular dazu sieht ganz einfach aus:
Fomular selbst:
Name: Main
Darauf ein TImage:
Name: Image
Und ein TButton:
Name: btGenerate
Caption: "Generate..."
Und hier der Source dazu:
Code:
{*-----------------------------------------------------------------------------
Kakuro Generator
Auch bekannt als "Kreuzworträtsel für Legastheniker"
@author The Necromancer
@version 0.2
-----------------------------------------------------------------------------*}
unit Dialogs.Main;
interface uses
Classes, Controls, Dialogs, ExtCtrls, Forms, Graphics, Messages,
StdCtrls, StrUtils, SysUtils, Variants, Windows;
type
{*-----------------------------------------------------------------------------
Record für ein einzelnes Feld des Kakurospielfelds
-----------------------------------------------------------------------------*}
TKakuroField = record
public
Name: String;
Value: Integer;
end;
type
{*-----------------------------------------------------------------------------
Klassendefinition für das Hauptformular
-----------------------------------------------------------------------------*}
TMain = class(TForm)
Image: TImage;
btGenerate: TButton;
procedure FormCreate(Sender: TObject);
procedure btGenerateClick(Sender: TObject);
private
PlayingField: array[0..12, 0..12] of TKakuroField;
procedure ReadingPlayingFieldTemplate(const p_Field: TStringList);
procedure PlayingFieldGenerate;
procedure PlayingFieldDraw;
procedure DrawGrid;
procedure DrawBlock( const p_X: Integer;
const p_Y: Integer;
const p_Color: TColor);
function IsInRow(const p_Value: Integer;
const p_x: Integer;
const p_y: Integer): boolean;
function IsInColumn(const p_Value: Integer;
const p_x: Integer;
const p_y: Integer): boolean;
function HorizontalSum(const p_x: Integer;
const p_y: Integer): Integer;
function VerticalSum(const p_x: Integer;
const p_y: Integer): Integer;
end;
var
{*-----------------------------------------------------------------------------
Objektdefinition für die Klasse des Hauptformulars
-----------------------------------------------------------------------------*}
Main: TMain;
implementation
{$R *.dfm}
{*-----------------------------------------------------------------------------
Wird vom Konstruktor aufgerufen
@param Sender Handle auf das aufrufende Objekt
-----------------------------------------------------------------------------*}
procedure TMain.FormCreate(Sender: TObject);
var
strlTemplate: TStringList;
x, y: Integer;
begin
// Um unschönes Flackern beim Neuzeichnen des Programms zu vermeiden
self.DoubleBuffered := true;
// Wird nur hier und einmalig aufgerufen, so wie es auch in der
// Delphi-Hilfe steht
Randomize;
// In der Stringlist mit dem Template steht die Struktur des
// Kakuro-Feldes drin. Anhand dieses Templates wird das
// Spielfeld erstmal grundlegend eingerichtet.
strlTemplate := TStringList.Create;
strlTemplate.Clear;
strlTemplate.Add('MMMSSSSMMSSS');
strlTemplate.Add('MMSNNNNSSNNN');
strlTemplate.Add('MSNNNNNNSNNN');
strlTemplate.Add('SNNSNNNSNNMM');
strlTemplate.Add('SNNSSNNSNNSS');
strlTemplate.Add('MSNNSNNSNNNN');
strlTemplate.Add('SNNNNNSNNNNN');
strlTemplate.Add('SNNNNSNNSNNS');
strlTemplate.Add('MMSNNSNNSSNN');
strlTemplate.Add('MSSNNNSNNSNN');
strlTemplate.Add('SNNNSNNNNNNM');
strlTemplate.Add('SNNNMSNNNNMM');
ReadingPlayingFieldTemplate(strlTemplate);
FreeAndNil(strlTemplate);
// Ich mag es nicht, eine graphische Ausgabe direkt auf den Canvas
// des Formulars zu zeichnen. Lieber kapsel ich das Ganze in die Bitmap
// eines unskalierten TImage.
// Damit ich aber (ohne ein Bild explizit zu laden), mit der Bitmap
// des TImage arbeiten kann, muß ich es erstmal einrichten, wobei das
// wichtigste die Zuweisung von Breite und Höhe ist.
// Die Zahlenwerte kommen daher:
// Breite des Spielfeldes: 12 Felder
// Höhe des SpielfeldeS: 12 Felder
// Pixelgrösse eines einzelnen Feldes des Spielfelds: 32x32
Image.Picture.Bitmap.Width := 12 * 32;
Image.Picture.Bitmap.Height := 12 * 32;
// Gitterraster in das Spielfeld einzeichnen
// Dabei wird die Anzeige des Spielfelds automatisch gelöscht
DrawGrid;
// Das geladene Template wird auf dem Spielfeld angezeigt, ohne daß dabei
// die Ziffernwerte der Spielfelder berücksichtigt werden.
for y := 0 to 11 do
begin
for x := 0 to 11 do
begin
if PlayingField[y][x].Name = 'M' then DrawBlock(x, y, clBlack)
else if PlayingField[y][x].Name = 'S' then Image.Picture.Bitmap.Canvas.TextOut(x * 32 + 6, y * 32 + 6, 'S')
else if PlayingField[y][x].Name = 'N' then DrawBlock(x, y, clSilver)
else DrawBlock(x, y, clRed);
end;
end;
end;
{*-----------------------------------------------------------------------------
Aktionsmethode des Buttons "Generate..."
In dieser Methode wird das eigentliche Spielfeld generiert und ggf.
angezeigt. Sehr einfach gehalten.
@param Sender Handle auf das aufrufende Objekt
-----------------------------------------------------------------------------*}
procedure TMain.btGenerateClick(Sender: TObject);
begin
Screen.Cursor := crHourglass;
btGenerate.Enabled := false;
PlayingFieldGenerate;
Screen.Cursor := crDefault;
btGenerate.Enabled := true;
end;
{*-----------------------------------------------------------------------------
Übertragen des Templates auf das Spielfeld
Wie der Methodenname schon sagt. Allerdings wird das Spielfeld vorher
noch sauber mit Leerwerten initialisiert.
@param Sender Handle auf das aufrufende Objekt
-----------------------------------------------------------------------------*}
procedure TMain.ReadingPlayingFieldTemplate(const p_Field: TStringList);
var
x, y: Integer;
begin
// Leeren des Spielfelds
for y := 0 to 11 do
begin
for x := 0 to 11 do
begin
PlayingField[y][x].Value := -1;
PlayingField[y][x].Name := '';
end;
end;
// Übernehmen der Spielfeldnamen aus dem Template
for y := 0 to p_Field.Count - 1 do
begin
for x := 0 to Length(p_Field.Strings[y]) - 1 do
PlayingField[y][x].Name := MidStr(p_Field.Strings[y], x + 1, 1);
end;
end;
{*-----------------------------------------------------------------------------
Erzeugen des Spielfelds
Für eine genauere Beschreibung kommentiere ich die Funktion direkt im
Source. Hier nur eine Beschreibung des verwendeten Variablen:
x, y: Die X- und Y-Koordinate des aktuell betrachteten Feldes
nTempWert: Übernimmt zeitweilig die neue Zufallszahl, die in das
Feld geschrieben werden soll.
bEingetragen: Flag ob der neue Wert in das Feld eingetragen werden konnte.
bUnsuccessful: Flag ob das Kakuro nicht mehr erstellt werden kann.
nTryCounter: Zähler wie oft versucht wurde, einen neuen Wert in das
aktuell betrachtete Feld zu schreiben.
@param Sender Handle auf das aufrufende Objekt
-----------------------------------------------------------------------------*}
procedure TMain.PlayingFieldGenerate;
var
x, y: Integer;
nTempWert: Integer;
bEingetragen: boolean;
bUnsuccessful: boolean;
nTryCounter: Integer;
begin
// Generell wird davon ausgegangen, daß das Spielfeld erstellt
// werden kann.
bUnsuccessful := false;
// Nochmal Leeren der Zahlenwerte der einzelnen Felder.
// Ist dafür gut, daß durch erneutes Klicken auf "Generate..."
// unterschiedliche Kakuros auf das gleiche Template gebastelt
// werden können.
for y := 0 to 11 do
for x := 0 to 11 do
PlayingField[y][x].Value := -1;
// Zeile für Zeile...
for y := 0 to 11 do
// ...und pro Zeile Feld für Feld
for x := 0 to 11 do
if PlayingField[y][x].Name = 'N' then
begin
// Für jedes Feld wird neu versucht, einen Zufallswert
// reinzuschreiben
nTryCounter := 0;
// Logisch, daß bislang noch kein neuer Zufallswert
// reingeschrieben wurde.
bEingetragen := false;
// Solche Bedingungen mag ich. Die sind einfach zu lesen
// und zu verstehen.
// Solange noch kein neuer Wert eingetragen wurde und das
// Kakuro noch nicht als unlösbar bewertet wurde, wird
// versucht, einen neuen Wert reinzuschreiben.
while (not bEingetragen) and
(not bUnsuccessful) do
begin
nTempWert := Random(9) + 1;
Inc(nTryCounter);
// Wenn auch nach 100 Versuchen noch kein passender
// neuer Wert gefunden wurde, dann wird das Kakuro
// als nicht lösbar gewertet
if nTryCounter > 100 then
bUnsuccessful := true;
// Auch die Bedingung sollte direkt verständlich sein:
// Die beiden Funktionen prüfen, ob der gewählte neue
// Zufallswert schon in der Zeile und/oder der Spalte
// vorkommt. Wenn nein, dann wird er eingetragen.
if ((not IsInRow(nTempWert, x, y)) and
(not IsInColumn(nTempWert, x, y))) then
begin
PlayingField[y][x].Value := nTempwert;
bEingetragen := true;
end;
end;
end;
// Falls das Kakuro gebaut werden konnte, wird es angezeigt...
if not bUnsuccessful then
PlayingFieldDraw
// ...andernfalls wird das Spielfeld gelöscht und eine entsprechende
// Hinweismeldung ausgegeben.
else
begin
DrawGrid;
ShowMessage('Generating unsuccessful.' + #13 + 'Ran into an unsolvable puzzle.');
end;
end;
{*-----------------------------------------------------------------------------
Prüfen des neuen Zahlenwerts auf die Zeile
Die Vorgehensweise ist sehr direkt: Es werden für die Zeile der Start- und
der Endpunkt in Relation zum angewählten Feld bestimmt. Der Startpunkt ist
das links vom angewählten Feld liegende Summenfeld + 1 und der Endpunkt
entsprechend das rechts vom angewählten Feld liegende Feld, das keine Zahlen
beinhaltet - 1. Es muß nur aufgepasst werden, daß die Spielfeldbegrenzungen
korrekt erkannt werden.
Sobald Anfang und Ende bekannt sind, wird einfach geschaut, ob der
übergebene (neue) Zahlenwert schon vorkommt oder nicht.
@param p_Value Der neue Zahlenwert, der überprüft werden soll
@param p_X X-Koordinate des angewählten Feldes
@param p_Y Y-Koordinate des angewählten Feldes
@return Flag ob der Wert schon vorhanden ist
-----------------------------------------------------------------------------*}
function TMain.IsInRow(const p_Value: Integer;
const p_x: Integer;
const p_y: Integer): boolean;
var
RowStart: Integer;
RowEnd: Integer;
i: Integer;
begin
// Sicher ist sicher, daher die Initialisierung
RowStart := 0;
RowEnd := 0;
// Ermitteln des Startpunkts
if p_x > 0 then
for i := p_x downto 0 do
if PlayingField[p_y][i].Name <> 'N' then
begin
RowStart := i + 1;
break;
end;
// Ermitteln des Endpunkts
if p_x <= 11 then
for i := p_x to 11 do
if i = 11 then
RowEnd := 11
else if PlayingField[p_y][i].Name <> 'N' then
begin
RowEnd := i - 1;
break;
end;
// Sicherstellen, daß die Spielfeldgrenzen gewahrt bleiben
if RowStart < 0 then RowStart := 0;
if RowStart > 11 then RowStart := 11;
if RowEnd < 0 then RowEnd := 0;
if RowEnd > 11 then RowEnd := 11;
// Rückgabewertermittlung, ob es den Wert des ausgewählten
// Feldes in der Reihe schon gibt oder nicht.
Result := false;
for i := RowStart to RowEnd do
if PlayingField[p_y][i].Value = p_Value then
Result := true;
end;
{*-----------------------------------------------------------------------------
Prüfen des neuen Zahlenwerts auf die Spalte
Funktioniert genauso wie die Reihenprüfung, weswegen ich mir eine exzessive
Dokumentation spare.
@param p_Value Der neue Zahlenwert, der überprüft werden soll
@param p_X X-Koordinate des angewählten Feldes
@param p_Y Y-Koordinate des angewählten Feldes
@return Flag ob der Wert schon vorhanden ist
-----------------------------------------------------------------------------*}
function TMain.IsInColumn(const p_Value: Integer;
const p_x: Integer;
const p_y: Integer): boolean;
var
ColStart: Integer;
ColEnd: Integer;
i: Integer;
begin
ColStart := 0;
ColEnd := 0;
if p_y > 0 then
for i := p_y downto 0 do
if PlayingField[i][p_x].Name <> 'N' then
begin
ColStart := i + 1;
break;
end;
if p_y <= 11 then
for i := p_y to 11 do
if i = 11 then
ColEnd := 11
else if PlayingField[i][p_x].Name <> 'N' then
begin
ColEnd := i - 1;
break;
end;
if ColStart < 0 then ColStart := 0;
if ColStart > 11 then ColStart := 11;
if ColEnd < 0 then ColEnd := 0;
if ColEnd > 11 then ColEnd := 11;
Result := false;
for i := ColStart to ColEnd do
if PlayingField[i][p_x].Value = p_Value then
Result := true;
end;
{*-----------------------------------------------------------------------------
Zeichnen des Spielfeldes
Macht fast das gleiche wie das Zeichnen des Templates, nur daß diesmal
die Zahlenwerte der Felder mit angegeben werden und die Summenfelder auch
passend beschriftet werden.
-----------------------------------------------------------------------------*}
procedure TMain.PlayingFieldDraw;
var
x, y: Integer;
Text: String;
pCanvas: TCanvas;
begin
pCanvas := Image.Picture.Bitmap.Canvas;
// Gitterraster einzeichnen (und damit das Spielfeld löschen)
DrawGrid;
// Und wieder: Zeile für Zeile...
for y := 0 to 11 do
// ...und pro Zeile Feld für Feld
for x := 0 to 11 do
// Blockfelder werden einfach als schwarze Kästchen dargestellt
if PlayingField[y][x].Name = 'M' then
DrawBlock(x, y, clBlack)
// Zahlenfelder bekommen einen grauen Hintergrund und danach
// wird der Zahlenwert reingeschrieben
else if PlayingField[y][x].Name = 'N' then
begin
DrawBlock(x, y, clSilver);
Text := IntToStr(PlayingField[y][x].Value);
pCanvas.Brush.Style := bsClear;
pCanvas.TextOut(x * 32 + 8, y * 32 + 6, Text);
pCanvas.Brush.Style := bsSolid;
end
// Es stimmt irgendwas nicht mit dem Feld, also wird es
// rot gefärbt.
else if PlayingField[y][x].Name <> 'S' then
DrawBlock(x, y, clRed);
// Jetzt kommen noch die Summenfelder dran
pCanvas.Font.Size := 8;
// Der Durchlauf ist ja bekannt
for y := 0 to 11 do
begin
for x := 0 to 11 do
begin
if PlayingField[y][x].Name = 'S' then
begin
// Falls eine Horizontalsumme vorhanden ist: Anzeigen
if HorizontalSum(x, y) > 0 then
pCanvas.TextOut(x * 32 + 18, y * 32 + 2, IntToStr(HorizontalSum(x, y)));
// Falls eine Vertikalsumme vorhanden ist: Anzeigen
if VerticalSum(x, y) > 0 then
pCanvas.TextOut(x * 32 + 2, y * 32 + 18, IntToStr(VerticalSum(x, y)));
// Zeichnen der schwarzen Schräglinie bei Summenfeldern
pCanvas.Pen.Color := clBlack;
pCanvas.MoveTo(x * 32, y * 32);
pCanvas.LineTo(x * 32 + 32, y * 32 + 32);
pCanvas.Pen.Color := clWhite;
end;
end;
end;
// Die gesamte Spielfläche neu zeichnen
Image.Invalidate;
end;
{*-----------------------------------------------------------------------------
Bestimmen der horizontalen Summe eines Summenfeldes
@param p_X X-Spielfeldkoordinate des Summenfeldes
@param p_Y Y-Spielfeldkoordinate des Summenfeldes
@return Horizontalsumme
-----------------------------------------------------------------------------*}
function TMain.HorizontalSum(const p_x: Integer;
const p_y: Integer): Integer;
var
i: Integer;
begin
Result := 0;
for i := p_x + 1 to 11 do
begin
if PlayingField[p_y][i].Name = 'N' then
Result := Result + PlayingField[p_y][i].Value
else
break;
end;
end;
{*-----------------------------------------------------------------------------
Bestimmen der vertikalen Summe eines Summenfeldes
@param p_X X-Spielfeldkoordinate des Summenfeldes
@param p_Y Y-Spielfeldkoordinate des Summenfeldes
@return Vertikalsumme
-----------------------------------------------------------------------------*}
function TMain.VerticalSum(const p_x: Integer;
const p_y: Integer): Integer;
var
i: Integer;
begin
Result := 0;
for i := p_y + 1 to 11 do
begin
if PlayingField[i][p_x].Name = 'N' then
Result := Result + PlayingField[i][p_x].Value
else
break;
end;
end;
{*-----------------------------------------------------------------------------
Zeichnen eines Blocks in einem Feld des Spielfelds
Der wesentliche Punkt ist nur, daß dabei die alten Zeichenfarben beibehalten
werden.
@param p_X X-Spielfeldkoordinate des angewählten Feldes
@param p_Y Y-Spielfeldkoordinate des angewählten Feldes
@param p_Color Farbe des zu zeichnenden Blocks
-----------------------------------------------------------------------------*}
procedure TMain.DrawBlock( const p_X: Integer;
const p_Y: Integer;
const p_Color: TColor);
var
OldPenColor: TColor;
OldBrushColor: TColor;
pCanvas: TCanvas;
begin
pCanvas := Image.Picture.Bitmap.Canvas;
OldPenColor := pCanvas.Pen.Color;
OldBrushColor := pCanvas.Brush.Color;
pCanvas.Pen.Color := p_Color;
pCanvas.Brush.Color := p_Color;
pCanvas.Rectangle(p_x * 32 + 1, p_y * 32 + 1, p_x * 32 + 32, p_y * 32 + 32);
pCanvas.Pen.Color := OldPenColor;
pCanvas.Brush.Color := OldBrushColor;
end;
{*-----------------------------------------------------------------------------
Zeichnen des Spielgitters
Löscht gleichzeitig die Anzeige des Spielfelds
-----------------------------------------------------------------------------*}
procedure TMain.DrawGrid;
var
pCanvas: TCanvas;
x, y: Integer;
begin
// Leeren des Spielfelds
pCanvas := Image.Picture.Bitmap.Canvas;
pCanvas.Pen.Color := clWhite;
pCanvas.Pen.Style := psSolid;
pCanvas.Brush.Color := clWhite;
pCanvas.Brush.Style := bsSolid;
pCanvas.Font.Name := 'Arial';
pCanvas.Font.Size := 16;
pCanvas.Rectangle(0, 0, Image.Picture.Bitmap.Width, Image.Picture.Bitmap.Height);
// Vorbereiten auf das Zeichnen der Gitterlinien
pCanvas.Pen.Color := clBlack;
pCanvas.Brush.Color := clBlack;
// Zeichnen der horizontalen Linien
for y := 0 to 11 do
begin
pCanvas.MoveTo(0, y * 32);
pCanvas.LineTo(Image.Picture.Bitmap.Width, y * 32);
end;
// Zeichnen der vertikalen Linien
for x := 0 to 11 do
begin
pCanvas.MoveTo(x * 32, 0);
pCanvas.LineTo(x * 32, Image.Picture.Bitmap.Height);
end;
// Rücksetzen der Farben, sonst kommen andere Outputmethoden in
// Schwierigkeiten
pCanvas.Pen.Color := clWhite;
pCanvas.Brush.Color := clWhite;
end;
end.Damit kannst du mal vergleichen und schauen, wo dann bei dir den Haken war.
