Форум: "Основная";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Вниз
Помогите написать процедуру ... Найти похожие ветки
← →
Liona © (2004-04-22 23:39) [0]Само задание - Динамически гинерируется лабиринт из Label- ов. Надо крайним левым верхним Label пройти по лабиринту до правой нижней.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Mas:array[1..20,1..20] of TLabel;
L: TLabel;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 20 do
for j:=1 to 20 do
begin
L:=TLabel.Create(Form1);
L.Left:=1+(j-1)*16;
L.Top:=1+(i-1)*17;
L.Caption:="";
L.AutoSize:=False;
L.Height:=16;
L.Width:=15;
L.Parent:=Form1;
L.Color:=clSkyBlue;
L.Font.Height:=-15;
L.OnClick := LClick;
Mas[i,j]:=L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color:=clRed;
Mas[1,1].Color:=clLime;
end;
end.
Помогите написать procedure LClick; Которая при нажатии мышкой на Label меняет цвет.
← →
Liona © (2004-04-22 23:39) [0]Само задание - Динамически гинерируется лабиринт из Label- ов. Надо крайним левым верхним Label пройти по лабиринту до правой нижней.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Mas:array[1..20,1..20] of TLabel;
L: TLabel;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 20 do
for j:=1 to 20 do
begin
L:=TLabel.Create(Form1);
L.Left:=1+(j-1)*16;
L.Top:=1+(i-1)*17;
L.Caption:="";
L.AutoSize:=False;
L.Height:=16;
L.Width:=15;
L.Parent:=Form1;
L.Color:=clSkyBlue;
L.Font.Height:=-15;
L.OnClick := LClick;
Mas[i,j]:=L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color:=clRed;
Mas[1,1].Color:=clLime;
end;
end.
Помогите написать procedure LClick; Которая при нажатии мышкой на Label меняет цвет.
← →
Yanis © (2004-04-22 23:51) [1]Оно?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure LblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Mas:array[1..20,1..20] of TLabel;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
l:TLabel;
begin
for i:=1 to 20 do
for j:=1 to 20 do
begin
L:=TLabel.Create(Form1);
L.Left:=1+(j-1)*16;
L.Top:=1+(i-1)*17;
L.Caption:="";
L.AutoSize:=False;
L.Height:=16;
L.Width:=15;
L.Parent:=Form1;
L.Color:=clSkyBlue;
L.Font.Height:=-15;
L.OnClick := Form1.LblClick;
Mas[i,j]:=L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color:=clRed;
Mas[1,1].Color:=clLime;
end;
procedure TForm1.LblClick(Sender: TObject);
begin
(Sender as TLabel).Color := clred;
end;
end.
Можно немного поточнее?
← →
Yanis © (2004-04-22 23:51) [1]Оно?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure LblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Mas:array[1..20,1..20] of TLabel;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
l:TLabel;
begin
for i:=1 to 20 do
for j:=1 to 20 do
begin
L:=TLabel.Create(Form1);
L.Left:=1+(j-1)*16;
L.Top:=1+(i-1)*17;
L.Caption:="";
L.AutoSize:=False;
L.Height:=16;
L.Width:=15;
L.Parent:=Form1;
L.Color:=clSkyBlue;
L.Font.Height:=-15;
L.OnClick := Form1.LblClick;
Mas[i,j]:=L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color:=clRed;
Mas[1,1].Color:=clLime;
end;
procedure TForm1.LblClick(Sender: TObject);
begin
(Sender as TLabel).Color := clred;
end;
end.
Можно немного поточнее?
← →
Gero © (2004-04-22 23:53) [2]Процедура цвета не имеет.
Если нужно поменять увет label"a то:
procedure _.LClick(Sender : TObject);
begin
TLabel(Sender).Color := clSomeColor;
end;
← →
Gero © (2004-04-22 23:53) [2]Процедура цвета не имеет.
Если нужно поменять увет label"a то:
procedure _.LClick(Sender : TObject);
begin
TLabel(Sender).Color := clSomeColor;
end;
← →
Liona © (2004-04-22 23:56) [3]Отлично спасибо, странно что я писала почти тоже самое но срабатывало.
Еще бы только сделать так что бы красились только те Label которые есть только радом с уже покрашеной.
← →
Liona © (2004-04-22 23:56) [3]Отлично спасибо, странно что я писала почти тоже самое но срабатывало.
Еще бы только сделать так что бы красились только те Label которые есть только радом с уже покрашеной.
← →
Liona © (2004-04-22 23:58) [4]Gero © Спасибо! Это уже прошло. теперь усложнить надо, смотри прошлый пост.
← →
Liona © (2004-04-22 23:58) [4]Gero © Спасибо! Это уже прошло. теперь усложнить надо, смотри прошлый пост.
← →
Liona © (2004-04-23 00:02) [5]Вот самое полное задание - Лабиринт. Программа случайно генерирует лабиринт – поле 20х20 клеток,
некоторые из которых являются препятствиями. Лабиринт изображается с помощью
динамически создаваемых Label. В левом верхнем углу находится человечек,
которому нужно попасть в правый нижний угол. Задача игрока – провести человечка
в правый нижний угол. Путь прокладывается с помощью мыши, нажатием на следующую клетку,
куда игроку надо пойти.
← →
Liona © (2004-04-23 00:02) [5]Вот самое полное задание - Лабиринт. Программа случайно генерирует лабиринт – поле 20х20 клеток,
некоторые из которых являются препятствиями. Лабиринт изображается с помощью
динамически создаваемых Label. В левом верхнем углу находится человечек,
которому нужно попасть в правый нижний угол. Задача игрока – провести человечка
в правый нижний угол. Путь прокладывается с помощью мыши, нажатием на следующую клетку,
куда игроку надо пойти.
← →
Liona © (2004-04-23 00:21) [6]Еще бы только сделать так что бы красились только те Label которые есть только радом с уже покрашеной.
← →
Liona © (2004-04-23 00:21) [6]Еще бы только сделать так что бы красились только те Label которые есть только радом с уже покрашеной.
← →
Mihey © (2004-04-23 00:48) [7]No Problemo...
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TmainForm = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure LblClick(Sender: TObject);
public
{ Public declarations }
end;
var
mainForm: TmainForm;
Mas: array [1..20,1..20] of TLabel;
implementation
{$R *.DFM}
procedure TmainForm.LblClick(Sender: TObject);
var x, y: Integer;
begin
// If (Sender as TLabel).Color = clred then ShowMessage("Red!");
x := ((Sender as TLabel).Tag-1) mod 20 + 1;
y := ((Sender as TLabel).Tag-1) div 20;
// ShowMessage(IntToStr(x) + ";" + IntToStr(y));
// If Mas[x+1, y].Color = clred then ShowMessage("Red!");
If (x+1 >= 1) and (x+1 <= 20) and (y >= 1) and (y <= 20) then
If (Mas[x+1, y].Color = clRed) then
begin
// ShowMessage(IntToStr(x) + ";" + IntToStr(y));
(Sender as TLabel).Color := clred;
end;
If (x-1 >= 1) and (x-1 <= 20) and (y >= 1) and (y <= 20) then
If (Mas[x-1, y].Color = clRed) then (Sender as TLabel).Color := clred;
If (x >= 1) and (x <= 20) and (y-1 >= 1) and (y-1 <= 20) then
If (Mas[x, y-1].Color = clRed) then (Sender as TLabel).Color := clred;
If (x >= 1) and (x <= 20) and (y+1 >= 1) and (y+1 <= 20) then
If (Mas[x, y+1].Color = clRed) then (Sender as TLabel).Color := clred;
end;
procedure TmainForm.FormCreate(Sender: TObject);
var i,j: integer;
l: TLabel;
begin
for i := 1 to 20 do
for j := 1 to 20 do
begin
L := TLabel.Create(mainForm);
L.Left := 1+(j-1)*16;
L.Top := 1+(i-1)*17;
L.Caption := "";
L.AutoSize := False;
L.Height := 16;
L.Width := 15;
L.Parent := mainForm;
L.Color := clBlue;
L.Font.Height := -15;
L.OnClick := mainForm.LblClick;
L.Tag := j*20 + i;
Mas[i,j] := L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color := clRed;
Mas[1,1].Color := clLime;
end;
← →
Mihey © (2004-04-23 00:48) [7]No Problemo...
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TmainForm = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure LblClick(Sender: TObject);
public
{ Public declarations }
end;
var
mainForm: TmainForm;
Mas: array [1..20,1..20] of TLabel;
implementation
{$R *.DFM}
procedure TmainForm.LblClick(Sender: TObject);
var x, y: Integer;
begin
// If (Sender as TLabel).Color = clred then ShowMessage("Red!");
x := ((Sender as TLabel).Tag-1) mod 20 + 1;
y := ((Sender as TLabel).Tag-1) div 20;
// ShowMessage(IntToStr(x) + ";" + IntToStr(y));
// If Mas[x+1, y].Color = clred then ShowMessage("Red!");
If (x+1 >= 1) and (x+1 <= 20) and (y >= 1) and (y <= 20) then
If (Mas[x+1, y].Color = clRed) then
begin
// ShowMessage(IntToStr(x) + ";" + IntToStr(y));
(Sender as TLabel).Color := clred;
end;
If (x-1 >= 1) and (x-1 <= 20) and (y >= 1) and (y <= 20) then
If (Mas[x-1, y].Color = clRed) then (Sender as TLabel).Color := clred;
If (x >= 1) and (x <= 20) and (y-1 >= 1) and (y-1 <= 20) then
If (Mas[x, y-1].Color = clRed) then (Sender as TLabel).Color := clred;
If (x >= 1) and (x <= 20) and (y+1 >= 1) and (y+1 <= 20) then
If (Mas[x, y+1].Color = clRed) then (Sender as TLabel).Color := clred;
end;
procedure TmainForm.FormCreate(Sender: TObject);
var i,j: integer;
l: TLabel;
begin
for i := 1 to 20 do
for j := 1 to 20 do
begin
L := TLabel.Create(mainForm);
L.Left := 1+(j-1)*16;
L.Top := 1+(i-1)*17;
L.Caption := "";
L.AutoSize := False;
L.Height := 16;
L.Width := 15;
L.Parent := mainForm;
L.Color := clBlue;
L.Font.Height := -15;
L.OnClick := mainForm.LblClick;
L.Tag := j*20 + i;
Mas[i,j] := L;
Randomize;
if ((Random(18)+2)=i) or ((Random(18)+2)=j) then
begin
Mas[i,j].Color:=cl3DLight;
Mas[i,j].Visible:=False;
end;
end;
Mas[20,20].Color := clRed;
Mas[1,1].Color := clLime;
end;
← →
Liona © (2004-04-23 00:57) [8]Чегой то неработает :(
← →
Liona © (2004-04-23 00:57) [8]Чегой то неработает :(
← →
Алхимик © (2004-04-23 00:58) [9]А так?
Переопределим метку для хранения в ней её позицииTMyLabel = class(TLabel)
public
pos_i : integer;
pos_j : integer;
end;
Везде вместо Tlabel используй TMyLabel.
В OnCreate замени:
L:=TLabel.Create(Form1);
на
L:=TMyLabel.Create(Form1);...
L.pos_i := i; // запоминаем позицию метки
L.pos_j := j;
Алгоритм закрашивания только рядом стоящей метки вижу таким:
необходимо проверить 8 меток из области:
***
*L*
***
на наличие красной.
Вводим локальные переменные n1,n2,m1,m2, отражающие координаты нужной области.
n1,m1 - координаты верхнего левого угла,
n2,m2 - координаты правого нижнего угла.
Плюс проверяем эти координаты на вхождение в диапазон 1..20,1..20
Затем двойным циклом проходим по полученной области в
поиске красной метки, если находим таковую - смело красим текущую метку в красный цвет и выходим из цикла.procedure TForm1.LblClick(Sender: TObject);
var
n1,n2,m1,m2 : integer;
nn,mm : integer;
CanChangeColor : boolean;
begin
if not (Sender is TMyLabel) then exit;
with (Sender as TMyLabel) do begin
if (Pos_i-1) >= 1 then n1 := pos_i-1
else n1 := pos_i;
if (Pos_i+1) <= 20 then n2 := pos_i+1
else n2 := pos_i;
if (Pos_j-1) >= 1 then m1 := pos_j-1
else m1 := pos_j;
if (Pos_j+1) <= 20 then m2 := pos_j+1
else m2 := pos_j;
CanChangeColor := false;
for nn := n1 to n2 do
for mm := m1 to m2 do
if mas[nn,mm].Color = clRed then begin
(Sender as TMyLabel).Color := clred;
break;
end;
end;
end;
← →
Алхимик © (2004-04-23 00:58) [9]А так?
Переопределим метку для хранения в ней её позицииTMyLabel = class(TLabel)
public
pos_i : integer;
pos_j : integer;
end;
Везде вместо Tlabel используй TMyLabel.
В OnCreate замени:
L:=TLabel.Create(Form1);
на
L:=TMyLabel.Create(Form1);...
L.pos_i := i; // запоминаем позицию метки
L.pos_j := j;
Алгоритм закрашивания только рядом стоящей метки вижу таким:
необходимо проверить 8 меток из области:
***
*L*
***
на наличие красной.
Вводим локальные переменные n1,n2,m1,m2, отражающие координаты нужной области.
n1,m1 - координаты верхнего левого угла,
n2,m2 - координаты правого нижнего угла.
Плюс проверяем эти координаты на вхождение в диапазон 1..20,1..20
Затем двойным циклом проходим по полученной области в
поиске красной метки, если находим таковую - смело красим текущую метку в красный цвет и выходим из цикла.procedure TForm1.LblClick(Sender: TObject);
var
n1,n2,m1,m2 : integer;
nn,mm : integer;
CanChangeColor : boolean;
begin
if not (Sender is TMyLabel) then exit;
with (Sender as TMyLabel) do begin
if (Pos_i-1) >= 1 then n1 := pos_i-1
else n1 := pos_i;
if (Pos_i+1) <= 20 then n2 := pos_i+1
else n2 := pos_i;
if (Pos_j-1) >= 1 then m1 := pos_j-1
else m1 := pos_j;
if (Pos_j+1) <= 20 then m2 := pos_j+1
else m2 := pos_j;
CanChangeColor := false;
for nn := n1 to n2 do
for mm := m1 to m2 do
if mas[nn,mm].Color = clRed then begin
(Sender as TMyLabel).Color := clred;
break;
end;
end;
end;
← →
Алхимик © (2004-04-23 01:00) [10]C pos_i... перемудрил, можно и вычислять было :)
← →
Алхимик © (2004-04-23 01:00) [10]C pos_i... перемудрил, можно и вычислять было :)
← →
Liona © (2004-04-23 01:08) [11]Алхимик © перемудрил. Може есть другие варианты? А то неработает :(
← →
Liona © (2004-04-23 01:08) [11]Алхимик © перемудрил. Може есть другие варианты? А то неработает :(
← →
Алхимик © (2004-04-23 01:10) [12]Работает. Проверено на людях.
← →
Алхимик © (2004-04-23 01:10) [12]Работает. Проверено на людях.
← →
Liona © (2004-04-23 01:15) [13]Mihey © (23.04.04 00:48) [7] Всё заработало !!!! после некоторых поправок.
Алхимик © Прости но то вариант был быстрее чем твой и мне показался более удобным. Но всё равно спасибо за старания. (За это я постараюсь прочитать пару умных книжек :))
← →
Liona © (2004-04-23 01:15) [13]Mihey © (23.04.04 00:48) [7] Всё заработало !!!! после некоторых поправок.
Алхимик © Прости но то вариант был быстрее чем твой и мне показался более удобным. Но всё равно спасибо за старания. (За это я постараюсь прочитать пару умных книжек :))
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];
Память: 0.55 MB
Время: 0.076 c
