med2.Open;
except
// Вызываем окно сообщающее об ошибке.
aboutbox4.ShowModal;
// Выходим из процедуры, т.о. даем пользователю возможность повторить
// ввод пути.
exit;
end;
// Если ошибки не произошло.
// Закрываем медиаплейеры этого "Aboutbox-а". Это необходимо,
// что бы AVI-файлы были доступны медиаплейерам основной формы
med1.Close;
med2.Close;
// Вызываем основную форму (поле игры).
form1.show;
// Свойствам 'FileName' медиаплейеров основной формы присваеваем
// теперь точно верные пути к AVI-файлам.
form1.mp1.FileName:=aboutbox3.Edit1.Text;
form1.mp2.FileName:=aboutbox3.Edit2.Text;
// "Прячем" окно ввода путей к AVI-файлам.
aboutbox3.Hide;
end;
procedure TAboutBox3.Button2Click(Sender: TObject);
// Клик на кнопке 'Выход'
begin
// Закрываем форму.
Close;
end;
// Следующие процедуры обрабатывают события OnChange компонентов //FileListBox,
// DirectoryListBox, DriveListBox. Обрабатывают таким образом, что бы //связать
// их между собой, т.е. при смене диска менялись папки, при смене папки
// менялись файлы, а при выборе файла путь к нему прописывался в Edit-ах.
procedure TAboutBox3.disk1Change(Sender: TObject);
begin
dir1.Drive:=disk1.Drive;
end;
procedure TAboutBox3.dir1Change(Sender: TObject);
begin
file1.Directory:=dir1.Directory;
end;
procedure TAboutBox3.disk2Change(Sender: TObject);
begin
dir2.Drive:=disk2.Drive;
end;
procedure TAboutBox3.dir2Change(Sender: TObject);
begin
file2.Directory:=dir2.Directory;
end;
// При выборе файла, путь к нему прописывается в Edit1
procedure TAboutBox3.file1Click(Sender: TObject);
begin
edit1.Text:=file1.FileName;
end;
// При выборе файла, путь к нему прописывается в Edit2
procedure TAboutBox3.file2Click(Sender: TObject);
begin
edit2.Text:=file2.FileName;
end;
end.
unit abbox4;
// Модуль окна, которое информирует об ошибке ввода пути к AVI-файлам.
// Не описано ни одной процедуры. Все надписи внесены при установке
// свойств компонентов.
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
TAboutBox4 = class(TForm)
OKButton: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutBox4: TAboutBox4;
implementation
{$R *.DFM}
end.
unit Cursproj;
//Указываем файл ресурсов.
{$r k.res}
interface
uses
//Стандартные модули.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ExtCtrls, MPlayer;
//Компоненты и процедуры использующиеся в программе.
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Button4: TButton;
Label2: TLabel;
Label3: TLabel;
l4: TLabel;
Image1: TImage;
Image2: TImage;
Label4: TLabel;
l5: TLabel;
Panel1: TPanel;
Panel2: TPanel;
mp1: TMediaPlayer;
mp2: TMediaPlayer;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
procedure N8Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Edit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Edit2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
//Переменные, в которые будут загружены картинки.
r1,r2,baks:tbitmap;
implementation
//Подключение модулей "ABOUTBOX-ов".
uses Abbox1, abbox2, abbox3;
{$R *.DFM}
procedure TForm1.N8Click(Sender: TObject);
begin
//Вызов окна о программе
aboutbox1.showmodal;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
//Вызов окна правила игры
aboutbox2.showmodal;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
//Процедура защиты от ввода недопустимых символов в поле ввода числа
begin
//если введен символ "1", то следующим может быть только "0", "1" или "2"
if edit1.Text='1' then
begin
edit1.MaxLength:=2;
case key of
'0'..'2',#8:
else key:=chr(0); //иначе символ не отображать
end
end
else //Пока ничего не введено (ноль не отображается).
case key of
'1'..'9',#8: //отображать только цифры. Разрешено использовать Backspase.
else key:=chr(0);
end;
//Если введена цифра 2,3,4,5,6,7,8 или 9 максимальная длинна строки 1 символ.
if (edit1.Text='2') or (edit1.Text='3') or (edit1.Text='4')
or(edit1.Text='5') or (edit1.Text='6') or (edit1.Text='7')
or(edit1.Text='8') or (edit1.Text='9') then
edit1.MaxLength:=1
end;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
// Для поля ввода ставки запрет ненужных символов анологичен.
begin
edit2.MaxLength:=3;
if (edit2.Text='') or (strtoint(edit2.text)>strtoint(l4.caption)) then
case key of
'1'..'9',#8:
else key:=chr(0)
end
else
case key of
'0'..'9',#8:
else key:=chr(0)
end
end;
//Основная часть программы. Клик на кнопке 'Играть'.
procedure TForm1.Button1Click(Sender: TObject);
//Используемые переменные.
// St - ставка игрока.
// bank- переменная отвечающая за кол-во очков.
// Sum - сумма цифр двух костей.
// Chislo - число загаданное игроком.
// K1,k2 - выпавшие кости.
var sum,chislo,k1,k2:byte;st,bank:integer;
// "Перехват" возможных ошибок.
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
begin
// Если не введены ни число ни ставка.
if (edit1.Text='') and (edit2.Text='') then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('Введите число и ставку',mterror,[mbok],0);
edit1.SetFocus;
exit;
end;
// Если не введено число.
if edit1.Text='' then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('Введите число',mterror,[mbok],0);
edit1.SetFocus;
exit;
end;
// Если не введена ставка.
if edit2.Text='' then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('Сделайте ставку',mterror,[mbok],0);
edit2.SetFocus;
exit;
end;
// Если ставка равна нолю
if edit2.Text='0' then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('Ноль это не ставка',mterror,[mbok],0);
edit2.SetFocus;
exit;
end;
// Преобразовываем строковые данные полей для ввода числа иставки и
// заносим в соответствующие переменные.
st:=strtoint(edit2.text);
chislo:=strtoint(edit1.text);
// Если игрок загадал единицу.
if chislo=1 then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('Сумма цифр двух костей '+#13+
'не может быть равна - 1.',mterror,[mbok],0);
edit1.Text:='';
edit1.SetFocus;
exit;
end;
// Если игрок сделал ствку больше чем есть в банке.
if st>strtoint(l4.caption) then
begin
// Выводится соответствующее сообщение и программа выходит из процедуры.
messagedlg('В долг играть нельзя',mterror,[mbok],0);
edit2.SetFocus;
exit;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// "Прячем" компоненты для вывода иллюстраций.
image1.Visible:=false;
image2.Visible:=false;
// "Показываем" компоненты (экраны) для вывода AVI-файлов.
panel1.Visible:=true;
panel2.Visible:=true;
// Открываем медиаплейеры и проигрываем AVI-файлы.
// Не предусматриваем исключения т.к. предусмотрели при закрытии
// формы для ввода путей к AVI - файлам.
mp1.Open;
// Задаём размеры области вывода AVI-файла.
mp1.DisplayRect:=rect(0,0,105,105);
// Воспроизведение
mp1.Play;
mp2.Open;
// Задаём размеры области вывода AVI-файла.
mp2.DisplayRect:=rect(0,0,105,105);
// Воспроизведение
mp2.Play;
// Устанавливаем задержку выполнения программы.
// Что-бы проиграть AVI-файл.
sleep(700);
// "Прячем" компоненты (экраны) для вывода AVI-файлов.
panel1.Visible:=false;
panel2.Visible:=false;
// "Показываем" компоненты для вывода иллюстраций.
image1.Visible:=true;
image2.Visible:=true;
// Включаем генератор случайных чисел.
randomize;
// "Бросаем" кубики.
// Присваеваем соответствующим переменным функцию random(6) и прибавляем 1.
k1:=random(6)+1;
k2:=random(6)+1;
// Заносим в переменную сумму цифр костей.
sum:=k1+k2;
// Создаём битовый образ для вывода изображения первого кубика.
r1:=tbitmap.Create;
// Загружаем картинку из файла ресурсов.
// Имя рисунка указываем с учётом выпавшей цифры.
r1.LoadFromResourceName(hinstance,'b'+inttostr(k1));
// Выводим картинку.
image1.Canvas.Draw(0,0,r1);
// Создаём битовый образ для вывода изображения второго кубика.
r2:=tbitmap.Create;
// Загружаем картинку из файла ресурсов.
// Имя рисунка указываем с учётом выпавшей цифры.
r2.LoadFromResourceName(hinstance,'b'+inttostr(k2));
// Выводим картинку.
image2.Canvas.Draw(0,0,r2);
{=========================================================}
// Следующая часть программы определяет проиграл или выиграл игрок.
// А так же величину выигрыша или проигрыша.
// Если загаданное число равно сумме выпавших костей.
if sum=chislo then
begin
// Ставку увеличиваем в 4 раза, прибавляем к имеющимся очкам в банке.
bank:=strtoint(l4.caption)+4*st;
// В поле для вывода кол-ва очей заносим теперешнее значение.
l4.Caption:=inttostr(bank);
// В метку для вывода информации
// выводим сообщение о выигрыше и его кол-во.
l5.Caption:='Невероятно!!! Вы угадали!!!'+#13+
'Выигрыш - '+inttostr(4*st);
end
else
// Следуюшее условие. Если и загаданное число и сумма цифр двух
// костей одновременно больше или меньше семи.
if (chislo<7) and (sum<7) or (chislo>7) and (sum>7) then
begin
// Ставку прибавляем к имеющимся очкам в банке.
bank:=strtoint(l4.caption)+st;
// В поле для вывода кол-ва очей заносим теперешнее значение.
l4.Caption:=inttostr(bank);
// В метку для вывода информации
// выводим сообщение о выигрыше и его кол-во.
l5.Caption:='Вы выиграли - '+inttostr(st)+#13+
'Вам определённо везёт!';
end
else
// Все остальные ситуации - проигрышные.
begin
// От имеющихся очей в банке отнимаем ставку.
bank:=strtoint(l4.caption)-st;
// В поле для вывода кол-ва очей заносим теперешнее значение.
l4.Caption:=inttostr(bank);
// В метку для вывода информации
// выводим сообщение о проигрыше и его кол-во.
l5.Caption:='Вы проиграли - '+inttostr(st)+#13+
'Попробуйте ещё!';
end;
// Определение победы или поражения в игре.
// Если кол-во очей в банке игрока превышает 1000, игрок победил.