Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
8
Добавлен:
10.12.2013
Размер:
12.18 Кб
Скачать
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Grids, JPEG, Buttons, Variants, Menus, tlhelp32,ShellApi;

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel3: TPanel;
ListBox1: TListBox;
GroupBox1: TGroupBox;
Pic: TImage;
State: TImage;
Shape1: TShape;
Button1: TButton;
Button2: TButton;
Button3: TButton;
WState: TStringGrid;
GroupBox2: TGroupBox;
Label1: TLabel;
DeadGame: TLabel;
Label2: TLabel;
Label3: TLabel;
Bevel2: TBevel;
Shape2: TShape;
Label4: TLabel;
Label5: TLabel;
Button30: TButton;
Bevel3: TBevel;
Label6: TLabel;
Label7: TLabel;
Timer1: TTimer;
GroupBox3: TGroupBox;
Image1: TImage;
Button4: TButton;
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
function GetWord: String;
procedure Button1Click(Sender: TObject);
procedure UpdateSize;
procedure GetChar(C: Char);
procedure InitializeGame;
procedure UpdateImg;
procedure Win;
procedure Lose;
procedure FormInfoVisible;
procedure Button30Click(Sender: TObject);
procedure ShowWord;
procedure RecupList;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1KeyPress(Sender: TObject; var Key: Char);
procedure Button3Click(Sender: TObject);
private
public
end;

const wImg=20;
hImg=20;
var
Form1: TForm1;
UsedWord: String;
LifeState: ShortInt;
Dirr: String;
MasChar: string=
'абвгдежзийклмнопрстуфхцчшщъыьэюя';
MasCharBool:array [1..32] of boolean;
Img1,Img2:TBitmap;
idGame:boolean=false;
idVictory:boolean=false;

implementation
uses Unit3,Unit2;

{$R *.DFM}

procedure TForm1.FormInfoVisible;
begin
form1.Visible:=false;
if idVictory
then
begin

unit3.currPlayer.Time:=StrToInt(Label7.caption);
Application.CreateForm(TForm2,Form2);
end
else
begin
unit3.currPlayer.Time:=99999;
Application.CreateForm(TForm3,Form3);
end;
end;

procedure TForm1.RecupList;
begin

ListBox1.Items.SaveToFile(Dirr + 'ListeMots.txt');
Label3.Caption := IntToStr(ListBox1.Items.Count);
end;

procedure TForm1.ShowWord;
Var
I: Integer;
begin
for I := 1 to Length(UsedWord) do
begin
WState.Cells[I - 1, 0] := UsedWord[I];
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label7.Caption:=IntToStr(StrToInt(Label7.Caption)+1);
end;

procedure TForm1.Win;
begin
Timer1.Enabled:=false;
MessageDlg('Молодец! Ты избежал виселицы!', mtInformation, [mbOK], 0);
panel3.Enabled := False;
DeadGame.Visible := True;
Label1.Visible := False;
idGame:=false;
idVictory:=true;
FormInfoVisible;
idVictory:=false;

end;

procedure TForm1.Lose;
begin
ShowWord;
Timer1.Enabled:=false;
MessageDlg('Эта задача оказалась сложной! Ты казнен!', mtInformation, [mbOK], 0);
DeadGame.Visible := True;
Label1.Visible := False;
idGame:=false;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var i,j,pos:integer;
begin
if idGame
then
begin
i:=(y+2) div (hImg+3);
j:=(x+2) div (wImg+3);
pos:=i*10+j+1;
Form1.Image1.Canvas.Draw(wImg*(j)+2+3*j,hImg*(i)+3*i,Img2);
if MasCharBool[pos]
then
begin
getChar(MasChar[pos]);
UpdateImg;
MasCharBool[pos]:=false;
end;
end;
end;

procedure TForm1.InitializeGame;
var i,j:integer;
begin
if FileExists(Dirr + 'ListeMots.txt') = True
then
ListBox1.Items.LoadFromFile(Dirr + 'ListeMots.txt')
else
RecupList;
Label3.Caption := IntToStr(ListBox1.Items.Count);
i:=0;
j:=0;
while ((i*10+j)<32) do
begin
Form1.Image1.Canvas.Draw(wImg*(j)+2+3*j,hImg*(i)+3*i,Img1);
Form1.Image1.Canvas.TextOut(wImg*(j)+2+3*j+7,hImg*(i)+3*i+2,MasChar[(i)*10+j+1]);
MasCharBool[i*10+j+1]:=true;
inc(j);
if j>9
then
begin
j:=0;
inc(i);
end;
end;
LifeState := 0;
UsedWord := '';
idGame:=true;
idVictory:=false;
end;

procedure TForm1.UpdateImg;
Var
I:integer;
WinW: String;
begin
WinW := '';
if FileExists(Dirr + 'Images\' + IntToStr(LifeState + 1) + '.jpg') = True
then
State.Picture.LoadFromFile(Dirr + 'Images\' + IntToStr(LifeState + 1) + '.jpg')
else
begin
MessageDlg('Ошибка: файл изображения не был найден. "Висилица" будет закрыта.', mtError, [mbOk], 0);
Application.Terminate;
end;
if LifeState = 9 then Lose;
for I := 0 to Length(usedword) - 1 do
begin
WinW := WinW + WState.Cells[I, 0];
end;
if (UpperCase(WinW) = UpperCase(UsedWord)) and (LifeState < 9) then Win;
Label1.Caption := 'Remained attempts: ' + IntToStr(10 - (LifeState + 1)) + '.';
end;

procedure TForm1.GetChar(C:Char);
Var
I: Integer;
GotIt: Boolean;
begin
GotIt := False;
for I := 1 to Length(usedWord) do
begin
if UpperCase(usedWord[I]) = UpperCase(C)
then
begin
WState.Cells[I - 1, 0] := C;
GotIt := True;
end;
end;
if GotIt = False
then
LifeState := LifeState + 1;
end;


procedure TForm1.UpdateSize;
Var
I: Integer;
begin
WState.ColCount := Length(UsedWord);
for I := 0 to Length(UsedWord) do
begin
WState.Cells[I, 0] := '...';
end;

end;


function TForm1.GetWord: String;
Var
R: Integer;
begin
randomize;
R := random(ListBox1.Items.Count - 1) + 1;
Result := ListBox1.Items.Strings[R];
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FormInfoVisible;
end;

procedure TForm1.Button1KeyPress(Sender: TObject; var Key: Char);
var s: string ;
posit:integer;
i,j:integer;
begin
s:=Key;
posit:=POS(s,MasChar);
if (posit=0)
then
ShowMessage('Перейдите на русскую раскладку и проверьте нажат ли "CapsLock"')
else
if MasCharBool[posit]
then
begin
j:=(posit mod 10);
if j=0
then
j:=10;
i:=(posit div 10);
if j=10
then
dec(i);
Form1.Image1.Canvas.Draw(wImg*(j-1)-1+3*j,hImg*(i)+3*i,Img2);
GetChar(key);
UpdateImg;
MasCharBool[posit]:=false;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
Mot: String;
begin
MessageDlg('Слова из более чем 10 букв и менее 3 букв, рассматриваться не будут!', mtWarning, [mbOK], 0);
if InputQuery('Добавить слово ',' Введите слово, чтобы добавить список:', Mot) = True then
begin
if (Length(Mot) > 2) and (Length(Mot) < 10) then
begin
ListBox1.Items.Add(Mot);
ListBox1.Sorted := False;
ListBox1.Sorted := True;
ListBox1.Items.SaveToFile(Dirr + 'ListeMots.txt');
Label3.Caption := IntToStr(ListBox1.Items.Count);
end;
end;
Button1.SetFocus;
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
Dirr := ExtractFilePath(Application.ExeName);
if FileExists(Dirr + 'Images\1.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\2.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\3.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\4.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\5.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\6.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\7.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\8.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\9.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
if FileExists(Dirr + 'Images\10.jpg') = False then begin MessageDlg('Ошибка: изображение не найдено!', mtError, [mbOK], 0); Application.Terminate; end;
Img1:=TBitmap.Create;
Img1.LoadFromFile(Dirr+'Images\1_1.bmp');
Img2:=TBitmap.Create;
Img2.LoadFromFile(Dirr+'Images\1_2.bmp');
Label1.Visible := False;
Label6.Caption:='Time:';
Label7.Caption:='0';
if FileExists(Dirr + 'Images\01.jpg') = True
then
Pic.Picture.LoadFromFile(Dirr + 'Images\01.jpg')
else
Label4.Visible := True;
InitializeGame;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=true;
Label6.Caption:='Time:';
Label7.Caption:='0';
Label5.Visible := False;
InitializeGame;
UsedWord := GetWord;
UpdateSize;
UpdateImg;
DeadGame.Visible := False;
Label1.Visible := True;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Application.Terminate;
end;

procedure TForm1.Button30Click(Sender: TObject);
Var
S: String;
begin

MessageDlg('Слова из более чем 10 букв и менее 3 букв, рассматриваться не будут!', mtWarning, [mbOK], 0);
if InputQuery('Выбор слова ',' Введите желаемое слово для игры:', S) then
begin
if Length(S) < 3 then begin MessageDlg('Ваше слово менее 3-х букв! Пожалуйста, введите новое слово!', mtError, [mbOk], 0); Exit; end;
if Length(S) > 10 then begin MessageDlg('Ваше слово более 10 букв! Пожалуйста, введите новое слово!', mtError, [mbOk], 0); Exit; end;
if (Length(S) < 11) and (Length(S) > 2) then
begin
if MessageDlg('Хотите добавить это слово в список?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin ListBox1.Items.Add(S); ListBox1.Sorted := False; ListBox1.Sorted := True; ListBox1.Items.SaveToFile(Dirr + 'ListeMots.txt'); Label3.Caption := IntToStr(ListBox1.Items.Count); end;
Label5.Visible := False;
InitializeGame;
UsedWord := S;
UpdateSize;
UpdateImg;
DeadGame.Visible := False;
Label1.Visible := True;
end;
end;
Button1.SetFocus;
end;



procedure TForm1.Button3Click(Sender: TObject);
begin
Application.Terminate;
end;
end.
Соседние файлы в папке Виселица
  • #
    10.12.2013876 б7Game.res
  • #
    10.12.2013108 б8ListeMots.txt
  • #
    10.12.201317.01 Кб7Main.dcu
  • #
    10.12.201351 б7Main.ddp
  • #
    10.12.20134.95 Кб7Main.dfm
  • #
    10.12.201312.18 Кб8Main.pas
  • #
    10.12.201351 б7Main.~ddp
  • #
    10.12.20134.95 Кб7Main.~dfm
  • #
    10.12.201312.2 Кб7Main.~pas
  • #
    10.12.201350 б8playerInfo.txt
  • #
    10.12.20134.39 Кб9Unit2.dcu