[maddamo4ka]

вот мой код программы

Код:

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);
    procedure BitBtn1Click(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);
yys4:=StringGrid1.Cells[4,2];
val(yys4, yy4, code);
yys4:=StringGrid1.Cells[4,2];
val (yys4, yy4, code);
xxs4:=StringGrid1.Cells[3,2];
val(xxs4, xx4, code);
{xxs3:=StringGrid1.Cells[3,1];
val(xxs3, xx3, code);  {}
repeat
if (yy1>yy2) or (xx1>xx2) then
begin
yy2:=yy2+5;
yy4:=yy4+5;
xx2:=xx2+5;  {}
xx4:=xx4+5;   {}
end else
begin
yy2:=yy2-5;
yy4:=yy4-5;
xx2:=xx2-5;  {}
xx4:=xx4-5;    {}
end;
if (((yy1-yy2)<5) and ((yy1-yy2)>-5)) or (((xx1-xx2)<5) and ((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;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
    Form1.Image1.Refresh;
end;

end.

Как с помощью таймера одна линия пододвигалась к другой? подскажите как сделать так, что бы линии которые показывают как двигается линия были белыми. И как нарисовать линию, которая соединяла бы концы двух линий. И как сделать так чтобы с помощью кнопки BitBtn очищалось поле для рисования? Заранее спасибо

[Ama]

Сообщение от maddamo4ka

Как с помощью таймера одна линия пододвигалась к другой? подскажите как сделать так, что бы линии которые показывают как двигается линия были белыми. И как нарисовать линию, которая соединяла бы концы двух линий. И как сделать так чтобы с помощью кнопки BitBtn очищалось поле для рисования? Заранее спасибо

Я думаю что-бы с помощью таймера линия двигалась нужно использовать написанную тобой проседуру меняя цвет предыдущей линии на белый. Что-бы заменить цвет на белый добавь в проседуру DrawShape добавь параметр Colot: TColor и меняй его на белый. Примерно так:

Код:

procedure DrawShape(TopLeft, BottomRight:TPoint;AMode:TPenMode; AColor: TColor);
 var OldColor: TColor;
begin
  with Form1.Image1.Canvas do 
    begin
      OldColor:= Pen.Color;
      Pen.Color:= AColor;
      Pen.Mode :=AMode;
      MoveTo(TopLeft.X, TopLeft.Y);
      LineTo(BottomRight.X,BottomRight.Y);
      PenColor:= OldColor;
    end;
end;

А чтобы очистить канву просто используй проседуру
Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height)
но перед вызовом запиши строчку: Image1.Canvas.Brush.Style:= bsClear;

[maddamo4ka]

спасибо мне с таймером нужна задержка, то есть будет показываться как двигается линия..не знаю как это осуществить..вчера с преподом на практике разбиралась..он сам не может это сделать. Эту процедуру с закраскй линий куда вставлять?

[Ama]

Сообщение от maddamo4ka

спасибо мне с таймером нужна задержка, то есть будет показываться как двигается линия..не знаю как это осуществить..вчера с преподом на практике разбиралась..он сам не может это сделать. Эту процедуру с закраскй линий куда вставлять?

Как я понял твоя процедура DrawShape рисует линию. А в StringGrid у тебя записаны координаты линий. Во первых я не могу понять какую именно линию тебе на "двигать". С помощью StringGrid можно выбрать требуемую линию по координатам. Естественно на свою форму бросаешь компонент Timer и обрабатываешь событие OnTimer. Укажи глобальные переменные X1, X2, Y1, Y2 которые соответствует снало начальным координатам двигаемой линии, затем меняешь координаты линии, а старые оставляешь в этих глобальных переменных. DrawShape(newXY, newX1Y1, pen, color) а затем DrawShape(Point(X1, X2), Point(X2, Y2), pen, white). Время задержки подбираешь примерно из расчета 25 кадро в секунду это получается примерно Round(1000/25). Вот примерно так.

[maddamo4ka]

спасибо надо попробовать если не получится буду пытать дальше

[lmikle]

помнится, я где-то писал тебе код, который собственно и двигал линию по таймеру. Правда я сделал это немного проще. Идея была такая:
У тебя есть исходные данные (координаты) и данные для отрисовки. Это разные переменные. По исходным данным идет только инициализация процесса (т.е. просто копирование исходных данных в данные для отрисовки). По даным для отрисовки ты каждый раз отрисовываешь картинку (я там использовал TPaintBox). таймер при срабатывании просто изменяет данные для отрисовки и принудительно заставялет TPaintBox перерисоваться по новым даннным. Так же, в обработчике таймера заданы конечные условия изменения, т.е. когда таймеру надо остановиться. Все. Если нужен код, могу попробовать восстановить.

[maddamo4ka]

код у меня остался..просто там еще зачем то код для формы какой-то

[maddamo4ka]

а мне надо сделать именно так, что бы вектора рисовались мышкой..именно так как у меня есть. Вот и мучаюсь теперь как сделать так что бы показывалось все

[maddamo4ka]

а что у тебя в коде за тип TVector? его вводить просто от руки или на форме должен быть такоей объект? и когда тулбар устанавливаю у меня не так pnToolBar: TPanel; пишется, а ToolBar1: TToolBar; и вот это все не могу понять что такое btGetVecors: TButton; pnBottom: TPanel; pbDraw:TPaintBox;btMult: TButton;

[maddamo4ka]

а можно как то сделать прогу с таймером чтобы не изменять мою программу?

[lmikle]

TVector - протсто мой тип, введенный для удобства. Это 2 точки, описывающие начало и конец вектора. pnToolBar - это просто панель, ну назвал я ее так. btGetVectors - кнопка для задания векторов (фактически, там машина состояний). pnBottom - тоже панель, куда выводятся координаты. pbdraw - Paintbox, на котором и происходит отрисовка. btMult - кнопка, запускающая процесс "умножения" (в моем примере - сдвиг вектора).

Предесть использования TPaintBox в том, что там ненадо ничего делать для стирания "следов" предыдущей отрисовки, т.к. там надо заного отрисовывать всю картинку.

Можно попробовать и твою поправить.
Выложи архивом весь проект, будет время - гляну (или еще кто глянет).

[maddamo4ka]

вот и архив

[maddamo4ka]

пожалуйста просмотрите, мою программу помогите кто чем может