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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.07.2016, 06:56   #1
MoneyCrafter
 
Регистрация: 29.09.2015
Сообщений: 7
По умолчанию LineTo под углом без синуса

Задача нарисовать LineTo по углу без синуса и косинуса (и др. функ.). То что получилось, здесь работает только угол от 33 до 43,5, странно...
Вот код (Есть неиспользующиеся переменные):
Код:
  procedure LineTo(angle: Extended);
  const
    QS = 1;
  var
    i, i1: integer;
    qlv: extended;              // = 45 / угол
    part, yU, m: integer;     //part - дробная часть QLV
  begin
    form1.Canvas.Pen.Color := clRed;
 
    if angle <> 0 then
      QLV := (45 / angle )
    else
      Qlv := 100;
 
    part := round((QLV - trunc(QLV)) * 100);
    i := 1;
    m := i;
    while i < 100 do
    begin
      
      if part <> 0 then
      begin
        if (i mod round(100 / part)) <> 0 then
        begin
          yu := Trunc(QLV) + 1;
          m := m + 1;
        end
        else
          yu := trunc(QLV);
      end
      else
        yu := trunc(QLV);
 
      for i1 := 1 to round(qlv) do
        if QLV >= 1 then
          form1.Canvas.Pixels[round(i1) + QS + i*round(qlv), form1.clientheight - QS - (m)] := form1.Canvas.Pen.Color;
        //else
          //form1.Canvas.Pixels[round(i1) + QS + i, form1.clientheight  - QS - (i*(round(QLV)))] := form1.Canvas.Pen.Color
      Inc(m);
      Inc(i)
    end;
    form1.Canvas.Pen.Color := clBlack;
  end;
MoneyCrafter вне форума Ответить с цитированием
Старый 01.07.2016, 08:31   #2
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 18,922
По умолчанию

Я бы примерно так поступил
Код:
procedure LineTo(angle: Extended); // angle - в градусах 0 <= angle < 90
var qlv,kofx,kofy: Double;
    i: Integer;
begin
  qlv:=3.14159*angle/180;
  kofx:=1-(qlv*qlv)/2+(qlv*qlv*qlv*qlv)/24;
  kofy:=qlv-(qlv*qlv*qlv)/6+(qlv*qlv*qlv*qlv*qlv)/120;
  for i:=1 to 200 do Form1.Canvas.Pixels[round(i*kofx),Form1.clientheight-round(i*kofy)]:=clRed;
end;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 01.07.2016, 08:54   #3
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Код:
procedure LineTo(angle: Extended);
Я чот не понял, а где аргумент-точка, через которую прямая проходить-то должна? Одного угла-то недостаточно!
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 01.07.2016, 09:13   #4
Utkin
Старожил
 
Аватар для Utkin
 
Регистрация: 04.02.2009
Сообщений: 17,351
По умолчанию

Цитата:
Я чот не понял, а где аргумент-точка, через которую прямая проходить-то должна? Одного угла-то недостаточно!
Вероятно по умолчанию один из углов экрана
Маньяк-самоучка
Utkin появился в результате деления на нуль.
Осторожно! Альтернативная логика
Utkin вне форума Ответить с цитированием
Старый 01.07.2016, 09:53   #5
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Вероятно по умолчанию один из углов экрана
Напомнило объяву в маршрутке:

Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
label под углом vova_ Общие вопросы Delphi 2 22.03.2012 05:51
Повернуть div под углом gigi1988 HTML и CSS 1 22.12.2010 09:47
Текст под углом в StringGrid artemavd Общие вопросы Delphi 7 25.07.2009 20:17
Движение тела под углом Lemo Помощь студентам 6 05.04.2009 14:49
Графика под углом BOBAH13 Мультимедиа в Delphi 5 12.09.2008 21:18