3945362ad51f08bda9b01182cfaa8bcd6b100a7e
1 {
2 $Id: ImagingComponents.pas 171 2009-09-02 01:34:19Z galfar $
3 Vampyre Imaging Library
4 by Marek Mauder
5 http://imaginglib.sourceforge.net
7 The contents of this file are used with permission, subject to the Mozilla
8 Public License Version 1.1 (the "License"); you may not use this file except
9 in compliance with the License. You may obtain a copy of the License at
10 http://www.mozilla.org/MPL/MPL-1.1.html
12 Software distributed under the License is distributed on an "AS IS" basis,
13 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
14 the specific language governing rights and limitations under the License.
16 Alternatively, the contents of this file may be used under the terms of the
17 GNU Lesser General Public License (the "LGPL License"), in which case the
18 provisions of the LGPL License are applicable instead of those above.
19 If you wish to allow use of your version of this file only under the terms
20 of the LGPL License and not to allow others to use your version of this file
21 under the MPL, indicate your decision by deleting the provisions above and
22 replace them with the notice and other provisions required by the LGPL
23 License. If you do not delete the provisions above, a recipient may use
24 your version of this file under either the MPL or the LGPL License.
26 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
27 }
29 { This unit contains VCL/LCL TGraphic descendant which uses Imaging library
30 for saving and loading.}
33 {$I ImagingOptions.inc}
35 interface
37 {$IFDEF LCL}
38 {$DEFINE COMPONENT_SET_LCL}
39 {$ENDIF}
41 {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
42 // If no component sets should be used just include empty unit.
43 //DOC-IGNORE-BEGIN
44 implementation
45 //DOC-IGNORE-END
46 {$ELSE}
48 uses
50 {$IFDEF MSWINDOWS}
51 Windows,
52 {$ENDIF}
53 {$IFDEF COMPONENT_SET_VCL}
54 Graphics,
55 {$ENDIF}
56 {$IFDEF COMPONENT_SET_LCL}
57 InterfaceBase,
58 GraphType,
59 Graphics,
60 LCLType,
61 LCLIntf,
62 {$ENDIF}
65 type
66 { Graphic class which uses Imaging to load images.
67 It has standard TBitmap class as ancestor and it can
68 Assign also to/from TImageData structres and TBaseImage
69 classes. For saving is uses inherited TBitmap methods.
70 This class is automatically registered to TPicture for all
71 file extensions supported by Imaging (useful only for loading).
72 If you just want to load images in various formats you can use this
73 class or simply use TPicture.LoadFromXXX which will create this class
74 automatically. For TGraphic class that saves with Imaging look
75 at TImagingGraphicForSave class.}
77 protected
80 public
83 { Loads new image from the stream. It can load all image
84 file formats supported by Imaging (and enabled of course)
85 even though it is called by descendant class capable of
86 saving only one file format.}
88 { Copies the image contained in Source to this graphic object.
89 Supports also TBaseImage descendants from ImagingClasses unit. }
91 { Copies the image contained in TBaseImage to this graphic object.}
93 { Copies the current image to TBaseImage object.}
95 { Copies the image contained in TImageData structure to this graphic object.}
97 { Copies the current image to TImageData structure.}
103 { Base class for file format specific TGraphic classes that use
104 Imaging for saving. Each descendant class can load all file formats
105 supported by Imaging but save only one format (TImagingBitmap
106 for *.bmp, TImagingJpeg for *.jpg). Format specific classes also
107 allow easy access to Imaging options that affect saving of files
108 (they are properties here).}
110 protected
114 public
116 { Saves the current image to the stream. It is saved in the
117 file format according to the DefaultFileExt property.
118 So each descendant class can save some other file format.}
120 { Returns TImageFileFormat descendant for this graphic class.}
122 {$IFDEF COMPONENT_SET_LCL}
123 { Returns file extensions of this graphic class.}
125 { Returns default MIME type of this graphic class.}
127 {$ENDIF}
128 { Default (the most common) file extension of this graphic class.}
134 {$IFNDEF DONT_LINK_BITMAP}
135 { TImagingGraphic descendant for loading/saving Windows bitmaps.
136 VCL/CLX/LCL all have native support for bitmaps so you might
137 want to disable this class (although you can save bitmaps with
138 RLE compression with this class).}
140 protected
142 public
146 { See ImagingBitmapRLE option for details.}
149 {$ENDIF}
151 {$IFNDEF DONT_LINK_JPEG}
152 { TImagingGraphic descendant for loading/saving JPEG images.}
154 protected
157 public
161 {$IFDEF COMPONENT_SET_LCL}
163 {$ENDIF}
164 { See ImagingJpegQuality option for details.}
166 { See ImagingJpegProgressive option for details.}
169 {$ENDIF}
171 {$IFNDEF DONT_LINK_PNG}
172 { TImagingGraphic descendant for loading/saving PNG images.}
174 protected
177 public
181 { See ImagingPNGPreFilter option for details.}
183 { See ImagingPNGCompressLevel option for details.}
186 {$ENDIF}
188 {$IFNDEF DONT_LINK_GIF}
189 { TImagingGraphic descendant for loading/saving GIF images.}
191 public
194 {$ENDIF}
196 {$IFNDEF DONT_LINK_TARGA}
197 { TImagingGraphic descendant for loading/saving Targa images.}
199 protected
201 public
205 { See ImagingTargaRLE option for details.}
208 {$ENDIF}
210 {$IFNDEF DONT_LINK_DDS}
211 { Compresssion type used when saving DDS files by TImagingDds.}
214 { TImagingGraphic descendant for loading/saving DDS images.}
216 protected
218 public
222 { You can choose compression type used when saving DDS file.
223 dcNone means that file will be saved in the current bitmaps pixel format.}
226 {$ENDIF}
228 {$IFNDEF DONT_LINK_MNG}
229 { TImagingGraphic descendant for loading/saving MNG images.}
231 protected
238 public
242 {$IFDEF COMPONENT_SET_LCL}
244 {$ENDIF}
245 { See ImagingMNGLossyCompression option for details.}
247 { See ImagingMNGLossyAlpha option for details.}
249 { See ImagingMNGPreFilter option for details.}
251 { See ImagingMNGCompressLevel option for details.}
253 { See ImagingMNGQuality option for details.}
255 { See ImagingMNGProgressive option for details.}
258 {$ENDIF}
260 {$IFNDEF DONT_LINK_JNG}
261 { TImagingGraphic descendant for loading/saving JNG images.}
263 protected
269 public
273 { See ImagingJNGLossyAlpha option for details.}
275 { See ImagingJNGPreFilter option for details.}
277 { See ImagingJNGCompressLevel option for details.}
279 { See ImagingJNGQuality option for details.}
281 { See ImagingJNGProgressive option for details.}
284 {$ENDIF}
286 { Returns bitmap pixel format with the closest match with given data format.}
288 { Returns data format with closest match with given bitmap pixel format.}
291 { Converts TImageData structure to VCL/CLX/LCL bitmap.}
293 { Converts VCL/CLX/LCL bitmap to TImageData structure.}
295 { Converts TBaseImage instance to VCL/CLX/LCL bitmap.}
297 { Converts VCL/CLX/LCL bitmap to TBaseImage. Image must exist before
298 procedure is called. It overwrites its current image data.
299 When Image is TMultiImage only the current image level is overwritten.}
302 { Displays image stored in TImageData structure onto TCanvas. This procedure
303 draws image without converting from Imaging format to TBitmap.
304 Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this
305 when you want displaying images that change frequently (because converting to
306 TBitmap by ConvertImageDataToBitmap is generally slow). Dest and Src
307 rectangles represent coordinates in the form (X1, Y1, X2, Y2).}
308 procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
309 { Displays image onto TCanvas at position [DstX, DstY]. This procedure
310 draws image without converting from Imaging format to TBitmap.
311 Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this
312 when you want displaying images that change frequently (because converting to
313 TBitmap by ConvertImageDataToBitmap is generally slow).}
315 { Displays image onto TCanvas to rectangle DstRect. This procedure
316 draws image without converting from Imaging format to TBitmap.
317 Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this
318 when you want displaying images that change frequently (because converting to
319 TBitmap by ConvertImageDataToBitmap is generally slow).}
321 { Displays part of the image specified by SrcRect onto TCanvas to rectangle DstRect.
322 This procedure draws image without converting from Imaging format to TBitmap.
323 Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this
324 when you want displaying images that change frequently (because converting to
325 TBitmap by ConvertImageDataToBitmap is generally slow).}
326 procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage; const SrcRect: TRect); overload;
328 {$IFDEF MSWINDOWS}
329 { Displays image stored in TImageData structure onto Windows device context.
330 Behaviour is the same as of DisplayImageData.}
331 procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
332 {$ENDIF}
334 implementation
336 uses
337 {$IF Defined(LCL)}
338 {$IF Defined(LCLGTK2)}
340 {$ELSEIF Defined(LCLGTK)}
342 {$IFEND}
343 {$IFEND}
344 {$IFNDEF DONT_LINK_BITMAP}
345 ImagingBitmap,
346 {$ENDIF}
347 {$IFNDEF DONT_LINK_JPEG}
348 ImagingJpeg,
349 {$ENDIF}
350 {$IFNDEF DONT_LINK_GIF}
351 ImagingGif,
352 {$ENDIF}
353 {$IFNDEF DONT_LINK_TARGA}
354 ImagingTarga,
355 {$ENDIF}
356 {$IFNDEF DONT_LINK_DDS}
357 ImagingDds,
358 {$ENDIF}
359 {$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
360 ImagingNetworkGraphics,
361 {$IFEND}
362 ImagingUtility;
364 resourcestring
371 { Registers types to VCL/LCL.}
373 var
377 var
379 begin
382 TImagingGraphic);
386 var
388 begin
394 begin
399 {$IFNDEF DONT_LINK_TARGA}
402 {$ENDIF}
403 {$IFNDEF DONT_LINK_DDS}
406 {$ENDIF}
407 {$IFNDEF DONT_LINK_JNG}
410 {$ENDIF}
411 {$IFNDEF DONT_LINK_MNG}
414 {$ENDIF}
415 {$IFNDEF DONT_LINK_GIF}
418 {$ENDIF}
419 {$IFNDEF DONT_LINK_PNG}
420 {$IFDEF COMPONENT_SET_LCL}
421 // Unregister LazarusĀ“ default PNG loader which crashes on some PNG files
423 {$ENDIF}
426 {$ENDIF}
427 {$IFNDEF DONT_LINK_JPEG}
430 {$ENDIF}
431 {$IFNDEF DONT_LINK_BITMAP}
434 {$ENDIF}
437 { Unregisters types from VCL/LCL.}
439 begin
440 {$IFNDEF DONT_LINK_BITMAP}
443 {$ENDIF}
444 {$IFNDEF DONT_LINK_JPEG}
447 {$ENDIF}
448 {$IFNDEF DONT_LINK_PNG}
451 {$ENDIF}
452 {$IFNDEF DONT_LINK_GIF}
455 {$ENDIF}
456 {$IFNDEF DONT_LINK_TARGA}
459 {$ENDIF}
460 {$IFNDEF DONT_LINK_DDS}
463 {$ENDIF}
469 begin
471 {$IFDEF COMPONENT_SET_VCL}
475 {$ENDIF}
476 ifA8R8G8B8,
478 else
484 begin
491 else
497 var
502 {$IFDEF COMPONENT_SET_VCL}
504 {$ENDIF}
505 {$IFDEF COMPONENT_SET_LCL}
508 {$ENDIF}
509 begin
513 begin
514 // Convert from formats not supported by Graphics unit
519 else
520 {$IFDEF COMPONENT_SET_VCL}
525 else
527 {$ELSE}
529 {$ENDIF}
533 end
534 else
542 {$IFDEF COMPONENT_SET_VCL}
548 begin
549 // Copy palette, this must be done before copying bits
555 begin
562 // Copy scanlines
566 // Delphi 2009 and newer support alpha transparency fro TBitmap
567 {$IF Defined(DELPHI) and (CompilerVersion >= 20.0)}
570 {$IFEND}
572 {$ENDIF}
573 {$IFDEF COMPONENT_SET_LCL}
574 // Create 32bit raw image from image data
577 begin
599 // Create bitmap from raw image
601 begin
605 {$ENDIF}
611 var
615 {$IFDEF COMPONENT_SET_VCL}
618 {$ENDIF}
619 {$IFDEF COMPONENT_SET_LCL}
622 {$ENDIF}
623 begin
624 {$IFDEF COMPONENT_SET_LCL}
625 // In the current Lazarus 0.9.10 Bitmap.PixelFormat property is useless.
626 // We cannot change bitmap's format by changing it (it will just release
627 // old image but not convert it to new format) nor we can determine bitmaps's
628 // current format (it is usually set to pfDevice). So bitmap's format is obtained
629 // trough RawImage api and cannot be changed to mirror some Imaging format
630 // (so formats with no coresponding Imaging format cannot be saved now).
637 Format := ifA1R5G5B5
638 else
644 else
647 {$ELSE}
650 begin
651 // Convert from formats not supported by Imaging (1/4 bit)
654 else
658 {$ENDIF}
667 {$IFDEF COMPONENT_SET_VCL}
670 begin
671 // Copy palette
677 begin
684 // Copy scanlines
687 {$ENDIF}
688 {$IFDEF COMPONENT_SET_LCL}
689 // Get raw image from bitmap (mask handle must be 0 or expect violations)
691 begin
694 // Copy scanlines
698 { If you get complitation error here upgrade to Lazarus 0.9.24+ }
701 {$ENDIF}
705 begin
710 begin
714 {$IFDEF MSWINDOWS}
715 procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
716 var
720 begin
722 begin
728 begin
742 try
747 begin
748 // StretchDIBits may fail on some ocassions (error 487, http://support.microsoft.com/kb/269585).
749 // This fallback is slow but works every time. Thanks to Sergey Galezdinov for the fix.
751 try
753 StretchBlt(DC, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top,
755 finally
759 finally
764 {$ENDIF}
766 procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
768 begin
771 {$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}
775 var
777 begin
786 var
790 begin
792 begin
808 begin
810 try
812 // Swap R-B channels for GTK display compatability!
816 finally
818 end
819 else
820 try
821 // Create new image with desired dimensions
823 // Stretch pixels from old image to new one TResizeFilter = (rfNearest, rfBilinear, rfBicubic);
826 // Swap R-B channels for GTK display compatability!
830 finally
832 end
836 {$ELSE}
837 begin
840 {$IFEND}
843 begin
849 begin
853 procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage; const SrcRect: TRect);
854 begin
859 { TImagingGraphic class implementation }
862 begin
868 begin
873 var
875 begin
877 try
880 finally
886 var
888 begin
890 begin
892 end
894 begin
899 end
900 else
905 begin
908 else
913 begin
919 begin
925 begin
931 begin
937 { TImagingGraphicForSave class implementation }
940 begin
948 var
950 begin
952 begin
954 try
959 finally
966 begin
970 {$IFDEF COMPONENT_SET_LCL}
972 begin
977 begin
980 {$ENDIF}
982 {$IFNDEF DONT_LINK_BITMAP}
984 { TImagingBitmap class implementation }
987 begin
993 begin
998 begin
1004 {$ENDIF}
1006 {$IFNDEF DONT_LINK_JPEG}
1008 { TImagingJpeg class implementation }
1011 begin
1018 begin
1022 {$IFDEF COMPONENT_SET_LCL}
1024 begin
1027 {$ENDIF}
1030 begin
1038 {$ENDIF}
1040 {$IFNDEF DONT_LINK_PNG}
1042 { TImagingPNG class implementation }
1045 begin
1052 begin
1057 begin
1064 {$ENDIF}
1066 {$IFNDEF DONT_LINK_GIF}
1068 { TImagingGIF class implementation}
1071 begin
1075 {$ENDIF}
1077 {$IFNDEF DONT_LINK_TARGA}
1079 { TImagingTarga class implementation }
1082 begin
1088 begin
1093 begin
1099 {$ENDIF}
1101 {$IFNDEF DONT_LINK_DDS}
1103 { TImagingDDS class implementation }
1106 begin
1112 begin
1117 begin
1132 {$ENDIF}
1134 {$IFNDEF DONT_LINK_MNG}
1136 { TImagingMNG class implementation }
1139 begin
1150 begin
1154 {$IFDEF COMPONENT_SET_LCL}
1156 begin
1159 {$ENDIF}
1162 begin
1173 {$ENDIF}
1175 {$IFNDEF DONT_LINK_JNG}
1177 { TImagingJNG class implementation }
1180 begin
1190 begin
1195 begin
1205 {$ENDIF}
1207 initialization
1208 RegisterTypes;
1209 finalization
1210 UnRegisterTypes;
1214 {
1215 File Notes:
1217 -- TODOS ----------------------------------------------------
1218 - nothing now
1220 -- 0.26.3 Changes/Bug Fixes ---------------------------------
1221 - Setting AlphaFormat property of TBitmap in ConvertDataToBitmap
1222 when using Delphi 2009+.
1223 - Fixed garbled LCL TBitmaps created by ConvertDataToBitmap
1224 in Mac OS X (Carbon).
1226 -- 0.26.1 Changes/Bug Fixes ---------------------------------
1227 - Added some more IFDEFs for Lazarus widget sets.
1228 - Removed CLX code.
1229 - GTK version of Unix DisplayImageData only used with LCL GTK so the
1230 the rest of the unit can be used with Qt or other LCL interfaces.
1231 - Fallback mechanism for DisplayImageDataOnDC, it may fail on occasions.
1232 - Changed file format conditional compilation to reflect changes
1233 in LINK symbols.
1234 - Lazarus 0.9.26 compatibility changes.
1236 -- 0.24.1 Changes/Bug Fixes ---------------------------------
1237 - Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus
1238 with GTK2 target.
1239 - Added commnets with code for Lazarus rev. 11861+ regarding
1240 RawImage interface. Replace current code with that in comments
1241 if you use Lazarus from SVN. New RawImage interface will be used by
1242 default after next Lazarus release.
1244 -- 0.23 Changes/Bug Fixes -----------------------------------
1245 - Added TImagingGIF.
1247 -- 0.21 Changes/Bug Fixes -----------------------------------
1248 - Uses only high level interface now (except for saving options).
1249 - Slightly changed class hierarchy. TImagingGraphic is now only for loading
1250 and base class for savers is new TImagingGraphicForSave. Also
1251 TImagingGraphic is now registered with all supported file formats
1252 by TPicture's format support.
1254 -- 0.19 Changes/Bug Fixes -----------------------------------
1255 - added DisplayImage procedures (thanks to Paul Michell, modified)
1256 - removed RegisterTypes and UnRegisterTypes from interface section,
1257 they are called automatically
1258 - added procedures: ConvertImageToBitmap and ConvertBitmapToImage
1260 -- 0.17 Changes/Bug Fixes -----------------------------------
1261 - LCL data to bitmap conversion didnĀ“t work in Linux, fixed
1262 - added MNG file format
1263 - added JNG file format
1265 -- 0.15 Changes/Bug Fixes -----------------------------------
1266 - made it LCL compatible
1267 - made it CLX compatible
1268 - added all initial stuff
1269 }