Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.03.2016, 22:16   #1
yana1996
Пользователь
 
Регистрация: 02.12.2015
Сообщений: 38
По умолчанию Описанный и вписанный треугольник

Помогите доделать пожалуйста , как сделать что бы рисовался (Описанный и вписанный треугольник ) ;

Код:
procedure TForm1.Button2Click(Sender: TObject);
  var a,b,c,xc,yc,x1,y1,x2,y2,x3,y3:integer;
      p,x,h,m,l:real;
  begin
  if not TryStrToInt(Edit1.Text,a)
  or not TryStrToInt(Edit2.Text,b)
  or not TryStrToInt(Edit3.Text,c) then
   begin
    Showmessage('Данные не введены или введены некорректно');
    Edit1.Clear;
    Edit2.Clear;
    Edit3.Clear;
    exit;
   end;
  a:=StrToInt(Edit7.Text);
  b:=StrToInt(Edit8.Text);
  c:=StrToInt(Edit9.Text);
  if (a>=b+c)or(b>=a+c)or(c>=a+b) then
   begin
    showmessage('Это не треугольник, повторите ввод');
    Edit1.Clear;
    Edit2.Clear;
    Edit3.Clear;
    exit;
   end;
  xc:=panel1.Width div 2;
  yc:=panel1.Height div 2;
  p:=(a+b+c)/2;//периметр
  Edit11.Text:=floattostr(p);
  h:=2*sqrt(p*(p-a)*(p-b)*(p-c))/a;//длина высоты на сторону А
  if a*a+c*c<b*b then //если справа тупой угол
   begin
    x:=sqrt(c*c-h*h);//дополнение стороны а вправо
    l:=a+x;//длина горизонтальной проекции треугольника
   end
  else if a*a+b*b<c*c then//если слева тупой угол
   begin
    x:=sqrt(b*b-h*h);//влево
    l:=a+x;
   end
  else //если у основания нет тупых углов
   begin
    x:=sqrt(b*b-h*h);//часть нижней стороны а слева от основания высоты
    l:=a;
   end;
  //определим масштаб
  m:=(yc-30)/(h/2);//масштаб по вертикали
  if (2*xc-60)/l<m then m:=(2*xc-60)/l;//если по горизонтаи меньше, то этот масштаб
  //определим горизонтальные координаты
  if a*a+c*c<b*b then //если наклонен вправо
   begin
    x3:=xc+round(l*m/2);
    x2:=x3-round(x*m);
    x1:=x2-round(a*m);
   end
  else if a*a+b*b<c*c then //если влево
   begin
    x3:=xc-round(l*m/2);
    x1:=x3+round(x*m);
    x2:=x1+round(a*m);
   end
  else //если нет в основании тупых углов
   begin
    x1:=xc-round(l*m/2);{левая вершина}
    x2:=xc+round(l*m/2);{правая вешина}
    x3:=x1+round(x*m);{верхняя вершина}
   end;
  //вертикальные координаты
  y1:=yc+round(h*m/2);
  y2:=y1;
  y3:=yc-round(h*m/2);
  panel1.Canvas.pen.color:=Clwhite;
  panel1.Canvas.Rectangle(0,0,ClientWidth,ClientHeight);
  with panel1.Canvas do //нарисуем треугольник
   begin
    pen.Width:=3;
    pen.Color:=clRed;
    moveto(x1,y1);lineto(x2,y2);
    moveto(x2,y2);lineto(x3,y3);
    moveto(x1,y1);lineto(x3,y3);
    font.Color:=clBlue;
    textout((x1+x2) div 2,y1+10,'A');
    textout((x1+x3)div 2-20,yc-10,'B');
    textout((x2+x3)div 2+20,yc-10,'C');
   end;
  end;
yana1996 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Треугольник Shoshona Общие вопросы Delphi 5 10.06.2014 20:20
текст вписанный в заданную ширину текстблока Diego__ Microsoft Office Word 0 25.04.2014 13:37
Треугольник midiss Visual C++ 0 02.06.2013 21:24
Треугольник вписанный в окружность. Найти площадь Ujas Паскаль, Turbo Pascal, PascalABC.NET 3 19.09.2012 01:13
Нужен фонт, описанный Безье Oak Помощь студентам 1 30.03.2008 00:10