Interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

type

TForml = class(TForm)

procedure FormCreate(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer); procedure FormPaint(Sender: TObject);

// эти объявления вставлены сюда вручную procedure ShowPole; procedure Mixer; procedure NewGame;

private

f Private declarations } public

{ Public declarations } end;

var

Forml: TForml;

implementation

{$R *.dfm}

const

H = 4; W = 4; // размер поля — 4x4

158

Част

Примеры и задачи

159

we,he: integer; // ширина и высота клетки

// игровое поле

pole: array[l..H, 1..W] of byte;

ex,ey: integer; // координаты пустой клетки

// правильное расположение клеток stp : array[1..H, 1..W] of byte = (( 1, 2, 3, 4),

( 5, 6, 7, 8),

( 9,10,11,12),

(13,14,15, 0));

pic: TBitmap; // картинка

// новая игра

procedure TForml.NewGame;

var

fname: string[20]; // файл картинки

i,j: integer; begin

{ сюда можно вставить инструкции,

обеспечивающее, например, случайный

выбор загружаемой картинки }

fname := 'pic_l.bmp'; try

pic.LoadFromFile(fname); except

on EEopenError do begin

ShowMessage('Ошибка обращения к файлу ' + fname); j

Forml.Close; end; end;

// установить размер формы, // равный размеру картинки

// размер клетки

he := Pic.Height div H;

we := Pic.Width div W;

// размер формы ClientWidth := we * W; ClientHeight := he * H;

// исходное (правильное) положение for i:=l to H do

for j:=l to W do

pole[i,j] := stp[i,j]; Forml.Mixer; // перемешать фишки Forml.ShowPole; // отобразить поле end;

// проверяет, расположены ли

// клетки (фрагменты картинки) в нужном порядке

function Finish: boolean;

var

row,col: integer; i: integer; begin

row :=1; col :=1;

Finish := True; // пусть фишки в нужном порядке

for i:=l to 15 do

begin

if pole[row,col] <> i then begin

Finish:= False; break; end;

// к следующей клетке if col < 4

then inc(col) else begin col :=1; inc(row); end; end; end;

// "перемещает" фишку в соседнюю пустую клетку, // если она есть, конечно Procedure Move(сх,су: integer);

160

Часть 1

Примеры и задачи

161

// ex,су — клетка, в которой игрок сделал щелчок var

г: integer; // выбор игрока begin

// проверим, возможен ли обмен

if not (( abs(cx-ex) = 1) and (cy-ey = 0) or

( abs(cy-ey) = 1) and (cx-ex = 0)) then exit;

// Обмен. Переместим фишку из х,у в ек,еу Pole[ey,ex] := Pole[су,сх]; Pole[су,сх] := 0; ех:=сх; еу:=су;

// отрисовать поле Forml.ShowPole; if Finish then begin

pole[4,4] := 16;

Forml.ShowPole;

r := MessageDlg("Цель достигнута!'+ #13+

'Еше раз?',mtlnformation,[mbYes,mbNo],0);

if t = mrNo then Forml.Close; // завершить работу

// программы

Forml.NewGame; end;

end;

// щелчок в клетке

procedure TForml.FormMouseDown(Sender: TObject;

Button: TMouseButton; 'shift: TShiftState; X, Y: Integer); var

cx,cy: integer; // координаты клетки begin

// преобразуем координаты мыши в координаты клетки

сх := Trunc(X / we) + 1;

су := Trunc(Y /he) + 1;

Move(cx,cy); end;

// выводит игровое поле procedure TForml.ShowPole;

var

Source, Dest: TRect; // области: источник и приемник

sx,sy: integer; // левый верхний угол области-источника

i,j: integer;

begin

// содержимое клеток for i := 1 to W do

for j := 1 to H do

begin

// преобразуем номер картинки // в координаты левого верхнего // угла области-источника sy := ((pole[i,j] -1) div W) * he; sx := ((pole[i,j] -1) mod W) * we;

Source := Bounds(sx,sy,we,he);

Dest := Bounds((j-1)*wc,(i-1)*hc,we,he);

if pole[i,j] <> 0

then Canvas.CopyRect(Dest,pic.Canvas,Source) else Canvas.Rectangle((j-l)*wc, (i-l)*hc,

j*wc, i*hc) ; end;

end;

// "перемешивает" фишки procedure TForml.Mixer; var

xl,yl: integer; // пустая клетка x2,y2: integer; // эту переместить в пустую d: integer; // направление, относительно пустой х: integer; begin

// см. описание массива stp

// кол-во перестановок

xl:=4; yl:=4

randomize;

for i:= 1 to 150 do

begin

repeat

x2:=xl; y2:=yl; d:=random(4)+1;

6 3ак. 939

162

ЧастьЩ

Примеры и задачи

163

I 7- Тес г памяти

Начать

Рис. 1.60. Форма программы Тест памяти

// число, которое должен запомнить испытуемый // количество правильных чисел // счетчик чисел

case d of

1: dec(x2); 2: inc(x2); 3: dec(y2); 4: inc(y2); end;

until (x2>=l) and (x2<=4) and (y2>=l) and (y2<=4); // здесь определили фишку, которую /./ надо переместить в пустую клетку Pole[yl,xl] : = Ро1е[у2,х2]; Ро1е[у2,х2] := 0; xl:=x2; _У1:=у2; end;

// запомним координаты пустой клетки ех:= xl; еу:= yl; end;

// обработка события OnCreate

procedure TForml.FormCreate(Sender: TObject);

begin

pic := TBitMap.Create;

NewGame; end;

// обработка события OnPaint

procedure TForml.FormPaint(Sender: TObject);

begin

Forml.ShowPole; end;

end.

56. Напишите программу, используя которую можно оценить! способность игрока (испытуемого) запоминать числа. Програм-| ма должна выводить числа, а испытуемый — вводить эти числа] с клавиатуры. Время, в течение которого игрок будет видетЦ число, ограничьте, например, одной секундой. По окончании! теста программа должна вывести результат: количество показан-| ных чисел и количество чисел, которые испытуемый запомнил Щ ввел правильно. Вид формы приведен на рис. 1.60.

implementation

// разрядность числа (кол-во цифр) // количество чисел (длина теста)

const

КС = 5; LT = 10;

var

numb: integer; right: integer; n: integer;

f$R *.dfm}

// генерирует к — разрядное число function GetNumb(k: integer) : integer; var

n: integer; // генерируемое число

i: integer; begin

// процедура генерирует число по разрядам

// начиная со старшего

n:= Random(9)+1; // старший разряд не может быть нулем

// остальные разряды

for i := 1 to (k-1) do n := n*10 + Random(10);

GetNumb := n; end;

// создание формы

procedure TForml.FormCreate(Sender: TObject);

begin

Editl.Visible := False; // скрыть поле ввода Editl Editl.MaxLength := КС; // кол-во символов, которое

// можно ввести

164

Часть

Примеры и задачи

165

Labell.Wordwrap := True; //разрешить перенос слов на

// следующую строку

Labell.Caption :=

'Сейчас на экране будут появляться числа. ' +

'Вы должны запомнить число, набрать его на клавиатуре '+

'и нажать <Enter>';

Buttonl.Caption := 'Начать';

Timerl.Enabled := False; // таймер остановлен

Timer1.Interval := 1000; // время показа числа — 1 секунда

right := 0; // кол-во правильных п := 0; // счетчик чисел Randomize; -// инициализация ГСЧ end;

// щелчок на кнопке "Начать/Завершить" procedure TForml.ButtonlClick(Sender: TObject); begin

if Buttonl.Caption = 'Завершить' then

Forml.Close; // закрыть окно программы

if Buttonl.Caption = 'Начать' then begin

Buttonl.Caption := 'Завершить';

Buttonl.Visible := False; // скрыть кнопку

// кнопка Buttonl станет доступной после того,

// как испытание закончится

Labell.Caption := ";

Labell.Font.Size := 24; Editl.Font.Size := 24;

// размер шрифта поля Labell // размер шрифта поля Editl

// сгенерировать и вывести число

numb := GetNumb(KC);

Labell.Caption := IntToStr(numb);

Timerl.Enabled := True; // запуск таймера // процедура обработки сигнала от таймера // "сотрет" число end; end;

// обработка события таймера

procedure TForml.TimerlTimer(Sender: TObj ect);

begin

Timerl.Enabled := False; // остановить таймер

Labell.Visible := False; // скрыть число

Editl.Visible := True; // сделать доступным поле Editl

Editl.SetFocus; // установить курсор в поле Editl end;

// нажатие клавиш в поле Editl

procedure TForml.EditlKeyPress(Sender: TObject; var Key: Char);

var

igrok: integer; // число, которое ввел испытуемый

begin

case Key of

'O'..'9',i8: ; // клавиши "0"-"9", клавиша <Backspace>

#13: // клавиша <Enter>

begin

igrok := StrToInt(Editl.Text); if (igrok = numb)

then right := right + 1;

n := n + 1; // счетчик чисел

Editl.Text := " ;

Editl.Visible := False; // скрыть поле Editl

if n < LT then begin

numb := GetNumb(KC); // сгенерировать следующее

// число Labell.Caption := IntToStr(numb); // отобразить

// число

Labell.Visible := True;

Timerl.Enabled := True; // пуск таймера end else begin

// испытание закончено // вывести результат

Labell.Font.Size := 10;

Labell.Caption := 'Результат:' + #13 +

'Показано чисел: ' + IntToStr(LT) + #13 + 'Правильных: ' + IntToStr(right);

166

Частьf

Примеры и задачи

167

В этих клетках были одинаковые картинки. Игрок "нашел" их

Щелчок в этой клетке закроет остальные клетки, даже если картинка в этой клетке совпадет с одной из открытых

Label1.Visible := True;

Buttonl.Visible := True; // показать кнопку Завершид^Л end; end;

else Key := Chr(O); end; end;

end.

57. Напишите программу, используя которую можно оценитм способность игрока (испытуемого) запоминать числа. Програм* ма должна выводить числа, а испытуемый — вводить эти числ! с клавиатуры. Время, в течение которого игрок будет видетм число, ограничьте, например, одной секундой. Программа должн^ быть "интеллектуальной". Сначала она должна предлагать запо-' минать четырехразрядные числа, затем пяти, шести и т. д. Ко-1 личество чисел одной разрядности — 10. Переход на следующий уровень сложности (увеличение разрядности числа) должен вы4 подняться, если количество правильных чисел больше, напри-! мер, восьми, или количество подряд правильно введенных чисел больше шести. По окончании теста программа должна вывести.; результат по каждой подгруппе: количество показанных чисел и количество чисел, которые испытуемый запомнил и ввел прав

ВИЛЬНО.

58. Игра "Парные картинки" развивает внимание. Вот ее прави41 ла. Игровое поле разделено на клетки, за каждой из которых скрыта картинка. Картинки — парные, т. е. на игровом полеi есть две клетки, в которых находятся одинаковые картинки. В начале игры все клетки "закрыты". Щелчок левой кнопкой мыши "открывает" клетку, в клетке появляется картинка. Теперь надо найти клетку, в которой находится такая же картинка, как и в открытой клетке. Щелчок к другой клетке открывает вторую! картинку (рис. 1.61). Если картинки в открытых клетках одина-| ковые, то эти клетки "исчезают". Если разные — то клетки oc-j таются открытыми. Очередной щелчок закрывает открытые-' клетки и открывает следующую. Следует обратить внимание, чтоД две открытые клетки закрываются даже в том случае, если оШ крытая картинка такая же, как и одна из двух открытых. Играя заканчивается, когда игрок откроет ("найдет") все пары картинок. |

Рис. 1.61. Игровое поле программы Парные картинки

Разработайте программу, реализующую игру "Парные картинки". Картинки должны загружаться из файла.

В приведенной реализации игры все картинки квадратные и на­ходятся в одном файле (рис. 1.62). Это позволило сделать про­грамму "интеллектуальной" — размер игрового поля (количество клеток по горизонтали и вертикали) определяется количеством картинок в файле: зная высоту и ширину картинки в файле, программа вычисляет размер картинок, их количество и уста­навливает соответствующий размер игрового поля.

Рис. 1.62. Все картинки находятся в одном файле

Вид формы программы "Парные картинки" приведен на рис. 1.63.