Разгоняем кроссплатформенный 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;

Масштаб и сдвиг многоугольника

Быстрый масштаб и сдвиг для 2D-полигона:

type
  // Динамический массив вещественных 2D-точек
  TPointFDynArray = TArray<TPointF>;

// Вычисляет новый полигон с трансформацией
function TransformPolygon(
  const Pts: TPointFDynArray;
  Count: Integer; 
  sX, sY, dX, dY: Single): TPointFDynArray;
var I: Integer; Src, Dst: PSingle;
begin
  if Count <= 0 then
    Count := Length(Pts);
  SetLength(Result, Count);
  if Count = 0 then exit;

  Src := @Pts[0];
  Dst := @Result[0];

  for I := 0 to Count - 1 do
  begin
    Dst^ := Src^ * sX + dX; // X
    Inc(Src); Inc(Dst);
    Dst^ := Src^ * sY + dY; // Y
    Inc(Src); Inc(Dst);
  end;
end;

#geom_code

Получить TBitmap из любого TGraphic с масштабированием

Иногда надо получить Bitmap из какого-либо графического формата для последующей обработки, анализа и прочего. Но порой попадается такое здоровенное изображение, что работать с ним становится мучительно больно из-за вполне предсказуемых тормозов. Хочется битмап поменьше, но без потери качества и прозрачности.

Ниже можно скачать небольшой модуль. Там пока три функции. Основная задача: либо просто конвертируют TGraphic в TBitmap, либо масштабируют, если какой-либо из размеров (Width|Height) превышает указанный максимум. Если в TGraphic есть прозрачность, то она сохранится.

- CreateBitmapFromGraphic - всё делает шустро. Используется GDI + HALFTONE;
- CreateBitmapFromGraphicHQ - всё делает в высоком качестве. Используется GDI+. Конвертирование происходит через поток;
- CreateBitmapFromGraphicD2D - всё делает в высочайшем качестве. Используется D2D. Работаем с WIC на низком уровне. Причины изложены в коде.

Скачать модуль (zip)

Лечим смещение на полпикселя в GDI+

Проблема
Есть такая проблема, что GDI+ считает координату (0,0) центром пикселя, а не его углом. Смотрим правый рисунок - узлы сетки ровно в середине пикселя.
Последствия (центральный рисунок):
- Смещение на полпикселя - изображение сдвинуто относительно GDI и D2D;
- Размытие линий - горизонтальная линия толщиной 1px в точке y=0 размывается на два ряда пикселей (по 50%);
- Несовпадение координат - прямоугольник (0,0,100,100) в GDI+ занимает другую область, чем в GDI.

Решение
Раньше борол это тем, что вычитал полпикселя из координат. И относительно недавно узнал, что можно это решить всего лишь одной строкой:

var
  Graphics: TGPGraphics;
...

Graphics.SetPixelOffsetMode(
  PixelOffsetModeHalf);

Причины
GDI+ создавался как “улучшенный GDI” с акцентом на сглаживание и качество. Центрирование координат на пикселях даёт более симметричный антиалиасинг для векторных фигур.
Но для работы с растровыми изображениями и совместимости с другими API это делает головную боль.

Кастомная отрисовка TrackBar'ов

Недавно возник вопрос, как можно нарисовать TrackBar по своему усмотрению.
Один из способов (не единственный) - это кастомная отрисовка через перехват CN_NOTIFY/WM_NOTIFY.
Использовал класс ThlTrackBar. Правда, немного его допилил.
Как рисовать - смотрим в главном модуле метод TrackBarCustomDraw.
Отрисовка определённого стиля осуществляется набором из двух процедур: Draw<Style>Track и Draw<Style>Thumb.

Шаблон промта для Claude 4.5 Opus (txt)
Исходник (79 Кб) Delphi XE7
Прога (926 Кб)

Гипнотический текст

Эффект получился случайно, другое делал, подумал, что надо на тексте опробовать. И вот что получилось. Думаю, надо сохранить в копилке эффектов.
Текстовый туннель - гипнотический эффект бесконечного приближения текста с иллюзией глубины и плавной сменой цветовых схем. Реализовано через GDI+. Три стиля отрисовки: PathGradient, LinearGradient, Hypnotic — переключение Ctrl+1/2/3. Или кнопками рядом с текстом 1/2/3.
В Hypnotic-режиме 4 цветовые схемы (Default, Fog, Night, Pastel), выбор через контекстное меню на поле отрисовки.
Интересный получится вид, если задать строку I_____I или R_____Я.

Исходник (64 Кб) Delphi XE7
Прога (930 Кб)

Отрисовка битмапа с масштабированием и отсечением невидимой области

Модуль ImageDrawing предоставляет возможности отрисовки TBitmap на канве с масштабированием и поддержкой прозрачности, используя три разных движка: GDI, GDI+ и Direct2D. Для GDI+ и D2D определяет видимую часть изображения и рисует только её, что позволяет рисовать быстро, даже при бикубической интерполяции.

Можно указать качество отрисовки:
- dqFast - без сглаживания (видны пиксели)
- dqMedium - билинейная интерполяция (среднее, возможна "мыльность")
- dqHigh - бикубическая интерполяция(высокое, лучше сохраняет резкость).

Вызов соответствующей функции рендеринга:
- GDI: использует StretchBlt/AlphaBlend/TransparentBlt с настройкой режима растяжения
- GDI+: конвертирует битмап в TGPBitmap и рисует с настраиваемой интерполяцией
- Direct2D: через WIC создаёт ID2D1Bitmap и использует TDirect2DCanvas с поддержкой бикубической интерполяции через ID2D1DeviceContext

Скачать ImageDrawing (+Winapi.D2DMissing)

TBitmap.ScanLine: Полное руководство

Три способа работы с пикселями — от классического до быстрого и кэшированного. Четыре формата (pf1bit, pf8bit, pf24bit, pf32bit), шаблоны навигации по памяти, padding, bottom-up, типичные ошибки. Каждый пример — самодостаточная процедура, бери и используй.

Внутри: бенчмарк, демо-приложение, исходники.

Запланированное продолжение темы, поднятой 3 года назад. Планировалось две статьи подряд: TBitmap.PixelFormat и эта. Закрываю ментальный долг )))

Статья...

TPngImage: глюк масштабирования и как это исправить

В TPngImage при масштабировании систематически недобирает исходные пиксели: правый и нижний край обрезаются.
Баг не исправлен даже в Delphi 13.0 Florence.

В статье разбор причины, три попытки решения (коэффициенты, билинейный фильтр, AlphaBlend). В итоге пришёл к простому и очевидному решению. Правда, оно стало очевидным после того, как прошёл весь этот путь.

Исходники, как обычно, внутри.

Статья...

Clipboard в Delphi: почему пропадает прозрачность и как её вернуть

💥 Clipboard + Delphi = потеря альфа-канала. Так было всегда, так есть сейчас, но не обязательно так всё оставлять.

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

📌 Внутри:
- почему VCL теряет альфу и как устроен синтез форматов в Windows;
- что на самом деле лежит в буфере (написал утилиту-просмотрщик);
- как достать PNG и CF_DIBV5 напрямую;
- готовый модуль: две функции, вставка и копирование с альфой.

📖 Статья + исходники

Blur в Delphi. Часть I: Gaussian Blur

Понадобился быстрый и качественный блюр. Решил разобраться, возможно, что-то придумать. В итоге статья получилась огромной, пришлось разрезать на две части.

В этой статье разговор только про Gaussian Blur:
- Что такое свёртка и почему Gaussian - эталон;
- Наивная реализация: работает, но σ=50 считается вечность;
- Сепарабельность: O(r²) превращается в O(r);
- Fixed-point: выкидываем Double, получаем ×2;
- Транспонирование + разделение краёв: ещё ×2.

Дополнительно проанализированы:
- GBlur2: легенда Delphi-форумов;
- GDI+: странный блюр, странный радиус;
- Direct2D: нереально быстрый правильный блюр.

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

Статья...

Blur в Delphi. Часть II: Box, Stack, Downscale

Вторая часть про блюр. Если Gaussian - эталон, то что делать, когда он слишком медленный? Искать аппроксимации.

В этой статье:

- Box Blur: наивный, потом со скользящей суммой - O(1) на пиксель;
- Тройной Box Blur: три прохода и почти Гаусс;
- Extended Box Blur: недавнее изобретение Ивана Кутскира, три прохода и более корректный Гаусс;
- Stack Blur Клингеманна: треугольное ядро за O(1), разобран по косточкам;
- Двойной Stack Blur: ещё ближе к Гауссу, и неожиданно быстрый;
- Downscale/Upscale: уменьшил, размыл, увеличил - грубо, но при большом σ летает.

Для каждого метода — формула пересчёта σ в радиус, сравнение с эталоном и бенчмарк. В конце — таблица: какой метод выбрать и когда.

Исходники, демо-приложение - всё есть.

Статья...

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

Пусть в вашей жизни:

- Код всегда компилируется с первого раза
- Баги обходят стороной — и в проектах, и в жизни
- Дедлайны будут щедрыми, а заказчики — понимающими
- Зарплата растёт как O(2ⁿ), а проблемы решаются за O(1)

Вы доказываете каждый день, что в IT нет границ - есть только if, else и бесконечные возможности.

Спасибо, что вы не только часть системы, но и её архитекторы.

Новость про убирание фона с фото устарела. Прежняя нейронка перестала грузиться без VPN.

Переделал инструмент на библиотеку Hugging Face Transformers с моделью RMBG-1.4 от Bria AI. Качество стало даже лучше, чем было раньше.

Ещё одно улучшение — модель теперь кэшируется после первой загрузки. То есть долгой будет только первая обработка, дальше всё быстро.

Попробовать можно в обновлённом инструменте: Удаление фона с картинки