ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Рисование стрелок мышкой на Canvas
20 сообщений из 20, страница 1 из 1
Рисование стрелок мышкой на Canvas
    #39959717
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
Здравствуйте!
Подскажите, как реализовать рисование стрелок мышкой на canvas?
Ниже код, как я это реализовал(на форме только TImage), но у меня имеется проблема - в начале стрелки рисуются лишние линии(скрин прикрепил).
 

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
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.



Так же не могу решить проблему: в процессе рисования(когда зажата кнопка мыши и меняется расположение курсора), стрелка не основного цвета, а черная и в месте, где стрелка проходит по уже нарисованной - происходит наложение с инверсией цвета.
Такая же проблема с инверсией при рисовании простой линии, эллипса и прямоугольника.
...
Рейтинг: 0 / 0
19.05.2020, 23:30
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39959727
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
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;

...
Рейтинг: 0 / 0
20.05.2020, 01:11
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39961960
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr, Благодарю!
...
Рейтинг: 0 / 0
26.05.2020, 03:08
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968451
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr,
А возможно ли подобным образом, с сохранением в список, реализовать рисование произвольной линии?
Само рисование реализовать получилось вот так:
 

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    Drawing:=True;
    PaintBox1.Canvas.MoveTo(x,y);
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    PaintBox1.Canvas.LineTo(X,Y);
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    Drawing:=false;
end;




Пока с голову пришел вариант сохранять точки в массив и рисовать их на OnPaint, но мне кажется это плохой вариант.
...
Рейтинг: 0 / 0
12.06.2020, 03:59
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968510
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
bigjoe
Пока с голову пришел вариант сохранять точки в массив и рисовать их на OnPaint, но мне кажется это плохой вариант.

Ну можно сделать Bitmap и рисовать на нём, а потом в OnPaint отрисовывать его...
...
Рейтинг: 0 / 0
12.06.2020, 12:19
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968525
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
type
TDrawObject = class
  ARect: TRect;
  procedure Draw(ACanvas: TCanvas); virtual;abstract;
  procedure SetLastPoint(P: TPoint);virtual;
  constructor Create(Rect: TRect);virtual;
end;

TLine = class(TDrawObject)
  procedure Draw(ACanvas: TCanvas); override;
end;
TRectangle = class(TDrawObject)
  procedure Draw(ACanvas: TCanvas); override;
end;
TCurve = class(TDrawObject)
  L: array of TPoint;
  procedure SetLastPoint(P: TPoint); override;
  procedure Draw(ACanvas: TCanvas);override;
  constructor Create(Rect: TRect);override;
end;

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

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if not Drawing then Exit;
  TDrawObject(DrawList.Last).SetLastPoint(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;

{ TDrawObject }

constructor TDrawObject.Create(Rect: TRect);
begin
  ARect := Rect;
  DrawList.Add(self);
end;

procedure TDrawObject.SetLastPoint(P: TPoint);
begin
  ARect.BottomRight := P;
end;

{ TCurve }

constructor TCurve.Create(Rect: TRect);
begin
  inherited;
  SetLength(L,1);
  L[0] := Rect.TopLeft;
end;

procedure TCurve.Draw(ACanvas: TCanvas);
var i: integer;
begin
  ACanvas.Pen.Color := clYellow;
  ACanvas.Pen.Width := 5;
  ACanvas.MoveTo(L[0].X,L[0].Y);
  for i := 1 to High(L) do
    ACanvas.LineTo(L[i].X,L[i].Y);
end;

procedure TCurve.SetLastPoint(P: TPoint);
var i: integer;
begin
  i := High(L);
  if PointsEqual(L[i],P) then Exit;
  SetLength(L,i+2);
  L[i+1] := P
end;

...
Рейтинг: 0 / 0
12.06.2020, 12:42
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968577
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
DimaBr
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
procedure TCurve.SetLastPoint(P: TPoint);
var i: integer;
begin
  i := High(L);
  if PointsEqual(L[i],P) then Exit;
  SetLength(L,i+2);
  L[i+1] := P
end;


А потом это в продакшн 😁
...
Рейтинг: 0 / 0
12.06.2020, 14:41
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968751
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr, Благодарю! То что надо!
...
Рейтинг: 0 / 0
13.06.2020, 10:28
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968765
didgik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
didgik
Участник
DimaBr, а можешь чтоб было семь взаимно перпендикулярных прямых красных линий, две зеленым цветом, три – прозрачным и одна чтоб в форме котика?
...
Рейтинг: 0 / 0
13.06.2020, 11:57
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968778
istrebitel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
istrebitel
Гость
...
Рейтинг: 0 / 0
13.06.2020, 12:36
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968779
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
rgreat
Участник
..
Обогнали.
...
Рейтинг: 0 / 0
13.06.2020, 12:36
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #39968787
didgik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
didgik
Участник
а где кот на дельфи? Без кота не считово.
...
Рейтинг: 0 / 0
13.06.2020, 13:12
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008676
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr, пробую доработать рисование стрелки так, чтобы рядом с ней можно было расположить текст(InputQuery пока взял для теста, потом планирую заменить на появляющийся memo или richedit)
 

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
// код располагаю в процедуре TLine.Draw в конце
  if Not Drawing then
  begin
    text:= '';
    InputQuery('', 'Введите текст', text);
    if text <> '' then
    begin
      if ARect.Left > ARect.Right then
        begin
          textX := ARect.Left;
        end
      else
        begin
          textX := ARect.Right;
        end;
      if ARect.Top > ARect.Bottom then
        begin
          textY := ARect.Top;
        end
      else
        begin
          textY := ARect.Bottom;
        end;
      ACanvas.TextRect(Rect(textX-5, textY-5, textX+ACanvas.TextWidth(text)+5, textY+ACanvas.TextHeight(text)+5), textX, textY, text);
    end;
  end;



но почему то при движении мыши, сразу появляется InputQuery.
...
Рейтинг: 0 / 0
15.10.2020, 01:57
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008680
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
Так же, подобным образом, на основе инструмента прямоугольник, пробую сделать инструмент "пикселизации" (эффект мозайки)
По задумке - DrawFocusRect рисует область, далее я эту область копирую с помощью BitBlt, обрабатываю полученный фрагмент функцией( https://delphisources.ru/pages/faq/base/bmp_mosaic.html) и размещаю его на PaintBox туда, где было выделение.
"По отдельности" это работает) Но мне не удается прикрутить это к текущей реализации рисования.
...
Рейтинг: 0 / 0
15.10.2020, 03:02
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008682
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник
bigjoe
но почему то при движении мыши, сразу появляется InputQuery.

Поместил InputQuery в метод рисования и удивляется что при рисовании выскакивает окно.
bigjoe"По отдельности" это работает) Но мне не удается прикрутить это к текущей реализации рисования.
Какой ответ вы хотите услышать ? У вас ошибка в 17 стоке !!!
...
Рейтинг: 0 / 0
15.10.2020, 03:10
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008685
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
procedure TPixelsEffect.Draw(ACanvas: TCanvas);
var B: TBitMap;
begin
  if (GetKeyState(VK_LBUTTON) < 0) and (DrawList.Last = self) then begin // рисуем рамку только у последнего объекта TPixelsEffect
    ACanvas.Pen.Color := clBlack;
    ACanvas.Pen.Width := 1;
    ACanvas.Brush.Style := bsClear;
    ACanvas.Rectangle(ARect);
  end
  else begin
    B := TBitMap.Create;
    B.Width := ARect.Right-ARect.Left;
    B.Height := ARect.Bottom - ARect.Top;
    B.Canvas.CopyRect(Rect(0,0,B.Width,B.Height),ACanvas,ARect);
    PixelsEffect(B,5,5);
    ACanvas.CopyRect(ARect,B.Canvas,Rect(0,0,B.Width,B.Height));
    B.Free;
  end;
end;
...
Рейтинг: 0 / 0
15.10.2020, 03:49
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008709
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr,
DimaBrПоместил InputQuery в метод рисования и удивляется что при рисовании выскакивает окно.
Ну мне это показалось логичным))
перед появлением inputbox я поставил проверку drawing = false, а false он становится в процедуре mouseup, перед "последней" PaintBox1.Invalidate.
...
Рейтинг: 0 / 0
15.10.2020, 08:36
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008886
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник
bigjoe
перед появлением inputbox я поставил проверку drawing = false, а false он становится в процедуре mouseup, перед "последней" PaintBox1.Invalidate.

Drawing - флажок указывающий рисует ли в данный момент пользователь.
Drawing := true когда пользователь нажал кнопку мыши и Drawing := false когда отпустил.
А объекты рисуются независимо от нажатой мыши. И спрашивать текст во время рисования нельзя.
Свернули/развернули форму, все объекты заново рисуются. Разве в этот момент нужно спрашивать текст ?
...
Рейтинг: 0 / 0
15.10.2020, 14:09
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40008917
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
TText = class(TDrawObject)
  AText: string;
  procedure Draw(ACanvas: TCanvas); override;
end;

procedure TText.Draw(ACanvas: TCanvas);
begin
  if (GetKeyState(VK_LBUTTON) < 0) and (DrawList.Last = self) then begin // рисуем рамку только у последнего объекта TText
    ACanvas.Pen.Color := clBlack;
    ACanvas.Pen.Width := 1;
    ACanvas.Brush.Style := bsClear;
    ACanvas.Rectangle(ARect);
  end
  else Windows.DrawText(ACanvas.Handle,PAnsiChar(AText),Length(AText),ARect, DT_WORDBREAK);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True;
  if tbLine.Down then TLine.Create(Rect(X,Y,X,Y)) else
  if tbRect.Down then TRectangle.Create(Rect(X,Y,X,Y)) else
  if tbCurve.Down then TCurve.Create(Rect(X,Y,X,Y)) else
  if tbPixels.Down then TPixelsEffect.Create(Rect(X,Y,X,Y)) else
  if tbText.Down then TText.Create(Rect(X,Y,X,Y)) else
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var S: string;
begin
  if TObject(DrawList.Last) is TText then begin
    if not InputQuery('', 'Введите текст', S) then begin
      TText(DrawList.Last).Free;
      DrawList.Delete(DrawList.Count-1);
    end
    else TText(DrawList.Last).AText := S
  end;
  if not Drawing then Exit;
  Drawing := False;
  PaintBox1.Invalidate;
end;

...
Рейтинг: 0 / 0
15.10.2020, 14:47
| Ответить | Цитировать | Написать  
Рисование стрелок мышкой на Canvas
    #40009484
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
bigjoe
Гость
DimaBr
Свернули/развернули форму, все объекты заново рисуются. Разве в этот момент нужно спрашивать текст ?

Действительно, этот момент я не учел...
Спасибо!)
...
Рейтинг: 0 / 0
17.10.2020, 17:06
| Ответить | Цитировать | Написать  
20 сообщений из 20, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Рисование стрелок мышкой на Canvas
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&msg=39968751&tid=2037923]:
 0ms
get settings:
 5ms
get forum list:
 14ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 177ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 68ms
get tp. blocked users:
 3ms
others: 207ms
total:  491ms
созд. / загр.: 491ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]