2
0

ImagingClasses.pas 28 KB

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