2
0

ImagingClasses.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984
  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;
  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. { Converts all images to another image data format.}
  217. procedure ConvertImages(Format: TImageFormat);
  218. { Resizes all images.}
  219. procedure ResizeImages(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
  220. { Overloaded loading method that will add new image to multiimage if
  221. image array is empty bero loading. }
  222. procedure LoadFromFile(const FileName: string); override;
  223. { Overloaded loading method that will add new image to multiimage if
  224. image array is empty bero loading. }
  225. procedure LoadFromStream(Stream: TStream); override;
  226. { Loads whole multi image from file.}
  227. procedure LoadMultiFromFile(const FileName: string);
  228. { Loads whole multi image from stream.}
  229. procedure LoadMultiFromStream(Stream: TStream);
  230. { Saves whole multi image to file.}
  231. procedure SaveMultiToFile(const FileName: string);
  232. { Saves whole multi image to stream. Ext identifies desired
  233. image file format (jpg, png, dds, ...).}
  234. procedure SaveMultiToStream(const Ext: string; Stream: TStream);
  235. { Indicates active image of this multi image. All methods inherited
  236. from TBaseImage operate on this image only.}
  237. property ActiveImage: LongInt read FActiveImage write SetActiveImage;
  238. { Number of images of this multi image.}
  239. property ImageCount: LongInt read GetImageCount write SetImageCount;
  240. { This value is True if all images of this TMultiImage are valid.}
  241. property AllImagesValid: Boolean read GetAllImagesValid;
  242. { This gives complete access to underlying TDynImageDataArray.
  243. It can be used in functions that take TDynImageDataArray
  244. as parameter.}
  245. property DataArray: TDynImageDataArray read FDataArray;
  246. { Array property for accessing individual images of TMultiImage. When you
  247. set image at given index the old image is freed and the source is cloned.}
  248. property Images[Index: LongInt]: TImageData read GetImage write SetImage; default;
  249. end;
  250. implementation
  251. const
  252. DefaultWidth = 16;
  253. DefaultHeight = 16;
  254. DefaultImages = 1;
  255. function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray;
  256. begin
  257. SetLength(Result, 1);
  258. Result[0] := ImageData;
  259. end;
  260. { TBaseImage class implementation }
  261. constructor TBaseImage.Create;
  262. begin
  263. SetPointer;
  264. end;
  265. constructor TBaseImage.CreateFromImage(AImage: TBaseImage);
  266. begin
  267. Create;
  268. Assign(AImage);
  269. end;
  270. destructor TBaseImage.Destroy;
  271. begin
  272. inherited Destroy;
  273. end;
  274. function TBaseImage.GetWidth: LongInt;
  275. begin
  276. if Valid then
  277. Result := FPData.Width
  278. else
  279. Result := 0;
  280. end;
  281. function TBaseImage.GetHeight: LongInt;
  282. begin
  283. if Valid then
  284. Result := FPData.Height
  285. else
  286. Result := 0;
  287. end;
  288. function TBaseImage.GetFormat: TImageFormat;
  289. begin
  290. if Valid then
  291. Result := FPData.Format
  292. else
  293. Result := ifUnknown;
  294. end;
  295. function TBaseImage.GetScanLine(Index: LongInt): Pointer;
  296. var
  297. Info: TImageFormatInfo;
  298. begin
  299. if Valid then
  300. begin
  301. Info := GetFormatInfo;
  302. if not Info.IsSpecial then
  303. Result := ImagingFormats.GetScanLine(FPData.Bits, Info, FPData.Width, Index)
  304. else
  305. Result := FPData.Bits;
  306. end
  307. else
  308. Result := nil;
  309. end;
  310. function TBaseImage.GetPixelPointer(X, Y: LongInt): Pointer;
  311. begin
  312. if Valid then
  313. Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * GetFormatInfo.BytesPerPixel]
  314. else
  315. Result := nil;
  316. end;
  317. function TBaseImage.GetSize: LongInt;
  318. begin
  319. if Valid then
  320. Result := FPData.Size
  321. else
  322. Result := 0;
  323. end;
  324. function TBaseImage.GetBits: Pointer;
  325. begin
  326. if Valid then
  327. Result := FPData.Bits
  328. else
  329. Result := nil;
  330. end;
  331. function TBaseImage.GetPalette: PPalette32;
  332. begin
  333. if Valid then
  334. Result := FPData.Palette
  335. else
  336. Result := nil;
  337. end;
  338. function TBaseImage.GetPaletteEntries: LongInt;
  339. begin
  340. Result := GetFormatInfo.PaletteEntries;
  341. end;
  342. function TBaseImage.GetFormatInfo: TImageFormatInfo;
  343. begin
  344. if Valid then
  345. Imaging.GetImageFormatInfo(FPData.Format, Result)
  346. else
  347. FillChar(Result, SizeOf(Result), 0);
  348. end;
  349. function TBaseImage.GetValid: Boolean;
  350. begin
  351. Result := Assigned(FPData) and Imaging.TestImage(FPData^);
  352. end;
  353. function TBaseImage.GetBoundsRect: TRect;
  354. begin
  355. Result := Rect(0, 0, GetWidth, GetHeight);
  356. end;
  357. procedure TBaseImage.SetWidth(const Value: LongInt);
  358. begin
  359. Resize(Value, GetHeight, rfNearest);
  360. end;
  361. procedure TBaseImage.SetHeight(const Value: LongInt);
  362. begin
  363. Resize(GetWidth, Value, rfNearest);
  364. end;
  365. procedure TBaseImage.SetFormat(const Value: TImageFormat);
  366. begin
  367. if Valid and Imaging.ConvertImage(FPData^, Value) then
  368. DoDataSizeChanged;
  369. end;
  370. procedure TBaseImage.DoDataSizeChanged;
  371. begin
  372. if Assigned(FOnDataSizeChanged) then
  373. FOnDataSizeChanged(Self);
  374. DoPixelsChanged;
  375. end;
  376. procedure TBaseImage.DoPixelsChanged;
  377. begin
  378. if Assigned(FOnPixelsChanged) then
  379. FOnPixelsChanged(Self);
  380. end;
  381. procedure TBaseImage.RecreateImageData(AWidth, AHeight: LongInt; AFormat: TImageFormat);
  382. begin
  383. if Assigned(FPData) and Imaging.NewImage(AWidth, AHeight, AFormat, FPData^) then
  384. DoDataSizeChanged;
  385. end;
  386. procedure TBaseImage.Resize(NewWidth, NewHeight: LongInt; Filter: TResizeFilter);
  387. begin
  388. if Valid and Imaging.ResizeImage(FPData^, NewWidth, NewHeight, Filter) then
  389. DoDataSizeChanged;
  390. end;
  391. procedure TBaseImage.Flip;
  392. begin
  393. if Valid and Imaging.FlipImage(FPData^) then
  394. DoPixelsChanged;
  395. end;
  396. procedure TBaseImage.Mirror;
  397. begin
  398. if Valid and Imaging.MirrorImage(FPData^) then
  399. DoPixelsChanged;
  400. end;
  401. procedure TBaseImage.Rotate(Angle: LongInt);
  402. begin
  403. if Valid and Imaging.RotateImage(FPData^, Angle) then
  404. DoPixelsChanged;
  405. end;
  406. procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: LongInt;
  407. DstImage: TBaseImage; DstX, DstY: LongInt);
  408. begin
  409. if Valid and Assigned(DstImage) and DstImage.Valid then
  410. begin
  411. Imaging.CopyRect(FPData^, SrcX, SrcY, Width, Height, DstImage.FPData^, DstX, DstY);
  412. DstImage.DoPixelsChanged;
  413. end;
  414. end;
  415. procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: LongInt;
  416. DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: LongInt; Filter: TResizeFilter);
  417. begin
  418. if Valid and Assigned(DstImage) and DstImage.Valid then
  419. begin
  420. Imaging.StretchRect(FPData^, SrcX, SrcY, SrcWidth, SrcHeight,
  421. DstImage.FPData^, DstX, DstY, DstWidth, DstHeight, Filter);
  422. DstImage.DoPixelsChanged;
  423. end;
  424. end;
  425. procedure TBaseImage.ReplaceColor(X, Y, Width, Height: Integer; OldColor,
  426. NewColor: Pointer);
  427. begin
  428. if Valid then
  429. begin
  430. Imaging.ReplaceColor(FPData^, X, Y, Width, Height, OldColor, NewColor);
  431. DoPixelsChanged;
  432. end;
  433. end;
  434. procedure TBaseImage.SwapChannels(SrcChannel, DstChannel: Integer);
  435. begin
  436. if Valid then
  437. begin
  438. Imaging.SwapChannels(FPData^, SrcChannel, DstChannel);
  439. DoPixelsChanged;
  440. end;
  441. end;
  442. function TBaseImage.ToString: string;
  443. begin
  444. Result := Iff(Valid, Imaging.ImageToStr(FPData^), 'empty image');
  445. end;
  446. procedure TBaseImage.LoadFromFile(const FileName: string);
  447. begin
  448. if Assigned(FPData) and Imaging.LoadImageFromFile(FileName, FPData^) then
  449. DoDataSizeChanged;
  450. end;
  451. procedure TBaseImage.LoadFromStream(Stream: TStream);
  452. begin
  453. if Assigned(FPData) and Imaging.LoadImageFromStream(Stream, FPData^) then
  454. DoDataSizeChanged;
  455. end;
  456. procedure TBaseImage.SaveToFile(const FileName: string);
  457. begin
  458. if Valid then
  459. Imaging.SaveImageToFile(FileName, FPData^);
  460. end;
  461. procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream);
  462. begin
  463. if Valid then
  464. Imaging.SaveImageToStream(Ext, Stream, FPData^);
  465. end;
  466. { TSingleImage class implementation }
  467. constructor TSingleImage.Create;
  468. begin
  469. inherited Create;
  470. RecreateImageData(DefaultWidth, DefaultHeight, ifDefault);
  471. end;
  472. constructor TSingleImage.CreateFromParams(AWidth, AHeight: LongInt; AFormat: TImageFormat);
  473. begin
  474. inherited Create;
  475. RecreateImageData(AWidth, AHeight, AFormat);
  476. end;
  477. constructor TSingleImage.CreateFromData(const AData: TImageData);
  478. begin
  479. inherited Create;
  480. if Imaging.TestImage(AData) then
  481. begin
  482. Imaging.CloneImage(AData, FImageData);
  483. DoDataSizeChanged;
  484. end
  485. else
  486. Create;
  487. end;
  488. constructor TSingleImage.CreateFromFile(const FileName: string);
  489. begin
  490. inherited Create;
  491. LoadFromFile(FileName);
  492. end;
  493. constructor TSingleImage.CreateFromStream(Stream: TStream);
  494. begin
  495. inherited Create;
  496. LoadFromStream(Stream);
  497. end;
  498. destructor TSingleImage.Destroy;
  499. begin
  500. Imaging.FreeImage(FImageData);
  501. inherited Destroy;
  502. end;
  503. procedure TSingleImage.SetPointer;
  504. begin
  505. FPData := @FImageData;
  506. end;
  507. procedure TSingleImage.Assign(Source: TPersistent);
  508. begin
  509. if Source = nil then
  510. begin
  511. Create;
  512. end
  513. else if Source is TSingleImage then
  514. begin
  515. CreateFromData(TSingleImage(Source).FImageData);
  516. end
  517. else if Source is TMultiImage then
  518. begin
  519. if TMultiImage(Source).Valid then
  520. CreateFromData(TMultiImage(Source).FPData^)
  521. else
  522. Assign(nil);
  523. end
  524. else
  525. inherited Assign(Source);
  526. end;
  527. { TMultiImage class implementation }
  528. constructor TMultiImage.Create;
  529. begin
  530. SetImageCount(DefaultImages);
  531. SetActiveImage(0);
  532. end;
  533. constructor TMultiImage.CreateFromParams(AWidth, AHeight: LongInt;
  534. AFormat: TImageFormat; Images: LongInt);
  535. var
  536. I: LongInt;
  537. begin
  538. Imaging.FreeImagesInArray(FDataArray);
  539. SetLength(FDataArray, Images);
  540. for I := 0 to GetImageCount - 1 do
  541. Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]);
  542. SetActiveImage(0);
  543. end;
  544. constructor TMultiImage.CreateFromArray(ADataArray: TDynImageDataArray);
  545. var
  546. I: LongInt;
  547. begin
  548. Imaging.FreeImagesInArray(FDataArray);
  549. SetLength(FDataArray, Length(ADataArray));
  550. for I := 0 to GetImageCount - 1 do
  551. begin
  552. // Clone only valid images
  553. if Imaging.TestImage(ADataArray[I]) then
  554. Imaging.CloneImage(ADataArray[I], FDataArray[I])
  555. else
  556. Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
  557. end;
  558. SetActiveImage(0);
  559. end;
  560. constructor TMultiImage.CreateFromFile(const FileName: string);
  561. begin
  562. LoadMultiFromFile(FileName);
  563. end;
  564. constructor TMultiImage.CreateFromStream(Stream: TStream);
  565. begin
  566. LoadMultiFromStream(Stream);
  567. end;
  568. destructor TMultiImage.Destroy;
  569. begin
  570. Imaging.FreeImagesInArray(FDataArray);
  571. inherited Destroy;
  572. end;
  573. procedure TMultiImage.SetActiveImage(Value: LongInt);
  574. begin
  575. FActiveImage := Value;
  576. SetPointer;
  577. end;
  578. function TMultiImage.GetImageCount: LongInt;
  579. begin
  580. Result := Length(FDataArray);
  581. end;
  582. procedure TMultiImage.SetImageCount(Value: LongInt);
  583. var
  584. I, OldCount: LongInt;
  585. begin
  586. if Value > GetImageCount then
  587. begin
  588. // Create new empty images if array will be enlarged
  589. OldCount := GetImageCount;
  590. SetLength(FDataArray, Value);
  591. for I := OldCount to Value - 1 do
  592. Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]);
  593. end
  594. else
  595. begin
  596. // Free images that exceed desired count and shrink array
  597. for I := Value to GetImageCount - 1 do
  598. Imaging.FreeImage(FDataArray[I]);
  599. SetLength(FDataArray, Value);
  600. end;
  601. SetPointer;
  602. end;
  603. function TMultiImage.GetAllImagesValid: Boolean;
  604. begin
  605. Result := (GetImageCount > 0) and TestImagesInArray(FDataArray);
  606. end;
  607. function TMultiImage.GetImage(Index: LongInt): TImageData;
  608. begin
  609. if (Index >= 0) and (Index < GetImageCount) then
  610. Result := FDataArray[Index];
  611. end;
  612. procedure TMultiImage.SetImage(Index: LongInt; Value: TImageData);
  613. begin
  614. if (Index >= 0) and (Index < GetImageCount) then
  615. Imaging.CloneImage(Value, FDataArray[Index]);
  616. end;
  617. procedure TMultiImage.SetPointer;
  618. begin
  619. if GetImageCount > 0 then
  620. begin
  621. FActiveImage := ClampInt(FActiveImage, 0, GetImageCount - 1);
  622. FPData := @FDataArray[FActiveImage];
  623. end
  624. else
  625. begin
  626. FActiveImage := -1;
  627. FPData := nil
  628. end;
  629. end;
  630. function TMultiImage.PrepareInsert(Index, Count: LongInt): Boolean;
  631. var
  632. I: LongInt;
  633. begin
  634. // Inserting to empty image will add image at index 0
  635. if GetImageCount = 0 then
  636. Index := 0;
  637. if (Index >= 0) and (Index <= GetImageCount) and (Count > 0) then
  638. begin
  639. SetLength(FDataArray, GetImageCount + Count);
  640. if Index < GetImageCount - 1 then
  641. begin
  642. // Move imges to new position
  643. System.Move(FDataArray[Index], FDataArray[Index + Count],
  644. (GetImageCount - Count - Index) * SizeOf(TImageData));
  645. // Null old images, not free them!
  646. for I := Index to Index + Count - 1 do
  647. InitImage(FDataArray[I]);
  648. end;
  649. Result := True;
  650. end
  651. else
  652. Result := False;
  653. end;
  654. procedure TMultiImage.DoInsertImages(Index: LongInt; const Images: TDynImageDataArray);
  655. var
  656. I, Len: LongInt;
  657. begin
  658. Len := Length(Images);
  659. if PrepareInsert(Index, Len) then
  660. begin
  661. for I := 0 to Len - 1 do
  662. Imaging.CloneImage(Images[I], FDataArray[Index + I]);
  663. end;
  664. end;
  665. procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: LongInt;
  666. AFormat: TImageFormat);
  667. begin
  668. if PrepareInsert(Index, 1) then
  669. Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[Index]);
  670. end;
  671. procedure TMultiImage.Assign(Source: TPersistent);
  672. var
  673. Arr: TDynImageDataArray;
  674. begin
  675. if Source = nil then
  676. begin
  677. Create;
  678. end
  679. else if Source is TMultiImage then
  680. begin
  681. CreateFromArray(TMultiImage(Source).FDataArray);
  682. SetActiveImage(TMultiImage(Source).ActiveImage);
  683. end
  684. else if Source is TSingleImage then
  685. begin
  686. SetLength(Arr, 1);
  687. Arr[0] := TSingleImage(Source).FImageData;
  688. CreateFromArray(Arr);
  689. Arr := nil;
  690. end
  691. else
  692. inherited Assign(Source);
  693. end;
  694. procedure TMultiImage.AddImage(AWidth, AHeight: LongInt; AFormat: TImageFormat);
  695. begin
  696. DoInsertNew(GetImageCount, AWidth, AHeight, AFormat);
  697. end;
  698. procedure TMultiImage.AddImage(const Image: TImageData);
  699. begin
  700. DoInsertImages(GetImageCount, GetArrayFromImageData(Image));
  701. end;
  702. procedure TMultiImage.AddImage(Image: TBaseImage);
  703. begin
  704. if Assigned(Image) and Image.Valid then
  705. DoInsertImages(GetImageCount, GetArrayFromImageData(Image.FPData^));
  706. end;
  707. procedure TMultiImage.AddImages(const Images: TDynImageDataArray);
  708. begin
  709. DoInsertImages(GetImageCount, Images);
  710. end;
  711. procedure TMultiImage.AddImages(Images: TMultiImage);
  712. begin
  713. DoInsertImages(GetImageCount, Images.FDataArray);
  714. end;
  715. procedure TMultiImage.InsertImage(Index, AWidth, AHeight: LongInt;
  716. AFormat: TImageFormat);
  717. begin
  718. DoInsertNew(Index, AWidth, AHeight, AFormat);
  719. end;
  720. procedure TMultiImage.InsertImage(Index: LongInt; const Image: TImageData);
  721. begin
  722. DoInsertImages(Index, GetArrayFromImageData(Image));
  723. end;
  724. procedure TMultiImage.InsertImage(Index: LongInt; Image: TBaseImage);
  725. begin
  726. if Assigned(Image) and Image.Valid then
  727. DoInsertImages(Index, GetArrayFromImageData(Image.FPData^));
  728. end;
  729. procedure TMultiImage.InsertImages(Index: LongInt;
  730. const Images: TDynImageDataArray);
  731. begin
  732. DoInsertImages(Index, FDataArray);
  733. end;
  734. procedure TMultiImage.InsertImages(Index: LongInt; Images: TMultiImage);
  735. begin
  736. DoInsertImages(Index, Images.FDataArray);
  737. end;
  738. procedure TMultiImage.ExchangeImages(Index1, Index2: LongInt);
  739. var
  740. TempData: TImageData;
  741. begin
  742. if (Index1 >= 0) and (Index1 < GetImageCount) and
  743. (Index2 >= 0) and (Index2 < GetImageCount) then
  744. begin
  745. TempData := FDataArray[Index1];
  746. FDataArray[Index1] := FDataArray[Index2];
  747. FDataArray[Index2] := TempData;
  748. end;
  749. end;
  750. procedure TMultiImage.DeleteImage(Index: LongInt);
  751. var
  752. I: LongInt;
  753. begin
  754. if (Index >= 0) and (Index < GetImageCount) then
  755. begin
  756. // Free image at index to be deleted
  757. Imaging.FreeImage(FDataArray[Index]);
  758. if Index < GetImageCount - 1 then
  759. begin
  760. // Move images to new indices if necessary
  761. for I := Index to GetImageCount - 2 do
  762. FDataArray[I] := FDataArray[I + 1];
  763. end;
  764. // Set new array length and update pointer to active image
  765. SetLength(FDataArray, GetImageCount - 1);
  766. SetPointer;
  767. end;
  768. end;
  769. procedure TMultiImage.ConvertImages(Format: TImageFormat);
  770. var
  771. I: LongInt;
  772. begin
  773. for I := 0 to GetImageCount - 1 do
  774. Imaging.ConvertImage(FDataArray[I], Format);
  775. end;
  776. procedure TMultiImage.ResizeImages(NewWidth, NewHeight: LongInt;
  777. Filter: TResizeFilter);
  778. var
  779. I: LongInt;
  780. begin
  781. for I := 0 to GetImageCount do
  782. Imaging.ResizeImage(FDataArray[I], NewWidth, NewHeight, Filter);
  783. end;
  784. procedure TMultiImage.LoadFromFile(const FileName: string);
  785. begin
  786. if GetImageCount = 0 then
  787. ImageCount := 1;
  788. inherited LoadFromFile(FileName);
  789. end;
  790. procedure TMultiImage.LoadFromStream(Stream: TStream);
  791. begin
  792. if GetImageCount = 0 then
  793. ImageCount := 1;
  794. inherited LoadFromStream(Stream);
  795. end;
  796. procedure TMultiImage.LoadMultiFromFile(const FileName: string);
  797. begin
  798. Imaging.LoadMultiImageFromFile(FileName, FDataArray);
  799. SetActiveImage(0);
  800. end;
  801. procedure TMultiImage.LoadMultiFromStream(Stream: TStream);
  802. begin
  803. Imaging.LoadMultiImageFromStream(Stream, FDataArray);
  804. SetActiveImage(0);
  805. end;
  806. procedure TMultiImage.SaveMultiToFile(const FileName: string);
  807. begin
  808. Imaging.SaveMultiImageToFile(FileName, FDataArray);
  809. end;
  810. procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream);
  811. begin
  812. Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray);
  813. end;
  814. {
  815. File Notes:
  816. -- TODOS ----------------------------------------------------
  817. - nothing now
  818. - add SetPalette, create some pal wrapper first
  819. - put all low level stuff here like ReplaceColor etc, change
  820. CopyTo to Copy, and add overload Copy(SrcRect, DstX, DstY) ...
  821. -- 0.23 Changes/Bug Fixes -----------------------------------
  822. - Added SwapChannels method to TBaseImage.
  823. - Added ReplaceColor method to TBaseImage.
  824. - Added ToString method to TBaseImage.
  825. -- 0.21 Changes/Bug Fixes -----------------------------------
  826. - Inserting images to empty MultiImage will act as Add method.
  827. - MultiImages with empty arrays will now create one image when
  828. LoadFromFile or LoadFromStream is called.
  829. - Fixed bug that caused AVs when getting props like Width, Height, asn Size
  830. and when inlining was off. There was call to Iff but with inlining disabled
  831. params like FPData.Size were evaluated and when FPData was nil => AV.
  832. - Added many FPData validity checks to many methods. There were AVs
  833. when calling most methods on empty TMultiImage.
  834. - Added AllImagesValid property to TMultiImage.
  835. - Fixed memory leak in TMultiImage.CreateFromParams.
  836. -- 0.19 Changes/Bug Fixes -----------------------------------
  837. - added ResizeImages method to TMultiImage
  838. - removed Ext parameter from various LoadFromStream methods, no
  839. longer needed
  840. - fixed various issues concerning ActiveImage of TMultiImage
  841. (it pointed to invalid location after some operations)
  842. - most of property set/get methods are now inline
  843. - added PixelPointers property to TBaseImage
  844. - added Images default array property to TMultiImage
  845. - renamed methods in TMultiImage to contain 'Image' instead of 'Level'
  846. - added canvas support
  847. - added OnDataSizeChanged and OnPixelsChanged event to TBaseImage
  848. - renamed TSingleImage.NewImage to RecreateImageData, made public, and
  849. moved to TBaseImage
  850. -- 0.17 Changes/Bug Fixes -----------------------------------
  851. - added props PaletteEntries and ScanLine to TBaseImage
  852. - aded new constructor to TBaseImage that take TBaseImage source
  853. - TMultiImage levels adding and inserting rewritten internally
  854. - added some new functions to TMultiImage: AddLevels, InsertLevels
  855. - added some new functions to TBaseImage: Flip, Mirror, Rotate,
  856. CopyRect, StretchRect
  857. - TBasicImage.Resize has now filter parameter
  858. - new stuff added to TMultiImage (DataArray prop, ConvertLevels)
  859. -- 0.13 Changes/Bug Fixes -----------------------------------
  860. - added AddLevel, InsertLevel, ExchangeLevels and DeleteLevel
  861. methods to TMultiImage
  862. - added TBaseImage, TSingleImage and TMultiImage with initial
  863. members
  864. }
  865. end.