ImagingClasses.pas 31 KB

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