Пользовательский стиль пера. Часть II: Бегущие муравьи

Рисуем рамку бегущих муравьёв в GDI и GDI+.
Для GDI+ аж два метода - хороший и очень хороший )))
Всё запаковано в класс, можно брать и запросто использовать.
Как использовать - всё подробно расписано, исходники как обычно в комплекте.

Почитать...

Пользовательский цвет в диалоге TFontDialog

В стандартном виде TFontDialog не позволяет выбрать произвольный цвет для шрифта.
Вот небольшой код, позволяющий это сделать.
Находка не моя. Источник: stackoverflow.
Показалось весьма полезным, чтобы сохранить для будущих копипастов.

Полюбопытствовать...

Контур текста в GDI с антиалиасом

Рисуем контур текста без использования чего либо стороннего и не трогаем GDI+
Казалось бы, невозможно. Но возможно )))

Статья тут...

Сегодня часто спрашивали у сайта -
Принадлежит ли точка отрезку?
Небольшой ответ на него таков:

// Uses: System.Math, System.Types
// Принадлежность точки P отрезку (P1,P2)
// с учетом попадания на P1 и P2
// Режим нахождения на отрезке: 0 - мимо, 
// 1 - P1, 2 - P2, 3 - между P1 и P2
function PtInSegment(const P1, P2, P: TPointF; 
   Eps: Double = 1e-2): Integer;
begin
  Result := 0;
  if P1.EqualsTo(P, Eps) then exit(1)
  else if P2.EqualsTo(P, Eps) then exit(2)
  else
    if SameValue(Abs(p1.Y-p.Y) + Abs(p2.Y-p.Y), 
         Abs(p2.Y-p1.Y), Eps) and
       SameValue(Abs(p1.X-p.X) + Abs(p2.X-p.X), 
         Abs(p2.X-p1.X), Eps) and
       SameValue((p.x-p1.x)*(p2.y-p1.y) - 
         (p.y-p1.y)*(p2.x-p1.x), 0, Eps)
  then
    Result := 3;
end;

Подробнее тут...
#geom_code

SpinEdit: как убрать кнопки
Ещё один интересный вопрос к сайту.
Например, можно так:

procedure RemoveSpinEditButtons(
  ASpinEdit: TSpinEdit);
var i: Integer;
begin
  with ASpinEdit do
  for i := 0 to ComponentCount-1 do
  begin
    if Components[i] is TSpinButton then
      TSpinButton(Components[i]).Visible :=
        False;
  end;
end;

Аффинная матрица масштаба

Блок накопившихся вопросов

Что происходит с масштабом при аффинных преобразованиях?
Если специально не задано преобразование масштаба, то с масштабом ничего не происходит.

Аффинные преобразования: меняется ли масштаб при преобразованиях, при каком?
Меняется при наличии в композиции преобразования масштаба.

Формула для масштабирования координат на плоскости
x' = x * Sx
y' = y * Sy

Применение аффинного преобразования для растяжения изображения
Если коэффициенты масштаба по X (Sx) и Y (Sy) не совпадают, то будет и растяжение, и сжатие. Например, меняя Sx и не трогая Sy(=1), мы получим растяжение/сжатие по горизонтали.

Матрица отражения

Исходник того, что на заставке (zip) 59.5 Кб. Delphi XE 7, XE 10, XE 11

Экзешник того, что на заставке (zip) 909 Кб.

Как вычислить координаты второй точки если известно расстояние и угол?
Последние несколько дней вопрос прямо в ТОПе.

Если надо просто получить точку P2 от точки P1 с углом A от оси X на расстоянии L, то просто делаем так:

  SinCos(A*PI/180, sn, cs);
  P2.X := p1.X + cs * L;
  P2.Y := p1.Y + sn * L;

Есть на эту тему статья, где рассматривается вариант, когда у нас есть произвольная прямая, и надо найти координаты точки, для которой известно расстояние и угол от прямой.
Немного поменял функцию нахождения координат, чтобы переменные соответствовали тексту статьи. Видимо, это вводило в недоумение.

Функция для расчёта координат точки, отстоящей от произвольной прямой (P0,P1) на угол A (от точки P1) и расстояние L:

function CalcPolarCoord(const P0, P1: TPointF;
  A, L: Single): TPointF;
var
  B, C: Single;
begin
  B := ArcTan2(P0.Y-P1.Y, P0.X-P1.x);
  C := A * PI/180 + B;
  Result.X := p1.X + cos(C) * L;
  Result.Y := p1.Y + sin(C) * L;
end;

#geom_code

Вопрос: Как квадрат превратить в трапецию с помощью аффинных преобразований?
Ответ: Никак.
Потому что:
Трапе́ция — выпуклый четырёхугольник, у которого две стороны параллельны, а две другие стороны не параллельны.
Аффи́нное преобразование — отображение плоскости или пространства в себя, при котором параллельные прямые переходят в параллельные прямые, пересекающиеся — в пересекающиеся, скрещивающиеся — в скрещивающиеся.
Квадрат — это правильный четырёхугольник. У него все стороны и углы равны между собой. Противолежащие стороны квадрата параллельны друг другу.

Невозможно применить аффинное преобразование так, чтобы две параллельные стороны стали не параллельны. Это противоречит определению. Поскольку при аффинных преобразованиях сохраняется параллельность, параллелограммы переходят в параллелограммы, а трапеции в трапеции. Только так.

Хорошая статья про массивы
Особенно в части динамических массивов.

Координаты "бесконечной" линии, проходящей через заданные точки

Иногда требуется посчитать координаты "бесконечной" линии, проходящей через точки отрезка (P1,P2) и ограниченной областью видимости ARect. ARect это чаще всего ClipRect холста, на котором рисуется линия.

procedure CalcEndlessLine(const ARect: TRectF;
  const P1, P2: TPointF; out V, W: TPointF);
var A,B,C: Double;
begin
  B := p2.x - p1.x;
  if Abs(B) > 0.01 then
  begin
    A := p2.y - p1.y;
    C := A/B;
    V.x := ARect.Left;
    W.x := ARect.Right;
    V.Y := p1.Y + C*(V.x-p1.X);
    W.Y := p2.Y + C*(W.x-p2.X);
  end
  else
  begin
    V := PointF(p1.X, ARect.Top);
    W := PointF(p2.X, ARect.Bottom);
  end;
end;

#geom_code

Найти перпендикуляр из точки P3 на прямую (P1,P2)

// Uses: System.Types
function CalcPerpendicularBase(
  const P1, P2, P3: TPointF): TPointF;
var
  dx, dy, L, A: Extended;
begin
  dx := P2.x-P1.x;
  dy := P2.y-P1.y;
  L := dx*dx + dy*dy;
  if IsZero(L) then exit(P1);

  A := ((P3.x - P1.x) * dx +
    (P3.y - P1.y) * dy) / L;
  Result.x := P1.x + A * dx;
  Result.y := P1.y + A * dy;
end;

Точки P1, P2, P3 кликабельны и таскабельны
Если внутри отрезка - зелёный, если на точках отрезка - жёлтый, мимо отрезка - красный.
Для определения принадлежности точки отрезку использован пост.

Исходник (zip) 61 Кб Delphi XE 7,10,11
Прога (zip) 915 Кб
#geom_code

Текст с размытым контуром. GDI+

Просто рисовашка.
Предназначена исключительно для оформления чего-либо.

Принцип:
Текст рисуется, как путь, с уменьшающейся шириной пера.
Перу изначально задан цвет со значением альфа = 256 / ширина пера.
Из-за последовательного наложения прозрачность с каждым слоем всё меньше.
Правда, при смешивании, может измениться и цвет )))
Одним словом, вот поле экспериментов:

Исходник (zip) 61 Кб Delphi XE 7,10,11
Прога (zip) 940 Кб

Простые плазмы на гармониках

В количестве восьми - внизу слева комбобокс.
Принципиально не отличаются, только параметрами квази-гармонических колебаний.
- Используется 8-битная битовая матрица, Scanline и палитра.
- Для формирования палитры использовано смещение по HLS.
- Процедура DrawPlasm8 безусловно нуждается в оптимизации при реальном применении. Сейчас это мешаниниа синусов со смещениями и прочей ерундовины. Но зато можно поиграться с параметрами. Когда оптимизируешь, уже не получится поиграться.

Исходник (zip) 60 Кб. Delphi XE 7,10,11
Прога (zip) 877 Кб.

Оптимизированная плазма по просьбам трудящихся

Изменения:
- Теперь в выпадающем списке действительно 8 заявленных элементов (а не 7 по факту).
- Пункт 1.1 разбит на два подпункта:
1.1.0 - это плазма без оптимизации;
1.1.1 - та же самая плазма с оптимизацией.

Как видно на гифе визуально изменений никаких, но скорость у 1.1.1 почти в 3 раза выше, чем у 1.1.0.
За счёт чего:
1) Деления переведены в константы (PI/...);
2) Убраны лишние вычисления в цикле (sin(y * PI45)/8);
3) Вожделенная таблица синусов (sin_(...)).

Дополнительную оптимизацию в таких штуках можно достигнуть ещё за счёт упрощения формул, уменьшения числа операторов.

Исходник (zip) 61 Кб. Delphi XE 7,10,11
Прога (zip) 878 Кб.

Эффект пламени. GDI+

Я уже использовал этот эффект тут.
Сейчас просто вынес два похожих алгоритма в отдельную тему.
Одинарный клик на поле - старт/стоп таймера.
Двойной клик сбросит огонь в стартовую нижнюю позицию.

Исходник (zip) 61 Кб. Delphi XE 7,10,11
Прога (zip) 910 Кб.

Договорился...

По запросу Артёма в поворотнике изображения появилась направляющая сетка.
Я обещал сделать в марте )))
Оставались последние часы

Пламенный текст. GDI+

Трудно удержаться, чтобы не объединить этот текст и этот эффект.
Что получилось - в заставке.
Дополнительные полезняшки в исходнике:
- Получить размеры текста для GDI+
- Получить полупрозрачный TGPBitmap

Одинарный клик на поле - старт/стоп таймера.
Двойной клик сбросит огонь в стартовую нижнюю позицию.

Исходник (zip) 61 Кб. Delphi XE 7,10,11
Прога (zip) 908 Кб.

Синусоидальный волновой эффект
Применимо для анимации флага, например.

Сам эффект без чего либо экзотического, всё на обычных TBitmap'ах.
При выводе использую GDI+ исключительно из-за приятного масштабирования.
И, конечно, наша любимая таблица синусов!

По проге:
- Параметры волны в подвале окна: Амплитуда, Частота, Вертикально/Горизонтально.
- За фазу отвечает таймер. Клик по полю - остановить/запустить таймер.

Вики: Статья по синусоидальной волне.

Исходник (zip) 215 Кб. Delphi XE 7,10,11
Прога (zip) 1.08 Мб.

VirtualTreeView for Delphi XE 11
Понадобился под XE11. У автора компонента такой версии нет. Поэтому небольшие телодвижения:

1. Качаем у автора.
2. В Delphi Tools-Options-Language-Library в поле Library Path добавляем путь к исходникам (картинка).
3. В Delphi открываем \Packages\RAD Studio 10.3\VirtualTreeView.groupproj
4. Compile All, нас выбрасывает в модуль VirtualTreesR.
5. В VirtualTreesR {$IMPLICITBUILD OFF} меняем на {$IMPLICITBUILD ON}
6. Compile All, нас выбрасывает в модуль VirtualTreesD.
7. Убираем VirtualTreesR:

requires
  DesignIDE{,
  VirtualTreesR};

8. Compile All - всё должно быть ок.
9. Встаём на VirtualTreesD26.bpl и по правой кнопке - Install.

Отпишитесь, если есть возможность, как у кого прошло.

Поиск двух максимально удалённых друг от друга точек в массиве

// Uses: + System.Types, 
//   System.Generics.Collections, System.Math

function FindFurthestPoints(
  const A: TArray<TPointF>;
  out P1, P2: TPointF): Boolean;
var
  D, DMax : Double;
  M, N: TPointF;
  i, j: Integer;
begin
  Result := Length(A)>1;
  if not Result then exit;

  DMax := MinDouble;
  for i := 0 to High(A)-1 do
  begin
    M := A[i];
    for j := i+1 to High(A) do
    begin
      N := A[j];
      D := sqr(N.X-M.x)+sqr(N.Y-M.y);
      if D > Dmax then
      begin
        DMax := D;
        P1 := N;
        P2 := M;
      end;
    end;
  end;
end;

Зачем это понадобилось, сейчас опубликую ))) Много в сообщении не напишешь, зато искать и копипастить удобно.

Разделить массив точек на две прямоугольные области

Понадобилось сделать быстрый поиск ближайших точек в громадном массиве координат. Кое-что набросал в процессе. Показалось полезным показать наброски.

Тут решается задача быстро получить прямоугольные области, включающие в себя все точки массива и, по возможности, мало пересекающиеся друг с другом.

1) Поиск двух максимально удалённых точек в массиве.
2) Бежим по массиву, определяем к кому ближе очередная точка и формируем соответствующий прямоугольник.
3) Корректировка результата в том случае, если все точки оказались ближайшими только к одно из двух.

Точки можно ставить кликом, можно нажать "Добавить". В этом случае добавиться несколько случайных точек в количестве, указанном в левом нижнем SpinEdit'е.

Если есть мысли по оптимизации, поделитесь )))

Исходник (zip) 61.4 Кб. Delphi XE7.
Прога (zip) 932 Мб.