Большой Воронежский Форум
» Программирование>помогите проблеиа с програмкой на делфи
dkuzechkin 15:36 29.05.2009
Вот к курсовой програмка есть но только что то она не хочет работать в чем проблемка может кто подскажет?програмка графическая мозаика)
вот ее листинг
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
C1: TMenuItem;
N5: TMenuItem;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
procedure Load;
procedure Refresh;
procedure New;
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure N5Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
H=4;
W=4; // размер поля 4*4 клетки
var
widt,heig:integer; // ширина и высота одной клетки
pole:array[1..H,1..W] of byte; // свойства поля
zx,zy:integer; // координаты пустой клетки
pos: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 TForm1.New;
var
f: string[20]; // файл загружаемой картинки
i,j: integer;
begin
f:='picture10.bmp';
try
pic.LoadFromFile(f);
except
on EFopenError do
begin
ShowMessage('Ошибка загрузки файла');
Form1.Close;
end;
end;
heig:=Pic.Height div H; // Размер клетки
widt:=Pic.Width div W;
ClientWidth:=widt*W; //Размер формы по размеру картинки
ClientHeight:=heig*H;
for i:=1 to H do
for j:=1 to W do
pole[i,j]:=pos[i,j];
Form1.Refresh; // перемещение клеток
Form1.Load; // загрузка поля
end;

// проверка на факт выигрыша
function GameOver: boolean;
var
rw,cl:integer;
i:integer;
begin
rw:=1;
cl:=1;
GameOver:=True; // клети расставлены правильно
for i:=1 to 15 do
begin
if pole[rw,cl]<>i then
begin
GameOver:=False;
break;
end;
if cl<4
then inc(cl)
else begin
cl:=1;
inc(rw);
end;
end;
end;

// ход в соседнюю пустую клетку
procedure Go(clickx,clicky:integer);
var
r:integer;
begin
if not ((abs(clickx-zx)=1) and (clicky-zy=0) or // проверка на возможность хода
(abs(clicky-zy)=1) and (clickx-zx=0))
then exit;
pole[zy,zx]:=Pole[clicky,clickx]; // осуществим переход из [x,y] в [zx,zy]
pole[clicky,clickx]:=0;
zx:=clickx;
zy:=clicky;
Form1.Load; // перерисовка поля
if GameOver then
begin
pole[4,4]:=16;
Form1.Load;
r:=MessageDlg('Вы выиграли!'+ #13+'Сыграем ещё?',mtInformation,[mbYes,mbNo],0);
if r=mrNo then Form1.Close;
Form1.New;
end;
end;

// клик по клетке
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X,Y:Integer);
var
clickx,clicky:integer; // координаты кликаемой клетки
begin
clickx:=Trunc(X/widt)+1; // переведём щелчок мыши в координаты клетки
clicky:=Trunc(Y/heig)+1;
Go(clickx,clicky);
end;

procedure TForm1.Load; // отвечает за загрузку поля
var
into,outof:Trect; // ввод и вывод
lx,ly:integer; // координаты верхнего левого угла ввода
i,j:integer;
begin
for i:=1 to W do // отслеживает содержимое клеток
for j:=1 to H do
begin
ly:=((pole[i,j]-1) div W) * heig; // присвоим координатам верхнего левого угла ввода номер картинки
lx:=((pole[i,j]-1) mod W) * widt;
into:=Bounds(lx,ly,widt,heig);
outof:=Bounds((j-1)*widt,(i-1)*heig,widt,heig);
if pole[i,j]<>0
then Canvas.CopyRect(outof,pic.Canvas,into)
else Canvas.Rectangle((j-1)*widt,(i-1)*heig,j*widt,i*heig);
end;
end;

procedure TForm1.refresh; // "тусует" фрагменты картинки
var
x1,y1:integer; // координаты пустой клетки
x2,y2:integer; // взять картинку из этой координаты и поменять её с пустой
n:integer; // направление возможного хода
i:integer;
begin
x1:=4;
y1:=4;
randomize;
for i:=1 to 150 do // варианты расстановки
begin
repeat
x2:=x1;
y2:=y1;
n:=random(4)+1;
case n of
1:dec(x2);
2:inc(x2);
3:dec(y2);
4:inc(y2);
end;
until (x2>=1) and (x2<=4) and (y2>=1) and (y2<=4);
pole[y1,x1]:=pole[y2,x2]; // определим фрагмент перемещения
pole[y2,x2]:=0;
x1:=x2;
y1:=y2;
end;
zx:=x1; // координаты пустой клетки
zy:=y1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
pic:=TBitMap.Create;
New;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Form1.Load;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N2Click(Sender: TObject);
var i,j: integer;
begin
heig:=Pic.Height div H; // Размер клетки
widt:=Pic.Width div W;
ClientWidth:=widt*W; //Размер формы по размеру картинки
ClientHeight:=heig*H;
for i:=1 to H do
for j:=1 to W do
pole[i,j]:=pos[i,j];
Form1.Refresh; // перемещение клеток
Form1.Load; // загрузка поля
end;

procedure TForm1.C1Click(Sender: TObject);
begin
showmessage('Программа к курсовому проекту');
end;

procedure TForm1.N5Click(Sender: TObject);
var
f: string[20]; // файл загружаемой картинки
i,j: integer;
begin
openpicturedialog1.Execute;
try
pic.LoadFromFile(openpicturedialog1.FileName);
except
on EFopenError do
begin
ShowMessage('Ошибка загрузки файла');
Form1.Close;
end;
end;
heig:=Pic.Height div H; // Размер клетки
widt:=Pic.Width div W;
ClientWidth:=widt*W; //Размер формы по размеру картинки
ClientHeight:=heig*H;
for i:=1 to H do
for j:=1 to W do
pole[i,j]:=pos[i,j];
Form1.Refresh; // перемещение клеток
Form1.Load; // загрузка поля
end;

end. [Ответ]
AIM-9M 16:48 29.05.2009
Что значит "не хочет работать"? [Ответ]
X0R 18:22 29.05.2009
хоть бы проект выложил. [Ответ]
dkuzechkin 15:18 31.05.2009
КУРСОВАЯ РАБОТА тема ИГРА «МОЗАЙКА» [Ответ]
X0R 15:50 31.05.2009

Сообщение от dkuzechkin:
КУРСОВАЯ РАБОТА тема ИГРА «МОЗАЙКА»

КРУТО что ЕЩЕ СКАЗАТЬ ТО [Ответ]
Yandex 18:02 31.05.2009
X0R, как что?! Чтобы готовил бабки и шел в прикрепленную тему для таких делов. [Ответ]
xxx-men 18:12 31.05.2009
dkuzechkin, ВЫЛОЖИ весь ПРОЕКТ. [Ответ]
X0R 18:41 31.05.2009
Yandex, ЧЕЛ видимо ХОЧЕТ БЕЗ БАБОК [Ответ]
mexx 19:10 31.05.2009
X0R, НЕ БУДЕТ тогда У НЕГО КУРСЯКА [Ответ]
Part!zan 19:38 31.05.2009

Сообщение от dkuzechkin:
ИГРА «МОЗАЙКА»

ПРО ЗАЙЦЕВ? [Ответ]
][irurg 20:47 31.05.2009

Сообщение от Part!zan:
ПРО ЗАЙЦЕВ?

)) МОгучий ЗАЙКА. ПЯТЬ баллов давай ЗАЧЕТКУ [Ответ]
X0R 21:00 31.05.2009
БЕЗ РАЗГРАБЛЕНИЯ КОРОВАНОВ на 5 НЕ ТЯНЕТ [Ответ]
xxx-men 11:23 01.06.2009
ВОТ ПЛЯ НАЛЕТЕЛИ, лучшебы ПОМОГЛИ [Ответ]
X0R 15:46 01.06.2009
xxx-men, НЕ флуди А ПОМОГИ! [Ответ]
Part!zan 19:43 01.06.2009
xxx-men, ДЕЦТВИТЕЛЬНО, взял бы И ПОМОГ. [Ответ]
dkuzechkin 20:21 01.06.2009
кароче необходимо было разработать графическую программу мозаика [Ответ]
xxx-men 01:33 02.06.2009
Part!zan, ТАК ПРОЕКТ НИФИГА не ВЫЛОЖЕН [Ответ]
xxx-men 01:34 02.06.2009

Сообщение от dkuzechkin:
кароче необходимо было разработать графическую программу мозаика

ТИПА с нуля НАПИСАТЬ? 0_о [Ответ]
Yandex 08:58 02.06.2009
xxx-men, познай всю лень неучей! [Ответ]
Part!zan 19:13 02.06.2009
xxx-men, А ЗАЧЕМ тебе ПРОЕКТ? ТЫ и так КУЛХАЦКЕР ))) [Ответ]
HelgaBeer 19:38 03.06.2009
Это не совсем Мозайка. Скорее Пятнашки...
Причем писали их мы с одногруппником году эдак в 2005 )))) Или даже раньше. Не помню.
И вполне рабочие. Были, по крайней мере. Уж не знаю, что там у топикстартера не работает... Может, картинку требует? [Ответ]
Вверх