Помогите с программой в Delphi
Вот код программы
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Grids, Buttons;
type
TForm1 = class(TForm)
Image1: TImage;
Label3: TLabel;
StringGrid1: TStringGrid;
Button1: TButton;
BitBtn1: TBitBtn;
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Image1:TImage;
X, N:Integer;
Y:Integer;
s:string;
Origin, MovePt: TPoint;
Drawing: boolean;
implementation
{$R *.dfm}
procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode);
begin
with Form1.Image1.Canvas do begin
Pen.Mode :=AMode;
MoveTo(TopLeft.X, TopLeft.Y);
LineTo(BottomRight.X,BottomRight.Y);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Drawing=true then begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
N:=N+1;
str(N,s);
StringGrid1.RowCount:=N;
if Button<>mbLeft then Exit;
Image1.Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
Drawing := true;
StringGrid1.RowCount:= N+1;
StringGrid1.Cells[0,0]:='Название вектора';
StringGrid1.Cells[1,0]:='x1';
StringGrid1.Cells[2,0]:='y1';
StringGrid1.Cells[3,0]:='x2';
StringGrid1.Cells[4,0]:='y2';
StringGrid1.Cells[0,N]:='Вектор № '+ s;
StringGrid1.Cells[1,N]:= Format('%d',[x]);
StringGrid1.Cells[2,N]:= Format('%d',[y]);
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
StringGrid1.Cells[3,N]:= Format('%d',[x]);
StringGrid1.Cells[4,N]:= Format('%d',[y]);
Drawing := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
xx1, xx2, xx4, yy1, yy2:integer;
yy4, code:integer;
xxs1, xxs2, xxs4, yys1, yys2, yys4:string;
begin
xxs1:=StringGrid1.Cells[1,1];
xxs2:=StringGrid1.Cells[1,2];
val (xxs1, xx1, code);
val (xxs2, xx2, code);
yys1:=StringGrid1.Cells[2,1];
yys2:=StringGrid1.Cells[2,2];
val (yys1, yy1, code);
val (yys2, yy2, code);
repeat
if (yy1>yy2) and (xx1>xx2) then
begin
yy2:=yy2+5;
yys4:=StringGrid1.Cells[4,2];
val(yys4, yy4, code);
yy4:=yy4+5;
xx2:=xx2+5;
xxs4:=StringGrid1.Cells[3,2];
val(xxs4, xx4, code);
xx4:=xx4+5;
end else
begin
yy2:=yy2-5;
yys4:=StringGrid1.Cells[4,2];
val (yys4, yy4, code);
yy4:=yy4-5;
xx2:=xx2-5;
xxs4:=StringGrid1.Cells[4,2];
val(xxs4, xx4, code);
xx4:=xx4-5;
end;
if ((yy1-yy2)<5) or ((yy1-yy2)>-5) and ((xx1-xx2)<5) or ((xx1-xx2)>-5) then
begin
yy2:=yy1;
yy4:=yy4+(yy1-yy2);
xx2:=xx1;
xx4:=xx4+(xx1-xx2);
end;
with Form1.Image1.Canvas do begin
{Pen.Mode :=AMode;}
MoveTo(xx2, yy2);
LineTo(xx4, yy4);
end;
until (yy1=yy2) and (xx1=xx2);
end;
end.
Программа заключается в том, чтобы начало одной линии передвинулось к началу другой и от конца одной к концу другой должна провестись еще одна линия. С моим кодом получается так, что линия когда передвигается, то она передвигается совсем не туда и под другим наклоном, либо вообще другой длины. Не понимаю, что делать. Помогите. Заранее спасибо. Очень нужна ваша помощь.
|