Текущий архив: 2004.04.11;
Скачать: CL | DM;

Вниз

Помогите написать процедуру ...   Найти похожие ветки 

← →
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.

Можно немного поточнее?

---

← →
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:58) [4]

Gero ©   Спасибо! Это уже прошло. теперь усложнить надо, смотри прошлый пост.

---

← →
Liona ©   (2004-04-23 00:02) [5]

Вот самое полное задание - Лабиринт. Программа случайно генерирует лабиринт – поле 20х20 клеток,
некоторые из которых являются препятствиями. Лабиринт изображается с помощью
динамически создаваемых 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;


---

← →
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 01:00) [10]

C pos_i... перемудрил, можно и вычислять было :)

---

← →
Liona ©   (2004-04-23 01:08) [11]

Алхимик © перемудрил. Може есть другие варианты? А то неработает :(

---

← →
Алхимик ©   (2004-04-23 01:10) [12]

Работает. Проверено на людях.

---

← →
Liona ©   (2004-04-23 01:15) [13]

Mihey ©   (23.04.04 00:48) [7] Всё заработало !!!! после некоторых поправок.

Алхимик ©   Прости но то вариант был быстрее чем твой и мне показался более удобным. Но всё равно спасибо за старания. (За это я постараюсь прочитать пару умных книжек :))

---

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

Текущий архив: 2004.04.11;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.028 c