Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Рисование стрелок мышкой на Canvas / 20 сообщений из 20, страница 1 из 1
19.05.2020, 23:30
    #39959717
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
Здравствуйте!
Подскажите, как реализовать рисование стрелок мышкой на 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
| Ответить | Цитировать | Написать  
20.05.2020, 01:11
    #39959727
DimaBr
DimaBr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas

 
Код: 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
| Ответить | Цитировать | Написать  
26.05.2020, 03:08
    #39961960
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
DimaBr, Благодарю!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
12.06.2020, 03:59
    #39968451
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
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, 12:19
    #39968510
alekcvp
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
bigjoe
Пока с голову пришел вариант сохранять точки в массив и рисовать их на OnPaint, но мне кажется это плохой вариант.

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

 
Код: 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, 14:41
    #39968577
alekcvp
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
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
| Ответить | Цитировать | Написать  
13.06.2020, 10:28
    #39968751
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
DimaBr, Благодарю! То что надо!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.06.2020, 11:57
    #39968765
didgik
didgik
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
DimaBr, а можешь чтоб было семь взаимно перпендикулярных прямых красных линий, две зеленым цветом, три – прозрачным и одна чтоб в форме котика?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.06.2020, 12:36
    #39968778
istrebitel
istrebitel
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.06.2020, 12:36
    #39968779
rgreat
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
..
Обогнали.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.06.2020, 13:12
    #39968787
didgik
didgik
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
а где кот на дельфи? Без кота не считово.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2020, 01:57
    #40008676
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
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, 03:02
    #40008680
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
Так же, подобным образом, на основе инструмента прямоугольник, пробую сделать инструмент "пикселизации" (эффект мозайки)
По задумке - DrawFocusRect рисует область, далее я эту область копирую с помощью BitBlt, обрабатываю полученный фрагмент функцией( https://delphisources.ru/pages/faq/base/bmp_mosaic.html) и размещаю его на PaintBox туда, где было выделение.
"По отдельности" это работает) Но мне не удается прикрутить это к текущей реализации рисования.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2020, 03:10
    #40008682
DimaBr
DimaBr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
bigjoe
но почему то при движении мыши, сразу появляется InputQuery.

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

Код: 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, 08:36
    #40008709
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
DimaBr,
DimaBrПоместил InputQuery в метод рисования и удивляется что при рисовании выскакивает окно.
Ну мне это показалось логичным))
перед появлением inputbox я поставил проверку drawing = false, а false он становится в процедуре mouseup, перед "последней" PaintBox1.Invalidate.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2020, 14:09
    #40008886
DimaBr
DimaBr
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
bigjoe
перед появлением inputbox я поставил проверку drawing = false, а false он становится в процедуре mouseup, перед "последней" PaintBox1.Invalidate.

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

 
Код: 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
| Ответить | Цитировать | Написать  
17.10.2020, 17:06
    #40009484
bigjoe
bigjoe
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Рисование стрелок мышкой на Canvas
DimaBr
Свернули/развернули форму, все объекты заново рисуются. Разве в этот момент нужно спрашивать текст ?

Действительно, этот момент я не учел...
Спасибо!)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Рисование стрелок мышкой на Canvas / 20 сообщений из 20, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 472ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2037923]:
 0ms
get settings:
 7ms
get forum list:
 19ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 165ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 52ms
get tp. blocked users:
 1ms
others: 210ms
total:  472ms
x
x
Закрыть


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