unit AlphaImageUtils;

{            AlphaImageUtils            }
{    Copyright (c) 2008, Torbins      }

interface

uses
  Windows, Classes, Graphics, PngImage;

type
  TRGBTripleArray = array[0..MaxInt div sizeof(TRGBTriple)-1] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBQuadArray  = array[0..MaxInt div sizeof(TRGBQuad)-1] of TRGBQuad;
  PRGBQuadArray  = ^TRGBQuadArray;

procedure DrawAlpha(Src: TBitmap; Canvas: TCanvas; X, Y: integer);
procedure DrawPng(Src: TPngObject; Canvas: TCanvas; X, Y: integer);

procedure AlphaCombine(Src, Dest: TBitmap; minW, minH: Cardinal; sX: cardinal =
    0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
procedure PngCombine(Src, Dest: TPngObject; minW, minH: Cardinal; sX: cardinal
    = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
procedure AlphaToPng(Src: TBitmap; Dest: TPngObject; minW, minH: Cardinal; sX:
    cardinal = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
procedure PngToAlpha(Src: TPngObject; Dest: TBitmap; minW, minH: Cardinal; sX:
    cardinal = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);

procedure CenterAlphaCombine(Src, Dest: TBitmap);
procedure CenterPngCombine(Src, Dest: TPngObject);
procedure CenterAlphaToPng(Src: TBitmap; Dest: TPngObject);
procedure CenterPngToAlpha(Src: TPngObject; Dest: TBitmap);

procedure PrepareAlpha(Dest: TBitmap; ChangeSize: boolean; NewWidth: cardinal;
  NewHeight: cardinal; transparency: byte = 255); overload;
procedure PrepareAlpha(Dest: TBitmap; transparency: byte = 255); overload;
procedure PreparePng(Dest: TPngObject; ChangeSize: boolean; NewWidth: cardinal;
  NewHeight: cardinal); overload;
procedure PreparePng(Dest: TPngObject); overload; 

implementation

procedure CheckA(Src, Dest: TObject; minW, minH, sX, sY, dX, dY: Cardinal);
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Assigned(Dest), 'Dest not assigned');
  if Src is TBitmap then
    Assert(TBitmap(Src).PixelFormat = pf32bit, 'Invalid Src format')
  else
  if Src is TPngObject then
  begin
    Assert((TPngObject(Src).Chunks.Count <> 0) and
      (TPngObject(Src).Chunks.Item[0] is TChunkIHDR), 'Src.Header missing');
    Assert(TPngObject(Src).Header.ColorType = COLOR_RGBALPHA,
      'Invalid Src ColorType');
  end;
  if Dest is TBitmap then
    Assert(TBitmap(Dest).PixelFormat = pf32bit, 'Invalid Dest format')
  else
  if Dest is TPngObject then
  begin
    Assert((TPngObject(Dest).Chunks.Count <> 0) and
      (TPngObject(Dest).Chunks.Item[0] is TChunkIHDR), 'Dest.Header missing');
    Assert(TPngObject(Dest).Header.ColorType = COLOR_RGBALPHA,
      'Invalid Dest ColorType');
  end;
  if Src is TGraphic then
  begin
    Assert(sX + minW <= TGraphic(Src).Width, 'Src.Width must be greater ' +
      'then sX+minW');
    Assert(sY + minH <= TGraphic(Src).Height, 'Src.Height must be greater ' +
      'then sY+minH');
  end;
  if Dest is TGraphic then
  begin
    Assert(dX + minW <= TGraphic(Dest).Width, 'Dest.Width must be greater ' +
      'then dX+minW');
    Assert(dY + minH <= TGraphic(Dest).Height, 'Dest.Height must be greater ' +
      'then dY+minH');
  end;
end;

procedure PngToAlpha(Src: TPngObject; Dest: TBitmap; minW, minH: Cardinal; sX:
    cardinal = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
var
  tsX, tdX, Y, a1, a2: cardinal;
  LineS:  PRGBTripleArray;
  ALineS: PByteArray;
  LineD:  PRGBQuadArray;
begin
  CheckA(Src, Dest, minW, minH, sX, sY, dX, dY);

  for Y := 0 to minH - 1 do
  begin
    LineS  := Src.ScanLine[Y + sY];
    ALineS := Src.AlphaScanline[Y + sY];
    LineD  := Dest.ScanLine[Y + dY];

    tsX := sX;
    tdX := dX;
    while tdX < minW + dX do
    begin
      a1 := (255 - ALineS[tsX]) * LineD[tdX].rgbReserved;
      a2 := 255 * ALineS[tsX];

      LineD[tdX].rgbReserved := (a1 + a2) div 255; //shr 8;

      if a1 + a2 > 0 then
      begin
        LineD[tdX].rgbBlue  :=
          (a1 * LineD[tdX].rgbBlue + a2 * LineS[tsX].rgbtBlue) div (a1 + a2);
        LineD[tdX].rgbGreen :=
          (a1 * LineD[tdX].rgbGreen + a2 * LineS[tsX].rgbtGreen) div (a1 + a2);
        LineD[tdX].rgbRed  :=
          (a1 * LineD[tdX].rgbRed + a2 * LineS[tsX].rgbtRed) div (a1 + a2);
      end
      else
      begin
        LineD[tdX].rgbBlue  := 0;
        LineD[tdX].rgbGreen := 0;
        LineD[tdX].rgbRed  := 0;
      end;

      Inc(tsX);
      Inc(tdX);
    end;
  end;

  Dest.Modified := True;
end;

procedure AlphaToPng(Src: TBitmap; Dest: TPngObject; minW, minH: Cardinal; sX:
    cardinal = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
var
  tsX, tdX, Y, a1, a2: cardinal;
  LineS:  PRGBQuadArray;
  LineD:  PRGBTripleArray;
  ALineD: PByteArray;
begin
  CheckA(Src, Dest, minW, minH, sX, sY, dX, dY);

  for Y := 0 to minH - 1 do
  begin
    LineS  := Src.ScanLine[Y + sY];
    LineD  := Dest.ScanLine[Y + dY];
    ALineD := Dest.AlphaScanline[Y + dY];

    tsX := sX;
    tdX := dX;
    while tdX < minW + dX do
    begin
      a1 := (255 - LineS[tsX].rgbReserved) * ALineD[tdX];
      a2 := 255 * LineS[tsX].rgbReserved;

      ALineD[tdX] := (a1 + a2) div 255; //shr 8;

      if a1 + a2 > 0 then
      begin
        LineD[tdX].rgbtBlue  :=
          (a1 * LineD[tdX].rgbtBlue + a2 * LineS[tsX].rgbBlue) div (a1 + a2);
        LineD[tdX].rgbtGreen :=
          (a1 * LineD[tdX].rgbtGreen + a2 * LineS[tsX].rgbGreen) div (a1 + a2);
        LineD[tdX].rgbtRed  :=
          (a1 * LineD[tdX].rgbtRed + a2 * LineS[tsX].rgbRed) div (a1 + a2);
      end
      else
      begin
        LineD[tdX].rgbtBlue  := 0;
        LineD[tdX].rgbtGreen := 0;
        LineD[tdX].rgbtRed  := 0;
      end;

      Inc(tsX);
      Inc(tdX);
    end;
  end;

  Dest.Modified := True;
end;

procedure Centerize(sSize, dSize: Cardinal; out min: Cardinal; out s, d:
    cardinal);
begin
  if sSize < dSize then
  begin
    min := sSize;
    s  := 0;
    d  := (dSize - sSize) div 2;
  end
  else
  if sSize > dSize then
  begin
    min := dSize;
    s  := (sSize - dSize) div 2;
    d  := 0;
  end
  else
  begin
    min := dSize;
    s  := 0;
    d  := 0;
  end;
end;

procedure CenterAlphaToPng(Src: TBitmap; Dest: TPngObject);
var
  sX, sY, dX, dY, minW, minH: cardinal;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Assigned(Dest), 'Dest not assigned');

  Centerize(Src.Height, Dest.Height, minH, sY, dY);
  Centerize(Src.Width, Dest.Width, minW, sX, dX);

  AlphaToPng(Src, Dest, minW, minH, sX, sY, dX, dY);
end;

procedure DrawPng(Src: TPngObject; Canvas: TCanvas; X, Y: integer);
var
  tbmp:  TBitmap;
  i, j:  cardinal;
  rS, rD: TRect;
  LineS:  PRGBTripleArray;
  ALineS: PByteArray;
  LineD:  PRGBQuadArray;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert((Src.Chunks.Count <> 0) and (Src.Chunks.Item[0] is TChunkIHDR),
    'Src.Header missing');
  Assert(Src.Header.ColorType = COLOR_RGBALPHA,
    'Invalid Src ColorType');
  Assert(((X < 0) and (Src.Width > -X)) or (X > 0),
    'X is too small. Image will not be visible');
  Assert(((Y < 0) and (Src.Height > -Y)) or (Y > 0),
    'Y is too small. Image will not be visible');

  tbmp := TBitmap.Create;
  try
    tbmp.PixelFormat := pf32Bit;
    tbmp.Canvas.Brush.Color := clBlack;
    tbmp.Width  := Src.Width;
    tbmp.Height := Src.Height;

    rS := Rect(0, 0, Src.Width, Src.Height);
    rD := Rect(X, Y, Src.Width + X, Src.Height + Y);
    tbmp.Canvas.CopyRect(rS, Canvas, rD);

    for i := 0 to Src.Height - 1 do
    begin
      LineS  := Src.ScanLine[i];
      ALineS := Src.AlphaScanline[i];
      LineD  := tbmp.ScanLine[i];

      for j := 0 to Src.Width - 1 do
      begin
        LineD[j].rgbReserved :=
          ALineS[j] + LineD[j].rgbReserved -
          ((LineD[j].rgbReserved * ALineS[j]) div 255); //shr 8);

        LineD[j].rgbBlue  := (LineD[j].rgbBlue * (255 - ALineS[j]) +
          LineS[j].rgbtBlue * ALineS[j]) div 255; //shr 8;
        LineD[j].rgbGreen := (LineD[j].rgbGreen * (255 - ALineS[j]) +
          LineS[j].rgbtGreen * ALineS[j]) div 255; //shr 8;
        LineD[j].rgbRed  := (LineD[j].rgbRed * (255 - ALineS[j]) +
          LineS[j].rgbtRed * ALineS[j]) div 255; //shr 8;
      end;
    end;

    Canvas.CopyRect(rD, tbmp.Canvas, rS);
  finally
    tbmp.Free;
  end;
end;

procedure DrawAlpha(Src: TBitmap; Canvas: TCanvas; X, Y: integer);
var
  tbmp:  TBitmap;
  i, j:  cardinal;
  rS, rD: TRect;
  LineS, LineD: PRGBQuadArray;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Src.PixelFormat = pf32bit, 'Invalid Src format');
  Assert(((X < 0) and (Src.Width > -X)) or (X > 0),
    'X is too small. Image will not be visible');
  Assert(((Y < 0) and (Src.Height > -Y)) or (Y > 0),
    'Y is too small. Image will not be visible');

  tbmp := TBitmap.Create;
  try
    tbmp.PixelFormat := pf32Bit;
    tbmp.Canvas.Brush.Color := clBlack;
    tbmp.Width  := Src.Width;
    tbmp.Height := Src.Height;

    rS := Rect(0, 0, Src.Width, Src.Height);
    rD := Rect(X, Y, Src.Width + X, Src.Height + Y);
    tbmp.Canvas.CopyRect(rS, Canvas, rD);

    for i := 0 to Src.Height - 1 do
    begin
      LineS := Src.ScanLine[i];
      LineD := tbmp.ScanLine[i];

      for j := 0 to Src.Width - 1 do
      begin
        LineD[j].rgbReserved :=
          LineS[j].rgbReserved + LineD[j].rgbReserved -
          ((LineD[j].rgbReserved * LineS[j].rgbReserved) div 255); //shr 8);
        //В качестве эталона был использован Paint.Net (возможно не лучший
        //выбор, но ставить чтото другое лень). Результаты оптимизированого кода
        //в некоторых пикселах отличаются от эталона.

        LineD[j].rgbBlue  := (LineD[j].rgbBlue * (255 - LineS[j].rgbReserved) +
          LineS[j].rgbBlue * LineS[j].rgbReserved) div 255; //shr 8;
        LineD[j].rgbGreen := (LineD[j].rgbGreen * (255 - LineS[j].rgbReserved) +
          LineS[j].rgbGreen * LineS[j].rgbReserved) div 255; //shr 8;
        LineD[j].rgbRed  := (LineD[j].rgbRed * (255 - LineS[j].rgbReserved) +
          LineS[j].rgbRed * LineS[j].rgbReserved) div 255; //shr 8;
      end;
    end;

    Canvas.CopyRect(rD, tbmp.Canvas, rS);
  finally
    tbmp.Free;
  end;
end;

procedure PrepareAlpha(Dest: TBitmap; ChangeSize: boolean; NewWidth: cardinal;
  NewHeight: cardinal; transparency: byte = 255); overload;
var
  X, Y:  cardinal;
  LineD: PRGBQuadArray;
begin
  Assert(Assigned(Dest), 'Dest not assigned');

  if ChangeSize then
  begin
    Dest.Width  := NewWidth;
    Dest.Height := NewHeight;

    Dest.Modified := True;
  end
  else
  begin
    Assert(Dest.Width > 0, 'Dest.Width must be greater then 0');
    Assert(Dest.Height > 0, 'Dest.Height must be greater then 0');
  end;
 
  if Dest.PixelFormat <> pf32Bit then
  begin
    Dest.PixelFormat := pf32Bit;

    for X := 0 to Dest.Height - 1 do
    begin
      LineD := Dest.ScanLine[X];
     
      for Y := 0 to Dest.Width - 1 do
        LineD[Y].rgbReserved := transparency;
    end;

    Dest.Modified := True;
  end;
end;

procedure PrepareAlpha(Dest: TBitmap; transparency: byte = 255); overload;
begin
  PrepareAlpha(Dest, False, 0, 0, transparency);
end;

procedure PreparePng(Dest: TPngObject; ChangeSize: boolean; NewWidth: cardinal;
  NewHeight: cardinal); overload;
var
  tbmp: TBitmap;
  HeaderPresent: boolean;
begin
  Assert(Assigned(Dest), 'Dest not assigned');

  HeaderPresent := (Dest.Chunks.Count <> 0) and (Dest.Chunks.Item[0] is TChunkIHDR);

  if (not HeaderPresent) or (Dest.Header.ColorType = COLOR_PALETTE) then
  begin
    tbmp := TBitmap.Create;
    try
      if HeaderPresent then
        Dest.AssignTo(tbmp);

      tbmp.PixelFormat := pf24bit;

      if ChangeSize then
      begin
        tbmp.Width  := NewWidth;
        tbmp.Height := NewHeight;
      end
      else
      begin
        Assert(Dest.Width > 0, 'Dest.Width must be greater then 0');
        Assert(Dest.Height > 0, 'Dest.Height must be greater then 0');

        tbmp.Width  := Dest.Width;
        tbmp.Height := Dest.Height;
      end;

      Dest.Assign(tbmp);
    finally
      tbmp.Free;
    end;

    Dest.Modified := True;
  end;

  if Dest.TransparencyMode <> ptmPartial then
  begin
    Dest.CreateAlpha;
    if not HeaderPresent then
      FillChar(Dest.AlphaScanline[0]^, Dest.Width * Dest.Height, #0);
    Dest.Modified := True;
  end;
end;

procedure PreparePng(Dest: TPngObject); overload;
begin
  PreparePng(Dest, False, 0, 0);
end;

procedure CenterPngToAlpha(Src: TPngObject; Dest: TBitmap);
var
  sX, sY, dX, dY, minW, minH: cardinal;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Assigned(Dest), 'Dest not assigned');

  Centerize(Src.Height, Dest.Height, minH, sY, dY);
  Centerize(Src.Width, Dest.Width, minW, sX, dX);

  PngToAlpha(Src, Dest, minW, minH, sX, sY, dX, dY);
end;

procedure PngCombine(Src, Dest: TPngObject; minW, minH: Cardinal; sX: cardinal
    = 0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
var
  tsX, tdX, Y, a1, a2: cardinal;
  LineS, LineD:  PRGBTripleArray;
  ALineS, ALineD: PByteArray;
begin
  CheckA(Src, Dest, minW, minH, sX, sY, dX, dY);

  for Y := 0 to minH - 1 do
  begin
    LineS  := Src.ScanLine[Y + sY];
    ALineS := Src.AlphaScanline[Y + sY];
    LineD  := Dest.ScanLine[Y + dY];
    ALineD := Dest.AlphaScanline[Y + dY];

    tsX := sX;
    tdX := dX;
    while tdX < minW + dX do
    begin
      a1 := (255 - ALineS[tsX]) * ALineD[tdX];
      a2 := 255 * ALineS[tsX];

      ALineD[tdX] := (a1 + a2) div 255; //shr 8;

      if a1 + a2 > 0 then
      begin
        LineD[tdX].rgbtBlue  :=
          (a1 * LineD[tdX].rgbtBlue + a2 * LineS[tsX].rgbtBlue) div (a1 + a2);
        LineD[tdX].rgbtGreen :=
          (a1 * LineD[tdX].rgbtGreen + a2 * LineS[tsX].rgbtGreen) div (a1 + a2);
        LineD[tdX].rgbtRed  :=
          (a1 * LineD[tdX].rgbtRed + a2 * LineS[tsX].rgbtRed) div (a1 + a2);
      end
      else
      begin
        LineD[tdX].rgbtBlue  := 0;
        LineD[tdX].rgbtGreen := 0;
        LineD[tdX].rgbtRed  := 0;
      end;

      Inc(tsX);
      Inc(tdX);
    end;
  end;

  Dest.Modified := True;
end;

procedure CenterPngCombine(Src, Dest: TPngObject);
var
  sX, sY, dX, dY, minW, minH: cardinal;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Assigned(Dest), 'Dest not assigned');

  Centerize(Src.Height, Dest.Height, minH, sY, dY);
  Centerize(Src.Width, Dest.Width, minW, sX, dX);

  PngCombine(Src, Dest, minW, minH, sX, sY, dX, dY);
end;

procedure AlphaCombine(Src, Dest: TBitmap; minW, minH: Cardinal; sX: cardinal =
    0; sY: cardinal = 0; dX: cardinal = 0; dY: cardinal = 0);
var
  tsX, tdX, Y, a1, a2: cardinal;
  LineS, LineD: PRGBQuadArray;
begin
  CheckA(Src, Dest, minW, minH, sX, sY, dX, dY);

  for Y := 0 to minH - 1 do
  begin
    Lines := Src.ScanLine[Y + sY];
    LineD := Dest.ScanLine[Y + dY];
   
    tsX  := sX;
    tdX  := dX;
    while tdX < minW + dX do
    begin
      a1 := (255 - LineS[tsX].rgbReserved) * LineD[tdX].rgbReserved;
      a2 := 255 * LineS[tsX].rgbReserved;

      LineD[tdX].rgbReserved := (a1 + a2) div 255; //shr 8;
      //Как показала практика, во всей процедуре лучше использовать либо
      //всюду div, либо всюду shr

      if a1 + a2 > 0 then
      begin
        LineD[tdX].rgbBlue  :=
          (a1 * LineD[tdX].rgbBlue + a2 * LineS[tsX].rgbBlue) div (a1 + a2);
        LineD[tdX].rgbGreen :=
          (a1 * LineD[tdX].rgbGreen + a2 * LineS[tsX].rgbGreen) div (a1 + a2);
        LineD[tdX].rgbRed  :=
          (a1 * LineD[tdX].rgbRed + a2 * LineS[tsX].rgbRed) div (a1 + a2);
      end
      else
      begin
        LineD[tdX].rgbBlue  := 0;
        LineD[tdX].rgbGreen := 0;
        LineD[tdX].rgbRed  := 0;
      end;

      Inc(tsX);
      Inc(tdX);
    end;
  end;

  Dest.Modified := True;
end;

procedure CenterAlphaCombine(Src, Dest: TBitmap);
var
  sX, sY, dX, dY, minW, minH: cardinal;
begin
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Assigned(Dest), 'Dest not assigned');

  Centerize(Src.Height, Dest.Height, minH, sY, dY);
  Centerize(Src.Width, Dest.Width, minW, sX, dX);

  AlphaCombine(Src, Dest, minW, minH, sX, sY, dX, dY);
end;

end.

type
  TRGBTripleArray = array[0..1024] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBQuadArray = array[0..1024] of TRGBQuad;
  PRGBQuadArray = ^TRGBQuadArray;

//By Torbins
procedure PNGCombine(Dest, Src: TPNGObject; minH, minW: integer;
  dX: cardinal = 0; dY: cardinal = 0; sX: cardinal = 0; sY: cardinal = 0);
var
  Y, tsX, tdX:    cardinal;
  LineD, Lines:  PRGBTripleArray;
  ALineD, ALineS: PByteArray;
begin
  Assert(Assigned(Dest), 'Dest not assigned');
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Dest.TransparencyMode = ptmPartial, 'Invalid Dest TransparencyMode');
  Assert(Src.TransparencyMode = ptmPartial, 'Invalid Src TransparencyMode');
  Assert(dX + minW <= Dest.Width, 'Dest.Width must be greater then dX+minW');
  Assert(sX + minW <= Src.Width, 'Src.Width must be greater then sX+minW');
  Assert(dY + minH <= Dest.Height, 'Dest.Height must be greater then dY+minH');
  Assert(sY + minH <= Src.Height, 'Src.Height must be greater then sY+minH');

  for Y := 0 to minH - 1 do
  begin
    LineD  := Dest.ScanLine[Y + dY];
    ALineD := Dest.AlphaScanline[Y + dY];
    Lines  := Src.ScanLine[Y + sY];
    ALineS := Src.AlphaScanline[Y + sY];

    tdX := dX;
    tsX := sX;
    while tdX < minW + dX do
    begin
      if ALineD[tdX] = 0 then
      begin
        LineD[tdX].rgbtBlue  := 0;
        LineD[tdX].rgbtGreen := 0;
        LineD[tdX].rgbtRed  := 0;
      end;
      if ALineS[tsX] = 0 then
      begin
        Lines[tsX].rgbtBlue  := 0;
        Lines[tsX].rgbtGreen := 0;
        Lines[tsX].rgbtRed  := 0;
      end;

      if ALineD[tdX] < ALineS[tsX] then
        ALineD[tdX] := ALineS[tsX];

      LineD[tdX].rgbtBlue  := (LineD[tdX].rgbtBlue * (255 - ALineS[tsX]) +
        Lines[tsX].rgbtBlue * ALineS[tsX]) div 255;
      LineD[tdX].rgbtGreen := (LineD[tdX].rgbtGreen * (255 - ALineS[tsX]) +
        Lines[tsX].rgbtGreen * ALineS[tsX]) div 255;
      LineD[tdX].rgbtRed  := (LineD[tdX].rgbtRed * (255 - ALineS[tsX]) +
        Lines[tsX].rgbtRed * ALineS[tsX]) div 255;

      Inc(tdX);
      Inc(tsX);
    end;
  end;
end;

procedure PNGCenterCombine(Dest, Src: TPNGObject);
var
  minH, minW:    integer;
  dX, dY, sX, sY: cardinal;

  procedure Centerize(dSize, sSize: integer; out min: integer; out s, d: cardinal);
  begin
    if dSize > sSize then
    begin
      min := sSize;
      s  := 0;
      d  := (dSize - sSize) div 2;
    end
    else
    if dSize < sSize then
    begin
      min := dSize;
      s  := (sSize - dSize) div 2;
      d  := 0;
    end
    else
    begin
      min := dSize;
      s  := 0;
      d  := 0;
    end;
  end;

begin
  Assert(Assigned(Dest), 'Dest not assigned');
  Assert(Assigned(Src), 'Src not assigned');

  Centerize(Dest.Height, Src.Height, minH, sY, dY);
  Centerize(Dest.Width, Src.Width, minW, sX, dX);

  PngCombine(Dest, Src, minH, minW, dX, dY, sX, sY);
end;

procedure AlphaCombine(Dest, Src: TBitmap; minH, minW: integer;
  dX: cardinal = 0; dY: cardinal = 0; sX: cardinal = 0; sY: cardinal = 0);
var
  Y, tsX, tdX:  cardinal;
  LineD, Lines: PRGBQuadArray;
begin
  Assert(Assigned(Dest), 'Dest not assigned');
  Assert(Assigned(Src), 'Src not assigned');
  Assert(Dest.PixelFormat = pf32bit, 'Invalid Dest format');
  Assert(Src.PixelFormat = pf32bit, 'Invalid Src format');
  Assert(dX + minW <= Dest.Width, 'Dest.Width must be greater then dX+minW');
  Assert(sX + minW <= Src.Width, 'Src.Width must be greater then sX+minW');
  Assert(dY + minH <= Dest.Height, 'Dest.Height must be greater then dY+minH');
  Assert(sY + minH <= Src.Height, 'Src.Height must be greater then sY+minH');

  for Y := 0 to minH - 1 do
  begin
    LineD := Dest.ScanLine[Y + dY];
    Lines := Src.ScanLine[Y + sY];
    tdX  := dX;
    tsX  := sX;
    while tdX < minW + dX do
    begin
      if LineD[tdX].rgbReserved < Lines[tsX].rgbReserved then
        LineD[tdX].rgbReserved := Lines[tsX].rgbReserved;

      LineD[tdX].rgbBlue  := (LineD[tdX].rgbBlue * (255 - Lines[tsX].rgbReserved) +
        Lines[tsX].rgbBlue * Lines[tsX].rgbReserved) div 255;
      LineD[tdX].rgbGreen := (LineD[tdX].rgbGreen * (255 - Lines[tsX].rgbReserved) +
        Lines[tsX].rgbGreen * Lines[tsX].rgbReserved) div 255;
      LineD[tdX].rgbRed  := (LineD[tdX].rgbRed * (255 - Lines[tsX].rgbReserved) +
        Lines[tsX].rgbRed * Lines[tsX].rgbReserved) div 255;

      Inc(tdX);
      Inc(tsX);
    end;
  end;
end;

procedure AlphaCenterCombine(Dest, Src: TBitmap);
var
  minH, minW:    integer;
  dX, dY, sX, sY: cardinal;

  procedure Centerize(dSize, sSize: integer; out min: integer; out s, d: cardinal);
  begin
    if dSize > sSize then
    begin
      min := sSize;
      s  := 0;
      d  := (dSize - sSize) div 2;
    end
    else
    if dSize < sSize then
    begin
      min := dSize;
      s  := (sSize - dSize) div 2;
      d  := 0;
    end
    else
    begin
      min := dSize;
      s  := 0;
      d  := 0;
    end;
  end;

begin
  Assert(Assigned(Dest), 'Dest not assigned');
  Assert(Assigned(Src), 'Src not assigned');

  Centerize(Dest.Height, Src.Height, minH, sY, dY);
  Centerize(Dest.Width, Src.Width, minW, sX, dX);

  AlphaCombine(Dest, Src, minH, minW, dX, dY, sX, sY);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  bmp:TBitmap;
  png:TPNGObject;
begin
  png:=TPNGObject.Create;
  png.LoadFromFile('D:\Images\TranspIm.png');
  try
    bmp:=TBitmap.Create;
    try
      PNGToAlphaBitmap(png, bmp);
      Canvas.Draw(100, 100, bmp);
    finally
      bmp.Free;
    end;
  finally
    png.Free;
  end;
end;