Как нарисовать Bitmap с прозрачностью

Delphi , Графика и Игры , Bitmap

procedure DrawTransparentBmp(Cnv: TCanvas; x,y: Integer; Bmp: TBitmap; clTransparent: TColor);
var
  bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
  oldcol: Longint;
begin
  try
    bmpAND := TBitmap.Create;
    bmpAND.Width := Bmp.Width;
    bmpAND.Height := Bmp.Height;
    bmpAND.Monochrome := True;
    oldcol := SetBkColor(Bmp.Canvas.Handle, ColorToRGB(clTransparent));
    BitBlt(bmpAND.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    SetBkColor(Bmp.Canvas.Handle, oldcol);

    bmpINVAND := TBitmap.Create;
    bmpINVAND.Width := Bmp.Width;
    bmpINVAND.Height := Bmp.Height;
    bmpINVAND.Monochrome := True;
    BitBlt(bmpINVAND.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpAND.Canvas.Handle, 0, 0, NOTSRCCOPY);

    bmpXOR := TBitmap.Create;
    bmpXOR.Width := Bmp.Width;
    bmpXOR.Height := Bmp.Height;
    BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpINVAND.Canvas.Handle, 0, 0, SRCAND);

    bmpTarget := TBitmap.Create;
    bmpTarget.Width := Bmp.Width;
    bmpTarget.Height := Bmp.Height;
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Cnv.Handle, x, y, SRCCOPY);
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpAND.Canvas.Handle, 0, 0, SRCAND);
    BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpXOR.Canvas.Handle, 0, 0, SRCINVERT);
    BitBlt(Cnv.Handle, x, y, Bmp.Width, Bmp.Height, bmpTarget.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    bmpXOR.Free;
    bmpAND.Free;
    bmpINVAND.Free;
    bmpTarget.Free;
  end;
end;

Перевод контента на русский язык:

В предоставленном коде Delphi есть процедура DrawTransparentBmp, которая рисует прозрачный битовую картинку на канвасе в указанной позиции (x, y). Прозрачность битовой картинки достигается созданием временных битовых картинок и использованием функций BitBlt с различными операциями (SRCCOPY, SRCAND, SRCINVERT).

Следующий разбор того, что каждый часть кода делает:

1. Создает четыре временные объекта TBitmap: bmpAND, bmpINVAND, bmpXOR и bmpTarget.
2. Устанавливает bmpAND созданием инвертированной копии оригинальной битовой картинки (Bmp) с всеми пикселями, установленными в цвет прозрачности (clTransparent). Это будет использовано для маскирования.
3. Создает bmpINVAND как побитовая операция NOT на bmpAND, эффективно инвертируя ее снова. Это будет использовано для операции XOR.
4. Создает bmpXOR копированием оригинальной битовой картинки, а затем выполняет операцию AND с инвертированной маской (bmpINVAND). Это дает нам пиксели, которые только в оригинальной битовой картинке и не в области прозрачности.
5. Создает bmpTarget как копию оригинальной битовой картинки, но с областью прозрачности, установленной в ноль (поскольку она уже была учтена).
6. Выполняет операцию SRCAND на bmpTarget с bmpAND, эффективно маскируя любые пиксели, которые прозрачны.
7. Выполняет операцию SRCINVERT на bmpTarget с bmpXOR, эффективно добавляя обратно пиксели, которые только в оригинальной битовой картинке и не в области прозрачности.
8. Наконец, рисует bmpTarget на канвасе в позиции (x, y) с помощью SRCCOPY, что будет рисовать прозрачную битову картинку.

Вот более простой альтернативный способ решения:

procedure DrawTransparentBmp(Cnv: TCanvas; x, y: Integer; Bmp: TBitmap; clTransparent: TColor);
var
  R: TRGB;
begin
  for R := 0 to Pred(Bmp.Width * Bmp.Height) do
  begin
    if BitToLong(R, Bmp.ScanLine[0]) and$FF <> ColorToRGB(clTransparent) then
      Cnv.Draw(0, 0, Bmp, x, y);
  end;
end;

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

В статье описывается процедура DrawTransparentBmp для рисования изображения с прозрачностью на canvas в Delphi, которая использует несколько битовлайтов и создает временные bitmap для достижения необходимого результата.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Bitmap ::