galfar.imaginglib/Extensions/ImagingGraphics32.pas

{
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net

  The contents of this file are used with permission, subject to the Mozilla
  Public License Version 1.1 (the "License"); you may not use this file except
  in compliance with the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL/MPL-1.1.html

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  the specific language governing rights and limitations under the License.

  Alternatively, the contents of this file may be used under the terms of the
  GNU Lesser General Public License (the  "LGPL License"), in which case the
  provisions of the LGPL License are applicable instead of those above.
  If you wish to allow use of your version of this file only under the terms
  of the LGPL License and not to allow others to use your version of this file
  under the MPL, indicate your decision by deleting  the provisions above and
  replace  them with the notice and other provisions required by the LGPL
  License.  If you do not delete the provisions above, a recipient may use
  your version of this file under either the MPL or the LGPL License.

  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}

{ Unit functions for converting and copying images between Imaging and Graphics32 library.}
unit ImagingGraphics32;

{$I ImagingOptions.inc}

interface

uses
  Types, GR32, ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingClasses;

{ Converts image from TImageData record to GR32's bitmap. Bitmap32 must be already
  instantiated.}
procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32);
{ Converts image from TBaseImage instance to GR32's bitmap. Bitmap32 must be already
  instantiated.}
procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32);

{ Converts image data from GR32's bitmap to TImageData record.}
procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData);
{ Converts image data from GR32's bitmap to existing TBaseImage instance.}
procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage);

{ Copies pixels from TImageData record (with all the necessary conversion if
  the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must
  have the same width and height. }
procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32);
{ Copies pixels from TBaseImage instance (with all the necessary conversion if
  the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must
  have the same width and height. }
procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32);

{ Copies rectangular area of pixels from TImageData record to existing GR32's bitmap.}
procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32;
  SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload;
{ Copies rectangular area of pixels from TBaseImage instance to existing GR32's bitmap.}
procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32;
  SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload;

{ Maps GR32 bitmap on TImageData record so that they'll both share
  the same pixels in memory (Bitmap32.Bits and Image.Bits point to the same
  memory address). Usefull if you wan to e.g. save Bitmap32 using Imaging
  and don't want to needlesly duplicate the entire image in memory.
  Note that you must not call FreeImage on Image after the mapping or
  the memory of Bitmap32 would be freed too.}
procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData);

implementation

procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32);
begin
  Assert(TestImage(Image));
  Bitmap32.SetSize(Image.Width, Image.Height);
  CopyImageDataToBitmap32(Image, Bitmap32);
end;

procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32);
begin
  ConvertImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32);
end;

procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData);
begin
  Assert(not Bitmap32.Empty);
  NewImage(Bitmap32.Width, Bitmap32.Height, ifA8R8G8B8, Image);
  Move(Bitmap32.Bits^, Image.Bits^, Image.Size);
end;

procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage);
begin
  ConvertBitmap32ToImageData(Bitmap32, Image.ImageDataPointer^);
end;

procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32);
begin
  Assert(TestImage(Image) and (Image.Width = Bitmap32.Width) and (Image.Height = Bitmap32.Height));
  CopyRectToBitmap32(Image, Bitmap32, 0, 0, Image.Width, Image.Height, 0, 0);
end;

procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32);
begin
  CopyImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32);
end;

procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32;
  SrcX, SrcY, Width, Height, DstX, DstY: Integer);
var
  TempImage: TImageData;
  X, Y, Bpp, SrcWidthBytes, DstWidth, MoveBytes: Integer;
  DstPtr: PColor32Rec;
  SrcPtr: PByte;
  Info: TImageFormatInfo;
begin
  Assert(TestImage(Image) and not Bitmap32.Empty);

  ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, Image.Width, Image.Height,
    Rect(0, 0, Bitmap32.Width, Bitmap32.Height));

  if Image.Format in [ifIndex8, ifGray8, ifA8Gray8, ifGray16, ifR8G8B8, ifA8R8G8B8,
    ifR16G16B16, ifA16R16G16B16] then
  begin
    GetImageFormatInfo(Image.Format, Info);
    Bpp := Info.BytesPerPixel;
    SrcWidthBytes := Image.Width * Bpp;
    DstWidth := Bitmap32.Width;
    MoveBytes := Width * Bpp;
    SrcPtr := @PByteArray(Image.Bits)[SrcY * SrcWidthBytes + SrcX * Bpp];
    DstPtr := @PColor32RecArray(Bitmap32.Bits)[DstY * DstWidth + DstX];

    for Y := 0 to Height - 1 do
    begin
      case Image.Format of
        ifIndex8:
          for X := 0 to Width - 1 do
          begin
            DstPtr^ := Image.Palette[SrcPtr^];
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifGray8:
          for X := 0 to Width - 1 do
          begin
            DstPtr.R := SrcPtr^;
            DstPtr.G := SrcPtr^;
            DstPtr.B := SrcPtr^;
            DstPtr.A := 255;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifA8Gray8:
          for X := 0 to Width - 1 do
          begin
            DstPtr.R := SrcPtr^;
            DstPtr.G := SrcPtr^;
            DstPtr.B := SrcPtr^;
            DstPtr.A := PWordRec(SrcPtr).High;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifGray16:
          for X := 0 to Width - 1 do
          begin
            DstPtr.R := PWord(SrcPtr)^ shr 8;
            DstPtr.G := DstPtr.R;
            DstPtr.B := DstPtr.R;
            DstPtr.A := 255;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifR8G8B8:
          for X := 0 to Width - 1 do
          begin
            DstPtr.Color24Rec := PColor24Rec(SrcPtr)^;
            DstPtr.A := 255;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifA8R8G8B8:
          begin
            Move(SrcPtr^, DstPtr^, MoveBytes);
            Inc(DstPtr, Width);
            Inc(SrcPtr, MoveBytes);
          end;
        ifR16G16B16:
          for X := 0 to Width - 1 do
          begin
            DstPtr.R := PColor48Rec(SrcPtr).R shr 8;
            DstPtr.G := PColor48Rec(SrcPtr).G shr 8;
            DstPtr.B := PColor48Rec(SrcPtr).B shr 8;
            DstPtr.A := 255;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
        ifA16R16G16B16:
          for X := 0 to Width - 1 do
          begin
            DstPtr.R := PColor64Rec(SrcPtr).R shr 8;
            DstPtr.G := PColor64Rec(SrcPtr).G shr 8;
            DstPtr.B := PColor64Rec(SrcPtr).B shr 8;
            DstPtr.A := PColor64Rec(SrcPtr).A shr 8;
            Inc(DstPtr);
            Inc(SrcPtr, Bpp);
          end;
      end;

      Inc(SrcPtr, SrcWidthBytes - MoveBytes);
      Inc(DstPtr, DstWidth - Width);
    end;
  end
  else
  begin
    InitImage(TempImage);
    CloneImage(Image, TempImage);
    ConvertImage(TempImage, ifA8R8G8B8);
    try
      CopyRectToBitmap32(TempImage, Bitmap32, SrcX, SrcY, Width, Height, DstX, DstY);
    finally
      FreeImage(TempImage);
    end;
  end;
end;

procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32;
  SrcX, SrcY, Width, Height, DstX, DstY: Integer);
begin
  CopyRectToBitmap32(Image.ImageDataPointer^, Bitmap32,
    SrcX, SrcY, Width, Height, DstX, DstY);
end;

procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData);
begin
  Assert(not Bitmap32.Empty);
  FreeImage(Image);

  Image.Width := Bitmap32.Width;
  Image.Height := Bitmap32.Height;
  Image.Format := ifA8R8G8B8;
  Image.Size := Image.Width * Image.Height * 4;

  Image.Bits := Bitmap32.Bits;
end;

{
  File Notes:

  -- 0.26.5 Changes/Bug Fixes ---------------------------------
    - Created with initial stuff.
}

end.