Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Рисование стрелок мышкой на Canvas  [new]
bigjoe
Member

Откуда:
Сообщений: 46
Здравствуйте!
Подскажите, как реализовать рисование стрелок мышкой на canvas?
Ниже код, как я это реализовал(на форме только TImage), но у меня имеется проблема - в начале стрелки рисуются лишние линии(скрин прикрепил).
+

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, math;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  p1,p2:Tpoint;      //стартовая и конечная позиции курсора
  Drawing:Boolean;   //флаг рисования

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drawing:=false;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	Drawing:=True;
  p1.X:=X;
  p1.Y:=Y;
  p2.X:=X;
  p2.Y:=Y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var
	Angle:real;
	p3,p4:TPoint;
begin
  image1.Canvas.Pen.Mode := pmNot;
  image1.Canvas.Brush.Style := bsClear;
  image1.CAnvas.Pen.Color:=clRed;
  image1.Canvas.Pen.Width:=5;

  if Drawing = True then
  begin
    Image1.Canvas.MoveTo(p1.X,p1.Y);
    Image1.Canvas.LineTo(p2.X,p2.Y);

    Angle:=180*ArcTan2(p2.y-p1.y,p2.x-p1.x)/pi;
    p3:=Point(p2.X+Round(15*cos(pi*(Angle+150)/180)),p2.y+Round(15*sin(pi*(Angle+150)/180)));
    p4:=Point(p2.X+Round(15*cos(pi*(Angle-150)/180)),p2.y+Round(15*sin(pi*(Angle-150)/180)));
    Image1.Canvas.MoveTo(p2.X,p2.Y);
    Image1.Canvas.LineTo(p3.X,p3.y);
    Image1.Canvas.MoveTo(p2.X,p2.Y);
    Image1.Canvas.LineTo(p4.X,p4.y);

    // рисую второй раз, чтобы небыло шлейфа из стрелок
    p2.X:=X;
    p2.Y:=Y;
    Image1.Canvas.MoveTo(p1.X,p1.Y);
    Image1.Canvas.LineTo(p2.X,p2.Y);

    Angle:=180*ArcTan2(p2.y-p1.y,p2.x-p1.x)/pi;
    p3:=Point(p2.X+Round(15*cos(pi*(Angle+150)/180)),p2.y+Round(15*sin(pi*(Angle+150)/180)));
    p4:=Point(p2.X+Round(15*cos(pi*(Angle-150)/180)),p2.y+Round(15*sin(pi*(Angle-150)/180)));
    Image1.Canvas.MoveTo(p2.X,p2.Y);
    Image1.Canvas.LineTo(p3.X,p3.y);
    Image1.Canvas.MoveTo(p2.X,p2.Y);
    Image1.Canvas.LineTo(p4.X,p4.y);
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
	Angle:real;
	p3,p4:TPoint;
begin
  p2.X:=X;
  p2.Y:=Y;
  image1.Canvas.Pen.Mode:=pmCopy;

  Image1.Canvas.MoveTo(p1.X,p1.Y);
  Image1.Canvas.LineTo(p2.X,p2.Y);

  Angle:=180*ArcTan2(p2.y-p1.y,p2.x-p1.x)/pi;
  p3:=Point(p2.X+Round(15*cos(pi*(Angle+150)/180)),p2.y+Round(15*sin(pi*(Angle+150)/180)));
  p4:=Point(p2.X+Round(15*cos(pi*(Angle-150)/180)),p2.y+Round(15*sin(pi*(Angle-150)/180)));
  Image1.Canvas.MoveTo(p2.X,p2.Y);
  Image1.Canvas.LineTo(p3.X,p3.y);
  Image1.Canvas.MoveTo(p2.X,p2.Y);
  Image1.Canvas.LineTo(p4.X,p4.y);
  Drawing:=False;
end;


end.


Так же не могу решить проблему: в процессе рисования(когда зажата кнопка мыши и меняется расположение курсора), стрелка не основного цвета, а черная и в месте, где стрелка проходит по уже нарисованной - происходит наложение с инверсией цвета.
Такая же проблема с инверсией при рисовании простой линии, эллипса и прямоугольника.

К сообщению приложен файл. Размер - 1Kb
19 май 20, 23:30    [22136114]     Ответить | Цитировать Сообщить модератору
 Re: Рисование стрелок мышкой на Canvas  [new]
DimaBr
Member

Откуда:
Сообщений: 11653
Картинка с другого сайта.
+
var
  Form1: TForm1;
  Drawing:Boolean;   //ôëàã ðèñîâàíèÿ
  DrawList: TList;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drawing := false;
  DrawList := TList.Create;
  DoubleBuffered := true;
end;

type
TDrawObject = class
  procedure Draw(ACanvas: TCanvas); virtual;abstract;
end;
TLine = class(TDrawObject)
  ARect: TRect;
  procedure Draw(ACanvas: TCanvas); override;
end;
TRectangle = class(TLine)
  procedure Draw(ACanvas: TCanvas); override;
end;


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var L: TLine;
    R: TRectangle;
begin
  if tbLine.Down then begin
    L := TLine.Create;
    L.ARect := Rect(X,Y,X,Y);
    DrawList.Add(L);
  end else
  if tbRect.Down then begin
    R := TRectangle.Create;
    R.ARect := Rect(X,Y,X,Y);
    DrawList.Add(R);
  end;
  Drawing := True;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var O: TObject;
begin
  if not Drawing then Exit;
  O := DrawList.Last;
  if O is TLine then TLine(O).ARect.BottomRight := Point(X,Y);
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not Drawing then Exit;
  Drawing := False;
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var	i: integer;
begin
  for i := 0 to DrawList.Count-1 do
    TDrawObject(DrawList[i]).Draw(PaintBox1.Canvas);
end;

{ TLine }

procedure TLine.Draw(ACanvas: TCanvas);
var Angle: real;
    p:TPoint;
begin
  ACanvas.Pen.Color := clRed;
  ACanvas.Pen.Width := 5;
  ACanvas.MoveTo(ARect.Left,ARect.Top);
  ACanvas.LineTo(ARect.Right,ARect.Bottom);
  Angle := 180*ArcTan2(ARect.Bottom-ARect.Top, ARect.Right-ARect.Left)/pi;
  p := Point(ARect.Right + Round(15*cos(pi*(Angle+150)/180)),ARect.Bottom + Round(15*sin(pi*(Angle+150)/180)));
  ACanvas.MoveTo(p.X,p.y);
  ACanvas.LineTo(ARect.Right,ARect.Bottom);
  p := Point(ARect.Right + Round(15*cos(pi*(Angle-150)/180)),ARect.Bottom+Round(15*sin(pi*(Angle-150)/180)));
  ACanvas.LineTo(p.X,p.y);
end;

{ TRectangle }

procedure TRectangle.Draw(ACanvas: TCanvas);
begin
  ACanvas.Pen.Color := clGreen;
  ACanvas.Pen.Width := 5;
  ACanvas.Brush.Style := bsClear;
  ACanvas.Rectangle(ARect);
end;
20 май 20, 01:11    [22136134]     Ответить | Цитировать Сообщить модератору
 Re: Рисование стрелок мышкой на Canvas  [new]
bigjoe
Member

Откуда:
Сообщений: 46
DimaBr, Благодарю!
26 май 20, 03:08    [22139424]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить