{
  $Id: ImagingClasses.pas,v 1.8 2005/06/22 13:53:21 galfar Exp $
  Vampyre Imaging Library
  by Marek Mauder (pentar@seznam.cz)
  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
}

{ This unit contains class based wrapper to Imaging library.}
unit ImagingClasses;

{$I ImagingOptions.inc}

interface

uses
  ImagingTypes, Imaging, Classes;

const
  DefaultWidth = 256;
  DefaultHeight = 256;
  DefaultLevels = 1;

type
  { Base abstract high level class wrapper to low level Imaging structures and
    functions.}
  TBaseImage = class(TPersistent)
  protected
    FPData: PImageData;
    function GetFormat: TImageFormat;
    function GetHeight: LongInt;
    function GetSize: LongInt;
    function GetWidth: LongInt;
    function GetBits: Pointer;
    function GetPalette: PPalette32;
    function GetFormatInfo: TImageFormatShortInfo;
    function GetValid: Boolean; 
    procedure SetFormat(Value: TImageFormat);
    procedure SetHeight(Value: LongInt);
    procedure SetWidth(Value: LongInt);
    procedure SetPointer; virtual; abstract;
  public
    constructor Create; virtual;

    { Resizes pixels of current image. Does no filtering.}
    procedure Resize(NewWidth, NewHeight: LongInt);

    { Loads current image data from file.}
    procedure LoadFromFile(const FileName: string);
    { Loads current image data from stream.}
    procedure LoadFromStream(const Ext: string; Stream: TStream);

    { Saves current image data to file.}
    procedure SaveToFile(const FileName: string);
    { Saves current image data to stream.}
    procedure SaveToStream(const Ext: string; Stream: TStream);

    { Width of current image in pixels.}
    property Width: LongInt read GetWidth write SetWidth;
    { Height of current image in pixels.}
    property Height: LongInt read GetHeight write SetHeight;
    { Image data format of current image.}
    property Format: TImageFormat read GetFormat write SetFormat;
    { Size in bytes of current image's data.}
    property Size: LongInt read GetSize;
    { Pointer to memory containing image bits.}
    property Bits: Pointer read GetBits;
    { Pointer to palette for indexed format images. It is nil for others.}
    property Palette: PPalette32 read GetPalette;
    { Extended image format information.}
    property FormatInfo: TImageFormatShortInfo read GetFormatInfo;
    { This gives complete access to underlying TImageData record.
      It can be used in functions that take TImageData as parameter
      (for example: ReduceColors(SingleImageInstance.ImageData^, 64)).}
    property ImageData: PImageData read FPData;
    { Indicates whether the current image is valid (proper format,
      allowed dimensions, right size, ...).}
    property Valid: Boolean read GetValid;
  end;

  { Extension of TBaseImage which uses single TImageData record to
    store image. All methods inherited from TBaseImage work with this record.}
  TSingleImage = class(TBaseImage)
  protected
    FImageData: TImageData;
    procedure NewImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
    procedure SetPointer; override;
  public
    constructor Create; override;
    constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault);
    constructor CreateFromData(const AData: TImageData);
    constructor CreateFromFile(const FileName: string);
    constructor CreateFromStream(const Ext: string; Stream: TStream);
    destructor Destroy; override;
    { Assigns single image from another single image or multi image.}
    procedure Assign(Source: TPersistent); override;
  end;

  { Extension of TBaseImage which uses array of TImageData records to
    store multiple images. All methods inherited from TBaseImage work only with
    active image (called level here). Methods whose names contain word
    'Multi' work with all images in array.}
  TMultiImage = class(TBaseImage)
  protected
    FDataArray: TDynImageDataArray;
    FActiveLevel: LongInt;
    FLevelCount: LongInt;
    function GetLevelCount: LongInt;
    procedure SetActiveLevel(Value: LongInt);
    procedure SetLevelCount(Value: LongInt);
    function PrepareInsert(Index: LongInt): Boolean;
    procedure SetPointer; override;
  public
    constructor Create; override;
    constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat;
      Levels: LongInt);
    constructor CreateFromArray(ADataArray: TDynImageDataArray);
    constructor CreateFromFile(const FileName: string);
    constructor CreateFromStream(const Ext: string; Stream: TStream);
    destructor Destroy; override;
    { Assigns multi image from another multi image or single image.}
    procedure Assign(Source: TPersistent); override;

    { Adds new image level at the end of the image array. }
    procedure AddLevel(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
    { Adds new image level at the end of the image array. }
    procedure AddLevel(const Level: TImageData); overload;
    { Adds new image level at the end of the image array. }
    procedure AddLevel(Level: TSingleImage); overload;
    { Inserts new image level at the given position in the image array. }
    procedure InsertLevel(Index, AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
    { Inserts new image level at the given position in the image array. }
    procedure InsertLevel(Index: LongInt; const Level: TImageData); overload;
    { Inserts new image level at the given position in the image array. }
    procedure InsertLevel(Index: LongInt; Level: TSingleImage); overload;
    { Exchanges two image levels at the given positions in the image array. }
    procedure ExchangeLevels(Index1, Index2: LongInt);
    { Deletes image level at the given position in the image array.}
    procedure DeleteLevel(Index: LongInt);

    { Loads whole multi image from file.}
    procedure LoadMultiFromFile(const FileName: string);
    { Loads whole multi image from stream.}
    procedure LoadMultiFromStream(const Ext: string; Stream: TStream);

    { Saves whole multi image to file.}
    procedure SaveMultiToFile(const FileName: string);
    { Saves whole multi image to stream.}
    procedure SaveMultiToStream(const Ext: string; Stream: TStream);

    { Indicates active level of this multi image. All methods inherited
      from TBaseImage operate on this image level only.}
    property ActiveLevel: LongInt read FActiveLevel write SetActiveLevel;
    { Number of levels of this multi image.}
    property LevelCount: LongInt read GetLevelCount write SetLevelCount;
  end;

implementation
       
{ TBaseImage class implementation }

constructor TBaseImage.Create;
begin
  SetPointer;
end;

function TBaseImage.GetWidth: LongInt;
begin
  Result := FPData.Width;
end;

function TBaseImage.GetHeight: LongInt;
begin
  Result := FPData.Height;
end;

function TBaseImage.GetFormat: TImageFormat;
begin
  Result := FPData.Format;
end;

function TBaseImage.GetSize: LongInt;
begin
  Result := FPData.Size;
end;

function TBaseImage.GetBits: Pointer;
begin
  Result := FPData.Bits;
end;

function TBaseImage.GetPalette: PPalette32;
begin
  Result := FPData.Palette;
end;

function TBaseImage.GetFormatInfo: TImageFormatShortInfo;
begin
  Imaging.GetImageFormatInfo(FPData.Format, Result);
end;

function TBaseImage.GetValid: Boolean;
begin
  Result := Imaging.TestImage(FPData^);
end;

procedure TBaseImage.SetWidth(Value: LongInt);
begin
  if FPData.Width <> Value then
    Resize(Value, FPData.Height);
end;

procedure TBaseImage.SetHeight(Value: LongInt);
begin
  if FPData.Height <> Value then
    Resize(FPData.Width, Value);
end;

procedure TBaseImage.SetFormat(Value: TImageFormat);
begin
  if FPData.Format <> Value then
    Imaging.ConvertImage(FPData^, Value);
end;

procedure TBaseImage.Resize(NewWidth, NewHeight: LongInt);
begin
  Imaging.ResizeImage(FPData^, NewWidth, NewHeight);
end;

procedure TBaseImage.LoadFromFile(const FileName: string);
begin
  Imaging.LoadImageFromFile(FileName, FPData^);
end;

procedure TBaseImage.LoadFromStream(const Ext: string; Stream: TStream);
begin
  Imaging.LoadImageFromStream(Ext, Stream, FPData^);
end;

procedure TBaseImage.SaveToFile(const FileName: string);
begin
  Imaging.SaveImageToFile(FileName, FPData^);
end;

procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream);
begin
  Imaging.SaveImageToStream(Ext, Stream, FPData^);
end;


{ TSingleImage class implementation }

constructor TSingleImage.Create;
begin
  inherited Create;
  NewImage(DefaultWidth, DefaultHeight, ifDefault);
end;

constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat);
begin
  inherited Create;
  NewImage(AWidth, AHeight, AFormat);
end;

constructor TSingleImage.CreateFromData(const AData: TImageData);
begin
  inherited Create;
  if Imaging.TestImage(AData) then
    Imaging.CloneImage(AData, FImageData)
  else
    Create;
end;

constructor TSingleImage.CreateFromFile(const FileName: string);
begin
  inherited Create;
  LoadFromFile(FileName);
end;

constructor TSingleImage.CreateFromStream(const Ext: string; Stream: TStream);
begin
  inherited Create;
  LoadFromStream(Ext, Stream);
end;

destructor TSingleImage.Destroy;
begin
  Imaging.FreeImage(FImageData);
  inherited Destroy;
end;

procedure TSingleImage.NewImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
begin
  Imaging.NewImage(AWidth, AHeight, AFormat, FPData^);
end;

procedure TSingleImage.SetPointer;
begin
  FPData := @FImageData;
end;

procedure TSingleImage.Assign(Source: TPersistent);
begin
  if Source = nil then
    Create
  else
  if Source is TSingleImage then
    CreateFromData(TSingleImage(Source).FImageData)
  else
  if Source is TMultiImage then
  begin
    if TMultiImage(Source).FPData <> nil then
      CreateFromData(TMultiImage(Source).FPData^)
    else
      Assign(nil);
  end
  else
    inherited Assign(Source);
end;


{ TMultiImage class implementation }

constructor TMultiImage.Create;
begin
  SetLevelCount(DefaultLevels);
end;

constructor TMultiImage.CreateFromParams(AWidth, AHeight: LongInt;
  AFormat: TImageFormat; Levels: LongInt);
var
  I: LongInt;
begin
  SetLength(FDataArray, Levels);
  for I := 0 to GetLevelCount - 1 do
    Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]);
  inherited Create;
end;

constructor TMultiImage.CreateFromArray(ADataArray: TDynImageDataArray);
var
  I: LongInt;
begin
  SetLength(FDataArray, Length(ADataArray));
  for I := 0 to GetLevelCount - 1 do
  begin
    if Imaging.TestImage(ADataArray[I]) then
      Imaging.CloneImage(ADataArray[I], FDataArray[I])
    else
      Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
  end;
  inherited Create;
end;

constructor TMultiImage.CreateFromFile(const FileName: string);
begin
  LoadMultiFromFile(FileName);
  inherited Create;
end;

constructor TMultiImage.CreateFromStream(const Ext: string; Stream: TStream);
begin
  LoadMultiFromStream(Ext, Stream);
  inherited Create;
end;

destructor TMultiImage.Destroy;
begin
  Imaging.FreeImagesInArray(FDataArray);
  inherited Destroy;
end;

function TMultiImage.GetLevelCount: LongInt;
begin
  Result := Length(FDataArray);
end;

procedure TMultiImage.SetActiveLevel(Value: LongInt);
begin
  FActiveLevel := Value;
  SetPointer;
end;

procedure TMultiImage.SetLevelCount(Value: LongInt);
var
  I, OldCount: LongInt;
begin
  if Value > GetLevelCount then
  begin
    OldCount := GetLevelCount;
    SetLength(FDataArray, Value);
    for I := OldCount to Value - 1 do
      Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
  end
  else
  begin
    for I := Value to GetLevelCount - 1 do
      Imaging.FreeImage(FDataArray[I]);
    SetLength(FDataArray, Value);
  end;
  SetPointer;
end;

function TMultiImage.PrepareInsert(Index: Integer): Boolean;
begin
  if (Index >= 0) and (Index <= GetLevelCount) then
  begin
    SetLength(FDataArray, GetLevelCount + 1);
    if Index < GetLevelCount - 1 then
      System.Move(FDataArray[Index], FDataArray[Index + 1],
        (GetLevelCount - 1 - Index) * SizeOf(TImageData));
    Result := True;
  end
  else
    Result := False;
end;

procedure TMultiImage.SetPointer;
begin
  if GetLevelCount > 0 then
  begin
    if FActiveLevel >= GetLevelCount then
      FActiveLevel := GetLevelCount - 1;
    FPData := @FDataArray[FActiveLevel];
  end
  else
    FPData := nil
end;

procedure TMultiImage.Assign(Source: TPersistent);
var
  Arr: TDynImageDataArray;
begin
  if Source = nil then
    Create
  else
  if Source is TMultiImage then
    CreateFromArray(TMultiImage(Source).FDataArray)
  else
  if Source is TSingleImage then
  begin
    SetLength(Arr, 1);
    Arr[0] := TSingleImage(Source).FImageData;
    CreateFromArray(Arr);
    Arr := nil;
  end
  else
    inherited Assign(Source);
end;

procedure TMultiImage.AddLevel(AWidth, AHeight: LongInt; AFormat: TImageFormat);
begin
  SetLength(FDataArray, GetLevelCount + 1);
  Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[GetLevelCount - 1]);
end;

procedure TMultiImage.AddLevel(const Level: TImageData);
begin
  SetLength(FDataArray, GetLevelCount + 1);
  Imaging.CloneImage(Level, FDataArray[GetLevelCount - 1]);
end;

procedure TMultiImage.AddLevel(Level: TSingleImage);
begin
  AddLevel(Level.FImageData);
end;

procedure TMultiImage.InsertLevel(Index, AWidth, AHeight: Integer;
  AFormat: TImageFormat);
begin
  if PrepareInsert(Index) then
    Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[Index]);
end;

procedure TMultiImage.InsertLevel(Index: Integer; const Level: TImageData);
begin
  if PrepareInsert(Index) then
    Imaging.CloneImage(Level, FDataArray[Index]);
end;

procedure TMultiImage.InsertLevel(Index: Integer; Level: TSingleImage);
begin
  InsertLevel(Index, Level.FImageData);
end;

procedure TMultiImage.ExchangeLevels(Index1, Index2: Integer);
var
  Data: TImageData;
begin
  if (Index1 >= 0) and (Index1 < GetLevelCount) and
     (Index2 >= 0) and (Index2 < GetLevelCount) then
  begin
    Data := FDataArray[Index1];
    FDataArray[Index1] := FDataArray[Index2];
    FDataArray[Index2] := Data;
  end;
end;

procedure TMultiImage.DeleteLevel(Index: LongInt);
var
  I: LongInt;
begin
  if (Index >= 0) and (Index < GetLevelCount) then
  begin
    if Index < GetLevelCount - 1 then
    begin
      Imaging.FreeImage(FDataArray[Index]);
      for I := Index to GetLevelCount - 2 do
        FDataArray[I] := FDataArray[I + 1];
    end;
    SetLength(FDataArray, GetLevelCount - 1);
  end;
end;

procedure TMultiImage.LoadMultiFromFile(const FileName: string);
begin
  Imaging.LoadMultiImageFromFile(FileName, FDataArray);
end;

procedure TMultiImage.LoadMultiFromStream(const Ext: string; Stream: TStream);
begin
  Imaging.LoadMultiImageFromStream(Ext, Stream, FDataArray);
end;

procedure TMultiImage.SaveMultiToFile(const FileName: string);
begin
  Imaging.SaveMultiImageToFile(FileName, FDataArray);
end;

procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream);
begin
  Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray);
end;

{
  File Notes:
  
  -- TODOS ----------------------------------------------------
    - add GetPixel/SetPixel, ScanLine access, SetPalette,
    - constructors should also take TBaseImage source param
    - catch exceptions in constructors

  -- 0.13 Changes/Bug Fixes -----------------------------------
    - added AddLevel, InsertLevel, ExchangeLevels and DeleteLevel
      methods to TMultiImage
    - added TBaseImage, TSingleImage and TMultiImage with initial
      members
}

end.

