DEADSOFTWARE

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