Free Pascal Fast Bitmaps (Part 2)

Whilst reading the Free Pascal mailing lists I read an interesting exchange where there was a discussion of the methods used by FPImage to store bitmap data (Questions regarding FPImage’s TFPMemoryImage.FData variable).  In this my eye was drawn to a class TFPCompactImgRGBA8Bit which was listed as using 32bits per pixel.  As covered in part one of this post, this is the magic pixel sized used by all of the fast software image handling libraries.  I was unaware that it was possible to vary the raw pixel storage in the FCL-Image library, but it turns out that the TFPCustomImage class is designed to allow the definition of descendants that can specify alternative memory allocation strategies.

The class mentioned TFPCompactImgRGBA8Bit does just this and assumes RGBA byte order within the 32bit pixel value.  Unfortunately some platforms, most notably Windows, store the colour components in a different order, BGRA to be precise, so I ideally would like a class that can adapt this order depending upon the target platform.  From this requirement was born my TCompactImage, as an adaptation of the TFPCompactImgRGBA8Bit class:

Unit CompImages;

{ FCL Compact Image Unit (c) 2016, Paul F. Michell. }

{$IFDEF FPC}
  {$ASMMODE INTEL}
  {$MODE OBJFPC}
  {$LONGSTRINGS ON}
{$ENDIF}

Interface

Uses
  Classes, fpImage;

{$I Defines.inc}

Type
  TCompactColor = Packed Record
    {$IFDEF BGRAIMAGE}
    Blue, Green, Red, Alpha: Byte;
    {$ELSE}
    Red, Green, Blue, Alpha: Byte;
    {$ENDIF}
  End;
  TCompactColorPointer = ^TCompactColor;

  TCompactImage = class(TFPCustomImage)
  Protected
    FData: TCompactColorPointer;
    Function GetInternalColor(x, y: Integer): TFPColor; 
                                              Override;
    Function GetInternalPixel({%H-}x, {%H-}y: Integer): 
                                     Integer; Override;
    Procedure SetInternalColor (x, y: Integer; 
                      Const Value: TFPColor); Override;
    Procedure SetInternalPixel({%H-}x, {%H-}y: Integer; 
                        {%H-}Value: Integer); Override;
  Public
    Destructor Destroy; Override;
    Procedure Clear(Color: TCompactColor);
    Procedure SetSize(AWidth, AHeight: Integer); 
                                              Override;
    Property Data: TCompactColorPointer Read FData 
                                           Write FData;
  End;

Implementation

Destructor TCompactImage.Destroy;
Begin
  ReAllocMem(FData, 0);
  Inherited Destroy;
End;

Procedure TCompactImage.SetSize(AWidth, 
                                     AHeight: Integer);
Begin
  If (AWidth<>Width) Or (AHeight<>Height) Then
    Begin
      ReAllocMem(FData, 
                 SizeOf(TCompactColor)*AWidth*AHeight);
      Inherited SetSize(AWidth, AHeight);
    End;
End;

Function TCompactImage.GetInternalColor(x, 
                                 y: Integer): TFPColor;
Var
  Color: TCompactColor;
Begin
  Color := FData[x+y*Width];
  With Color Do
    Begin
      Result.Red := (Red ShL 8)+Red;
      Result.Green := (Green ShL 8)+Green;
      Result.Blue := (Blue ShL 8)+Blue;
      Result.Alpha := (Alpha ShL 8)+Alpha;
    End;
End;

Function TCompactImage.GetInternalPixel(x, 
                                  y: Integer): Integer;
Begin
  { Not used by Compact Images. }
  Result := 0;
End;

Procedure TCompactImage.SetInternalColor(x, y: Integer; 
                                Const Value: TFPColor);
Var
  Color: TCompactColor;
Begin
  Color.Red := Value.Red ShR 8;
  Color.Green := Value.Green ShR 8;
  Color.Blue := Value.Blue ShR 8;
  Color.Alpha := Value.Alpha ShR 8;
  FData[x+y*Width] := Color;
End;

Procedure TCompactImage.SetInternalPixel(x, y: Integer; 
                                       Value: Integer);
Begin
  { Not used by Compact Images. }
End;

Procedure TCompactImage.Clear(Color: TCompactColor);
Begin
  FillDWord(FData^, Width*Height, DWord(Color));
End;

End.

The key difference is the BGRAIMAGE define which enables the colour byte order to change with the target platform.  This is controlled by the ‘Defines.inc’ file:

{ Define platform specific byte order. }
{$IFDEF WINDOWS}
  {$DEFINE BGRAIMAGE}
{$ELSE} {$IFDEF LCLQT}
  {$DEFINE BGRAIMAGE}
{$ELSE}
  {$DEFINE RGBAIMAGE}
{$ENDIF}{$ENDIF}

This proves to be the base technique that fulfils my requirements of: platform portability; fast 32bit pixel access; no external dependencies; potential for headless use; integration with the FCL-Image library; and via TRawImage, the potential to integrate with LCL too.  In a future post I will upload my test program that will demonstrate a bridge to LCL and can achieve in the region of 30 frames per second of full screen updates.

 

 

Leave a Reply