Create Alpha-Blending

Unit BMixer.pas

unit BMixer;

interface

uses Windows, Graphics, Types;

type 
  PPointer = ^Pointer;  // This type will describe an array of pointers
type 
  TYZBitMap = record     // This type we will use to store ScanLines of our bitmaps
    RowMap: PPointer;  // to accelerate access to them during drawing
    Width: Integer;
    Height: Integer;
  end;

var
  TransMap: pbyte;
  // Transparency Map - actually it is an array[0..255,0..255] of byte
  // where first index is color byte (R, G or B channel)
  // and second index is it`s alpha value over black

  FG, BG, Alpha: TBitMap;
  FGScans, BGScans, AlphaScans: TYZBitMap;

                     {
                         I used global instances of this values
                         only for simplification of the example
                         actually it would be better to create
                         a descendant of TBitmap, incapsulate them into it
                         and initialize them while Bitmap is loaded, created or resized.

                         So, here we will use 3 bitmaps, named
                         'BG'        (Background Bitmap),
                         'FG'        (Our Sprite) and
                         'Alpha'     (Transparency bitmap for Foreground Bitmap).

                     }

procedure Init(); // This must be called only once - at the beginning of all drawings

procedure AlphaDraw(ABG, AFG, AAlpha: TYZBitMap; SrcRect: TRect;
  DstPoint: TPoint; Transparency: Byte = 255);

implementation

//------------------------------------------------------------------------------
// This is the body of BuildTransparencyMap :

procedure BuildTransparencyMap(var P: PByte);
var 
  i, j: Integer;
  pb: pbyte;
  x: Byte;
begin
  if P <> nil then freemem(p);
  getmem(p, 65536);
  pb := P;
  for i := 0 to 255 do for j := 0 to 255 do
    begin
      x   := round(i * j / 255) mod 256;
      pb^ := x;
      Inc(pb);
    end;
end;

//------------------------------------------------------------------------------
// Here is body of InitBitmapScans :
// We will fill a TYZBitMap structure for future use in AlphaDraw()

procedure InitBitmapScans(B: TBitmap; var Map: TYZBitmap);
var 
  I, X: Integer;
  P: PPointer;
begin
  B.PixelFormat := pf24bit; // Ensure that our bitmap has 24bit depth color map
  Map.Width     := B.Width;
  Map.Height    := B.Height;

  if Map.RowMap <> nil then FreeMem(Map.RowMap);
  Map.RowMap := nil;
  if Map.Height = 0 then Exit;
  GetMem(Map.RowMap, Map.Height * SizeOf(Pointer));
  P := Map.RowMap;
  for i := 0 to Map.Height - 1 do
  begin
    p^ := B.ScanLine[i];
    Inc(p);
  end;
end;

procedure Init();
begin
  // This is an initialization procedure
  // which must be called at the beginning of all drawings - only once.

  BuildTransparencymap(TransMap);

  // Then we must prepare ScanLine Tables for our bitmaps

  InitBitmapScans(BG, BGScans);
  InitBitmapScans(FG, FGScans);
  InitBitmapScans(Alpha, AlphaScans);
end;

procedure AlphaDraw(  // Params:

  ABG: TYZBitMap; // BG scanlines record
  AFG: TYZBitMap; // FG scanlines record
  AAlpha: TYZBitMap; // Alpha scanlines record

  SrcRect: TRect;     // A rectangle to copy from FG-Bitmap
  DstPoint: TPoint;    // A TopLeft point in Background bitmap to put
  Transparency: Byte =
  255 // Global Transparency of our Sprite (this will be combined with Alpha channel)

  );
var 
  dstRect: TRect;
  srcp, mskp, dstp: pbyte;
  i, x: Integer;
  wdt, hgt: Word;
  skt: Byte;
  srcleft, dstleft: Word;
  offs: TRect;
begin
  // Okay! Let`s do it!
  // First of all, we must ensure,
  // that our drawing areas do not cross borders of bitmaps

  wdt := ABG.Width;
  hgt := ABG.Height;

  // Lets calculate output (Destination, or DST) rect (Where our Sprite will be shown on a BG)

  dstRect.Left := dstpoint.x;
  dstRect.Top  := dstpoint.y;

  dstRect.Right  := dstpoint.x + srcrect.Right - srcrect.Left;
  dstRect.Bottom := dstpoint.y + srcrect.Bottom - srcrect.Top;

  // Validate Source (SRC) rect

  offs := rect(0,0,0,0);

  if srcrect.Left < 0 then offs.Left := offs.Left - srcrect.Left;
  if srcrect.Top < 0 then offs.Top := offs.Top - srcrect.Top;
  if srcrect.Right >= wdt then offs.Right := offs.Right - (srcrect.Right - wdt + 1);
  if srcrect.Bottom >= hgt then offs.Bottom := offs.Bottom - (srcrect.Bottom - hgt + 1);

  srcrect.Left   := srcrect.Left + offs.Left;
  srcrect.Top    := srcrect.Top + offs.Top;
  srcrect.Right  := srcrect.Right + offs.Right;
  srcrect.Bottom := srcrect.Bottom + offs.Bottom;

  // We also must update DST rect if SRC was changed

  dstrect.Left   := dstrect.Left + offs.Left;
  dstrect.Top    := dstrect.Top + offs.Top;
  dstrect.Right  := dstrect.Right + offs.Right;
  dstrect.Bottom := dstrect.Bottom + offs.Bottom;

  offs := rect(0,0,0,0);

  // Now, validate DST rect again - it can also be invalid

  if dstrect.Left < 0 then offs.Left := offs.Left - dstrect.Left;
  if dstrect.Top < 0 then offs.Top := offs.Top - dstrect.Top;
  if dstrect.Right >= wdt then offs.Right := offs.Right - (dstrect.Right - wdt + 1);
  if dstrect.Bottom >= hgt then offs.Bottom := offs.Bottom - (dstrect.Bottom - hgt + 1);

  // Update SRC rect again

  srcrect.Left   := srcrect.Left + offs.Left;
  srcrect.Top    := srcrect.Top + offs.Top;
  srcrect.Right  := srcrect.Right + offs.Right;
  srcrect.Bottom := srcrect.Bottom + offs.Bottom;

  dstrect.Left   := dstrect.Left + offs.Left;
  dstrect.Top    := dstrect.Top + offs.Top;
  dstrect.Right  := dstrect.Right + offs.Right;
  dstrect.Bottom := dstrect.Bottom + offs.Bottom;

  // Hmmm... Nay be our DST-rect or/and SRC-rect are invalid?

  if (dstrect.Top >= dstrect.Bottom) or (srcrect.Top >= srcrect.Bottom) or
    (dstrect.Left >= dstrect.Right) or (srcrect.Left >= srcrect.Right) then
    Exit; // Then exit!

  srcp := pbyte(AFG.RowMap); // prepare our pointers
  mskp := pbyte(AAlpha.RowMap);
  dstp := pbyte(ABG.RowMap);

  wdt := (dstrect.Right - dstrect.Left + 1) * 3;
  // here is actual width of a scanrow in bytes
  hgt     := (dstrect.Bottom - dstrect.Top + 1);
  srcleft := srcrect.Left * 3; // actual left offset in Sprite
  dstleft := dstrect.Left * 3; // actual left offset in BG


  // FINE! Let`s Dance!

  asm
      push EAX         // Push-Push
      push EBX
      push ECX
      push EDX
      push EDI
      push ESI

      mov EDI,srcp     // first Sprite scanline
      mov ESI,dstp     // --"-- Background scanline
      mov EDX,mskp     // and Alpha too!

      xor eax,eax
      mov AX,LOWORD(srcrect.top) // find needed scanlines
      shl AX,2
      add EDI,EAX
      add EDX,EAX
      mov AX,LOWORD(dstrect.top)
      shl AX,2
      add ESI,EAX
      mov BX,hgt   // BX - is our vertical lines counter

   @vloop:         // begin vertical loop

      push BX
      mov BX,wdt   // now BX becomes our horizontal bytes counter
      push EDI     // Push again
      push ESI
      push EDX
      mov EDI,[EDI]
      mov ESI,[ESI]
      mov EDX,[EDX]
      mov AX,srcleft  // move to the left rect sides
      add EDI,EAX
      add EDX,EAX
      mov AX,dstleft
      add ESI,EAX

    @loop:

      // Here I must note, that this routine doesn`t work with colors as triades
      // Instead of it, we will work with each byte separately
      // Thats why Alpha bitmap must be also 24bit depth RGB image
      // where all R, G and B are equal in each pixel (desaturated)

      mov ECX,&TransMap
      mov AH,[EDX]
      mov AL,&Transparency
      neg AL
      dec AL
      sub AH,AL  // calculate sprite pixel opacity (using global Transparency)
      jnc @skip  // if result is less than zero
      xor AH,AH  // then force it to be the ZERO!

    @skip:

      mov AL,[EDI]
      add ECX,EAX
      mov AL,[ECX]
      mov &skt,AL
      mov ECX,&TransMap // calculate inverted transparency for BG
      mov AH,[EDX]
      mov AL,&Transparency
      neg AL
      dec AL
      sub AH,AL
      jnc @skip2
      xor AH,AH

    @skip2:

      neg AH
      dec AH
      mov AL,[ESI]
      add ECX,EAX
      mov AL,[ECX]
      add AL,&skt      // Finally, the result of this mixing will be the same as
                       // COLOR = ( FG_COLOR * Alpha ) + ( BG_Color * ( 255 - Alpha ) )
      mov [ESI],AL

      inc EDI
      inc ESI
      inc EDX
      dec BX
      jnz @loop       // horizontal loop
      pop EDX
      pop ESI
      pop EDI
      add EDI,4      // next scanline
      add ESI,4
      add EDX,4
      pop BX         // BX becomes vertical loop counter again!
      dec BX
      jnz @vloop     // vertical loop
      pop ESI
      pop EDI
      pop EDX
      pop ECX
      pop EBX
      pop EAX
    end;
end;

end.

Unit 1:

uses BMixer

//

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  c: tcolor;
  B: Byte;
begin
  FG        := TBitmap.Create;
  FG.Width  := Image1.Picture.Bitmap.Width;
  FG.Height := Image1.Picture.Bitmap.Height;


  BG        := TBitmap.Create;
  BG.Width  := FG.Width;
  BG.Height := FG.Height;
  BG.Canvas.Brush.Color := clSilver;
  BG.Canvas.FillRect(rect(0,0,BG.Width, BG.Height));

  Alpha        := TBitmap.Create;
  Alpha.Width  := FG.Width;
  Alpha.Height := FG.Height;
  Alpha.Canvas.Draw(0,0,Image2.Picture.Bitmap);

  Init;

  Image3.Width  := BG.Width;
  Image3.Height := BG.Height;
  AlphaDraw(BGScans,
            FGScans,
            AlphaScans,
            rect(0,0,FG.Width, FG.Height),
            point(0,0),
            255);

  Image3.Canvas.Draw(0,0,BG);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BG.Destroy;
  FG.Destroy;
  Alpha.Destroy;
end;