Obihoernchen'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