unit RGraphics;
{

Version 1.0 from 20.07.2016

Copyright (C) 2016 - Ronald Daleske

Licence
=======

 LGPLv2.1 with static linking exception (See COPYING.modifiedLGPL.txt)

}

{$mode delphi} {Default to Delphi compatible syntax}
{$H+}          {Default to AnsiString}
{$inline on}   {Allow use of Inline procedures}



interface



uses
  Classes,
  SysUtils;



{==============================================================================}

const
  { Table of Error-Codes }
  EC_no_errors                 = 0;
  EC_File_not_found            = 1;
  EC_no_FileHeader             = 2;
  EC_File_is_not_a_Bitmap      = 3;
  EC_color_depth_is_not_24     = 4;
  EC_X_POS_greater_then_width  = 5;
  EC_Y_POS_greater_then_height = 6;

{==============================================================================}

type


  TPoint = record
             X, Y: LongWord;
           end;

  TPixel_24RGB = record
                   Red, Green, Blue  : Byte;
                 end;

  TPixel_32ABGR = record
                    Alpha, Blue, Green, Red : Byte;
                  end;


  TBITMAPFILEHEADER = record
                        bfType : Word;
                        bfSize, bfReserved, bfOffBits : DWord;
                      end; { TBITMAPFILEHEADER }

  TBITMAPFILEHEADER2 = record
                        bfSize, bfReserved, bfOffBits : DWord;
                      end; { TBITMAPFILEHEADER2 }


  TBITMAPINFOHEADER = record
                        biSize : DWord;
                        biWidth, biHeight : Integer;
                        biPlanes, biBitCount : Word;
                        biCompression, biSizeImage : DWord;
                        biXPelsPerMeter, biYPelsPerMeter : Integer;
                        biClrUsed, biClrImportant : DWord;
                      end; { TBITMAPINFOHEADER }



  {TBitmap specific clases}
  TBitmap = class(TObject)
    private
      {Internal Variables}
      FWidth, FHeight, FSize : LongWord;
      {Internal Methods}
      procedure SetWidth(BM_Width : LongWord);
      function GetWidth : LongWord;
      procedure SetHeight(BM_Height : LongWord);
      function GetHeight : LongWord;
      procedure SetSize(BM_Size : LongWord);
      function GetSize : LongWord;
      procedure SetPixel(X,Y,Value: LongWord);
      function GetPixel(X,Y: LongWord): LongWord;
    public
      {Public Properties}
      BM_RAW_Memory : TMemoryStream;
      Error_Code : Byte;
      BITMAPFILEHEADER : TBITMAPFILEHEADER;
      BITMAPINFOHEADER : TBITMAPINFOHEADER;
      BM_FileSize : Int64;
      {Public Methods}
      constructor Create;
      function LoadFromFile(FileName : String) : Boolean;
      procedure LoadFromArray(var Load_Array : Array of Byte);
      function SaveToFile(FileName : String) : Boolean;
      property Width: LongWord read GetWidth write SetWidth;
      property Height: LongWord read GetHeight write SetHeight;
      property Size: LongWord read GetSize write SetSize;
      property Pixels[X, Y: LongWord]: LongWord read GetPixel write SetPixel;
      destructor Destroy;

    protected
      {Internal Variables}

      {Internal Methods}

   end; { TBitmap }



implementation



{==============================================================================}
{==============================================================================}
{TBitmap}
constructor TBitmap.Create;
begin
  {}
  inherited Create;

  Error_Code := EC_no_errors;

  BM_RAW_Memory := TMemoryStream.Create;

  Height:=0;
  Width:=0;
  Size:=0;

end; { constructor TBitmap.Create }



{==============================================================================}
{==============================================================================}
{TBitmap}
procedure TBitmap.SetWidth(BM_Width : LongWord);
begin

  FWidth:=BM_Width;
  Size:=FWidth*FHeight*4;

end; { procedure TBitmap.SetWidth }




{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.GetWidth : LongWord;
begin

  Result:=FWidth;

end; { function TBitmap.GetWidth }




{==============================================================================}
{==============================================================================}
{TBitmap}
procedure TBitmap.SetHeight(BM_Height : LongWord);
begin
  FHeight:=BM_Height;
  Size:=FWidth*FHeight*4;

end; { procedure TBitmap.SetHeight }




{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.GetHeight : LongWord;
begin

  Result:=FHeight;

end; { function TBitmap.GetHeight }







{==============================================================================}
{==============================================================================}
{TBitmap}
procedure TBitmap.SetSize(BM_Size : LongWord);
begin

  FSize:=BM_Size;
  BM_RAW_Memory.Size:=FSize;

end; { procedure TBitmap.SetSize }




{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.GetSize : LongWord;
begin

  Result:=FSize;

end; { function TBitmap.GetSize }



{==============================================================================}
{==============================================================================}
{TBitmap}
procedure TBitmap.SetPixel(X,Y,Value: LongWord);
begin

  if X<Width then begin
    if Y<Height then begin
      BM_RAW_Memory.Position:=(X+((Height-Y-1)*Width))*4;
      BM_RAW_Memory.Write(Value,4);
    end; { if Pos_Y<=Height then }
  end; { if Pos_X<=Width then }

end; { procedure TBitmap.SetPixel }



{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.GetPixel(X,Y: LongWord): LongWord;
var
  Pixel_Value : LongWord;
begin

  if X<Width then begin
    if Y<Height then begin
      BM_RAW_Memory.Position:=(X+((Height-Y-1)*Width))*4;
      BM_RAW_Memory.Read(Pixel_Value,4);
    end
    else begin
      Pixel_Value:=0;
      Error_Code:=EC_Y_POS_greater_then_Height;
    end; { if Pos_Y<=Height then }
  end
  else begin
    Pixel_Value:=0;
    Error_Code:=EC_X_POS_greater_then_Width;
  end; { if Pos_X<=Width then }

  Result:=Pixel_Value;

end; { function TBitmap.GetPixel }




{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.LoadFromFile(FileName : String) : Boolean;
var
  load_ok : Boolean;
  counter_height, counter_width,
  Length_Line : LongWord;
  BM_File : TMemoryStream;
  LB_Pixel_32ABGR : LongWord;
  LB_Pixel_24RGB : TPixel_24RGB;


  function Color24RGB_to_Color_32ABGR(Pixel_BMP : TPixel_24RGB) : LongWord;
  var
    fa, fb : LongWord;
    Pixel_32ABGR : TPixel_32ABGR;
  begin

    Pixel_32ABGR.Red:=Pixel_BMP.Red;
    Pixel_32ABGR.Green:=Pixel_BMP.Green;
    Pixel_32ABGR.Blue:=Pixel_BMP.Blue;
    Pixel_32ABGR.Alpha:=(Pixel_BMP.Red+Pixel_BMP.Green+Pixel_BMP.Blue) DIV 3;

    fa:=Pixel_32ABGR.Red;
    fb:=Pixel_32ABGR.Green shl 8;
    fa:=fa or fb;
    fb:=Pixel_32ABGR.Blue shl 16;
    fa:=fa or fb;
    fb:=Pixel_32ABGR.Alpha shl 24;
    fa:=fa or fb;

    Result:=fa;
  end; { function Color24RGB_to_Color_32ABGR }



begin

  BM_File := TMemoryStream.Create;

  if FileExists(FileName) then begin
    load_ok:=true;
    BM_File.LoadFromFile(FileName);
    BM_FileSize:=BM_File.Size;

    if BM_File.Size>=54 then begin

      BM_File.Position:=0;
      BM_File.Read(BITMAPFILEHEADER,14);
      BM_File.Read(BITMAPINFOHEADER,40);

      BM_RAW_Memory.Clear;

      if BITMAPFILEHEADER.bfType=$4D42 then begin

        if BITMAPINFOHEADER.biBitCount=24 then begin

          FWidth:=BITMAPINFOHEADER.biWidth;
          FHeight:=BITMAPINFOHEADER.biHeight;
          Size:=FWidth*FHeight*4;

          BM_RAW_Memory.Position:=0;

          BM_File.Position:=54+BITMAPFILEHEADER.bfOffBits;

          Length_Line:=FWidth*3;

          for counter_height:=FHeight-1 downto 0 do begin
            BM_File.Position:=(54+BITMAPFILEHEADER.bfOffBits)+
                              (counter_height*Length_Line)+((FWidth mod 4)*counter_height);
            for counter_width:=0 to FWidth-1 do begin
              BM_File.Read(LB_Pixel_24RGB,3);
              LB_Pixel_32ABGR:=Color24RGB_to_Color_32ABGR(LB_Pixel_24RGB);
              BM_RAW_Memory.Write(LB_Pixel_32ABGR,4);
            end;
          end; { for bm_counter:=BM_File.Position to BM_File.Size-1 do }

        end
        else begin
          load_ok:=false;
          Error_Code:=EC_color_depth_is_not_24;
        end; { if BITMAPINFOHEADER.biBitCount=24 then }

      end
      else begin
        load_ok:=false;
        Error_Code:=EC_File_is_not_a_Bitmap;
      end; { if BITMAPFILEHEADER.bfType=$4D42 then }

    end
    else begin
      load_ok:=false;
      Error_Code:=EC_no_FileHeader;
    end; { if BM_File.Size>=54 then }

  end
  else begin
    load_ok:=false;
    Error_Code:=EC_File_not_found;
  end;

  BM_File.Free;

  Result:=load_ok;

end; { function TBitmap.LoadFromFile }











{==============================================================================}
{==============================================================================}
{TBitmap}
procedure TBitmap.LoadFromArray(var Load_Array : Array of Byte);
var
  line : String;
  one_Byte : Byte;
  Array_Width, Array_Height,
  Array_Size, A_counter : LongWord;

begin

  one_Byte:=Load_Array[0];
  line:='$'+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[1];
  line:=line+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[2];
  line:=line+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[3];
  line:=line+IntToHex(one_Byte,2);
  Array_Width:=StrToInt(line);

  Width:=Array_Width;


  one_Byte:=Load_Array[4];
  line:='$'+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[5];
  line:=line+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[6];
  line:=line+IntToHex(one_Byte,2);
  one_Byte:=Load_Array[7];
  line:=line+IntToHex(one_Byte,2);
  Array_Height:=StrToInt(line);

  Height:=Array_Height;

  Array_Size:=(Width*Height*4)+4+4;

  BM_RAW_Memory.Position:=0;

  for A_counter:=8 to Array_Size-1 do begin
    one_Byte:=Load_Array[A_counter];
    BM_RAW_Memory.Write(one_Byte,1);
  end; {  }


end; { function TBitmap.LoadFromArray }










{==============================================================================}
{==============================================================================}
{TBitmap}
function TBitmap.SaveToFile(FileName : String) : Boolean;
var
  save_ok : Boolean;
  BM_File : TMemoryStream;
 { bm_counter, bm_end,  }
  counter_height, counter_width : LongWord;
  BITMAPFILEHEADER2 :  TBITMAPFILEHEADER2;
  SB_Pixel_32ABGR : LongWord;
  SB_Pixel_24RGB : TPixel_24RGB;
  BMP24_Size, FillBytes : LongWord;
  one_byte : Byte;

  function Color_32ABGR_to_Color24RGB(Pixel_Color : LongWord) : TPixel_24RGB;
  var
    fa : LongWord;
    Pixel_BMP : TPixel_24RGB;
    Pixel_Byte : Byte;
  begin

    fa:=Pixel_Color and $000000FF;
    Pixel_Byte:=fa;
    Pixel_BMP.Red:=Pixel_Byte;

    fa:=Pixel_Color shr 8;
    fa:=fa and $000000FF;
    Pixel_Byte:=fa;
    Pixel_BMP.Green:=Pixel_Byte;

    fa:=Pixel_Color shr 16;
    fa:=fa and $000000FF;
    Pixel_Byte:=fa;
    Pixel_BMP.Blue:=Pixel_Byte;

    Result:=Pixel_BMP;

  end; { function Color_32ABGR_to_Color24RGB }



begin

  save_ok:=true;

  FillBytes:=0;

  if (FWidth mod 4)>0 then
    FillBytes:=(((FWidth div 4)+1)*4)-FWidth;

  BMP24_Size:=(FWidth+FillBytes)*FHeight * 3;

  BITMAPFILEHEADER2.bfSize:=14+40+BMP24_Size;
  BITMAPFILEHEADER2.bfReserved:=0;
  BITMAPFILEHEADER2.bfOffBits:=14+40;

  BITMAPINFOHEADER.biSize:=40;
  BITMAPINFOHEADER.biWidth:=FWidth;
  BITMAPINFOHEADER.biHeight:=FHeight;
  BITMAPINFOHEADER.biPlanes:=1;
  BITMAPINFOHEADER.biBitCount:=24;
  BITMAPINFOHEADER.biCompression:=0;
  BITMAPINFOHEADER.biSizeImage:=BMP24_Size; // Raw without Header
  BITMAPINFOHEADER.biXPelsPerMeter:=0;
  BITMAPINFOHEADER.biYPelsPerMeter:=0;

  BM_File := TMemoryStream.Create;
  BM_File.Size:=14+40+BMP24_Size;
  BM_File.Position:=0;

  one_byte:=$42;
  BM_File.Write(one_byte,1);
  one_byte:=$4D;
  BM_File.Write(one_byte,1);
  BM_File.Write(BITMAPFILEHEADER2,12);
  BM_File.Write(BITMAPINFOHEADER,40);

  BM_RAW_Memory.Position:=0;

  for counter_height:=FHeight-1 downto 0 do begin

    BM_RAW_Memory.Position:=(counter_height*FWidth)*4;

    for counter_width:=0 to FWidth-1 do begin
      BM_RAW_Memory.Read(SB_Pixel_32ABGR,4);
      SB_Pixel_24RGB:=Color_32ABGR_to_Color24RGB(SB_Pixel_32ABGR);
      BM_File.Write(SB_Pixel_24RGB,3);
    end; { for counter_width:=0 to FWidth-1 do }

    if FillBytes>0 then begin
      SB_Pixel_24RGB.Red:=0;
      SB_Pixel_24RGB.Green:=0;
      SB_Pixel_24RGB.Blue:=0;
      for counter_width:=1 to FillBytes do begin
        BM_File.Write(SB_Pixel_24RGB,3);
      end;
    end; { if FillBytes>0 then }

  end; { for counter_height:=FHeight-1 downto 0 do }


  if FileExists(FileName) then
    DeleteFile(FileName);

  BM_File.SaveToFile(FileName);

  BM_File.Free;

  Result:=save_ok;

end; { function TBitmap.SaveToFile }




{==============================================================================}
{==============================================================================}
{TBitmap}
destructor TBitmap.Destroy;
begin
  BM_RAW_Memory.Free;
  inherited Destroy;
end; { destructor TBitmap.Destroy }





end.

