TheoNick

Galgenraten - Delphi

Apr 11th, 2021
726
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, jpeg, pngimage, StrUtils;
  8.  
  9. type
  10.   TfrmGalgenraten = class(TForm)
  11.     imgImage: TImage;
  12.     btnRaten: TButton;
  13.     lblWort: TLabel;
  14.     edtBS: TEdit;
  15.     btnNext: TButton;
  16.     lblW01: TLabel;
  17.     lblW02: TLabel;
  18.     lblW03: TLabel;
  19.     lblW04: TLabel;
  20.     lblW05: TLabel;
  21.     lblW06: TLabel;
  22.     lblW07: TLabel;
  23.     lblW08: TLabel;
  24.     lblW09: TLabel;
  25.     lblW10: TLabel;
  26.     Label1: TLabel;
  27.     lblWins: TLabel;
  28.     Label2: TLabel;
  29.     lblLosses: TLabel;
  30.     procedure Activate; override;
  31.     procedure btnRatenClick(Sender: TObject);
  32.     procedure btnNextClick(Sender: TObject);
  33.   private
  34.     { Private-Deklarationen }
  35.   public
  36.     { Public-Deklarationen }
  37.   end;
  38.  
  39. var
  40.   frmGalgenraten: TfrmGalgenraten;
  41.   strListe: TStringList;
  42.   strWort: string;
  43.   lblWrong: array[1..10] of TLabel;
  44.   intWrongs: integer;
  45.  
  46.  
  47. implementation
  48.  
  49. {$R *.dfm}
  50.  
  51. procedure TfrmGalgenraten.Activate;
  52. begin
  53.   inherited Activate;
  54.   //loading words from file
  55.   strListe := TStringList.Create;
  56.   strListe.LoadFromFile('words.txt');
  57.   //populating label-list
  58.   lblWrong[1] := frmGalgenraten.lblW01;
  59.   lblWrong[2] := frmGalgenraten.lblW02;
  60.   lblWrong[3] := frmGalgenraten.lblW03;
  61.   lblWrong[4] := frmGalgenraten.lblW04;
  62.   lblWrong[5] := frmGalgenraten.lblW05;
  63.   lblWrong[6] := frmGalgenraten.lblW06;
  64.   lblWrong[7] := frmGalgenraten.lblW07;
  65.   lblWrong[8] := frmGalgenraten.lblW08;
  66.   lblWrong[9] := frmGalgenraten.lblW09;
  67.   lblWrong[10] := frmGalgenraten.lblW10;
  68.   //running first word
  69.   btnNext.Click();
  70. end;
  71.  
  72. procedure TfrmGalgenraten.btnNextClick(Sender: TObject);
  73. var intIndex: integer;
  74. begin
  75.   //choosing word
  76.   strWort := Uppercase(strListe[Random(strListe.Count)]);
  77.   //writing encrypted word to label
  78.   lblWort.Caption := '';
  79.   for intIndex := 1 to Length(strWort) do
  80.   begin
  81.     lblWort.Caption := lblWort.Caption + '_ ';
  82.   end;
  83.   //clearing wrong-labels
  84.   for intIndex := 1 to 10 do
  85.   begin
  86.     lblWrong[intIndex].Caption := '';
  87.   end;
  88.   //resetting other
  89.   imgImage.Picture.LoadFromFile('img0.jpg');
  90.   intWrongs := 1;
  91.   edtBS.Text := '';
  92.   edtBS.SetFocus;
  93.   btnRaten.Visible := true;
  94.   btnNext.Visible := false;
  95. end;
  96.  
  97. procedure TfrmGalgenraten.btnRatenClick(Sender: TObject);
  98. var intIndex: integer;
  99.     strGuessed, strChar: string;
  100.     intPos: array of integer;
  101.     bolOcur: boolean;
  102.     pwcMsg: PWideChar;
  103. begin
  104.   //gets guessed char
  105.   strChar := (Uppercase(edtBS.Text));
  106.   edtBS.Text := '';
  107.   //gets positions of strChar in lblWort.Caption
  108.   bolOcur := false;
  109.   for intIndex := 1 to Length(strWort) do
  110.   begin
  111.     if strWort[intIndex] = strChar then
  112.     begin
  113.       SetLength(intPos, Length(intPos)+1);
  114.       intPos[High(intPos)] := (intIndex*2)-1;
  115.       bolOcur := true;
  116.     end;
  117.   end;
  118.  
  119.   //intPos := POS(strChar, strWort);
  120.  
  121.   //checks if strChar is not empty
  122.   if (strChar = ' ') or (strChar = '') then
  123.   begin
  124.     Application.MessageBox('Kein Buchstabe im Feld', 'Achtung', MB_ICONERROR or MB_OK);
  125.   end
  126.   else
  127.   begin
  128.     //checks if all 10 tries are done
  129.     if intWrongs < 11 then
  130.     begin
  131.       //checks if word contains char
  132.       if bolOcur then
  133.       begin
  134.         //put letter into label
  135.         for intIndex := 0 to Length(intPos)-1 do
  136.         begin
  137.           strGuessed := lblWort.Caption;
  138.           delete(strGuessed, intPos[intIndex], 1);
  139.           insert(strChar, strGuessed, intPos[intIndex]);
  140.           lblWort.Caption := strGuessed;
  141.         end;
  142.       end
  143.       else
  144.       begin
  145.         //cycle through images
  146.         imgImage.Picture.LoadFromFile('img'+IntToStr(intWrongs)+'.jpg');
  147.         //add letter to wrong ones
  148.         lblWrong[intWrongs].Caption := strChar;
  149.         intWrongs := intWrongs + 1;
  150.       end;
  151.     end
  152.     else
  153.     begin
  154.       //lock guessing when 10 tries are out
  155.       //messagebox
  156.       pwcMsg := PWideChar('Sie haben versagt.'+sLineBreak+'Das Wort wäre '+strWort+' gewesen.');
  157.       Application.MessageBox(pwcMsg, 'Naja', MB_ICONINFORMATION  or MB_OK);
  158.       lblLosses.Caption := IntToStr(StrToInt(lblLosses.Caption)+1);
  159.       //reset buttons
  160.       btnRaten.Visible := false;
  161.       btnNext.Visible := true;
  162.     end;
  163.  
  164.     if (not ContainsText(lblWort.Caption, '_')) and (btnRaten.Visible) then
  165.     begin
  166.       //messagebox
  167.       pwcMsg := PWideChar('Sie haben das Wort erraten!'+sLineBreak+'Sie hatten '+IntToStr(intWrongs-1)+' Fehlversuche.');
  168.       Application.MessageBox(pwcMsg, 'Glückwunsch', MB_ICONINFORMATION  or MB_OK);
  169.       lblWins.Caption := IntToStr(StrToInt(lblWins.Caption)+1);
  170.       //reset buttons
  171.       btnNext.Visible := true;
  172.       btnRaten.Visible := false;
  173.     end;
  174.   end;
  175.  
  176.   edtBS.SetFocus;
  177. end;
  178.  
  179. end.
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×