Рисования в Lazarus
Модератор: Модераторы
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Рисования в Lazarus
У меня есть заданной алгоритм, который при клике мишки рисует один елипс.Как сделать что бы при каждом клике рисовалось столько елипсов сколько было кликов?
Вы сами то поняли. что сказали?
У Вас при каждом клике только один клик. При одном клике несколько кликов в принципе быть не может. 
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Вот весь код программы.Мне нужно что бы при клике на окно программы можно было рисовать столько эллипсов сколько раз я нажал кнопкой мышьи!Помогите!Заранье спасибо!
Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls;
type
{ TForm1 }
Ttargan = class
public
x,y : double;
golod : integer;
stan : integer;
{ 0 - стою
1 - Гуляю
2 - Біжу до їжі
3 - Їм!
4 - Тікаю до темного
}
dov_krok : double;
procedure BigtiDo( a,b:double); //Змінити координати таргана, щоб був ближще до вказаної точки
procedure Gulyaty; //Робимо випадковий рух, гуляємо
procedure ZminityStan( svitlo: integer; a,b:double; var izha:integer); //За правилами скінченного автомату міняємо стан
procedure Isty( a,b:double; var izha:integer); //Якщо їжа досяжна - істи
procedure Tikaty;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
IdleTimer1: TIdleTimer;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdleTimer1Timer(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ private declarations }
public
{ public declarations }
Izha : integer; //Кількість їжі
A,B : integer; //Координати їжі
targan: array [0..50] of Ttargan;
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var i:integer; //Створюємо початкові стани тарганам
begin
for i:=0 to 50 do
begin
targan[i] := Ttargan.Create;
targan[i].x:=random(400)+50;
targan[i].y:=random(400)+50;
targan[i].golod:=random(200);
targan[i].dov_krok:=5;
targan[i].stan:=0;
end;
Image1.Canvas.Brush.Color:=0;
Image1.Canvas.FillRect(0,0,511,511);
Izha := 0;
end;
procedure TForm1.IdleTimer1Timer(Sender: TObject);
begin
Button2Click(Sender);
Button1Click(Sender);
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
A := X; B := Y; Izha := 600;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer; //Малюємо стадо тарганів
begin
if CheckBox1.Checked then
Image1.Canvas.Brush.Color:=127+127*256+127*256*256
else
Image1.Canvas.Brush.Color:=0;
Image1.Canvas.FillRect(0,0,511,511);
Image1.Canvas.Pen.Color:=255*256;
for i:=0 to 50 do
begin
Image1.Canvas.EllipseC(round(targan[i].x),round(targan[i].y),2,2);
end;
if Izha>0 then
begin
Image1.Canvas.Pen.Color:=255;
Image1.Canvas.EllipseC(A,B,1+round(Izha/100),1+round(Izha/100));
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i,c:integer;
begin
if CheckBox1.Checked then c:=1 else c:=0;
for i:=0 to 50 do
begin
if targan[i].golod>0 then targan[i].golod:= targan[i].golod-1;
if Izha>0 then targan[i].ZminityStan(c,A,B,Izha)
else targan[i].ZminityStan(c,-100,-100,Izha);
end;
end;
{$R *.lfm}
procedure Ttargan.BigtiDo( a,b:double);
var D : double;
begin
D := sqrt( sqr(a-x)+sqr(b-y) );
x := x + 1.5*dov_krok*(a-x)/D;
y := y + 1.5*dov_krok*(b-y)/D;
end;
procedure Ttargan.Gulyaty;
var a,b,D:double;
begin
a := random(512);
b := random(512);
D := sqrt( sqr(a-x)+sqr(b-y) );
x := x + 0.5*dov_krok*(a-x)/D;
y := y + 0.5*dov_krok*(b-y)/D;
end;
procedure Ttargan.ZminityStan( svitlo: integer; a,b:double; var izha:integer);
begin
if svitlo=1 then
begin
stan:=4;
Tikaty;
end else
if stan=0 then
begin
if golod=0 then stan:=1;
if random(2)=1 then stan:=1;
end else
if stan=1 then
begin
Gulyaty;
if (a>0)and(golod=0) then
begin
stan:=2;
end;
if golod>0 then if random(2)=0 then stan:=0;
end else
if stan=2 then
begin
if a<0 then stan:=1 else Isty(a,b,izha);
if golod=200 then stan:=0;
end else
if stan=4 then
begin
if svitlo=0 then stan:=0;
end;
end;
procedure Ttargan.Isty( a,b:double; var izha:integer); //Якщо їжа досяжна - істи
var D : double;
begin
D := sqrt( sqr(a-x)+sqr(b-y) );
if( D< 1.5*dov_krok ) then
begin
izha := izha - 1;
golod := golod + 4;
end else
begin
BigtiDo(a,b);
end;
end;
procedure Ttargan.Tikaty;
begin
if x<y then
begin
if x<(512.0-y) then BigtiDo(x,512.0) else BigtiDo(0,y);
end else
begin
if y<(512.0-x) then BigtiDo(512.0,y) else BigtiDo(x,0);
end;
end;
end. При каждом клике надо сохранять где-то куда кликнули и параметры элипса, чтобы при перерисовке(OnPaint) отрисовывать старые элипсы. Второй вариант - не делать FillRect, а просто рисовать элипс
Вы же на TImage рисуете - она не стирает старое.
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Как ето реализовать?
kolian2000 писал(а):Как ето реализовать?
Вам нужно, чтобы при клике мышкой по канве рисовался новый эллипс, а старый не стирался? Или Вы что-то другое имели в виду?
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Да,ето я имел виду
Вы могли б мне подправить код для достижения етой цели?
Что-нибудь типа такого:
Элипс рисуется в том месте, где кликнулась мышка. Старый элипс не стирается.
Код: Выделить всё
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Randomize;
Image1.Canvas.Brush.Color:=Random(16000000);
Image1.Canvas.EllipseC(X, Y, 25, 30);
end; Элипс рисуется в том месте, где кликнулась мышка. Старый элипс не стирается.
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Смисл Вы поняли но мне нужно чтобы эллипсы можно было рисовать много раз кликами мишки в разних местах!Там где кликнув там и появляется эллипс еще раз кликнув в другом месте новый эллипс появился и старый остался на месте!
Именно так процедура и работает. Или Вам нужно, чтобы под новым элипсом был виден старый? Объяснитесь поточнее, что именно Вы хотите.
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Мне не нужно что бы старый эллипс был под новым мне нужно что бы было так 

Процедура именно так и работает - просто щёлкайте мышкой в нужном Вам месте.
Поскольку свою проблему Вы объяснить не можете, то, боюсь, помочь Вам будет невозможно. Если хотите получить помощь, постарайтесь сформулировать суть Вашей проблемы более понятным образом.
Поскольку свою проблему Вы объяснить не можете, то, боюсь, помочь Вам будет невозможно. Если хотите получить помощь, постарайтесь сформулировать суть Вашей проблемы более понятным образом.
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
Я ету процедуру вставил в код потом запустил и начал кликать и нечего не работало!Рисовался один эллипс который при клике перемещается!
Значит Вы где-то допустили ошибку. Упакуйте свою программу в архив (только исходники, ни в коем случае не откомпилированные модули!!!) и кидайте сюда, буду проверять, что Вы там накалякали.
Чтобы Вы не думали, будто я Вас обманываю, вот результат работы моей процедуры.
Чтобы Вы не думали, будто я Вас обманываю, вот результат работы моей процедуры.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
-
kolian2000
- новенький
- Сообщения: 11
- Зарегистрирован: 22.12.2012 19:04:31
