src/lib/vampimg/ImagingComponents.pas

   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
   6
   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
  11
  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.
  15
  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.
  25
  26   For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  27 }
  28
  29 { This unit contains VCL/LCL TGraphic descendant which uses Imaging library
  30   for saving and loading.}
  31 unit ImagingComponents;
  32
  33 {$I ImagingOptions.inc}
  34
  35 interface
  36
  37 {$IFDEF LCL}
  38   {$DEFINE COMPONENT_SET_LCL}
  39 {$ENDIF}
  40
  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}
  47
  48 uses
  49   SysUtils, Types, Classes,
  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}
  63   ImagingTypes, Imaging, ImagingClasses;
  64
  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.}
  76   TImagingGraphic = class(TBitmap)
  77   protected
  78     procedure ReadDataFromStream(Stream: TStream); virtual;
  79     procedure AssignTo(Dest: TPersistent); override;
  80   public
  81     constructor Create; override;
  82
  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.}
  87     procedure LoadFromStream(Stream: TStream); override;
  88     { Copies the image contained in Source to this graphic object.
  89       Supports also TBaseImage descendants from ImagingClasses unit. }
  90     procedure Assign(Source: TPersistent); override;
  91     { Copies the image contained in TBaseImage to this graphic object.}
  92     procedure AssignFromImage(Image: TBaseImage);
  93     { Copies the current image to TBaseImage object.}
  94     procedure AssignToImage(Image: TBaseImage);
  95     { Copies the image contained in TImageData structure to this graphic object.}
  96     procedure AssignFromImageData(const ImageData: TImageData);
  97     { Copies the current image to TImageData structure.}
  98     procedure AssignToImageData(var ImageData: TImageData);
  99   end;
 100
 101   TImagingGraphicClass = class of TImagingGraphic;
 102
 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).}
 109   TImagingGraphicForSave = class(TImagingGraphic)
 110   protected
 111     FDefaultFileExt: string;
 112     FSavingFormat: TImageFormat;
 113     procedure WriteDataToStream(Stream: TStream); virtual;
 114   public
 115     constructor Create; override;
 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.}
 119     procedure SaveToStream(Stream: TStream); override;
 120     { Returns TImageFileFormat descendant for this graphic class.}
 121     class function GetFileFormat: TImageFileFormat; virtual; abstract;
 122   {$IFDEF COMPONENT_SET_LCL}
 123     { Returns file extensions of this graphic class.}
 124     class function GetFileExtensions: string; override;
 125     { Returns default MIME type of this graphic class.}
 126     function GetMimeType: string; override;
 127   {$ENDIF}
 128     { Default (the most common) file extension of this graphic class.}
 129     property DefaultFileExt: string read FDefaultFileExt;
 130   end;
 131
 132   TImagingGraphicForSaveClass = class of TImagingGraphicForSave;
 133
 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).}
 139   TImagingBitmap = class(TImagingGraphicForSave)
 140   protected
 141     FUseRLE: Boolean;
 142   public
 143     constructor Create; override;
 144     procedure SaveToStream(Stream: TStream); override;
 145     class function GetFileFormat: TImageFileFormat; override;
 146     { See ImagingBitmapRLE option for details.}
 147     property UseRLE: Boolean read FUseRLE write FUseRLE;
 148   end;
 149 {$ENDIF}
 150
 151 {$IFNDEF DONT_LINK_JPEG}
 152   { TImagingGraphic descendant for loading/saving JPEG images.}
 153   TImagingJpeg = class(TImagingGraphicForSave)
 154   protected
 155     FQuality: LongInt;
 156     FProgressive: Boolean;
 157   public
 158     constructor Create; override;
 159     procedure SaveToStream(Stream: TStream); override;
 160     class function GetFileFormat: TImageFileFormat; override;
 161   {$IFDEF COMPONENT_SET_LCL}
 162     function GetMimeType: string; override;
 163   {$ENDIF}
 164     { See ImagingJpegQuality option for details.}
 165     property Quality: LongInt read FQuality write FQuality;
 166     { See ImagingJpegProgressive option for details.}
 167     property Progressive: Boolean read FProgressive write FProgressive;
 168   end;
 169 {$ENDIF}
 170
 171 {$IFNDEF DONT_LINK_PNG}
 172   { TImagingGraphic descendant for loading/saving PNG images.}
 173   TImagingPNG = class(TImagingGraphicForSave)
 174   protected
 175     FPreFilter: LongInt;
 176     FCompressLevel: LongInt;
 177   public
 178     constructor Create; override;
 179     procedure SaveToStream(Stream: TStream); override;
 180     class function GetFileFormat: TImageFileFormat; override;
 181     { See ImagingPNGPreFilter option for details.}
 182     property PreFilter: LongInt read FPreFilter write FPreFilter;
 183     { See ImagingPNGCompressLevel option for details.}
 184     property CompressLevel: LongInt read FCompressLevel write FCompressLevel;
 185   end;
 186 {$ENDIF}
 187
 188 {$IFNDEF DONT_LINK_GIF}
 189   { TImagingGraphic descendant for loading/saving GIF images.}
 190   TImagingGIF = class(TImagingGraphicForSave)
 191   public
 192     class function GetFileFormat: TImageFileFormat; override;
 193   end;
 194 {$ENDIF}
 195
 196 {$IFNDEF DONT_LINK_TARGA}
 197   { TImagingGraphic descendant for loading/saving Targa images.}
 198   TImagingTarga = class(TImagingGraphicForSave)
 199   protected
 200     FUseRLE: Boolean;
 201   public
 202     constructor Create; override;
 203     procedure SaveToStream(Stream: TStream); override;
 204     class function GetFileFormat: TImageFileFormat; override;
 205     { See ImagingTargaRLE option for details.}
 206     property UseRLE: Boolean read FUseRLE write FUseRLE;
 207   end;
 208 {$ENDIF}
 209
 210 {$IFNDEF DONT_LINK_DDS}
 211   { Compresssion type used when saving DDS files by TImagingDds.}
 212   TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5);
 213
 214   { TImagingGraphic descendant for loading/saving DDS images.}
 215   TImagingDDS = class(TImagingGraphicForSave)
 216   protected
 217     FCompression: TDDSCompresion;
 218   public
 219     constructor Create; override;
 220     procedure SaveToStream(Stream: TStream); override;
 221     class function GetFileFormat: TImageFileFormat; override;
 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.}
 224     property Compression: TDDSCompresion read FCompression write FCompression;
 225   end;
 226 {$ENDIF}
 227
 228 {$IFNDEF DONT_LINK_MNG}
 229   { TImagingGraphic descendant for loading/saving MNG images.}
 230   TImagingMNG = class(TImagingGraphicForSave)
 231   protected
 232     FLossyCompression: Boolean;
 233     FLossyAlpha: Boolean;
 234     FPreFilter: LongInt;
 235     FCompressLevel: LongInt;
 236     FQuality: LongInt;
 237     FProgressive: Boolean;
 238   public
 239     constructor Create; override;
 240     procedure SaveToStream(Stream: TStream); override;
 241     class function GetFileFormat: TImageFileFormat; override;
 242   {$IFDEF COMPONENT_SET_LCL}
 243     function GetMimeType: string; override;
 244   {$ENDIF}
 245     { See ImagingMNGLossyCompression option for details.}
 246     property LossyCompression: Boolean read FLossyCompression write FLossyCompression;
 247     { See ImagingMNGLossyAlpha option for details.}
 248     property LossyAlpha: Boolean read FLossyAlpha write FLossyAlpha;
 249     { See ImagingMNGPreFilter option for details.}
 250     property PreFilter: LongInt read FPreFilter write FPreFilter;
 251     { See ImagingMNGCompressLevel option for details.}
 252     property CompressLevel: LongInt read FCompressLevel write FCompressLevel;
 253     { See ImagingMNGQuality option for details.}
 254     property Quality: LongInt read FQuality write FQuality;
 255     { See ImagingMNGProgressive option for details.}
 256     property Progressive: Boolean read FProgressive write FProgressive;
 257   end;
 258 {$ENDIF}
 259
 260 {$IFNDEF DONT_LINK_JNG}
 261   { TImagingGraphic descendant for loading/saving JNG images.}
 262   TImagingJNG = class(TImagingGraphicForSave)
 263   protected
 264     FLossyAlpha: Boolean;
 265     FAlphaPreFilter: LongInt;
 266     FAlphaCompressLevel: LongInt;
 267     FQuality: LongInt;
 268     FProgressive: Boolean;
 269   public
 270     constructor Create; override;
 271     procedure SaveToStream(Stream: TStream); override;
 272     class function GetFileFormat: TImageFileFormat; override;
 273     { See ImagingJNGLossyAlpha option for details.}
 274     property LossyAlpha: Boolean read FLossyAlpha write FLossyAlpha;
 275     { See ImagingJNGPreFilter option for details.}
 276     property AlphaPreFilter: LongInt read FAlphaPreFilter write FAlphaPreFilter;
 277     { See ImagingJNGCompressLevel option for details.}
 278     property AlphaCompressLevel: LongInt read FAlphaCompressLevel write FAlphaCompressLevel;
 279     { See ImagingJNGQuality option for details.}
 280     property Quality: LongInt read FQuality write FQuality;
 281     { See ImagingJNGProgressive option for details.}
 282     property Progressive: Boolean read FProgressive write FProgressive;
 283   end;
 284 {$ENDIF}
 285
 286 { Returns bitmap pixel format with the closest match with given data format.}
 287 function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
 288 { Returns data format with closest match with given bitmap pixel format.}
 289 function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat;
 290
 291 { Converts TImageData structure to VCL/CLX/LCL bitmap.}
 292 procedure ConvertDataToBitmap(const Data: TImageData; Bitmap: TBitmap);
 293 { Converts VCL/CLX/LCL bitmap to TImageData structure.}
 294 procedure ConvertBitmapToData(Bitmap: TBitmap; var Data: TImageData);
 295 { Converts TBaseImage instance to VCL/CLX/LCL bitmap.}
 296 procedure ConvertImageToBitmap(Image: TBaseImage; Bitmap: TBitmap);
 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.}
 300 procedure ConvertBitmapToImage(Bitmap: TBitmap; Image: TBaseImage);
 301
 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).}
 314 procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage); overload;
 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).}
 320 procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage); overload;
 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;
 327
 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}
 333
 334 implementation
 335
 336 uses
 337 {$IF Defined(LCL)}
 338   {$IF Defined(LCLGTK2)}
 339     GLib2, GDK2, GTK2, GTKDef, GTKProc,
 340   {$ELSEIF Defined(LCLGTK)}
 341     GDK, GTK, GTKDef, GTKProc,
 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;
 363
 364 resourcestring
 365   SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
 366   SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p';
 367   SBadFormatDisplay = 'Unsupported image format passed';
 368   SUnsupportedLCLWidgetSet = 'This function is not implemented for current LCL widget set';
 369   SImagingGraphicName = 'Imaging Graphic AllInOne';
 370
 371 { Registers types to VCL/LCL.}
 372 procedure RegisterTypes;
 373 var
 374   I: LongInt;
 375
 376   procedure RegisterFileFormatAllInOne(Format: TImageFileFormat);
 377   var
 378     I: LongInt;
 379   begin
 380     for I := 0 to Format.Extensions.Count - 1 do
 381       TPicture.RegisterFileFormat(Format.Extensions[I], SImagingGraphicName,
 382         TImagingGraphic);
 383   end;
 384
 385   procedure RegisterFileFormat(AClass: TImagingGraphicForSaveClass);
 386   var
 387     I: LongInt;
 388   begin
 389     for I := 0 to AClass.GetFileFormat.Extensions.Count - 1 do
 390       TPicture.RegisterFileFormat(AClass.GetFileFormat.Extensions[I],
 391         AClass.GetFileFormat.Name, AClass);
 392   end;
 393
 394 begin
 395   for I := Imaging.GetFileFormatCount - 1 downto 0 do
 396     RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I));
 397   Classes.RegisterClass(TImagingGraphic);
 398
 399 {$IFNDEF DONT_LINK_TARGA}
 400   RegisterFileFormat(TImagingTarga);
 401   Classes.RegisterClass(TImagingTarga);
 402 {$ENDIF}
 403 {$IFNDEF DONT_LINK_DDS}
 404   RegisterFileFormat(TImagingDDS);
 405   Classes.RegisterClass(TImagingDDS);
 406 {$ENDIF}
 407 {$IFNDEF DONT_LINK_JNG}
 408   RegisterFileFormat(TImagingJNG);
 409   Classes.RegisterClass(TImagingJNG);
 410 {$ENDIF}
 411 {$IFNDEF DONT_LINK_MNG}
 412   RegisterFileFormat(TImagingMNG);
 413   Classes.RegisterClass(TImagingMNG);
 414 {$ENDIF}
 415 {$IFNDEF DONT_LINK_GIF}
 416   RegisterFileFormat(TImagingGIF);
 417   Classes.RegisterClass(TImagingGIF);
 418 {$ENDIF}
 419 {$IFNDEF DONT_LINK_PNG}
 420   {$IFDEF COMPONENT_SET_LCL}
 421     // Unregister Lazarus´ default PNG loader which crashes on some PNG files
 422     TPicture.UnregisterGraphicClass(TPortableNetworkGraphic);
 423   {$ENDIF}
 424   RegisterFileFormat(TImagingPNG);
 425   Classes.RegisterClass(TImagingPNG);
 426 {$ENDIF}
 427 {$IFNDEF DONT_LINK_JPEG}
 428   RegisterFileFormat(TImagingJpeg);
 429   Classes.RegisterClass(TImagingJpeg);
 430 {$ENDIF}
 431 {$IFNDEF DONT_LINK_BITMAP}
 432   RegisterFileFormat(TImagingBitmap);
 433   Classes.RegisterClass(TImagingBitmap);
 434 {$ENDIF}
 435 end;
 436
 437 { Unregisters types from VCL/LCL.}
 438 procedure UnRegisterTypes;
 439 begin
 440 {$IFNDEF DONT_LINK_BITMAP}
 441   TPicture.UnregisterGraphicClass(TImagingBitmap);
 442   Classes.UnRegisterClass(TImagingBitmap);
 443 {$ENDIF}
 444 {$IFNDEF DONT_LINK_JPEG}
 445   TPicture.UnregisterGraphicClass(TImagingJpeg);
 446   Classes.UnRegisterClass(TImagingJpeg);
 447 {$ENDIF}
 448 {$IFNDEF DONT_LINK_PNG}
 449   TPicture.UnregisterGraphicClass(TImagingPNG);
 450   Classes.UnRegisterClass(TImagingPNG);
 451 {$ENDIF}
 452 {$IFNDEF DONT_LINK_GIF}
 453   TPicture.UnregisterGraphicClass(TImagingGIF);
 454   Classes.UnRegisterClass(TImagingGIF);
 455 {$ENDIF}
 456 {$IFNDEF DONT_LINK_TARGA}
 457   TPicture.UnregisterGraphicClass(TImagingTarga);
 458   Classes.UnRegisterClass(TImagingTarga);
 459 {$ENDIF}
 460 {$IFNDEF DONT_LINK_DDS}
 461   TPicture.UnregisterGraphicClass(TImagingDDS);
 462   Classes.UnRegisterClass(TImagingDDS);
 463 {$ENDIF}
 464   TPicture.UnregisterGraphicClass(TImagingGraphic);
 465   Classes.UnRegisterClass(TImagingGraphic);
 466 end;
 467
 468 function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
 469 begin
 470   case Format of
 471 {$IFDEF COMPONENT_SET_VCL}
 472     ifIndex8: Result := pf8bit;
 473     ifR5G6B5: Result := pf16bit;
 474     ifR8G8B8: Result := pf24bit;
 475 {$ENDIF}
 476     ifA8R8G8B8,
 477     ifX8R8G8B8: Result := pf32bit;
 478   else
 479     Result := pfCustom;
 480   end;
 481 end;
 482
 483 function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat;
 484 begin
 485   case Format of
 486     pf8bit: Result := ifIndex8;
 487     pf15bit: Result := ifA1R5G5B5;
 488     pf16bit: Result := ifR5G6B5;
 489     pf24bit: Result := ifR8G8B8;
 490     pf32bit: Result := ifA8R8G8B8;
 491   else
 492     Result := ifUnknown;
 493   end;
 494 end;
 495
 496 procedure ConvertDataToBitmap(const Data: TImageData; Bitmap: TBitmap);
 497 var
 498   I, LineBytes: LongInt;
 499   PF: TPixelFormat;
 500   Info: TImageFormatInfo;
 501   WorkData: TImageData;
 502 {$IFDEF COMPONENT_SET_VCL}
 503   LogPalette: TMaxLogPalette;
 504 {$ENDIF}
 505 {$IFDEF COMPONENT_SET_LCL}
 506   RawImage: TRawImage;
 507   ImgHandle, ImgMaskHandle: HBitmap;
 508 {$ENDIF}
 509 begin
 510   PF := DataFormatToPixelFormat(Data.Format);
 511   GetImageFormatInfo(Data.Format, Info);
 512   if PF = pfCustom then
 513   begin
 514     // Convert from formats not supported by Graphics unit
 515     Imaging.InitImage(WorkData);
 516     Imaging.CloneImage(Data, WorkData);
 517     if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
 518       Imaging.ConvertImage(WorkData, ifA8R8G8B8)
 519     else
 520 {$IFDEF COMPONENT_SET_VCL}
 521       if Info.IsIndexed or Info.HasGrayChannel then
 522         Imaging.ConvertImage(WorkData, ifIndex8)
 523       else if Info.UsePixelFormat then
 524         Imaging.ConvertImage(WorkData, ifR5G6B5)
 525       else
 526         Imaging.ConvertImage(WorkData, ifR8G8B8);
 527 {$ELSE}
 528         Imaging.ConvertImage(WorkData, ifA8R8G8B8);
 529 {$ENDIF}
 530
 531     PF := DataFormatToPixelFormat(WorkData.Format);
 532     GetImageFormatInfo(WorkData.Format, Info);
 533   end
 534   else
 535     WorkData := Data;
 536
 537   if PF = pfCustom then
 538     RaiseImaging(SBadFormatDataToBitmap, [ImageToStr(WorkData)]);
 539
 540   LineBytes := WorkData.Width * Info.BytesPerPixel;
 541
 542 {$IFDEF COMPONENT_SET_VCL}
 543   Bitmap.Width := WorkData.Width;
 544   Bitmap.Height := WorkData.Height;
 545   Bitmap.PixelFormat := PF;
 546
 547   if (PF = pf8bit) and (WorkData.Palette <> nil) then
 548   begin
 549     // Copy palette, this must be done before copying bits
 550     FillChar(LogPalette, SizeOf(LogPalette), 0);
 551     LogPalette.palVersion := $300;
 552     LogPalette.palNumEntries := Info.PaletteEntries;
 553     for I := 0 to Info.PaletteEntries - 1 do
 554     with LogPalette do
 555     begin
 556       palPalEntry[I].peRed := WorkData.Palette[I].R;
 557       palPalEntry[I].peGreen := WorkData.Palette[I].G;
 558       palPalEntry[I].peBlue := WorkData.Palette[I].B;
 559     end;
 560     Bitmap.Palette := CreatePalette(PLogPalette(@LogPalette)^);
 561   end;
 562   // Copy scanlines
 563   for I := 0 to WorkData.Height - 1 do
 564     Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
 565
 566   // Delphi 2009 and newer support alpha transparency fro TBitmap
 567 {$IF Defined(DELPHI) and (CompilerVersion >= 20.0)}
 568   if Bitmap.PixelFormat = pf32bit then
 569     Bitmap.AlphaFormat := afDefined;
 570 {$IFEND}
 571
 572 {$ENDIF}
 573 {$IFDEF COMPONENT_SET_LCL}
 574   // Create 32bit raw image from image data
 575   FillChar(RawImage, SizeOf(RawImage), 0);
 576   with RawImage.Description do
 577   begin
 578     Width := WorkData.Width;
 579     Height := WorkData.Height;
 580     BitsPerPixel := 32;
 581     Format := ricfRGBA;
 582     LineEnd := rileDWordBoundary;
 583     BitOrder := riboBitsInOrder;
 584     ByteOrder := riboLSBFirst;
 585     LineOrder := riloTopToBottom;
 586     AlphaPrec := 8;
 587     RedPrec := 8;
 588     GreenPrec := 8;
 589     BluePrec := 8;
 590     AlphaShift := 24;
 591     RedShift := 16;
 592     GreenShift := 8;
 593     BlueShift := 0;
 594     Depth := 32; // Must be 32 for alpha blending (and for working in MacOSX Carbon)
 595   end;
 596   RawImage.Data := WorkData.Bits;
 597   RawImage.DataSize := WorkData.Size;
 598
 599   // Create bitmap from raw image
 600   if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle) then
 601   begin
 602     Bitmap.Handle := ImgHandle;
 603     Bitmap.MaskHandle := ImgMaskHandle;
 604   end;
 605 {$ENDIF}
 606   if WorkData.Bits <> Data.Bits then
 607     Imaging.FreeImage(WorkData);
 608 end;
 609
 610 procedure ConvertBitmapToData(Bitmap: TBitmap; var Data: TImageData);
 611 var
 612   I, LineBytes: LongInt;
 613   Format: TImageFormat;
 614   Info: TImageFormatInfo;
 615 {$IFDEF COMPONENT_SET_VCL}
 616   Colors: Word;
 617   LogPalette: TMaxLogPalette;
 618 {$ENDIF}
 619 {$IFDEF COMPONENT_SET_LCL}
 620   RawImage: TRawImage;
 621   LineLazBytes: LongInt;
 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).
 631
 632   if RawImage_DescriptionFromBitmap(Bitmap.Handle, RawImage.Description) then
 633     case RawImage.Description.BitsPerPixel of
 634       8: Format := ifIndex8;
 635       16:
 636         if RawImage.Description.Depth = 15 then
 637           Format := ifA1R5G5B5
 638         else
 639           Format := ifR5G6B5;
 640       24: Format := ifR8G8B8;
 641       32: Format := ifA8R8G8B8;
 642       48: Format := ifR16G16B16;
 643       64: Format := ifA16R16G16B16;
 644     else
 645       Format := ifUnknown;
 646     end;
 647 {$ELSE}
 648   Format := PixelFormatToDataFormat(Bitmap.PixelFormat);
 649   if Format = ifUnknown then
 650   begin
 651     // Convert from formats not supported by Imaging (1/4 bit)
 652     if Bitmap.PixelFormat < pf8bit then
 653        Bitmap.PixelFormat := pf8bit
 654     else
 655       Bitmap.PixelFormat := pf32bit;
 656     Format := PixelFormatToDataFormat(Bitmap.PixelFormat);
 657   end;
 658 {$ENDIF}
 659
 660   if Format = ifUnknown then
 661     RaiseImaging(SBadFormatBitmapToData, []);
 662
 663   Imaging.NewImage(Bitmap.Width, Bitmap.Height, Format, Data);
 664   GetImageFormatInfo(Data.Format, Info);
 665   LineBytes := Data.Width * Info.BytesPerPixel;
 666
 667 {$IFDEF COMPONENT_SET_VCL}
 668   if (Format = ifIndex8) and (GetObject(Bitmap.Palette, SizeOf(Colors),
 669     @Colors) <> 0) then
 670   begin
 671     // Copy palette
 672     GetPaletteEntries(Bitmap.Palette, 0, Colors, LogPalette.palPalEntry);
 673     if Colors > Info.PaletteEntries  then
 674       Colors := Info.PaletteEntries;
 675     for I := 0 to Colors - 1 do
 676     with LogPalette do
 677     begin
 678       Data.Palette[I].A := $FF;
 679       Data.Palette[I].R := palPalEntry[I].peRed;
 680       Data.Palette[I].G := palPalEntry[I].peGreen;
 681       Data.Palette[I].B := palPalEntry[I].peBlue;
 682     end;
 683   end;
 684   // Copy scanlines
 685   for I := 0 to Data.Height - 1 do
 686     Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
 687 {$ENDIF}
 688 {$IFDEF COMPONENT_SET_LCL}
 689   // Get raw image from bitmap (mask handle must be 0 or expect violations)
 690   if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then
 691   begin
 692     LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel,
 693       RawImage.Description.LineEnd);
 694     // Copy scanlines
 695     for I := 0 to Data.Height - 1 do
 696       Move(PByteArray(RawImage.Data)[I * LineLazBytes],
 697         PByteArray(Data.Bits)[I * LineBytes], LineBytes);
 698     { If you get complitation error here upgrade to Lazarus 0.9.24+ }
 699     RawImage.FreeData;
 700   end;
 701 {$ENDIF}
 702 end;
 703
 704 procedure ConvertImageToBitmap(Image: TBaseImage; Bitmap: TBitmap);
 705 begin
 706   ConvertDataToBitmap(Image.ImageDataPointer^, Bitmap);
 707 end;
 708
 709 procedure ConvertBitmapToImage(Bitmap: TBitmap; Image: TBaseImage);
 710 begin
 711   ConvertBitmapToData(Bitmap, Image.ImageDataPointer^);
 712 end;
 713
 714 {$IFDEF MSWINDOWS}
 715 procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
 716 var
 717   OldMode: Integer;
 718   BitmapInfo: Windows.TBitmapInfo;
 719   Bmp: TBitmap;
 720 begin
 721   if TestImage(ImageData) then
 722   begin
 723     Assert(ImageData.Format in [ifA8R8G8B8, ifX8R8G8B8], SBadFormatDisplay);
 724     OldMode := Windows.SetStretchBltMode(DC, COLORONCOLOR);
 725
 726     FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
 727     with BitmapInfo.bmiHeader do
 728     begin
 729       biSize := SizeOf(TBitmapInfoHeader);
 730       biPlanes := 1;
 731       biBitCount := 32;
 732       biCompression := BI_RGB;
 733       biWidth := ImageData.Width;
 734       biHeight := -ImageData.Height;
 735       biSizeImage := ImageData.Size;
 736       biXPelsPerMeter := 0;
 737       biYPelsPerMeter := 0;
 738       biClrUsed := 0;
 739       biClrImportant := 0;
 740     end;
 741
 742     try
 743        with SrcRect, ImageData do
 744         if Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top,
 745           DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, Left,
 746           Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY) <> Height then
 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.
 750           Bmp := TBitmap.Create;
 751           try
 752             ConvertDataToBitmap(ImageData, Bmp);
 753             StretchBlt(DC, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top,
 754               Bmp.Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
 755           finally
 756             Bmp.Free;
 757           end;
 758         end;
 759     finally
 760       Windows.SetStretchBltMode(DC, OldMode);
 761     end;
 762   end;
 763 end;
 764 {$ENDIF}
 765
 766 procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
 767 {$IF Defined(DCC) or Defined(LCLWIN32)} // Delphi or LCL Win32
 768 begin
 769   DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
 770 end;
 771 {$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}
 772
 773   procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
 774     SrcWidth, SrcHeight: Integer; ImageData: TImageData);
 775   var
 776     P: TPoint;
 777   begin
 778     P := TGtkDeviceContext(Dest).Offset;
 779     Inc(DstX, P.X);
 780     Inc(DstY, P.Y);
 781     gdk_draw_rgb_32_image(TGtkDeviceContext(Dest).Drawable, TGtkDeviceContext(Dest).GC,
 782       DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
 783       @PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4);
 784   end;
 785
 786 var
 787   DisplayImage: TImageData;
 788   NewWidth, NewHeight: Integer;
 789   SrcBounds, DstBounds, DstClip: TRect;
 790 begin
 791   if TestImage(ImageData) then
 792   begin
 793     Assert(ImageData.Format in [ifA8R8G8B8, ifX8R8G8B8], SBadFormatDisplay);
 794     InitImage(DisplayImage);
 795
 796     SrcBounds := RectToBounds(SrcRect);
 797     DstBounds := RectToBounds(DstRect);
 798     WidgetSet.GetClipBox(DstCanvas.Handle, @DstClip);
 799
 800     ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom,
 801       DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, ImageData.Width,
 802       ImageData.Height, DstClip);
 803
 804     NewWidth := DstBounds.Right;
 805     NewHeight := DstBounds.Bottom;
 806
 807     if (NewWidth > 0) and (NewHeight > 0) then
 808     begin
 809       if (SrcBounds.Right = NewWidth) and (SrcBounds.Bottom = NewHeight) then
 810       try
 811         CloneImage(ImageData, DisplayImage);
 812         // Swap R-B channels for GTK display compatability!
 813         SwapChannels(DisplayImage, ChannelRed, ChannelBlue);
 814         GDKDrawBitmap(DstCanvas.Handle, DstBounds.Left, DstBounds.Top,
 815           SrcBounds.Left, SrcBounds.Top, NewWidth, NewHeight, DisplayImage);
 816       finally
 817         FreeImage(DisplayImage);
 818       end
 819       else
 820       try
 821         // Create new image with desired dimensions
 822         NewImage(NewWidth, NewHeight, ImageData.Format, DisplayImage);
 823         // Stretch pixels from old image to new one  TResizeFilter = (rfNearest, rfBilinear, rfBicubic);
 824         StretchRect(ImageData, SrcBounds.Left, SrcBounds.Top, SrcBounds.Right,
 825           SrcBounds.Bottom, DisplayImage, 0, 0, NewWidth, NewHeight, rfNearest);
 826         // Swap R-B channels for GTK display compatability!
 827         SwapChannels(DisplayImage, ChannelRed, ChannelBlue);
 828         GDKDrawBitmap(DstCanvas.Handle, DstBounds.Left, DstBounds.Top, 0, 0,
 829           NewWidth, NewHeight, DisplayImage);
 830        finally
 831         FreeImage(DisplayImage);
 832       end
 833     end;
 834   end;
 835 end;
 836 {$ELSE}
 837 begin
 838   raise Exception.Create(SUnsupportedLCLWidgetSet);
 839 end;
 840 {$IFEND}
 841
 842 procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage);
 843 begin
 844   DisplayImageData(DstCanvas, BoundsToRect(DstX, DstY, Image.Width, Image.Height),
 845     Image.ImageDataPointer^, Image.BoundsRect);
 846 end;
 847
 848 procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage);
 849 begin
 850   DisplayImageData(DstCanvas, DstRect, Image.ImageDataPointer^, Image.BoundsRect);
 851 end;
 852
 853 procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage; const SrcRect: TRect);
 854 begin
 855   DisplayImageData(DstCanvas, DstRect, Image.ImageDataPointer^, SrcRect);
 856 end;
 857
 858
 859 { TImagingGraphic class implementation }
 860
 861 constructor TImagingGraphic.Create;
 862 begin
 863   inherited Create;
 864   PixelFormat := pf24Bit;
 865 end;
 866
 867 procedure TImagingGraphic.LoadFromStream(Stream: TStream);
 868 begin
 869   ReadDataFromStream(Stream);
 870 end;
 871
 872 procedure TImagingGraphic.ReadDataFromStream(Stream: TStream);
 873 var
 874   Image: TSingleImage;
 875 begin
 876   Image := TSingleImage.Create;
 877   try
 878     Image.LoadFromStream(Stream);
 879     Assign(Image);
 880   finally
 881     Image.Free;
 882   end;
 883 end;
 884
 885 procedure TImagingGraphic.AssignTo(Dest: TPersistent);
 886 var
 887   Arr: TDynImageDataArray;
 888 begin
 889   if Dest is TSingleImage then
 890   begin
 891     AssignToImage(TSingleImage(Dest))
 892   end
 893   else if Dest is TMultiImage then
 894   begin
 895     SetLength(Arr, 1);
 896     AssignToImageData(Arr[0]);
 897     TMultiImage(Dest).CreateFromArray(Arr);
 898     Imaging.FreeImagesInArray(Arr);
 899   end
 900   else
 901     inherited AssignTo(Dest);
 902 end;
 903
 904 procedure TImagingGraphic.Assign(Source: TPersistent);
 905 begin
 906   if Source is TBaseImage then
 907     AssignFromImage(TBaseImage(Source))
 908   else
 909     inherited Assign(Source);
 910 end;
 911
 912 procedure TImagingGraphic.AssignFromImage(Image: TBaseImage);
 913 begin
 914   if (Image <> nil) and Image.Valid then
 915     AssignFromImageData(Image.ImageDataPointer^);
 916 end;
 917
 918 procedure TImagingGraphic.AssignToImage(Image: TBaseImage);
 919 begin
 920   if (Image <> nil) and (Image.ImageDataPointer <> nil) then
 921     AssignToImageData(Image.ImageDataPointer^);
 922 end;
 923
 924 procedure TImagingGraphic.AssignFromImageData(const ImageData: TImageData);
 925 begin
 926   if Imaging.TestImage(ImageData) then
 927     ConvertDataToBitmap(ImageData, Self);
 928 end;
 929
 930 procedure TImagingGraphic.AssignToImageData(var ImageData: TImageData);
 931 begin
 932   Imaging.FreeImage(ImageData);
 933   ConvertBitmapToData(Self, ImageData);
 934 end;
 935
 936
 937 { TImagingGraphicForSave class implementation }
 938
 939 constructor TImagingGraphicForSave.Create;
 940 begin
 941   inherited Create;
 942   FDefaultFileExt := GetFileFormat.Extensions[0];
 943   FSavingFormat := ifUnknown;
 944   GetFileFormat.CheckOptionsValidity;
 945 end;
 946
 947 procedure TImagingGraphicForSave.WriteDataToStream(Stream: TStream);
 948 var
 949   Image: TSingleImage;
 950 begin
 951   if FDefaultFileExt <> '' then
 952   begin
 953     Image := TSingleImage.Create;
 954     try
 955       Image.Assign(Self);
 956       if FSavingFormat <> ifUnknown then
 957         Image.Format := FSavingFormat;
 958       Image.SaveToStream(FDefaultFileExt, Stream);
 959     finally
 960       Image.Free;
 961     end;
 962   end;
 963 end;
 964
 965 procedure TImagingGraphicForSave.SaveToStream(Stream: TStream);
 966 begin
 967   WriteDataToStream(Stream);
 968 end;
 969
 970 {$IFDEF COMPONENT_SET_LCL}
 971 class function TImagingGraphicForSave.GetFileExtensions: string;
 972 begin
 973   Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]);
 974 end;
 975
 976 function TImagingGraphicForSave.GetMimeType: string;
 977 begin
 978   Result := 'image/' + FDefaultFileExt;
 979 end;
 980 {$ENDIF}
 981
 982 {$IFNDEF DONT_LINK_BITMAP}
 983
 984 { TImagingBitmap class implementation }
 985
 986 constructor TImagingBitmap.Create;
 987 begin
 988   inherited Create;
 989   FUseRLE := (GetFileFormat as TBitmapFileFormat).UseRLE;
 990 end;
 991
 992 class function TImagingBitmap.GetFileFormat: TImageFileFormat;
 993 begin
 994   Result := FindImageFileFormatByClass(TBitmapFileFormat);
 995 end;
 996
 997 procedure TImagingBitmap.SaveToStream(Stream: TStream);
 998 begin
 999   Imaging.PushOptions;
1000   Imaging.SetOption(ImagingBitmapRLE, Ord(FUseRLE));
1001   inherited SaveToStream(Stream);
1002   Imaging.PopOptions;
1003 end;
1004 {$ENDIF}
1005
1006 {$IFNDEF DONT_LINK_JPEG}
1007
1008 { TImagingJpeg class implementation }
1009
1010 constructor TImagingJpeg.Create;
1011 begin
1012   inherited Create;
1013   FQuality := (GetFileFormat as TJpegFileFormat).Quality;
1014   FProgressive := (GetFileFormat as TJpegFileFormat).Progressive;
1015 end;
1016
1017 class function TImagingJpeg.GetFileFormat: TImageFileFormat;
1018 begin
1019   Result := FindImageFileFormatByClass(TJpegFileFormat);
1020 end;
1021
1022 {$IFDEF COMPONENT_SET_LCL}
1023 function TImagingJpeg.GetMimeType: string;
1024 begin
1025   Result := 'image/jpeg';
1026 end;
1027 {$ENDIF}
1028
1029 procedure TImagingJpeg.SaveToStream(Stream: TStream);
1030 begin
1031   Imaging.PushOptions;
1032   Imaging.SetOption(ImagingJpegQuality, FQuality);
1033   Imaging.SetOption(ImagingJpegProgressive, Ord(FProgressive));
1034   inherited SaveToStream(Stream);
1035   Imaging.PopOptions;
1036 end;
1037
1038 {$ENDIF}
1039
1040 {$IFNDEF DONT_LINK_PNG}
1041
1042 { TImagingPNG class implementation }
1043
1044 constructor TImagingPNG.Create;
1045 begin
1046   inherited Create;
1047   FPreFilter := (GetFileFormat as TPNGFileFormat).PreFilter;
1048   FCompressLevel := (GetFileFormat as TPNGFileFormat).CompressLevel;
1049 end;
1050
1051 class function TImagingPNG.GetFileFormat: TImageFileFormat;
1052 begin
1053   Result := FindImageFileFormatByClass(TPNGFileFormat);
1054 end;
1055
1056 procedure TImagingPNG.SaveToStream(Stream: TStream);
1057 begin
1058   Imaging.PushOptions;
1059   Imaging.SetOption(ImagingPNGPreFilter, FPreFilter);
1060   Imaging.SetOption(ImagingPNGCompressLevel, FCompressLevel);
1061   inherited SaveToStream(Stream);
1062   Imaging.PopOptions;
1063 end;
1064 {$ENDIF}
1065
1066 {$IFNDEF DONT_LINK_GIF}
1067
1068 { TImagingGIF class implementation}
1069
1070 class function TImagingGIF.GetFileFormat: TImageFileFormat;
1071 begin
1072   Result := FindImageFileFormatByClass(TGIFFileFormat);
1073 end;
1074
1075 {$ENDIF}
1076
1077 {$IFNDEF DONT_LINK_TARGA}
1078
1079 { TImagingTarga class implementation }
1080
1081 constructor TImagingTarga.Create;
1082 begin
1083   inherited Create;
1084   FUseRLE := (GetFileFormat as TTargaFileFormat).UseRLE;
1085 end;
1086
1087 class function TImagingTarga.GetFileFormat: TImageFileFormat;
1088 begin
1089   Result := FindImageFileFormatByClass(TTargaFileFormat);
1090 end;
1091
1092 procedure TImagingTarga.SaveToStream(Stream: TStream);
1093 begin
1094   Imaging.PushOptions;
1095   Imaging.SetOption(ImagingTargaRLE, Ord(FUseRLE));
1096   inherited SaveToStream(Stream);
1097   Imaging.PopOptions;
1098 end;
1099 {$ENDIF}
1100
1101 {$IFNDEF DONT_LINK_DDS}
1102
1103 { TImagingDDS class implementation }
1104
1105 constructor TImagingDDS.Create;
1106 begin
1107   inherited Create;
1108   FCompression := dcNone;
1109 end;
1110
1111 class function TImagingDDS.GetFileFormat: TImageFileFormat;
1112 begin
1113   Result := FindImageFileFormatByClass(TDDSFileFormat);
1114 end;
1115
1116 procedure TImagingDDS.SaveToStream(Stream: TStream);
1117 begin
1118   case FCompression of
1119     dcNone: FSavingFormat := ifUnknown;
1120     dcDXT1: FSavingFormat := ifDXT1;
1121     dcDXT3: FSavingFormat := ifDXT3;
1122     dcDXT5: FSavingFormat := ifDXT5;
1123   end;
1124   Imaging.PushOptions;
1125   Imaging.SetOption(ImagingDDSSaveCubeMap, Ord(False));
1126   Imaging.SetOption(ImagingDDSSaveVolume, Ord(False));
1127   Imaging.SetOption(ImagingDDSSaveMipMapCount, 1);
1128   Imaging.SetOption(ImagingDDSSaveDepth, 1);
1129   inherited SaveToStream(Stream);
1130   Imaging.PopOptions;
1131 end;
1132 {$ENDIF}
1133
1134 {$IFNDEF DONT_LINK_MNG}
1135
1136 { TImagingMNG class implementation }
1137
1138 constructor TImagingMNG.Create;
1139 begin
1140   inherited Create;
1141   FLossyCompression := (GetFileFormat as TMNGFileFormat).LossyCompression;
1142   FLossyAlpha := (GetFileFormat as TMNGFileFormat).LossyAlpha;
1143   FPreFilter := (GetFileFormat as TMNGFileFormat).PreFilter;
1144   FCompressLevel := (GetFileFormat as TMNGFileFormat).CompressLevel;
1145   FQuality := (GetFileFormat as TMNGFileFormat).Quality;
1146   FProgressive := (GetFileFormat as TMNGFileFormat).Progressive;
1147 end;
1148
1149 class function TImagingMNG.GetFileFormat: TImageFileFormat;
1150 begin
1151   Result := FindImageFileFormatByClass(TMNGFileFormat);
1152 end;
1153
1154 {$IFDEF COMPONENT_SET_LCL}
1155 function TImagingMNG.GetMimeType: string;
1156 begin
1157   Result := 'video/mng';
1158 end;
1159 {$ENDIF}
1160
1161 procedure TImagingMNG.SaveToStream(Stream: TStream);
1162 begin
1163   Imaging.PushOptions;
1164   Imaging.SetOption(ImagingMNGLossyCompression, Ord(FLossyCompression));
1165   Imaging.SetOption(ImagingMNGLossyAlpha, Ord(FLossyAlpha));
1166   Imaging.SetOption(ImagingMNGPreFilter, FPreFilter);
1167   Imaging.SetOption(ImagingMNGCompressLevel, FCompressLevel);
1168   Imaging.SetOption(ImagingMNGQuality, FQuality);
1169   Imaging.SetOption(ImagingMNGProgressive, Ord(FProgressive));
1170   inherited SaveToStream(Stream);
1171   Imaging.PopOptions;
1172 end;
1173 {$ENDIF}
1174
1175 {$IFNDEF DONT_LINK_JNG}
1176
1177 { TImagingJNG class implementation }
1178
1179 constructor TImagingJNG.Create;
1180 begin
1181   inherited Create;
1182   FLossyAlpha := (GetFileFormat as TJNGFileFormat).LossyAlpha;
1183   FAlphaPreFilter := (GetFileFormat as TJNGFileFormat).PreFilter;
1184   FAlphaCompressLevel := (GetFileFormat as TJNGFileFormat).CompressLevel;
1185   FQuality := (GetFileFormat as TJNGFileFormat).Quality;
1186   FProgressive := (GetFileFormat as TJNGFileFormat).Progressive;
1187 end;
1188
1189 class function TImagingJNG.GetFileFormat: TImageFileFormat;
1190 begin
1191   Result := FindImageFileFormatByClass(TJNGFileFormat);
1192 end;
1193
1194 procedure TImagingJNG.SaveToStream(Stream: TStream);
1195 begin
1196   Imaging.PushOptions;
1197   Imaging.SetOption(ImagingJNGLossyALpha, Ord(FLossyAlpha));
1198   Imaging.SetOption(ImagingJNGAlphaPreFilter, FAlphaPreFilter);
1199   Imaging.SetOption(ImagingJNGAlphaCompressLevel, FAlphaCompressLevel);
1200   Imaging.SetOption(ImagingJNGQuality, FQuality);
1201   Imaging.SetOption(ImagingJNGProgressive, Ord(FProgressive));
1202   inherited SaveToStream(Stream);
1203   Imaging.PopOptions;
1204 end;
1205 {$ENDIF}
1206
1207 initialization
1208   RegisterTypes;
1209 finalization
1210   UnRegisterTypes;
1211
1212 {$IFEND} // {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
1213
1214 {
1215   File Notes:
1216
1217   -- TODOS ----------------------------------------------------
1218     - nothing now
1219
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).
1225
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.
1235
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.
1243
1244   -- 0.23 Changes/Bug Fixes -----------------------------------
1245     - Added TImagingGIF.
1246
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.
1253
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
1259
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
1264
1265   -- 0.15 Changes/Bug Fixes -----------------------------------
1266     - made it LCL compatible
1267     - made it CLX compatible
1268     - added all initial stuff
1269 }
1270
1271 end.