Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.10.2015, 13:37   #1
shadd
 
Регистрация: 16.03.2015
Сообщений: 3
Сообщение Соединение точек на канве между собой

Здравствуйте Подскажите пожалуйста как соединить точки на канвас между собой
код

нужно сделать аналогично раставлять точки мышкой кнопкой соеденять
Код:
 unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    PaintBox1: TPaintBox;
    Button3: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure line(x1,y1,x2,y2:real;canvas:Tcanvas);
    

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

var
  Form1: TForm1;
   x1,y1,x2,y2,i:integer;
  a,b:array [1..10]of integer;
  x,y,dy,dx,length:real;
implementation

{$R *.dfm}
function sign(a:real):real;
begin
  if a<0 then
    result:=1;
  if a=0 then
      result:=0;
  if a>0 then
    result:=-1;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
PaintBox1.Refresh;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 PaintBox1.Canvas.Pen.Color:=clRed;
 PaintBox1.Canvas.MoveTo(a[1],b[1]);
//PaintBox1.Canvas.LineTo(a[2],b[2]);

for i:=2 to 10 do
 begin
  if (a[i]OR b[i])<>0 then

 begin
PaintBox1.Canvas.LineTo(a[i],b[i]);
 end;
 end;
 PaintBox1.Canvas.LineTo(a[1],b[1]);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
i:=0;
PaintBox1.Canvas.Brush.Color:=clBlack;
PaintBox1.Canvas.Pen.Color:=clBlack;
PaintBox1.Canvas.Rectangle(0,0,PaintBox1.Width-1,PaintBox1.Height-1);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
i:=1;
i:=i+1;
X1:=x;
Y1:=y;
i:=i+1;
PaintBox1.Canvas.Pixels[x1,y1]:=ClGreen;
a[i]:=x1;
b[i]:=y1;
i:=i+1;
X1:=x;
Y1:=y;
end;
end;
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
x2:=x;
y2:=y;
end;

procedure TForm1.line(x1, y1, x2, y2: real; canvas: Tcanvas);
begin
  if (abs(x2-x1)>=abs(y2-y1)) then
    length:=abs(x2-x1)
  else
  length:=abs(y2-y1);
  dx:=(x2-x1)/length;
  dy:=(y2-y1)/length;
  x:=x1+0.5*sign(dx);
  y:=y1+0.5*sign(dy);
  i:=1;
  while i<=length do
  begin
    Canvas.Pixels[trunc(x),trunc(y)]:=clGray;
    x:=x+dx;
    y:=y+dy;
    i:=i+1;

  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Label1.Caption:=inttostr(x)+':'+inttostr(y);
end;

end.
Вложения
Тип файла: rar граф лаб.rar (320.9 Кб, 10 просмотров)

Последний раз редактировалось Stilet; 18.10.2015 в 13:54.
shadd вне форума Ответить с цитированием
Старый 20.10.2015, 06:47   #2
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,876
По умолчанию

Сперва Вам надо бы разобраться, что Вы подразумевали, задействуя в подпрограммах одновременно одинаковые идентификаторы x, y - свои глобальные и X, Y - параметры подпрограмм, судя по коду, в некоторых случаях Вы подразумеваете свои, в некоторых - параметры, из-за этого каша.
Во-вторых, в PaintBox1MouseDown Вы каждый раз перезаписываете координаты точек (засчёт одного и того же индекса), а надо их складывать в некую очередь, например, запоминая, под каким индексом была последняя точка, чтобы новую точку запомнить следующим элементом "очереди", после чего уже можно рисовать линии по этим точкам в цикле.
phomm вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Php, соединение элементов шаблона сайта между собой. как правильно? cyx PHP 6 27.08.2015 22:53
Заданы координаты n точек на плоскости. Найти номера двух точек, расстояние между которыми наибольшее. Программа на языке С nync Помощь студентам 6 20.01.2014 14:30
Даны координаты точек n на плоскости. Найти номера двух точек, расстояние между которыми наибольшее. getredtm Помощь студентам 3 01.07.2013 01:47
Комбинирование классов между собой monolit111 Общие вопросы C/C++ 9 29.07.2012 23:39
Даны координаты n точек на плоскости. Найти номера двух точек, расстояние между которыми наибольшее. Viwwna Паскаль, Turbo Pascal, PascalABC.NET 2 19.11.2011 06:33