doublecmd/src/ugraphics.pas

{
   Double Commander
   -------------------------------------------------------------------------
   Graphic functions

   Copyright (C) 2013-2023 Alexander Koblov (alexx2000@mail.ru)

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

unit uGraphics;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, IntfGraphics, LCLVersion;

procedure BitmapConvert(Bitmap: TRasterImage);
procedure BitmapAssign(Bitmap, Image: TRasterImage);
procedure BitmapConvert(ASource, ATarget: TRasterImage);
procedure BitmapAlpha(var ABitmap: TBitmap; APercent: Single);
procedure BitmapAssign(Bitmap: TRasterImage; Image: TLazIntfImage);
procedure BitmapCenter(var Bitmap: TBitmap; Width, Height: Integer);
procedure BitmapMerge(ALow, AHigh: TLazIntfImage; const ADestX, ADestY: Integer);

implementation

uses
  Math, GraphType, FPimage;

type
  TRawAccess = class(TRasterImage) end;

procedure BitmapConvert(Bitmap: TRasterImage);
begin
  BitmapConvert(Bitmap, Bitmap);
end;

procedure BitmapConvert(ASource, ATarget: TRasterImage);
var
  Source, Target: TLazIntfImage;
begin
  Source:= TLazIntfImage.Create(ASource.RawImage, False);
  try
    Target:= TLazIntfImage.Create(ASource.Width, ASource.Height, [riqfRGB, riqfAlpha]);
    try
{$if lcl_fullversion < 2020000}
      Target.CreateData;
{$endif}
      Target.CopyPixels(Source);
      BitmapAssign(ATarget, Target);
    finally
      Target.Free;
    end;
  finally
    Source.Free;
  end;
end;

procedure BitmapAssign(Bitmap, Image: TRasterImage);
var
  RawImage: PRawImage;
begin
  RawImage:= TRawAccess(Image).GetRawImagePtr;
  // Simply change raw image owner without data copy
  Bitmap.LoadFromRawImage(RawImage^, True);
  // Set image data pointer to nil, so it will not free double
  RawImage^.ReleaseData;
end;

procedure BitmapAssign(Bitmap: TRasterImage; Image: TLazIntfImage);
var
  ARawImage: TRawImage;
begin
  Image.GetRawImage(ARawImage, True);
  // Simply change raw image owner without data copy
  Bitmap.LoadFromRawImage(ARawImage, True);
end;

procedure BitmapAlpha(var ABitmap: TBitmap; APercent: Single);
var
  X, Y: Integer;
  Color: TFPColor;
  Masked: Boolean;
  AImage: TLazIntfImage;
  SrcIntfImage: TLazIntfImage;
begin
  if ABitmap.RawImage.Description.AlphaPrec <> 0 then
  begin
    ABitmap.BeginUpdate;
    try
      AImage:= TLazIntfImage.Create(ABitmap.RawImage, False);
      for X:= 0 to AImage.Width - 1 do
      begin
        for Y:= 0 to AImage.Height - 1 do
        begin
          Color:= AImage.Colors[X, Y];
          Color.Alpha:= Round(Color.Alpha * APercent);
          AImage.Colors[X, Y]:= Color;
        end;
      end;
      AImage.Free;
    finally
      ABitmap.EndUpdate;
    end;
  end
  else begin
    Masked:= ABitmap.RawImage.Description.MaskBitsPerPixel > 0;
    SrcIntfImage:= TLazIntfImage.Create(ABitmap.RawImage, False);
    AImage:= TLazIntfImage.Create(ABitmap.Width, ABitmap.Height, [riqfRGB, riqfAlpha]);
{$if lcl_fullversion < 2020000}
    AImage.CreateData;
{$endif}
    for X:= 0 to AImage.Width - 1 do
    begin
      for Y:= 0 to AImage.Height - 1 do
      begin
        Color := SrcIntfImage.Colors[X, Y];
        if Masked and SrcIntfImage.Masked[X, Y] then
          Color.Alpha:= Low(Color.Alpha)
        else begin
          Color.Alpha:= Round(High(Color.Alpha) * APercent);
        end;
        AImage.Colors[X, Y]:= Color;
      end
    end;
    SrcIntfImage.Free;
    BitmapAssign(ABitmap, AImage);
    AImage.Free;
  end;
end;

procedure BitmapCenter(var Bitmap: TBitmap; Width, Height: Integer);
var
  X, Y: Integer;
  Source, Target: TLazIntfImage;
begin
  if (Bitmap.Width <> Width) or (Bitmap.Height <> Height) then
  begin
    Source:= TLazIntfImage.Create(Bitmap.RawImage, False);
    try
      Target:= TLazIntfImage.Create(Width, Height, [riqfRGB, riqfAlpha]);
      try
{$if lcl_fullversion < 2020000}
        Target.CreateData;
{$endif}
        Target.FillPixels(colTransparent);
        X:= (Width - Bitmap.Width) div 2;
        Y:= (Height - Bitmap.Height) div 2;
        Target.CopyPixels(Source, X, Y);
        BitmapAssign(Bitmap, Target);
      finally
        Target.Free;
      end;
    finally
      Source.Free;
    end;
  end;
end;

procedure BitmapMerge(ALow, AHigh: TLazIntfImage; const ADestX, ADestY: Integer);
var
  CurColor: TFPColor;
  X, Y, CurX, CurY: Integer;
  MaskValue, InvMaskValue: Word;
  lDrawWidth, lDrawHeight: Integer;
begin
  lDrawWidth := Min(ALow.Width - ADestX, AHigh.Width);
  lDrawHeight := Min(ALow.Height - ADestY, AHigh.Height);
  for Y := 0 to lDrawHeight - 1 do
  begin
    for X := 0 to lDrawWidth - 1 do
    begin
      CurX := ADestX + X;
      CurY := ADestY + Y;

      if (CurX < 0) or (CurY < 0) then Continue;

      MaskValue := AHigh.Colors[X, Y].Alpha;
      InvMaskValue := $FFFF - MaskValue;

      if MaskValue = $FFFF then
      begin
        ALow.Colors[CurX, CurY] := AHigh.Colors[X, Y];
      end
      else if MaskValue > $00 then
      begin
        CurColor := ALow.Colors[CurX, CurY];

        if CurColor.Alpha = 0 then
        begin
          CurColor:= AHigh.Colors[X, Y];
        end
        else begin
          if MaskValue > CurColor.Alpha then
            CurColor.Alpha:= MaskValue;

          CurColor.Red := Round(
            CurColor.Red * InvMaskValue / $FFFF +
            AHigh.Colors[X, Y].Red * MaskValue / $FFFF);

          CurColor.Green := Round(
            CurColor.Green * InvMaskValue / $FFFF +
            AHigh.Colors[X, Y].Green * MaskValue / $FFFF);

          CurColor.Blue := Round(
            CurColor.Blue * InvMaskValue / $FFFF +
            AHigh.Colors[X, Y].Blue * MaskValue / $FFFF);
         end;
        ALow.Colors[CurX, CurY] := CurColor;
      end;
    end;
  end;
end;

end.