SRL Archive - General

Alpha Transparency for Simba (No Plugins)

Brandon

2015-02-02 04:47:11

I wrote a class for Simba to allow Bitmaps with the alpha channel. All you have to do is change SMART to also use it.

To do this, I opened Client.java and replaced: BufferedImage.TYPE_INT_RGB with BufferedImage.TYPE_INT_ARGB and recompiled Smart. All you need is the new SMART.jar. NOTE: You can also draw transparent images on the browser or any window as well..

Next, I wrote the following class to load images manually:


type
  TBitmap32 = record
    Pixels: array of byte;
    W, H: Integer;
  end;


Procedure TBitmap32.Init(W, H: Integer);
Begin
  Self.W := W;
  Self.H := H;
  SetLength(Pixels, ((Self.W * $20 + $1F) div $20) * $4 * Self.H);
End;

Procedure TBitmap32.Init(Path: String); overload;
type PInt = ^Integer;
var
  Stream: TFileStream;
  Header: array[0..53] of byte;
  Offset, Size: Integer;
Begin
  try
    Stream.Init(Path, $0000);
    Stream.Read(Header, sizeof(Header));
    If ((Header[0] = $42) and (Header[1] = $4D) and (Header[28] = $20)) Then
    begin
      Self.W := PInt(@Header[18])^;
      Self.H := PInt(@Header[22])^;
      Offset := PInt(@header[10])^;
      Size := ((Self.W * Header[28] + $1F) div $20) * $4 * Self.H;
      Stream.Seek(Offset, soBeginning);
      SetLength(Self.Pixels, Size);
      Stream.Read(Self.Pixels[0], Size);
      Self.Flip();
    end;
  finally
    Stream.Free;
  end;
End;

Procedure TBitmap32.Save(Path: String);
type PInt = ^Integer;
var
  Stream: TFileStream;
  I, Size: Integer;
Begin
  try
    Self.Flip();
    Stream.Init(Path, $FF00);
    Size := ((Self.W * $20 + $1F) div $20) * $4 * Self.H;
    Stream.WriteWord($4D42);
    {$IFNDEF BHEXTENDED}
    Stream.WriteDWord(Size + $7A);
    {$ELSE}
    Stream.WriteDWord(Size + $8A);
    {$ENDIF}
    Stream.WriteDWord($0);
    {$IFNDEF BHEXTENDED}
    Stream.WriteDWord($7A);
    Stream.WriteDWord($6C);
    {$ELSE}
    Stream.WriteDWord($8A);
    Stream.WriteDWord($7C);
    {$ENDIF}
    Stream.WriteDWord(Self.W);
    Stream.WriteDWord(Self.H);
    Stream.WriteWord($1);
    Stream.WriteWord($20);
    Stream.WriteDWord($3);
    Stream.WriteDWord(Size);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($FF0000);
    Stream.WriteDWord($FF00);
    Stream.WriteDWord($FF);
    Stream.WriteDWord($FF000000);
    Stream.WriteDWord($73524742);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    {$IFDEF BHEXTENDED}
    Stream.WriteDWord($4);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    Stream.WriteDWord($0);
    {$ENDIF}
    Stream.WriteBuffer(Self.Pixels[0], Size);
  finally
    Stream.Free;
  end;
End;

Procedure TBitmap32.Flip();
var
  I, J: Integer;
  Ptr: ^PtrUInt;
Begin
  Ptr := @Self.Pixels[0];
  For I := 0 To (Self.H div 2) - 1 do
    For J := 0 To Self.W - 1 Do
      Swap(Ptr[(Self.H - I - 1) * Self.W + J]^, Ptr[I * Self.W + J]^);
End;

Function TBitmap32.GetMufasaBitmap(): TMufasaBitmap;
Begin
  Result.Init(Client.GetMBitmaps);
  Result.SetPersistentMemory(PtrUInt(@Self.Pixels[0]), Self.W, Self.H);
End;

Function TBitmap32.Copy(): TBitmap32;
Begin
  Result.W := Self.W;
  Result.H := Self.H;
  Result.Pixels := Self.Pixels;
End;

Function TBitmap32.GetPixel(X, Y: Integer): TColor;
type
  TColour32 = Union Colour: Integer; RGB: TRGB32; end;
var
  Ptr: ^TColour32;
Begin
  Ptr := @Self.Pixels[0];
  Result := Ptr[Y * Self.W + X]^.Colour;
  Result := (Result and $FF000000) or ((Result and $FF0000) shr 16) or (Result and $00FF00) or ((Result and $0000FF) shl 16);
End;

Procedure TBitmap32.SetPixel(X, Y: Integer; Colour: TColor);
type
  TColour32 = Union Colour: Integer; RGB: TRGB32; end;
  PColour32 = ^TColour32;
var
  Ptr: ^TColour32;
Begin
  Ptr := @Self.Pixels[0];
  Colour := (Colour and $FF000000) or ((Colour and $FF0000) shr 16) or (Colour and $00FF00) or ((Colour and $0000FF) shl 16);
  Ptr[Y * Self.W + X]^.Colour := Colour;
End;

Procedure TBitmap32.GetPixel(X, Y: Integer; var R, G, B, A: Byte) overload;
type
  TColour32 = Union Colour: Integer; RGB: TRGB32; end;
  PColour32 = ^TColour32;
var
  Ptr: ^TColour32;
Begin
  Ptr := @Self.Pixels[0];
  R := Ptr[Y * Self.W + X]^.RGB.R;
  G := Ptr[Y * Self.W + X]^.RGB.G;
  B := Ptr[Y * Self.W + X]^.RGB.B;
  A := Ptr[Y * Self.W + X]^.RGB.A;
End;

Procedure TBitmap32.SetPixel(X, Y: Integer; R, G, B, A: Byte) overload;
type
  TColour32 = Union Colour: Integer; RGB: TRGB32; end;
  PColour32 = ^TColour32;
var
  Ptr: ^TColour32;
Begin
  Ptr := @Self.Pixels[0];
  Ptr[Y * Self.W + X]^.RGB.R := R;
  Ptr[Y * Self.W + X]^.RGB.G := G;
  Ptr[Y * Self.W + X]^.RGB.B := B;
  Ptr[Y * Self.W + X]^.RGB.A := A;
End;

Procedure TBitmap32.FromString(const Data: String);
type PInt = ^Integer;
var
  Str: String;
  I: Integer;
  O: Integer;
Begin
  If (Data[1] = 'm') Then
  begin
    O := sizeof(Integer) * 2;
    Str := DecompressString(Base64Decode(Copy(Data, 2, Length(Data) - 1)));
    SetLength(Self.Pixels, Length(Str));

    Self.W := PInt(@Str[1])^;
    Self.H := PInt(@Str[5])^;

    For I := O + 1 To Length(Str) Do
      Self.Pixels[I - 1] := Byte(Str[I]);
  end;
End;

Function TBitmap32.ToString(): String;
type PInt = ^Integer;
var
  Str: String;
  I: Integer;
  O: Integer;
Begin
  O := sizeof(Integer) * 2;
  SetLength(Str, Length(Self.Pixels) + O);

  PInt(@Str[1])^ := Self.W;
  PInt(@Str[5])^ := Self.H;

  For I := O + 1 To Length(Self.Pixels) Do
    Str[I] := AnsiChar(Self.Pixels[I - 1]);
  Result := 'm' + Base64Encode(CompressString(Str));
End;

Function ToString(var Bmp: TBitmap32): String; override;
begin
  Result := Bmp.ToString();
end; 


//Just a test function.. Not part of the API.
Procedure SetAlphas(var Bmp: TBitmap32; ADiv: Integer);
var
  I, J: Integer;
  R, G, B, A: Byte;
Begin
  For I := 0 To Bmp.H - 1 Do
    For J := 0 To Bmp.W - 1 Do
    Begin
      Bmp.GetPixel(J, I, R, G, B, A);
      Bmp.SetPixel(J, I, R, G, B, A div ADiv);
    End;
End;

var
  Smart: TSmart;
  TBmp: TBitmap32;
  TMBmp: TMufasaBitmap;
begin
  ClearDebug();
  Smart.Create(800, 600);
  Smart.Graphics().Clear();

  TBmp.Init('C:/Users/Brandon/Desktop/Small.bmp');
  SetAlphas(TBmp, 100);

  TMBmp := TBmp.GetMufasaBitmap();
  Smart.Graphics().DrawBitmap(TMBmp.getIndex(), Point(175, 100));
  TMBmp.Free();
end.

Example Results:

Saving Bitmaps to disk (You can see that it has a transparent background):

and it's a BITMAP.. Not a PNG.

Properties:

Photoviewer shows the background as transparent as well..

You can use this site to convert a PNG to a 32-bit bitmap (I use my own program to convert): http://www.picresize.com/

OR pray that someone adds Alpha support to Simba.. Enjoy.

NOTES:

The code above does not require explicit memory allocation. This means that if something crashes, you don't have a leak. You never have to free anything either because there's nothing to free. The only time freeing of anything is required is if you convert to TMufasaBitmap. That's when you free the resulting TMufasaBitmap. NOT the bitmap belonging to this API.

I also doubt TMufasaBitmap would need freeing as it doesn't allocate memory for bitmap pointers. But who knows.. There's also a ToString and FromString function to allow you to store and create bitmaps to/from strings.

the bank

2015-02-02 10:59:38

Sweet! Thanks for the share!

Brandon

2015-02-02 13:20:10

From: the bank
Sweet! Thanks for the share!

Glad you like it.

In case anyone needs to figure out conversions between 32-bit and 24-bit colours.. Quick lesson in bit-masking:



//Because Simba's TRGB32 struct is actually BGRA and NOT RGBA.. Lol.. It's named badly.
type
  TRGBA = packed record
    R, G, B, A: Byte;
  end;

//Just to "show" another conversion between RGBA and Integer.
type
  TColour32 = Union Colour: Integer; RGB: TRGBA; end;
  PColour32 = ^TColour32;


//Not needed. Only used to print colours in a recognisable format.
Function RGBAToBGRA(var Colour: Integer): Integer;
begin
  Result := (Colour and $FF000000) or ((Colour and $FF0000) shr 16) or (Colour and $00FF00) or ((Colour and $0000FF) shl 16);
end;


var
  A, B: Integer;
begin
  A := $FFFF0000;       //Red with Full Alpha channel.
  A := A xor $FF000000; //Mask out the alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  A := $FF00FF00;        //Green with Full Alpha channel.
  A := A xor $FF000000;  //Mask out the alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  A := $FF0000FF;       //Blue with Full Alpha channel.
  A := A xor $FF000000; //Mask out the alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  writeln('');
  //-----------------------------------------------------------//


  A := $00FF0000;       //Red without Full Alpha channel.
  A := A or $FF000000;  //Add full alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  A := $0000FF00;       //Green without Full Alpha channel.
  A := A or $FF000000;  //Add full alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  A := $000000FF;       //Blue without Full Alpha channel.
  A := A or $FF000000;  //Add full alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));


  writeln('');
  //----------------------------------------------------------//



  A := $00FF0000;        //Red without alpha channel.
  A := A or $80000000;   //Add half alpha channel.
  writeln(TColour32(RGBAToBGRA(A)));

  A := $80FF0000;        //Red with Half alpha channel.
  A := A or $FF000000 xor $FF000000;   //Mask out alpha channel. Does not matter if it's half or not.
  writeln(TColour32(RGBAToBGRA(A)));


  A := $80FF0000;        //Red with Half alpha channel.
  A := A and $00FFFFFF;   //Mask out alpha channel. Does not matter if it's half or not. Same as the above or + xor.
  writeln(TColour32(RGBAToBGRA(A)));

  //etc..
end.


{COLOUR = 255, RGB = {R = 255, G = 0, B = 0, A = 0}}
{COLOUR = 65280, RGB = {R = 0, G = 255, B = 0, A = 0}}
{COLOUR = 16711680, RGB = {R = 0, G = 0, B = 255, A = 0}}

{COLOUR = -16776961, RGB = {R = 255, G = 0, B = 0, A = 255}}
{COLOUR = -16711936, RGB = {R = 0, G = 255, B = 0, A = 255}}
{COLOUR = -65536, RGB = {R = 0, G = 0, B = 255, A = 255}}

{COLOUR = -2147483393, RGB = {R = 255, G = 0, B = 0, A = 128}}
{COLOUR = 255, RGB = {R = 255, G = 0, B = 0, A = 0}}

{COLOUR = -2147483393, RGB = {R = 255, G = 0, B = 0, A = 128}}
{COLOUR = 255, RGB = {R = 255, G = 0, B = 0, A = 0}}

Without masking, you could always just cast the colour to a TRGB32 and remove the alpha channel that way as well.. In the above examples, I used masking. You do not need the BGRAToRGBA or TColour32 when you do masking.

Something Simba really should have been doing.. That way, you can compare 32-bit colours with 24-bit colours without the alpha channel getting in the way..

TLDR:

To add the alpha channel: Colour := Colour or $XX000000; Where XX is between 0 and $FF aka 255 inclusive.

To remove the alpha channel: Colour := Colour and $00FFFFFF.

rj

2015-02-02 13:31:06

Nice, and how are you calling flip inside of Init and Save without a forwarded procedure?

Brandon

2015-02-02 13:32:18

From: Robert
Nice, and how are you calling flip inside of Init and Save without a forwarded procedure?

Because Flip is a member function belonging to the record/class TBitmap32. If you fully qualify it by using "self (dot) FunctionName", the lookup will be fine. If you just do "FunctionName", it will not find it unless it's forwarded or declared before init & save. It must be fully qualified with the self pointer/reference to avoid forwarding or pre-declaration.

TLDR: Self.Flip() vs. Flip(); Self.FunctionName() vs. FunctionName();