Форум: "Основная";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Вниз

Ребята мастера помогите с лаблраторной...   Найти похожие ветки 

← →
Liona ©   (2004-05-09 15:50) [0]

В PaintBox изображается таблица размером 20х20 клеток и по ней не слишком быстро (заметно для пользователя) перемещается крестик ходами шахматного коня, каждый раз случайно выбирая ход.используя компоненту PaintBox, сформировать изображение в соответствии с индивидуальным заданием. При необходимости пошагового формирования изображения использовать таймер. При необходимости перерисовки изображение должно корректно восстанавливаться.

---

← →
Anatoly Podgoretsky ©   (2004-05-09 16:17) [1]

Вопросы есть или работу хочешь заказать?

---

← →
Mim1 ©   (2004-05-09 16:43) [2]


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   PaintBox1: TPaintBox;
   Timer1: TTimer;
   procedure PaintBox1Paint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
   x_pos,y_pos:integer;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PaintBox1Paint(Sender: TObject);
var i:integer;
   r:TRect;
begin
 with PaintBox1.Canvas do
   begin
     with Brush do
       begin
         Style := bsSolid;
         color := clWhite;
       end;
     FillRect(Rect(0,0,400,400));

     pen.Color := clBlack;

     for i:= 1 to 20 do
       begin
         MoveTo(i*20,0);
         LineTo(i*20,400);
       end;
     for i:= 1 to 20 do
       begin
         MoveTo(0,i*20);
         LineTo(400,i*20);
       end;
     MoveTo((x_pos-1)*20,(y_pos-1)*20);
     LineTo((x_pos-0)*20,(y_pos-0)*20);
     MoveTo((x_pos-1)*20,(y_pos-0)*20);
     LineTo((x_pos-0)*20,(y_pos-1)*20);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBox1.SetBounds(0,0,400,400);
 AutoSize := true;
 x_pos := 10;
 y_pos := 10;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
const a : array[1..8] of array [1..2] of integer =
 ((-1,-2),(1,-2),(2,-1),(2,1),(-1,2),(1,2),(-2,-1),(-2,1));
var x,y,i:integer;
begin
 repeat
   x := x_pos;
   y := y_pos;
   i := random(8)+1;
   x := x+a[i,1];
   y := y+a[i,2];
 until (x <= 20) and (x >= 0) and (y <= 20) and (y >= 0);
 x_pos := x;
 y_pos := y;
 PaintBox1.Repaint;
end;

initialization
 randomize;
end.


---

← →
Mim1 ©   (2004-05-09 16:45) [3]

В OnCreate формы можно добавить DoubleBuffered := true;

---

← →
Mim1 ©   (2004-05-09 16:48) [4]

Проверка не правильная  until (x <= 20) and (x >= 1) and (y <= 20) and (y >= 1); Поспешиш, людей намешиш.

---

← →
Liona ©   (2004-05-09 17:21) [5]

Mim1 © Памятник вам поставить надо. Только вот бы как с вами связатся что бы кое какие моменты уточнить?

---

← →
Mim1 ©   (2004-05-09 17:53) [6]

С комментариями


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   PaintBox1: TPaintBox;
   Timer1: TTimer;
   procedure PaintBox1Paint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
   x_pos,y_pos:integer; // текущее положение фигуры
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PaintBox1Paint(Sender: TObject);
var i:integer;
   r:TRect;
begin
 with PaintBox1.Canvas do
   begin
     with Brush do
       begin
         Style := bsSolid; // выставляем стиль кисти - "заливка"
         color := clWhite; // устанавливаем цвет кисти
       end;
     FillRect(Rect(0,0,400,400)); // заливаем прямоугольник

     pen.Color := clBlack; // устнавливаем цвет карандаша

     for i:= 1 to 20 do // ривуем вертикальные линии
       begin
         MoveTo(i*20,0); // указываем точку начала линии
         LineTo(i*20,400); // рисуем линии из "точки начала" в указанную коордитнату
       end;
     for i:= 1 to 20 do // рисуем горизонтальные линии
       begin
         MoveTo(0,i*20);
         LineTo(400,i*20);
       end;
     // рисуем крестик
     MoveTo((x_pos-1)*20,(y_pos-1)*20);
     LineTo((x_pos-0)*20,(y_pos-0)*20);
     MoveTo((x_pos-1)*20,(y_pos-0)*20);
     LineTo((x_pos-0)*20,(y_pos-1)*20);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBox1.SetBounds(0,0,400,400); // устанавливаем размер поля
 AutoSize := true; // выравниваем размер фррмы по разперу поля
 x_pos := 1; // устанавляваем начальное положение крестика по x
 y_pos := 1; // устанавляваем начальное положение крестика по y
 DoubleBuffered := true; // чтобы избежать мигания при перерисовке
end;

procedure TForm1.Timer1Timer(Sender: TObject);
// смешения при движении фигуры
const a : array[1..8] of array [1..2] of integer =
 ((-1,-2),(1,-2),(2,-1),(2,1),(-1,2),(1,2),(-2,-1),(-2,1));
var x,y,i:integer;
begin
 // вычисляем новые случайные координаты фигуры
 repeat
   x := x_pos;
   y := y_pos;
   i := random(8)+1; // индекс случайного смещения из массива
   x := x+a[i,1];
   y := y+a[i,2];
 until (x <= 20) and (x >= 1) and (y <= 20) and (y >= 1); // повторяем вычисление до тех пор пока новые координаты не окажутся в пределах нашего поля
 x_pos := x; // учсанавливаем новые координаты фигуры
 y_pos := y;
 PaintBox1.Repaint; // перерисовываем
end;

initialization
 randomize;// инициализируем генератор случайных чисел
end.


---

← →
KilkennyCat ©   (2004-05-09 18:06) [7]

А где вывод звука "Иго-го" ? :))

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.23;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.04 c