Пересечение отрезков в 2D и 3D

Небольшая статья про нахождение пересечений отрезков в 2D и 3D. Теоретическая часть начинается с векторов и внезапно уходит в метод Крамера. Для любителей острых сюжетных поворотов.
Исходники, как обычно, в комплекте.

Читать статью...

Вычислить расстояние от точки P до отрезка AB
Также возвращает точку на отрезке. Максимально откомментировал каждое действие. Надеюсь, пригодится

function DistanceToSegment(
  const P, A, B: TPointF;
  out R: TPointF): Single;
var
  AB, AP: TPointF;
  DotProduct, Len, t: Single;
begin
  // Вектор AB
  AB := B-A;
  // Квадрат длины отрезка AB
  Len := AB.X*AB.X+AB.Y*AB.Y;
  // Если отрезок вырожден (A и B совпадают)
  if IsZero(Len, 1e-6) then
    // То возвращаем расстояние от P до A
    exit((A-P).Length);
  // Вектор AP
  AP := P-A;
  // Вычисляем скалярное произведение 
  // векторов AB и AP
  DotProduct := AB.DotProduct(AP);
  // Вычисляем параметр t 
  // (нормализованная проекция)
  t := DotProduct/Len;
  // Ограничиваем t в пределах [0, 1]
  t := EnsureRange(t, 0, 1);
  // Находим ближайшую точку на отрезке
  R := A + t*AB;
  // Возвращаем расстояние между 
  // точкой P и проекцией
  Result := (P-R).Length;
end;

#geom_code

Как сделать чёрным системное меню элемента Windows

История такая. Однажды, в нашей группе прозвучала невозможность сменить цвет системного контекстного меню. Даже стилем. Но ведь это неправда, ИИ ошибается, и я рванулся было делать, как делал это когда-то давно. Но, учитывая, что с той поры приобрёл некоторый опыт, могу предложить другое решение. Собственно, статья про то, как отрисовать любое контекстное меню цветами вашей фантазии без особых знаний WinApi. И речь не идёт о подмене своими PopupMenu, работаем с тем, что есть.

Читать статью...

Кубический Сплайн Эрмита

Ещё один способ построить гладкую кривую, проходящую через все заданные точки ломаной.
Ни разу не сталкивался, решил посмотреть, что за зверь. Заодно подразобраться со сплайнами вообще. Поэтому теоретическая часть достаточно большая. В силу этого, про самого Эрмита ни слова, только про его сплайны.
Внутри исходники, как обычно. Плюс к этому: интерактивное построение сплайна (давно хотел вспомнить JS).

Читать статью...

Список цветов Delphi
Даже не знал, что у них на сайте есть такая полезность

Д. Роджерс, Дж. Адамс
Математические основы машинной графики

Неожиданный фидбэк. Увидели, какого качества у меня представлена эта книга в статье про кубический сплайн Эрмита и прислали вот...
Очень много математики, но зато очень подробно разжёвываются про всё, что только можно. Затронуты как двумерные, так и трёхмерные преобразования. Плоскости, кривые, проекции, и т.д. и т.п.
Сейчас пробую на вкус B-Spline. Там про это почти 100 страниц, ух...

Скачать (.djvu) 7.23 Мб
Книга большая, аккуратно!

Вычислить Z-координату точки P в 3D-треугольнике ABC по X,Y. Если попадает мимо треугольника, вернёт DefaultZ:

function GetZInTriangle(const P: TPointF;
  const A, B, C: TPoint3D;
  DefaultZ: Single = -1000): Single;
const Eps = 1e-10;
var d, u, v, w: Double;
begin
  // Вычисляем знаменатель для
  // барицентрических координат
  d := (B.Y-C.Y)*(A.X-C.X) + 
       (C.X-B.X)*(A.Y-C.Y);
  // Проверка на вырожденный треугольник
  if IsZero(d, Eps) then
    Exit(DefaultZ);
  // Вычисляем барицентрическую координату u
  u := ((B.Y-C.Y)*(P.X-C.X) + 
        (C.X-B.X)*(P.Y-C.Y))/d;
  // Вычисляем барицентрическую координату v
  v := ((C.Y-A.Y)*(P.X-C.X) + 
        (A.X-C.X)*(P.Y-C.Y))/d;
  // Вычисляем третью координату w
  w := 1 - u - v;
  // Проверка, находится ли точка 
  // внутри треугольника
  if (u >= -Eps) and (v >= -Eps) and 
    (w >= -Eps) then
    // Интерполяция Z-координаты
    Result := u*A.Z + v*B.Z + w*C.Z
  else
    Result := DefaultZ;
end;

#geom_code

Инструмент цветовой матрицы

Продолжаю мучить JS. Оторвался на стилях. Наверное, переборщил...
Давно хотел сделать такой инструмент.

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

26 предустановленных эффектов:
- Сепия
- Черно-белое
- Негатив
- Усиление красного
- Сдвиг в синий
- Ярче
- Темнее
- Зеленая матрица
- Цианотипия
- Винтаж
- Полароид
- Lomo Эффект
- Инфракрасный
- Кросс-процесс
- Сновидческий
- Янтарный монохром
- Соляризация
- Фильм-нуар
- Техниколор
- Дуплекс
- Винтаж (улучшенный)
- Зелёная матрица (другая)
- Холодный тон
- Тёплый тон
- Высокая контрастность
- Цианотипия (улучшенная)

Ознакомиться с инструментом можно тут

Шум Перлина: Разбор алгоритма

Разбор механики этого замечательного изобретения. Где математика становится частью естественного хаоса.
Это не просто математика — это поэзия, воплощенная в коде.
Внутри есть приятный интерактив и непременные исходники.

Приятного чтения!!!

Перспективная трансформация онлайн

Когда-то озадачился такой вещью, как перспективная трансформация. Теперь дошли руки сделать это онлайн.
- Сохраняет в PNG, фон прозрачный.
- Сохраняет и копирует в размерах оригинального файла.
- Ограничений на размер оригинального файла нет.

Новый инструмент в коллекции - перспективная трансформация

Конвертер изображений в черно-белое

Сейчас совсем нет времени на полноценные статьи.
Поэтому, вот новый инструмент для преобразования исходного изображения в градации серого и истинно черно-белое. Умеет менять яркость-контраст-чёткость-резкость исходного изображения. Поддерживает количество градаций серого и дизеринг. Инструмент писать быстрее, чем статью.

Очень хотелось попробовать сделать дизеринг. Это когда в черно-белом изображении, если есть ограничения на используемые цвета (например, в истинно чёрно-белом только два цвета), имитируем градации определёнными узорами. Вот как дама справа на рисунке - там дизеринг, и там всего два цвета.

Инструмент тут...

Напоминалка: Преобразовать число в строку без SysUtils

Всем нам известны такие функции, как IntToStr, FloatToStr и т.д. Что делать, если использовать SysUtils нельзя или нежелательно? Для этого существует ядерная процедура Str. Про которую не сразу и вспомнишь.

procedure Str(const X [: Width [:Decimals]]; var S: String);

Преобразует целое число или число с плавающей точкой X в строку, с возможностью указания необязательных настроек форматирования. Примеры и описание.

procedure TForm1.Button1Click(Sender: TObject);
var S: string;
begin
  // '123'
  Str(123, S); Label1.Caption := S;
  // '                           123'
  Str(123:30, S); Label2.Caption := S;
  // ' 1.23456000000000E+0002'
  Str(123.456, S); Label3.Caption := S;
  // '     1.23456000000000000E+0002'
  Str(123.456:30, S); Label4.Caption := S;
  // '                      123.4560'
  Str(123.456:30:4, S); Label5.Caption := S;
end;

Итеративный алгоритм Рамера-Дугласа-Пекера

Дополнил статью итеративным алгоритмом. Мне конечно был милее рекурсивный вариант, но вот возникла необходимость в таком его прочтении. Заодно оптимизировал рекурсивный. Итеративный оказался медленней собрата, поэтому пришлось до кучи оптимизировать и его. Теперь у нас есть три разновидности алгоритма Рамера-Дугласа-Пекера: рекурсивный, итеративный и шустрый.
Всё детально описал. Надеюсь пригодится.

Четыре нюанса реализации...
Переход сразу на итеративный алгоритм...

Кроссплатформенная MulDiv для Delphi

Сделал кроссплатформенную версию MulDiv для Delphi, проверил, описал.
Думал, что в 13-ой версии уже есть подобная штука, но нет.
Ради чрезвычайно шустрой Winapi-функции MulDiv приходится отказываться от всяческой кроссплатформенности. Хотелось сделать не только кроссплатформенный аналог, но и разогнать по скорости.

И вот, что у меня получилось:
Кроссплатформенная MulDiv тут...

Разгоняем кроссплатформенный MulDiv
Теперь наш MulDiv с правильным округлением работает быстрее. А 64 битах работает быстрее оригинального! Peter, спасибо за наводку!
1) MulDiv стала быстрее за счёт небольшой оптимизации;
2) Появилась MulDiv32, более шустрая в 32 битах;
3) Появилась MulDiv64, оглушительно быстрая в 64 битах;
4) Появилась функция MulDivX, использующая преимущества двух предыдущих функций.
Исходник обновлены.

Эффект стекла: Как смешивать Direct2D эффекты

Пример микса D2D-эффектов: D2D1GaussianBlur + D2D1Brightness [+ D2D1Tile + D2D1ColorMatrix + D2D1Blend].
В обойме эффектов D2D шума нет (если не считать Перлина). Поэтому здесь присутствует два вида шума: рукописный (на битмапах и ScanLine'ах) и с помощью дополнительного микса эффектов D2D (которые в квадратных скобках).
- NoiseD2D переключает режимы;
- Ползунок рядом регулирует шум.

Исходник (294 Кб) Delphi XE7
Прога (x64) (1.5 Мб)

Друзья! С Новым 0x07EA годом!

Пусть ваши баги будут тривиальными, а тикеты — закрытыми. Желаю нулевых AV на продакшне и своевременного Free для объектов. Пусть красота begin..end не перестаёт радовать глаз, а RAD означал «Реально Адекватный Дедлайн», а не «Ручная Адская Доработка». И пусть Delphi работает стабильнее, чем ваша любовь к Ctrl+Space!

Убираем фон в один клик

Сделал новый инструмент в копилку. Загружаем картинку из файла или буфера обмена, жмём кнопку "Убрать фон". Думать будет долго, но почти всегда результат будет хорошим. Сохраняет в заказанном формате (JPEG, PNG, WebP) и в размерах оригинала.
Алгоритм убирания фона не мой, этот: @imgly/background-removal.

Попробовать убрать фон...

Сделать цвет темнее или светлее

Мега полезные функции. Рекомендую:

function Darker(Color: TColor; 
  Percent: Byte): TColor;
var r, g, b: Byte;
begin
  r := GetRValue(Color);
  g := GetGValue(Color);
  b := GetBValue(Color);
  r := r-muldiv(r, Percent, 100);
  g := g-muldiv(g, Percent, 100);
  b := b-muldiv(b, Percent, 100);
  Result := RGB(r, g, b);
end;
 
function Lighter(Color: TColor; 
  Percent: Byte):TColor;
var r, g, b: Byte;
begin
  r := GetRValue(Color);
  g := GetGValue(Color);
  b := GetBValue(Color);
  r := r+muldiv(255-r, Percent, 100);
  g := g+muldiv(255-g, Percent, 100);
  b := b+muldiv(255-b, Percent, 100);
  Result := RGB(r, g, b);
end;

Избавляемся от фокусной рамки
Иногда очень хочется избавиться от примитивной фокусной рамки на контроле. В некоторых случаях может помочь:

function RecreateControlRgn(
  const AControl: TWinControl;
  const AMargin: TRect; 
  const ARGN: NativeInt): NativeInt;
var rct: TRect;
begin
  if ARGN <> 0 then
    DeleteObject(ARGN);

  rct := AControl.ClientRect;
  rct.TopLeft := rct.TopLeft +
    AMargin.TopLeft;
  rct.BottomRight := rct.BottomRight -
    AMargin.BottomRight;

  Result := CreateRectRgn(rct.Left, rct.Top,
    rct.Right, rct.Bottom);
  SetWindowRgn(AControl.Handle,
    Result, TRUE);
end;

Использовать, например, так:

procedure TForm1.FormResize(Sender: TObject);
var i: Integer; P: TWinControl;
begin
  for i := 0 to ComponentCount-1 do
    if (Components[i] is TTrackBar) then
    begin
      P := TWinControl(Components[i]);
      P.Tag := RecreateControlRgn(
        P, Rect(1, 1, 1, 1), P.Tag);
    end;
end;

Работает со стилями, и без.

Сохранить битмап в формате png, jpg, gif, bmp

Каким бы образом мы не получили изображение, внутри программы работаем только с битмап. Но бывает нужно сохранять результат. И как-то глупо сохранять его всегда в bmp.

Альтернативное и простое решение, без использования TGraphicClass - через TWICImage. Работают встроенные конверторы Windows.

Если для битмапа указано:
PixelFormat = pf32bit и
AlphaFormat <> afIgnored
то в PNG будет экспортироваться сразу с прозрачностью

procedure SaveBitmapAs(Bitmap: TBitmap;
  const FileName: string);
var WIC: TWICImage; S: string;
begin
  WIC := TWICImage.Create;
  try
    WIC.Assign(Bitmap);
    S := ExtractFileExt(FileName).ToLower;
    if S='.png' then
      WIC.ImageFormat := wifPng
    else if (S='.jpg') or (S='.jpeg') then
      WIC.ImageFormat := wifJpeg
    else if S='.gif' then
      WIC.ImageFormat := wifGif
    else 
      WIC.ImageFormat := wifBmp;
    WIC.SaveToFile(FileName);
  finally
    WIC.Free;
  end;
end;