src/lib/vampimg/ImagingClasses.pas

   1 {
   2   $Id: ImagingClasses.pas 173 2009-09-04 17:05:52Z galfar $
   3   Vampyre Imaging Library
   4   by Marek Mauder
   5   http://imaginglib.sourceforge.net
   6
   7   The contents of this file are used with permission, subject to the Mozilla
   8   Public License Version 1.1 (the "License"); you may not use this file except
   9   in compliance with the License. You may obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   Software distributed under the License is distributed on an "AS IS" basis,
  13   WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  14   the specific language governing rights and limitations under the License.
  15
  16   Alternatively, the contents of this file may be used under the terms of the
  17   GNU Lesser General Public License (the  "LGPL License"), in which case the
  18   provisions of the LGPL License are applicable instead of those above.
  19   If you wish to allow use of your version of this file only under the terms
  20   of the LGPL License and not to allow others to use your version of this file
  21   under the MPL, indicate your decision by deleting  the provisions above and
  22   replace  them with the notice and other provisions required by the LGPL
  23   License.  If you do not delete the provisions above, a recipient may use
  24   your version of this file under either the MPL or the LGPL License.
  25
  26   For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  27 }
  28
  29 { This unit contains class based wrapper to Imaging library.}
  30 unit ImagingClasses;
  31
  32 {$I ImagingOptions.inc}
  33
  34 interface
  35
  36 uses
  37   Types, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility;
  38
  39 type
  40   { Base abstract high level class wrapper to low level Imaging structures and
  41     functions.}
  42   TBaseImage = class(TPersistent)
  43   protected
  44     FPData: PImageData;
  45     FOnDataSizeChanged: TNotifyEvent;
  46     FOnPixelsChanged: TNotifyEvent;
  47     function GetFormat: TImageFormat; {$IFDEF USE_INLINE}inline;{$ENDIF}
  48     function GetHeight: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  49     function GetSize: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  50     function GetWidth: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  51     function GetBits: Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
  52     function GetPalette: PPalette32; {$IFDEF USE_INLINE}inline;{$ENDIF}
  53     function GetPaletteEntries: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  54     function GetScanLine(Index: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
  55     function GetPixelPointer(X, Y: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
  56     function GetFormatInfo: TImageFormatInfo; {$IFDEF USE_INLINE}inline;{$ENDIF}
  57     function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
  58     function GetBoundsRect: TRect;
  59     procedure SetFormat(const Value: TImageFormat); {$IFDEF USE_INLINE}inline;{$ENDIF}
  60     procedure SetHeight(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
  61     procedure SetWidth(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
  62     procedure SetPointer; virtual; abstract;
  63     procedure DoDataSizeChanged; virtual;
  64     procedure DoPixelsChanged; virtual;
  65   published
  66   public
  67     constructor Create; virtual;
  68     constructor CreateFromImage(AImage: TBaseImage);
  69     destructor Destroy; override;
  70     { Returns info about current image.}
  71     function ToString: string; {$IF Defined(DCC) and (CompilerVersion >= 20.0)}override;{$IFEND}
  72
  73     { Creates a new image data with the given size and format. Old image
  74       data is lost. Works only for the current image of TMultiImage.}
  75     procedure RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat);
  76     { Resizes current image with optional resampling.}
  77     procedure Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
  78     { Flips current image. Reverses the image along its horizontal axis the top
  79       becomes the bottom and vice versa.}
  80     procedure Flip;
  81     { Mirrors current image. Reverses the image along its vertical axis the left
  82       side becomes the right and vice versa.}
  83     procedure Mirror;
  84     { Rotates image by Angle degrees counterclockwise.}
  85     procedure Rotate(Angle: Single);
  86     { Copies rectangular part of SrcImage to DstImage. No blending is performed -
  87       alpha is simply copied to destination image. Operates also with
  88       negative X and Y coordinates.
  89       Note that copying is fastest for images in the same data format
  90       (and slowest for images in special formats).}
  91     procedure CopyTo(SrcX, SrcY, Width, Height: LongInt; DstImage: TBaseImage; DstX, DstY: LongInt);
  92     { Stretches the contents of the source rectangle to the destination rectangle
  93       with optional resampling. No blending is performed - alpha is
  94       simply copied/resampled to destination image. Note that stretching is
  95       fastest for images in the same data format (and slowest for
  96       images in special formats).}
  97     procedure StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt; DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter);
  98     { Replaces pixels with OldPixel in the given rectangle by NewPixel.
  99       OldPixel and NewPixel should point to the pixels in the same format
 100       as the given image is in.}
 101     procedure ReplaceColor(X, Y, Width, Height: LongInt; OldColor, NewColor: Pointer);
 102     { Swaps SrcChannel and DstChannel color or alpha channels of image.
 103       Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to
 104       identify channels.}
 105     procedure SwapChannels(SrcChannel, DstChannel: LongInt);
 106
 107     { Loads current image data from file.}
 108     procedure LoadFromFile(const FileName: string); virtual;
 109     { Loads current image data from stream.}
 110     procedure LoadFromStream(Stream: TStream); virtual;
 111
 112     { Saves current image data to file.}
 113     procedure SaveToFile(const FileName: string);
 114     { Saves current image data to stream. Ext identifies desired image file
 115       format (jpg, png, dds, ...)}
 116     procedure SaveToStream(const Ext: string; Stream: TStream);
 117
 118     { Width of current image in pixels.}
 119     property Width: LongInt read GetWidth write SetWidth;
 120     { Height of current image in pixels.}
 121     property Height: LongInt read GetHeight write SetHeight;
 122     { Image data format of current image.}
 123     property Format: TImageFormat read GetFormat write SetFormat;
 124     { Size in bytes of current image's data.}
 125     property Size: LongInt read GetSize;
 126     { Pointer to memory containing image bits.}
 127     property Bits: Pointer read GetBits;
 128     { Pointer to palette for indexed format images. It is nil for others.
 129       Max palette entry is at index [PaletteEntries - 1].}
 130     property Palette: PPalette32 read GetPalette;
 131     { Number of entries in image's palette}
 132     property PaletteEntries: LongInt read GetPaletteEntries;
 133     { Provides indexed access to each line of pixels. Does not work with special
 134       format images (like DXT).}
 135     property ScanLine[Index: LongInt]: Pointer read GetScanLine;
 136     { Returns pointer to image pixel at [X, Y] coordinates.}
 137     property PixelPointers[X, Y: LongInt]: Pointer read GetPixelPointer;
 138     { Extended image format information.}
 139     property FormatInfo: TImageFormatInfo read GetFormatInfo;
 140     { This gives complete access to underlying TImageData record.
 141       It can be used in functions that take TImageData as parameter
 142       (for example: ReduceColors(SingleImageInstance.ImageData^, 64)).}
 143     property ImageDataPointer: PImageData read FPData;
 144     { Indicates whether the current image is valid (proper format,
 145       allowed dimensions, right size, ...).}
 146     property Valid: Boolean read GetValid;
 147     {{ Specifies the bounding rectangle of the image.}
 148     property BoundsRect: TRect read GetBoundsRect;
 149     { This event occurs when the image data size has just changed. That means
 150       image width, height, or format has been changed.}
 151     property OnDataSizeChanged: TNotifyEvent read FOnDataSizeChanged write FOnDataSizeChanged;
 152     { This event occurs when some pixels of the image have just changed.}
 153     property OnPixelsChanged: TNotifyEvent read FOnPixelsChanged write FOnPixelsChanged;
 154   end;
 155
 156   { Extension of TBaseImage which uses single TImageData record to
 157     store image. All methods inherited from TBaseImage work with this record.}
 158   TSingleImage = class(TBaseImage)
 159   protected
 160     FImageData: TImageData;
 161     procedure SetPointer; override;
 162   public
 163     constructor Create; override;
 164     constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault);
 165     constructor CreateFromData(const AData: TImageData);
 166     constructor CreateFromFile(const FileName: string);
 167     constructor CreateFromStream(Stream: TStream);
 168     destructor Destroy; override;
 169     { Assigns single image from another single image or multi image.}
 170     procedure Assign(Source: TPersistent); override;
 171   end;
 172
 173   { Extension of TBaseImage which uses array of TImageData records to
 174     store multiple images. Images are independent on each other and they don't
 175     share any common characteristic. Each can have different size, format, and
 176     palette. All methods inherited from TBaseImage work only with
 177     active image (it could represent mipmap level, animation frame, or whatever).
 178     Methods whose names contain word 'Multi' work with all images in array
 179     (as well as other methods with obvious names).}
 180   TMultiImage = class(TBaseImage)
 181   protected
 182     FDataArray: TDynImageDataArray;
 183     FActiveImage: LongInt;
 184     procedure SetActiveImage(Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
 185     function GetImageCount: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
 186     procedure SetImageCount(Value: LongInt);
 187     function GetAllImagesValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
 188     function GetImage(Index: LongInt): TImageData; {$IFDEF USE_INLINE}inline;{$ENDIF}
 189     procedure SetImage(Index: LongInt; Value: TImageData); {$IFDEF USE_INLINE}inline;{$ENDIF}
 190     procedure SetPointer; override;
 191     function PrepareInsert(Index, Count: LongInt): Boolean;
 192     procedure DoInsertImages(Index: LongInt; const Images: TDynImageDataArray);
 193     procedure DoInsertNew(Index: LongInt; AWidth, AHeight: LongInt; AFormat: TImageFormat);
 194   public
 195     constructor Create; override;
 196     constructor CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat; Images: LongInt);
 197     constructor CreateFromArray(ADataArray: TDynImageDataArray);
 198     constructor CreateFromFile(const FileName: string);
 199     constructor CreateFromStream(Stream: TStream);
 200     destructor Destroy; override;
 201     { Assigns multi image from another multi image or single image.}
 202     procedure Assign(Source: TPersistent); override;
 203
 204     { Adds new image at the end of the image array. }
 205     procedure AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
 206     { Adds existing image at the end of the image array. }
 207     procedure AddImage(const Image: TImageData); overload;
 208     { Adds existing image (Active image of a TmultiImage)
 209       at the end of the image array. }
 210     procedure AddImage(Image: TBaseImage); overload;
 211     { Adds existing image array ((all images of a multi image))
 212       at the end of the image array. }
 213     procedure AddImages(const Images: TDynImageDataArray); overload;
 214     { Adds existing MultiImage images at the end of the image array. }
 215     procedure AddImages(Images: TMultiImage); overload;
 216
 217     { Inserts new image image at the given position in the image array. }
 218     procedure InsertImage(Index, AWidth, AHeight: LongInt; AFormat: TImageFormat = ifDefault); overload;
 219     { Inserts existing image at the given position in the image array. }
 220     procedure InsertImage(Index: LongInt; const Image: TImageData); overload;
 221     { Inserts existing image (Active image of a TmultiImage)
 222       at the given position in the image array. }
 223     procedure InsertImage(Index: LongInt; Image: TBaseImage); overload;
 224     { Inserts existing image at the given position in the image array. }
 225     procedure InsertImages(Index: LongInt; const Images: TDynImageDataArray); overload;
 226     { Inserts existing images (all images of a TmultiImage) at
 227       the given position in the image array. }
 228     procedure InsertImages(Index: LongInt; Images: TMultiImage); overload;
 229
 230     { Exchanges two images at the given positions in the image array. }
 231     procedure ExchangeImages(Index1, Index2: LongInt);
 232     { Deletes image at the given position in the image array.}
 233     procedure DeleteImage(Index: LongInt);
 234     { Rearranges images so that the first image will become last and vice versa.}
 235     procedure ReverseImages;
 236
 237     { Converts all images to another image data format.}
 238     procedure ConvertImages(Format: TImageFormat);
 239     { Resizes all images.}
 240     procedure ResizeImages(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
 241
 242     { Overloaded loading method that will add new image to multiimage if
 243       image array is empty bero loading. }
 244     procedure LoadFromFile(const FileName: string); override;
 245     { Overloaded loading method that will add new image to multiimage if
 246       image array is empty bero loading. }
 247     procedure LoadFromStream(Stream: TStream); override;
 248
 249     { Loads whole multi image from file.}
 250     procedure LoadMultiFromFile(const FileName: string);
 251     { Loads whole multi image from stream.}
 252     procedure LoadMultiFromStream(Stream: TStream);
 253     { Saves whole multi image to file.}
 254     procedure SaveMultiToFile(const FileName: string);
 255     { Saves whole multi image to stream. Ext identifies desired
 256       image file format (jpg, png, dds, ...).}
 257     procedure SaveMultiToStream(const Ext: string; Stream: TStream);
 258
 259     { Indicates active image of this multi image. All methods inherited
 260       from TBaseImage operate on this image only.}
 261     property ActiveImage: LongInt read FActiveImage write SetActiveImage;
 262     { Number of images of this multi image.}
 263     property ImageCount: LongInt read GetImageCount write SetImageCount;
 264     { This value is True if all images of this TMultiImage are valid.}
 265     property AllImagesValid: Boolean read GetAllImagesValid;
 266     { This gives complete access to underlying TDynImageDataArray.
 267       It can be used in functions that take TDynImageDataArray
 268       as parameter.}
 269     property DataArray: TDynImageDataArray read FDataArray;
 270     { Array property for accessing individual images of TMultiImage. When you
 271       set image at given index the old image is freed and the source is cloned.}
 272     property Images[Index: LongInt]: TImageData read GetImage write SetImage; default;
 273   end;
 274
 275 implementation
 276
 277 const
 278   DefaultWidth  = 16;
 279   DefaultHeight = 16;
 280   DefaultImages = 1;
 281
 282 function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray;
 283 begin
 284   SetLength(Result, 1);
 285   Result[0] := ImageData;
 286 end;
 287
 288 { TBaseImage class implementation }
 289
 290 constructor TBaseImage.Create;
 291 begin
 292   SetPointer;
 293 end;
 294
 295 constructor TBaseImage.CreateFromImage(AImage: TBaseImage);
 296 begin
 297   Create;
 298   Assign(AImage);
 299 end;
 300
 301 destructor TBaseImage.Destroy;
 302 begin
 303   inherited Destroy;
 304 end;
 305
 306 function TBaseImage.GetWidth: LongInt;
 307 begin
 308   if Valid then
 309     Result := FPData.Width
 310   else
 311     Result := 0;
 312 end;
 313
 314 function TBaseImage.GetHeight: LongInt;
 315 begin
 316   if Valid then
 317     Result := FPData.Height
 318   else
 319     Result := 0;
 320 end;
 321
 322 function TBaseImage.GetFormat: TImageFormat;
 323 begin
 324   if Valid then
 325     Result := FPData.Format
 326   else
 327     Result := ifUnknown;
 328 end;
 329
 330 function TBaseImage.GetScanLine(Index: LongInt): Pointer;
 331 var
 332   Info: TImageFormatInfo;
 333 begin
 334   if Valid then
 335   begin
 336     Info := GetFormatInfo;
 337     if not Info.IsSpecial then
 338       Result := ImagingFormats.GetScanLine(FPData.Bits, Info, FPData.Width, Index)
 339     else
 340       Result := FPData.Bits;
 341   end
 342   else
 343     Result := nil;
 344 end;
 345
 346 function TBaseImage.GetPixelPointer(X, Y: LongInt): Pointer;
 347 begin
 348   if Valid then
 349     Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * GetFormatInfo.BytesPerPixel]
 350   else
 351     Result := nil;
 352 end;
 353
 354 function TBaseImage.GetSize: LongInt;
 355 begin
 356   if Valid then
 357     Result := FPData.Size
 358   else
 359     Result := 0;
 360 end;
 361
 362 function TBaseImage.GetBits: Pointer;
 363 begin
 364   if Valid then
 365     Result := FPData.Bits
 366   else
 367     Result := nil;
 368 end;
 369
 370 function TBaseImage.GetPalette: PPalette32;
 371 begin
 372   if Valid then
 373     Result := FPData.Palette
 374   else
 375     Result := nil;
 376 end;
 377
 378 function TBaseImage.GetPaletteEntries: LongInt;
 379 begin
 380   Result := GetFormatInfo.PaletteEntries;
 381 end;
 382
 383 function TBaseImage.GetFormatInfo: TImageFormatInfo;
 384 begin
 385   if Valid then
 386     Imaging.GetImageFormatInfo(FPData.Format, Result)
 387   else
 388     FillChar(Result, SizeOf(Result), 0);
 389 end;
 390
 391 function TBaseImage.GetValid: Boolean;
 392 begin
 393   Result := Assigned(FPData) and Imaging.TestImage(FPData^);
 394 end;
 395
 396 function TBaseImage.GetBoundsRect: TRect;
 397 begin
 398   Result := Rect(0, 0, GetWidth, GetHeight);
 399 end;
 400
 401 procedure TBaseImage.SetWidth(const Value: LongInt);
 402 begin
 403   Resize(Value, GetHeight, rfNearest);
 404 end;
 405
 406 procedure TBaseImage.SetHeight(const Value: LongInt);
 407 begin
 408   Resize(GetWidth, Value, rfNearest);
 409 end;
 410
 411 procedure TBaseImage.SetFormat(const Value: TImageFormat);
 412 begin
 413   if Valid and Imaging.ConvertImage(FPData^, Value) then
 414     DoDataSizeChanged;
 415 end;
 416
 417 procedure TBaseImage.DoDataSizeChanged;
 418 begin
 419   if Assigned(FOnDataSizeChanged) then
 420     FOnDataSizeChanged(Self);
 421   DoPixelsChanged;
 422 end;
 423
 424 procedure TBaseImage.DoPixelsChanged;
 425 begin
 426   if Assigned(FOnPixelsChanged) then
 427     FOnPixelsChanged(Self);
 428 end;
 429
 430 procedure TBaseImage.RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat);
 431 begin
 432   if Assigned(FPData) and Imaging.NewImage(AWidth, AHeight, AFormat, FPData^) then
 433     DoDataSizeChanged;
 434 end;
 435
 436 procedure TBaseImage.Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
 437 begin
 438   if Valid and Imaging.ResizeImage(FPData^, NewWidth, NewHeight, Filter) then
 439     DoDataSizeChanged;
 440 end;
 441
 442 procedure TBaseImage.Flip;
 443 begin
 444   if Valid and Imaging.FlipImage(FPData^) then
 445     DoPixelsChanged;
 446 end;
 447
 448 procedure TBaseImage.Mirror;
 449 begin
 450   if Valid and Imaging.MirrorImage(FPData^) then
 451     DoPixelsChanged;
 452 end;
 453
 454 procedure TBaseImage.Rotate(Angle: Single);
 455 begin
 456   if Valid and Imaging.RotateImage(FPData^, Angle) then
 457     DoPixelsChanged;
 458 end;
 459
 460 procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: LongInt;
 461   DstImage: TBaseImage; DstX, DstY: LongInt);
 462 begin
 463   if Valid and Assigned(DstImage) and DstImage.Valid then
 464   begin
 465     Imaging.CopyRect(FPData^, SrcX, SrcY, Width, Height, DstImage.FPData^, DstX, DstY);
 466     DstImage.DoPixelsChanged;
 467   end;
 468 end;
 469
 470 procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt;
 471   DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter);
 472 begin
 473   if Valid and Assigned(DstImage) and DstImage.Valid then
 474   begin
 475     Imaging.StretchRect(FPData^, SrcX, SrcY, SrcWidth, SrcHeight,
 476       DstImage.FPData^, DstX, DstY, DstWidth, DstHeight, Filter);
 477     DstImage.DoPixelsChanged;
 478   end;
 479 end;
 480
 481 procedure TBaseImage.ReplaceColor(X, Y, Width, Height: Integer; OldColor,
 482   NewColor: Pointer);
 483 begin
 484   if Valid then
 485   begin
 486     Imaging.ReplaceColor(FPData^, X, Y, Width, Height, OldColor, NewColor);
 487     DoPixelsChanged;
 488   end;
 489 end;
 490
 491 procedure TBaseImage.SwapChannels(SrcChannel, DstChannel: Integer);
 492 begin
 493   if Valid then
 494   begin
 495     Imaging.SwapChannels(FPData^, SrcChannel, DstChannel);
 496     DoPixelsChanged;
 497   end;
 498 end;
 499
 500 function TBaseImage.ToString: string;
 501 begin
 502   Result := Iff(Valid, Imaging.ImageToStr(FPData^), 'empty image');
 503 end;
 504
 505 procedure TBaseImage.LoadFromFile(const FileName: string);
 506 begin
 507   if Assigned(FPData) and Imaging.LoadImageFromFile(FileName, FPData^) then
 508     DoDataSizeChanged;
 509 end;
 510
 511 procedure TBaseImage.LoadFromStream(Stream: TStream);
 512 begin
 513   if Assigned(FPData) and Imaging.LoadImageFromStream(Stream, FPData^) then
 514     DoDataSizeChanged;
 515 end;
 516
 517 procedure TBaseImage.SaveToFile(const FileName: string);
 518 begin
 519   if Valid then
 520     Imaging.SaveImageToFile(FileName, FPData^);
 521 end;
 522
 523 procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream);
 524 begin
 525   if Valid then
 526     Imaging.SaveImageToStream(Ext, Stream, FPData^);
 527 end;
 528
 529
 530 { TSingleImage class implementation }
 531
 532 constructor TSingleImage.Create;
 533 begin
 534   inherited Create;
 535   RecreateImageData(DefaultWidth, DefaultHeight, ifDefault);
 536 end;
 537
 538 constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat);
 539 begin
 540   inherited Create;
 541   RecreateImageData(AWidth, AHeight, AFormat);
 542 end;
 543
 544 constructor TSingleImage.CreateFromData(const AData: TImageData);
 545 begin
 546   inherited Create;
 547   if Imaging.TestImage(AData) then
 548     begin
 549       Imaging.CloneImage(AData, FImageData);
 550       DoDataSizeChanged;
 551     end
 552   else
 553     Create;
 554 end;
 555
 556 constructor TSingleImage.CreateFromFile(const FileName: string);
 557 begin
 558   inherited Create;
 559   LoadFromFile(FileName);
 560 end;
 561
 562 constructor TSingleImage.CreateFromStream(Stream: TStream);
 563 begin
 564   inherited Create;
 565   LoadFromStream(Stream);
 566 end;
 567
 568 destructor TSingleImage.Destroy;
 569 begin
 570   Imaging.FreeImage(FImageData);
 571   inherited Destroy;
 572 end;
 573
 574 procedure TSingleImage.SetPointer;
 575 begin
 576   FPData := @FImageData;
 577 end;
 578
 579 procedure TSingleImage.Assign(Source: TPersistent);
 580 begin
 581   if Source = nil then
 582   begin
 583     Create;
 584   end
 585   else if Source is TSingleImage then
 586   begin
 587     CreateFromData(TSingleImage(Source).FImageData);
 588   end
 589   else if Source is TMultiImage then
 590   begin
 591     if TMultiImage(Source).Valid then
 592       CreateFromData(TMultiImage(Source).FPData^)
 593     else
 594       Assign(nil);
 595   end
 596   else
 597     inherited Assign(Source);
 598 end;
 599
 600
 601 { TMultiImage class implementation }
 602
 603 constructor TMultiImage.Create;
 604 begin
 605   SetImageCount(DefaultImages);
 606   SetActiveImage(0);
 607 end;
 608
 609 constructor TMultiImage.CreateFromParams(AWidth, AHeight: LongInt;
 610   AFormat: TImageFormat; Images: LongInt);
 611 var
 612   I: LongInt;
 613 begin
 614   Imaging.FreeImagesInArray(FDataArray);
 615   SetLength(FDataArray, Images);
 616   for I := 0 to GetImageCount - 1 do
 617     Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]);
 618   SetActiveImage(0);
 619 end;
 620
 621 constructor TMultiImage.CreateFromArray(ADataArray: TDynImageDataArray);
 622 var
 623   I: LongInt;
 624 begin
 625   Imaging.FreeImagesInArray(FDataArray);
 626   SetLength(FDataArray, Length(ADataArray));
 627   for I := 0 to GetImageCount - 1 do
 628   begin
 629     // Clone only valid images
 630     if Imaging.TestImage(ADataArray[I]) then
 631       Imaging.CloneImage(ADataArray[I], FDataArray[I])
 632     else
 633       Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
 634   end;
 635   SetActiveImage(0);
 636 end;
 637
 638 constructor TMultiImage.CreateFromFile(const FileName: string);
 639 begin
 640   LoadMultiFromFile(FileName);
 641 end;
 642
 643 constructor TMultiImage.CreateFromStream(Stream: TStream);
 644 begin
 645   LoadMultiFromStream(Stream);
 646 end;
 647
 648 destructor TMultiImage.Destroy;
 649 begin
 650   Imaging.FreeImagesInArray(FDataArray);
 651   inherited Destroy;
 652 end;
 653
 654 procedure TMultiImage.SetActiveImage(Value: LongInt);
 655 begin
 656   FActiveImage := Value;
 657   SetPointer;
 658 end;
 659
 660 function TMultiImage.GetImageCount: LongInt;
 661 begin
 662   Result := Length(FDataArray);
 663 end;
 664
 665 procedure TMultiImage.SetImageCount(Value: LongInt);
 666 var
 667   I, OldCount: LongInt;
 668 begin
 669   if Value > GetImageCount then
 670   begin
 671     // Create new empty images if array will be enlarged
 672     OldCount := GetImageCount;
 673     SetLength(FDataArray, Value);
 674     for I := OldCount to Value - 1 do
 675       Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
 676   end
 677   else
 678   begin
 679     // Free images that exceed desired count and shrink array
 680     for I := Value to GetImageCount - 1 do
 681       Imaging.FreeImage(FDataArray[I]);
 682     SetLength(FDataArray, Value);
 683   end;
 684   SetPointer;
 685 end;
 686
 687 function TMultiImage.GetAllImagesValid: Boolean;
 688 begin
 689   Result := (GetImageCount > 0) and TestImagesInArray(FDataArray);
 690 end;
 691
 692 function TMultiImage.GetImage(Index: LongInt): TImageData;
 693 begin
 694   if (Index >= 0) and (Index < GetImageCount) then
 695     Result := FDataArray[Index];
 696 end;
 697
 698 procedure TMultiImage.SetImage(Index: LongInt; Value: TImageData);
 699 begin
 700   if (Index >= 0) and (Index < GetImageCount) then
 701     Imaging.CloneImage(Value, FDataArray[Index]);
 702 end;
 703
 704 procedure TMultiImage.SetPointer;
 705 begin
 706   if GetImageCount > 0 then
 707   begin
 708     FActiveImage := ClampInt(FActiveImage, 0, GetImageCount - 1);
 709     FPData := @FDataArray[FActiveImage];
 710   end
 711   else
 712   begin
 713     FActiveImage := -1;
 714     FPData := nil
 715   end;
 716 end;
 717
 718 function TMultiImage.PrepareInsert(Index, Count: LongInt): Boolean;
 719 var
 720   I: LongInt;
 721 begin
 722   // Inserting to empty image will add image at index 0
 723   if GetImageCount = 0 then
 724     Index := 0;
 725
 726   if (Index >= 0) and (Index <= GetImageCount) and (Count > 0) then
 727   begin
 728     SetLength(FDataArray, GetImageCount + Count);
 729     if Index < GetImageCount - 1 then
 730     begin
 731       // Move imges to new position
 732       System.Move(FDataArray[Index], FDataArray[Index + Count],
 733         (GetImageCount - Count - Index) * SizeOf(TImageData));
 734       // Null old images, not free them!
 735       for I := Index to Index + Count - 1 do
 736         InitImage(FDataArray[I]);
 737     end;
 738     Result := True;
 739   end
 740   else
 741     Result := False;
 742 end;
 743
 744 procedure TMultiImage.DoInsertImages(Index: LongInt; const Images: TDynImageDataArray);
 745 var
 746   I, Len: LongInt;
 747 begin
 748   Len := Length(Images);
 749   if PrepareInsert(Index, Len) then
 750   begin
 751     for I := 0 to Len - 1 do
 752       Imaging.CloneImage(Images[I], FDataArray[Index + I]);
 753   end;
 754 end;
 755
 756 procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: LongInt;
 757   AFormat: TImageFormat);
 758 begin
 759   if PrepareInsert(Index, 1) then
 760     Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[Index]);
 761 end;
 762
 763 procedure TMultiImage.Assign(Source: TPersistent);
 764 var
 765   Arr: TDynImageDataArray;
 766 begin
 767   if Source = nil then
 768   begin
 769     Create;
 770   end
 771   else if Source is TMultiImage then
 772   begin
 773     CreateFromArray(TMultiImage(Source).FDataArray);
 774     SetActiveImage(TMultiImage(Source).ActiveImage);
 775   end
 776   else if Source is TSingleImage then
 777   begin
 778     SetLength(Arr, 1);
 779     Arr[0] := TSingleImage(Source).FImageData;
 780     CreateFromArray(Arr);
 781     Arr := nil;
 782   end
 783   else
 784     inherited Assign(Source);
 785 end;
 786
 787 procedure TMultiImage.AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
 788 begin
 789   DoInsertNew(GetImageCount, AWidth, AHeight, AFormat);
 790 end;
 791
 792 procedure TMultiImage.AddImage(const Image: TImageData);
 793 begin
 794   DoInsertImages(GetImageCount, GetArrayFromImageData(Image));
 795 end;
 796
 797 procedure TMultiImage.AddImage(Image: TBaseImage);
 798 begin
 799   if Assigned(Image) and Image.Valid then
 800     DoInsertImages(GetImageCount, GetArrayFromImageData(Image.FPData^));
 801 end;
 802
 803 procedure TMultiImage.AddImages(const Images: TDynImageDataArray);
 804 begin
 805   DoInsertImages(GetImageCount, Images);
 806 end;
 807
 808 procedure TMultiImage.AddImages(Images: TMultiImage);
 809 begin
 810   DoInsertImages(GetImageCount, Images.FDataArray);
 811 end;
 812
 813 procedure TMultiImage.InsertImage(Index, AWidth, AHeight: LongInt;
 814   AFormat: TImageFormat);
 815 begin
 816   DoInsertNew(Index, AWidth, AHeight, AFormat);
 817 end;
 818
 819 procedure TMultiImage.InsertImage(Index: LongInt; const Image: TImageData);
 820 begin
 821   DoInsertImages(Index, GetArrayFromImageData(Image));
 822 end;
 823
 824 procedure TMultiImage.InsertImage(Index: LongInt; Image: TBaseImage);
 825 begin
 826   if Assigned(Image) and Image.Valid then
 827     DoInsertImages(Index, GetArrayFromImageData(Image.FPData^));
 828 end;
 829
 830 procedure TMultiImage.InsertImages(Index: LongInt;
 831   const Images: TDynImageDataArray);
 832 begin
 833   DoInsertImages(Index, FDataArray);
 834 end;
 835
 836 procedure TMultiImage.InsertImages(Index: LongInt; Images: TMultiImage);
 837 begin
 838   DoInsertImages(Index, Images.FDataArray);
 839 end;
 840
 841 procedure TMultiImage.ExchangeImages(Index1, Index2: LongInt);
 842 var
 843   TempData: TImageData;
 844 begin
 845   if (Index1 >= 0) and (Index1 < GetImageCount) and
 846      (Index2 >= 0) and (Index2 < GetImageCount) then
 847   begin
 848     TempData := FDataArray[Index1];
 849     FDataArray[Index1] := FDataArray[Index2];
 850     FDataArray[Index2] := TempData;
 851   end;
 852 end;
 853
 854 procedure TMultiImage.DeleteImage(Index: LongInt);
 855 var
 856   I: LongInt;
 857 begin
 858   if (Index >= 0) and (Index < GetImageCount) then
 859   begin
 860     // Free image at index to be deleted
 861     Imaging.FreeImage(FDataArray[Index]);
 862     if Index < GetImageCount - 1 then
 863     begin
 864       // Move images to new indices if necessary
 865       for I := Index to GetImageCount - 2 do
 866         FDataArray[I] := FDataArray[I + 1];
 867     end;
 868     // Set new array length and update pointer to active image
 869     SetLength(FDataArray, GetImageCount - 1);
 870     SetPointer;
 871   end;
 872 end;
 873
 874 procedure TMultiImage.ConvertImages(Format: TImageFormat);
 875 var
 876   I: LongInt;
 877 begin
 878   for I := 0 to GetImageCount - 1 do
 879     Imaging.ConvertImage(FDataArray[I], Format);
 880 end;
 881
 882 procedure TMultiImage.ResizeImages(NewWidth, NewHeight: LongInt;
 883   Filter: TResizeFilter);
 884 var
 885   I: LongInt;
 886 begin
 887   for I := 0 to GetImageCount do
 888     Imaging.ResizeImage(FDataArray[I], NewWidth, NewHeight, Filter);
 889 end;
 890
 891 procedure TMultiImage.ReverseImages;
 892 var
 893   I: Integer;
 894 begin
 895   for I := 0 to GetImageCount div 2 do
 896     ExchangeImages(I, GetImageCount - 1 - I);
 897 end;
 898
 899 procedure TMultiImage.LoadFromFile(const FileName: string);
 900 begin
 901   if GetImageCount = 0 then
 902     ImageCount := 1;
 903   inherited LoadFromFile(FileName);
 904 end;
 905
 906 procedure TMultiImage.LoadFromStream(Stream: TStream);
 907 begin
 908   if GetImageCount = 0 then
 909     ImageCount := 1;
 910   inherited LoadFromStream(Stream);
 911 end;
 912
 913 procedure TMultiImage.LoadMultiFromFile(const FileName: string);
 914 begin
 915   Imaging.LoadMultiImageFromFile(FileName, FDataArray);
 916   SetActiveImage(0);
 917 end;
 918
 919 procedure TMultiImage.LoadMultiFromStream(Stream: TStream);
 920 begin
 921   Imaging.LoadMultiImageFromStream(Stream, FDataArray);
 922   SetActiveImage(0);
 923 end;
 924
 925 procedure TMultiImage.SaveMultiToFile(const FileName: string);
 926 begin
 927   Imaging.SaveMultiImageToFile(FileName, FDataArray);
 928 end;
 929
 930 procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream);
 931 begin
 932   Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray);
 933 end;
 934
 935 {
 936   File Notes:
 937
 938   -- TODOS ----------------------------------------------------
 939     - nothing now
 940     - add SetPalette, create some pal wrapper first
 941     - put all low level stuff here like ReplaceColor etc, change
 942       CopyTo to Copy, and add overload Copy(SrcRect, DstX, DstY) ...
 943
 944   -- 0.24.3 Changes/Bug Fixes ---------------------------------
 945     - Added TMultiImage.ReverseImages method.
 946
 947   -- 0.23 Changes/Bug Fixes -----------------------------------
 948     - Added SwapChannels method to TBaseImage.
 949     - Added ReplaceColor method to TBaseImage.
 950     - Added ToString method to TBaseImage.
 951
 952   -- 0.21 Changes/Bug Fixes -----------------------------------
 953     - Inserting images to empty MultiImage will act as Add method.
 954     - MultiImages with empty arrays will now create one image when
 955       LoadFromFile or LoadFromStream is called.
 956     - Fixed bug that caused AVs when getting props like Width, Height, asn Size
 957       and when inlining was off. There was call to Iff but with inlining disabled
 958       params like FPData.Size were evaluated and when FPData was nil => AV.
 959     - Added many FPData validity checks to many methods. There were AVs
 960       when calling most methods on empty TMultiImage.
 961     - Added AllImagesValid property to TMultiImage.
 962     - Fixed memory leak in TMultiImage.CreateFromParams.
 963
 964   -- 0.19 Changes/Bug Fixes -----------------------------------
 965     - added ResizeImages method to TMultiImage
 966     - removed Ext parameter from various LoadFromStream methods, no
 967       longer needed
 968     - fixed various issues concerning ActiveImage of TMultiImage
 969       (it pointed to invalid location after some operations)
 970     - most of property set/get methods are now inline
 971     - added PixelPointers property to TBaseImage
 972     - added Images default array property to TMultiImage
 973     - renamed methods in TMultiImage to contain 'Image' instead of 'Level'
 974     - added canvas support
 975     - added OnDataSizeChanged and OnPixelsChanged event to TBaseImage
 976     - renamed TSingleImage.NewImage to RecreateImageData, made public, and
 977       moved to TBaseImage
 978
 979   -- 0.17 Changes/Bug Fixes -----------------------------------
 980     - added props PaletteEntries and ScanLine to TBaseImage
 981     - aded new constructor to TBaseImage that take TBaseImage source
 982     - TMultiImage levels adding and inserting rewritten internally
 983     - added some new functions to TMultiImage: AddLevels, InsertLevels
 984     - added some new functions to TBaseImage: Flip, Mirror, Rotate,
 985       CopyRect, StretchRect
 986     - TBasicImage.Resize has now filter parameter
 987     - new stuff added to TMultiImage (DataArray prop, ConvertLevels)
 988
 989   -- 0.13 Changes/Bug Fixes -----------------------------------
 990     - added AddLevel, InsertLevel, ExchangeLevels and DeleteLevel
 991       methods to TMultiImage
 992     - added TBaseImage, TSingleImage and TMultiImage with initial
 993       members
 994 }
 995
 996 end.