DEADSOFTWARE

added Vampyre Imaging Library; now textures can be in various formats, including...
[d2df-sdl.git] / 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
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
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.
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.
26 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
27 }
29 { This unit contains class based wrapper to Imaging library.}
30 unit ImagingClasses;
32 {$I ImagingOptions.inc}
34 interface
36 uses
37 Types, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility;
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}
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);
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;
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);
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;
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;
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;
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;
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;
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;
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);
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;
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);
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;
275 implementation
277 const
278 DefaultWidth = 16;
279 DefaultHeight = 16;
280 DefaultImages = 1;
282 function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray;
283 begin
284 SetLength(Result, 1);
285 Result[0] := ImageData;
286 end;
288 { TBaseImage class implementation }
290 constructor TBaseImage.Create;
291 begin
292 SetPointer;
293 end;
295 constructor TBaseImage.CreateFromImage(AImage: TBaseImage);
296 begin
297 Create;
298 Assign(AImage);
299 end;
301 destructor TBaseImage.Destroy;
302 begin
303 inherited Destroy;
304 end;
306 function TBaseImage.GetWidth: LongInt;
307 begin
308 if Valid then
309 Result := FPData.Width
310 else
311 Result := 0;
312 end;
314 function TBaseImage.GetHeight: LongInt;
315 begin
316 if Valid then
317 Result := FPData.Height
318 else
319 Result := 0;
320 end;
322 function TBaseImage.GetFormat: TImageFormat;
323 begin
324 if Valid then
325 Result := FPData.Format
326 else
327 Result := ifUnknown;
328 end;
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;
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;
354 function TBaseImage.GetSize: LongInt;
355 begin
356 if Valid then
357 Result := FPData.Size
358 else
359 Result := 0;
360 end;
362 function TBaseImage.GetBits: Pointer;
363 begin
364 if Valid then
365 Result := FPData.Bits
366 else
367 Result := nil;
368 end;
370 function TBaseImage.GetPalette: PPalette32;
371 begin
372 if Valid then
373 Result := FPData.Palette
374 else
375 Result := nil;
376 end;
378 function TBaseImage.GetPaletteEntries: LongInt;
379 begin
380 Result := GetFormatInfo.PaletteEntries;
381 end;
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;
391 function TBaseImage.GetValid: Boolean;
392 begin
393 Result := Assigned(FPData) and Imaging.TestImage(FPData^);
394 end;
396 function TBaseImage.GetBoundsRect: TRect;
397 begin
398 Result := Rect(0, 0, GetWidth, GetHeight);
399 end;
401 procedure TBaseImage.SetWidth(const Value: LongInt);
402 begin
403 Resize(Value, GetHeight, rfNearest);
404 end;
406 procedure TBaseImage.SetHeight(const Value: LongInt);
407 begin
408 Resize(GetWidth, Value, rfNearest);
409 end;
411 procedure TBaseImage.SetFormat(const Value: TImageFormat);
412 begin
413 if Valid and Imaging.ConvertImage(FPData^, Value) then
414 DoDataSizeChanged;
415 end;
417 procedure TBaseImage.DoDataSizeChanged;
418 begin
419 if Assigned(FOnDataSizeChanged) then
420 FOnDataSizeChanged(Self);
421 DoPixelsChanged;
422 end;
424 procedure TBaseImage.DoPixelsChanged;
425 begin
426 if Assigned(FOnPixelsChanged) then
427 FOnPixelsChanged(Self);
428 end;
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;
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;
442 procedure TBaseImage.Flip;
443 begin
444 if Valid and Imaging.FlipImage(FPData^) then
445 DoPixelsChanged;
446 end;
448 procedure TBaseImage.Mirror;
449 begin
450 if Valid and Imaging.MirrorImage(FPData^) then
451 DoPixelsChanged;
452 end;
454 procedure TBaseImage.Rotate(Angle: Single);
455 begin
456 if Valid and Imaging.RotateImage(FPData^, Angle) then
457 DoPixelsChanged;
458 end;
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;
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;
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;
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;
500 function TBaseImage.ToString: string;
501 begin
502 Result := Iff(Valid, Imaging.ImageToStr(FPData^), 'empty image');
503 end;
505 procedure TBaseImage.LoadFromFile(const FileName: string);
506 begin
507 if Assigned(FPData) and Imaging.LoadImageFromFile(FileName, FPData^) then
508 DoDataSizeChanged;
509 end;
511 procedure TBaseImage.LoadFromStream(Stream: TStream);
512 begin
513 if Assigned(FPData) and Imaging.LoadImageFromStream(Stream, FPData^) then
514 DoDataSizeChanged;
515 end;
517 procedure TBaseImage.SaveToFile(const FileName: string);
518 begin
519 if Valid then
520 Imaging.SaveImageToFile(FileName, FPData^);
521 end;
523 procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream);
524 begin
525 if Valid then
526 Imaging.SaveImageToStream(Ext, Stream, FPData^);
527 end;
530 { TSingleImage class implementation }
532 constructor TSingleImage.Create;
533 begin
534 inherited Create;
535 RecreateImageData(DefaultWidth, DefaultHeight, ifDefault);
536 end;
538 constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat);
539 begin
540 inherited Create;
541 RecreateImageData(AWidth, AHeight, AFormat);
542 end;
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;
556 constructor TSingleImage.CreateFromFile(const FileName: string);
557 begin
558 inherited Create;
559 LoadFromFile(FileName);
560 end;
562 constructor TSingleImage.CreateFromStream(Stream: TStream);
563 begin
564 inherited Create;
565 LoadFromStream(Stream);
566 end;
568 destructor TSingleImage.Destroy;
569 begin
570 Imaging.FreeImage(FImageData);
571 inherited Destroy;
572 end;
574 procedure TSingleImage.SetPointer;
575 begin
576 FPData := @FImageData;
577 end;
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;
601 { TMultiImage class implementation }
603 constructor TMultiImage.Create;
604 begin
605 SetImageCount(DefaultImages);
606 SetActiveImage(0);
607 end;
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;
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;
638 constructor TMultiImage.CreateFromFile(const FileName: string);
639 begin
640 LoadMultiFromFile(FileName);
641 end;
643 constructor TMultiImage.CreateFromStream(Stream: TStream);
644 begin
645 LoadMultiFromStream(Stream);
646 end;
648 destructor TMultiImage.Destroy;
649 begin
650 Imaging.FreeImagesInArray(FDataArray);
651 inherited Destroy;
652 end;
654 procedure TMultiImage.SetActiveImage(Value: LongInt);
655 begin
656 FActiveImage := Value;
657 SetPointer;
658 end;
660 function TMultiImage.GetImageCount: LongInt;
661 begin
662 Result := Length(FDataArray);
663 end;
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;
687 function TMultiImage.GetAllImagesValid: Boolean;
688 begin
689 Result := (GetImageCount > 0) and TestImagesInArray(FDataArray);
690 end;
692 function TMultiImage.GetImage(Index: LongInt): TImageData;
693 begin
694 if (Index >= 0) and (Index < GetImageCount) then
695 Result := FDataArray[Index];
696 end;
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;
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;
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;
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;
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;
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;
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;
787 procedure TMultiImage.AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
788 begin
789 DoInsertNew(GetImageCount, AWidth, AHeight, AFormat);
790 end;
792 procedure TMultiImage.AddImage(const Image: TImageData);
793 begin
794 DoInsertImages(GetImageCount, GetArrayFromImageData(Image));
795 end;
797 procedure TMultiImage.AddImage(Image: TBaseImage);
798 begin
799 if Assigned(Image) and Image.Valid then
800 DoInsertImages(GetImageCount, GetArrayFromImageData(Image.FPData^));
801 end;
803 procedure TMultiImage.AddImages(const Images: TDynImageDataArray);
804 begin
805 DoInsertImages(GetImageCount, Images);
806 end;
808 procedure TMultiImage.AddImages(Images: TMultiImage);
809 begin
810 DoInsertImages(GetImageCount, Images.FDataArray);
811 end;
813 procedure TMultiImage.InsertImage(Index, AWidth, AHeight: LongInt;
814 AFormat: TImageFormat);
815 begin
816 DoInsertNew(Index, AWidth, AHeight, AFormat);
817 end;
819 procedure TMultiImage.InsertImage(Index: LongInt; const Image: TImageData);
820 begin
821 DoInsertImages(Index, GetArrayFromImageData(Image));
822 end;
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;
830 procedure TMultiImage.InsertImages(Index: LongInt;
831 const Images: TDynImageDataArray);
832 begin
833 DoInsertImages(Index, FDataArray);
834 end;
836 procedure TMultiImage.InsertImages(Index: LongInt; Images: TMultiImage);
837 begin
838 DoInsertImages(Index, Images.FDataArray);
839 end;
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;
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;
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;
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;
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;
899 procedure TMultiImage.LoadFromFile(const FileName: string);
900 begin
901 if GetImageCount = 0 then
902 ImageCount := 1;
903 inherited LoadFromFile(FileName);
904 end;
906 procedure TMultiImage.LoadFromStream(Stream: TStream);
907 begin
908 if GetImageCount = 0 then
909 ImageCount := 1;
910 inherited LoadFromStream(Stream);
911 end;
913 procedure TMultiImage.LoadMultiFromFile(const FileName: string);
914 begin
915 Imaging.LoadMultiImageFromFile(FileName, FDataArray);
916 SetActiveImage(0);
917 end;
919 procedure TMultiImage.LoadMultiFromStream(Stream: TStream);
920 begin
921 Imaging.LoadMultiImageFromStream(Stream, FDataArray);
922 SetActiveImage(0);
923 end;
925 procedure TMultiImage.SaveMultiToFile(const FileName: string);
926 begin
927 Imaging.SaveMultiImageToFile(FileName, FDataArray);
928 end;
930 procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream);
931 begin
932 Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray);
933 end;
936 File Notes:
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) ...
944 -- 0.24.3 Changes/Bug Fixes ---------------------------------
945 - Added TMultiImage.ReverseImages method.
947 -- 0.23 Changes/Bug Fixes -----------------------------------
948 - Added SwapChannels method to TBaseImage.
949 - Added ReplaceColor method to TBaseImage.
950 - Added ToString method to TBaseImage.
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.
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
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)
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
996 end.