Obihörnchen's Blog

Mich überkam die Langeweile und da bin ich auf die Idee gekommen mal schnell ein kleines Hangman Spiel zu coden 😉
Ist nichts besonderes, aber vielleicht braucht ja der ein oder andere eine Anregung wie man so was realisieren könnte.
Das ganze ist in Delphi geschrieben und kann bestimmt noch optimiert werden. Kommentare gibt es nicht, da es einfach genug zu verstehen sein sollte.
Eine Datei “datenbank.txt” muss erstellt werden, in der die Wörter eingetragen werden.

unit Unit1;
interface
uses
Windows, SysUtils, Classes, Graphics, Forms,
Dialogs, StdCtrls, Menus, ExtCtrls, Controls;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Datei1: TMenuItem;
Start1: TMenuItem;
Beenden1: TMenuItem;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Label4: TLabel;
procedure Beenden1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Start1Click(Sender: TObject);
procedure zeigeChar(Buchstabe: char);
procedure setLoesungswort;
procedure drawHangman;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
Button: array[1..26] of TButton;
procedure disableButton(Sender:TObject);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
Loesungswort: string;
LoesungswortList: Tstringlist;
DateiEintraege: integer;
FehlVersuche: integer;
f: text;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
help: string;
begin
RANDOMIZE;
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clRed;
DateiEintraege := 0;
FehlVersuche := 0;
loesungswortlist := TStringList.Create;
if fileexists('datenbank.txt') then
begin
Assignfile(f,'datenbank.txt');
Reset(f);
while not Eof(f) do
begin
inc(DateiEintraege);
ReadLn(f, help);
loesungswortlist.Add(help);
end;
CloseFile(f);
end;
for i:=1 to 26 do
begin
Button[i]:=Tbutton.Create(Form1);
Button[i].Parent:=Form1;
Button[i].Caption:=chr(64+i);
Button[i].OnClick:=disableButton;
end;
for i:=1 to 13 do
Button[i].SetBounds(-10+i*41,360,41,41);
for i:=14 to 26 do
Button[i].SetBounds(-10+(i-13)*41,400,41,41);
setLoesungswort;
End;
procedure TForm1.disableButton(Sender:TObject);
begin
TButton(Sender).visible := false;
zeigeChar(TButton(Sender).Caption[1]);
end;
procedure TForm1.zeigeChar(Buchstabe: char);
var
I,J: integer;
labeltext: string;
help: boolean;
begin
setLength(labeltext,length(Loesungswort));
help := false;
for I:= 1 to length(Loesungswort) do
begin
if (Loesungswort[I] = Buchstabe) then
begin
help := true;
labeltext := Label1.Caption;
labeltext[I] := Buchstabe;
label1.Caption := labeltext;
end
else if Loesungswort[I] = chr(ord(Buchstabe)+32) then
begin
help := true;
labeltext := Label1.Caption;
labeltext[I] := chr(ord(Buchstabe)+32);
label1.Caption := labeltext;
end
end;
if help = false then
inc(FehlVersuche);
drawHangman;
end;
procedure TForm1.drawHangman;
begin
case FehlVersuche of
1: begin
Canvas.MoveTo(200,250);
Canvas.LineTo(250,200);
end;
2: Canvas.LineTo(300,250);
3: begin
Canvas.MoveTo(250,200);
Canvas.LineTo(250,50);
end;
4: Canvas.LineTo(375,50);
5: Canvas.LineTo(375,100);
6: Canvas.LineTo(325,150);
7: begin
Canvas.MoveTo(375,100);
Canvas.LineTo(425,150);
end;
8: begin
Canvas.MoveTo(375,100);
Canvas.LineTo(375,175);
end;
9: Canvas.LineTo(325,225);
10:begin
Canvas.MoveTo(375,175);
Canvas.LineTo(425,225);
end;
end;
if FehlVersuche < 10 then
begin
if label1.Caption = Loesungswort then
showmessage('Gewonnen');
end
else
begin
showmessage('Verloren');
setLoesungswort;
end;
end;
procedure TForm1.setLoesungswort;
var
I: integer;
begin
Repaint;
Loesungswort := loesungswortlist[Random(DateiEintraege)];
Label1.Caption := '';
FehlVersuche := 0;
for i:=1 to 26 do
Button[I].visible := true;
for I := 1 to length(Loesungswort) do
Label1.Caption := Label1.Caption + '#';
Label3.Caption:=inttostr(length(Loesungswort));
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = Char(VK_RETURN) then
if Edit1.Text = Loesungswort then
showmessage('Gewonnen!')
else
begin
showmessage('Falsch!');
inc(FehlVersuche);
drawHangman;
end;
end;
procedure TForm1.Start1Click(Sender: TObject);
begin
setLoesungswort;
end;
end;

Alles kann frei und ohne Einschränkungen verwendet werden von mir aus auch für kommerzielle Zwecke 😀

Hier noch der Formcode (ALT + F12)

object Form1: TForm1
<pre> Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 458
ClientWidth = 587
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 40
Top = 270
Width = 6
Height = 25
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -21
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label2: TLabel
Left = 435
Top = 270
Width = 129
Height = 13
Caption = 'Anzahl der Buchstaben'
Color = clNone
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label3: TLabel
Left = 490
Top = 290
Width = 5
Height = 19
Color = clNone
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label4: TLabel
Left = 40
Top = 307
Width = 55
Height = 13
Caption = 'Vorschlag'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
Transparent = True
end
object Edit1: TEdit
Left = 101
Top = 304
Width = 121
Height = 21
TabOrder = 0
OnKeyPress = Edit1KeyPress
end
object MainMenu1: TMainMenu
Left = 32
Top = 16
object Datei1: TMenuItem
Caption = 'Datei'
object Start1: TMenuItem
Caption = 'N'#228'chstes Wort'
OnClick = Start1Click
end
object Beenden1: TMenuItem
Caption = 'Beenden'
OnClick = Beenden1Click
end
end
end
end