0 / 0 / 0
Регистрация: 30.09.2015
Сообщений: 21

Рисование стрелки

17.02.2016, 00:25. Показов 5276. Ответов 25
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Мои стрелки рисуются к центру окружности, а мне нужно только к дуге самой. Помогите, пожалуйста
Delphi
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
unit Cursor;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math, StdCtrls, Buttons, ExtCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    OpenDialog1: TOpenDialog;
    BitBtn2: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
tmas2=array of array of Integer;
tmaskoord=array[0..10] of integer;
 
 
var
  Form1: TForm1;
  stringgrid1:tstringgrid;
  m,n:Integer;
  ms,minc:tmas2; //матрицы смежности и инциденций
  x,y:tmaskoord;
 
implementation
 
{$R *.dfm}
 
procedure DrawArrowHead(Canvas: TCanvas; X,Y: Integer; Angle,LW: Extended);
// вычисления угла наклона стрелки
var
  A1,A2: Extended;
  Arrow: array[0..3] of TPoint;
  OldWidth: Integer;
const
  Beta=0.322;
  LineLen=4.74;
  CentLen=3;
begin
  Angle:=Pi+Angle;
  Arrow[0]:=Point(X,Y);
  A1:=Angle-Beta;
  A2:=Angle+Beta;
  Arrow[1]:=Point(X+Round(LineLen*LW*Cos(A1)),Y-Round(LineLen*LW*Sin(A1)));
  Arrow[2]:=Point(X+Round(CentLen*LW*Cos(Angle)),Y-Round(CentLen*LW*Sin(Angle)));
  Arrow[3]:=Point(X+Round(LineLen*LW*Cos(A2)),Y-Round(LineLen*LW*Sin(A2)));
  OldWidth:=Canvas.Pen.Width;
  Canvas.Pen.Width:=4;
  Canvas.Polygon(Arrow);
  Canvas.Pen.Width:=OldWidth
end;
 
procedure DrawArrow(Canvas: TCanvas; X1,Y1,X2,Y2: Integer; LW: Extended);
//стрелка для графа
var
  Angle: Extended;
begin
  Angle:=ArcTan2(Y1-Y2,X2-X1);
  Canvas.MoveTo(X1,Y1);
  Canvas.LineTo(X2-Round(2*LW*Cos(Angle)),Y2+Round(2*LW*Sin(Angle)));
  DrawArrowHead(Canvas,X2,Y2,Angle,LW);
end;
 
procedure grafv(n:Integer;x,y:tmaskoord);
//Рисование графа
var
  i:Integer;
begin
 with  Form1.Image1 do
 begin
  canvas.Font.Size:=14;
  canvas.Font.Color:=clwhite;
  for i:=0 to n do
    begin
     canvas.Ellipse(x[i]-20,y[i]-20,x[i]+20,y[i]+20);
     if i<n then
      canvas.TextOut(x[i]-5,y[i]-10,inttostr(i+1))
     else
      canvas.TextOut(x[i]-5,y[i]-10,inttostr(1));
    end;
 end;
end;
 
procedure graf(n:Integer;var x,y:tmaskoord);
//Рисование графа
var
  i,j,k:Integer;
  xr,yr:real;
 
begin
  with Form1.Image1 do
  begin
   Picture:=nil;
   Canvas.Brush.Color:=clBlack;
   for i:=0 to n do
   begin
//делим всю область на многоугольник и в вершинах будут находится вершины графа
     xr:=200+200*cos(2*pi*i/n);
     yr:=200+200*sin(2*pi*i/n);
     x[i]:=trunc(xr)+ 80;
     y[i]:=trunc(yr*0.8)+20;
   end;
//поиск первой вершины и продолжения ребер
     for j:=0 to m-1 do
      begin
       for i:=0 to n-1 do
       begin
        if minc[i,j]=1 then  //первая вершина
        for k:=0 to n-1 do
         if (i<>k) and (minc[k,j]=-1) then
         begin
          DrawArrow(Form1.Image1.Canvas,x[i],y[i],x[k],y[k],4);
          Break;
         end;
       end;
      grafv(n,x,y);
      end;
    end;
 
end;
 
 
 
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  ft:TextFile;
  i,j:Integer;
begin
  Image1.Picture:=nil;
  //открытие файла со значениями матрицы инцидентности
  OpenDialog1.Filter:='Text files (*.txt)|minc*.txt';
  if OpenDialog1.Execute then
  begin
    //создание запись данных из файла(матрица инцидентности) в компонент stringgrid
    stringgrid1:=tstringgrid.Create(Self);
    stringgrid1.parent:=Self;
    AssignFile(ft,OpenDialog1.FileName);
    Reset(ft);
    readln(ft,n,m);
    SetLength(minc,m);
    with stringgrid1 do
    begin
     colcount:=m+1;
     rowcount:=n+1;
     width:=(m+1)*(DefaultColWidth+2)+5;
     Height:=(n+1)*(DefaultRowHeight+2)+5;
     top:=200;
     left:=50;
     For i:=0 to High(minc) do
     begin
      Cells[0,i+1]:=IntToStr(i+1);
      SetLength(minc[i],m);
      for j:=0 to  High(minc[i]) do
      begin
       read(ft,minc[i,j]);
       Cells[j+1,i+1]:=IntToStr(minc[i,j]);
      end;
     end;
     for j:=0 to  High(minc[0]) do
      Cells[j+1,0]:=IntToStr(j+1);
    end;
    CloseFile(ft);
    //рисование графа
    graf(n,x,y);
 end;
 
end;
end.
0
Лучшие ответы (1)
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
17.02.2016, 00:25
Ответы с готовыми решениями:

Стрелки
Может у кого найдётся лишняя минутка и он поможет мне перевести данный код в Delphi? uses graphABC,crt; var...

Дуги и стрелки для орграфов
Снова требуется помощь - нужно подрисовать к дуге стрелку. До этого вместо дуг были прямые линии, стрелки на них так и остались, а...

Рисование стрелки
Здравствуйте.Написал небольшой скрипт который рисует линии, что нужно дописать что б на конце линии рисовалась стрелка по направлению...

25
0 / 0 / 0
Регистрация: 30.09.2015
Сообщений: 21
17.02.2016, 23:45  [ТС]
Студворк — интернет-сервис помощи студентам
огромное всем спасибо
0
Модератор
 Аватар для FIL
3492 / 2614 / 742
Регистрация: 19.09.2012
Сообщений: 7,977
18.02.2016, 09:46
Делал как-то рисование стрелок:
Delphi
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
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
{$J+}
  i: Integer = 1;
{$J-}
  R = 20;
var
  a: Real;
  dX, dY: Integer;
  Xo, Yo: Integer;
  s: String;
begin
  Xo := Canvas.PenPos.X;
  Yo := Canvas.PenPos.Y;
 
  s := IntToStr(i);
  Canvas.Ellipse(X - R, Y - R, X + R, Y + R);
  Canvas.TextOut(X - Canvas.TextWidth(s) div 2, Y - Canvas.TextHeight(s) div 2, s);
  inc(i);
 
  if i = 2 then
  begin
    Canvas.MoveTo(X, Y);
    Exit;
  end;
 
  if X - Xo = 0 then
    if Y - Yo > 0 then
      a := + pi / 2
    else
      a := - pi / 2
  else
    a := ArcTan((Y - Yo)/(X - Xo)); // uses Math
 
  if X - Xo < 0 then
    a := a + pi;
 
  dX := Round(R * cos(a));
  dY := Round(R * sin(a));
 
  Canvas.MoveTo(Xo + dX, Yo + dY);
  Xo := X - dX;
  Yo := Y - dY;
  Canvas.LineTo(Xo, Yo);
 
  Canvas.Polygon([Point(Xo, Yo),
                  Point(Xo - Round(30 * cos(a + pi/10)), Yo - Round(30 * sin(a + pi/10))),
                  Point(Xo - Round(30 * cos(a - pi/10)), Yo - Round(30 * sin(a - pi/10)))]);
                  
  Canvas.MoveTo(X, Y);
end;
Миниатюры
Рисование стрелки  
0
0 / 0 / 0
Регистрация: 30.09.2015
Сообщений: 21
18.02.2016, 12:37  [ТС]
а по какой теме вы это писали?
0
Модератор
 Аватар для FIL
3492 / 2614 / 742
Регистрация: 19.09.2012
Сообщений: 7,977
18.02.2016, 21:02
Без темы, просто так писал.
0
19.02.2016, 01:07

Не по теме:

Цитата Сообщение от FIL Посмотреть сообщение
Без темы, просто так писал.
Минутная блажь? :)

0
19.02.2016, 10:37

Не по теме:

Цитата Сообщение от northener Посмотреть сообщение
Минутная блажь?
Вроде того. Потянуло на круглое со стрелочками. :)

0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
19.02.2016, 10:37

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

Рисование стрелки
Всем добрый день. Есть ли у кого опыт в рисовании самой обычной стрелки? Программирую на C#. Видел код на С++ но ничего там не понял :(...

Рисование стрелки
Всем привет! Может здесь хоть кто поможет, пробовала несколько дней, ну не понимаю я, и всё тут) Нужно нарисовать вот такую стрелку, на...

Рисование стрелки
Столнкулся с проблемой - как нарисовать более-менее красивую стрелочку через координаты? т.е.: (AB) линия, (BC) грань 1, (BD) грань 2. Не...

Рисование изогнутой стрелки
Здравствуйте, помогите, пожалуйста, нарисовать изогнутую линию со стрелой на конце, как на этом рисунке ниже. Ось рисовать и input...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
26
Ответ Создать тему
Опции темы

Новые блоги и статьи
Жизня: рисунок укладки багажа, сделанный клодом
anaschu 21.08.2026
Сделал 15 снимков, он по снимкам сделал схему.
Был там один разговор по поводу свободы в материальном мире.
kumehtar 19.08.2026
Суть: рассматривается живое существо, оказавшееся внутри довольно странной системы (этого мира) и пытающееся обустроить в ней свой кусок пространства. Жизнь действительно предъявляет каждому. . .
Когда логика программы не спасает от человеческих ошибок
Maks 18.08.2026
В последнее время всё чаще и чаще сталкиваюсь с таким явлением, как абсолютная невнимательность (или глупость) пользователей. Проявляется это чаще всего на работе в коллективе. Допустим, человек с. . .
Лето уходит
kumehtar 17.08.2026
Мысли в слух
kumehtar 17.08.2026
Забавно, насколько сейчас стала доступна информация. Например о магии, духовном развитии, медитациях, и других подобных направлениях, ранее зачастую тайных, передаваемых от учителя к ученику. Хотя. . .
Перемещение строк из ТЧ в другой документ с учетом текущего пробега
Maks 17.08.2026
Реализация из решения ниже выполнена на примере нетипового документа "Автозапчасти", с ТЧ "Шины". За основу взят алгоритм отсюда: https:/ / www. cyberforum. ru/ blogs/ 359708/ 10838. html Задача: . . .
Саморегулирующийся социальный контракт для сервера cross-section.
Hrethgir 14.08.2026
С кодом конечно таких глубоких размышлений пока не было, впрочем я уже привык к алгоритмизации. Суть предмета записи: снова в диалоге с нейросетью (я взял пока себе ник для учётки админа - Rector). . . .
Часы электронные
Uhbif79 12.08.2026
Выкладываю программу часов. Программа позволяет: 1. Использовать системное время и дату, 2. Есть возможность вводить время и дату вручную. 3. Реализованы 2 будильника: начало и конец рабочего дня. . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru