ImagingClasses.pas 33 KB

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