Vampyre Imaging Library updated to latest HEAD

[d2df-sdl.git] / src / lib / vampimg / ImagingComponents.pas

diff --git a/src/lib/vampimg/ImagingComponents.pas b/src/lib/vampimg/ImagingComponents.pas
index 3945362ad51f08bda9b01182cfaa8bcd6b100a7e..61451fe8a16ff8e2dbc6738dd4ad7611335a8c39 100644 (file)
--- a/src/lib/vampimg/ImagingComponents.pas
+++ b/src/lib/vampimg/ImagingComponents.pas
@@ -1,5 +1,4 @@
 {
-  $Id: ImagingComponents.pas 171 2009-09-02 01:34:19Z galfar $
   Vampyre Imaging Library
   by Marek Mauder
   http://imaginglib.sourceforge.net
@@ -36,6 +35,7 @@ interface
 
 {$IFDEF LCL}
   {$DEFINE COMPONENT_SET_LCL}
+  {$UNDEF COMPONENT_SET_VCL}
 {$ENDIF}
 
 {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
@@ -336,9 +336,7 @@ implementation
 uses
 {$IF Defined(LCL)}
   {$IF Defined(LCLGTK2)}
-    GLib2, GDK2, GTK2, GTKDef, GTKProc,
-  {$ELSEIF Defined(LCLGTK)}
-    GDK, GTK, GTKDef, GTKProc,
+    GLib2, GDK2, GTK2, GTK2Def, GTK2Proc,
   {$IFEND}
 {$IFEND}
 {$IFNDEF DONT_LINK_BITMAP}
@@ -359,7 +357,7 @@ uses
 {$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
   ImagingNetworkGraphics,
 {$IFEND}
-  ImagingUtility;
+  ImagingFormats, ImagingUtility;
 
 resourcestring
   SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
@@ -509,6 +507,14 @@ var
 begin
   PF := DataFormatToPixelFormat(Data.Format);
   GetImageFormatInfo(Data.Format, Info);
+
+  if (PF = pf8bit) and PaletteHasAlpha(Data.Palette, Info.PaletteEntries) then
+  begin
+    // Some indexed images may have valid alpha data, dont lose it!
+    // (e.g. transparent 8bit PNG or GIF images)
+    PF := pfCustom;
+  end;
+
   if PF = pfCustom then
   begin
     // Convert from formats not supported by Graphics unit
@@ -517,6 +523,7 @@ begin
     if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
       Imaging.ConvertImage(WorkData, ifA8R8G8B8)
     else
+    begin
 {$IFDEF COMPONENT_SET_VCL}
       if Info.IsIndexed or Info.HasGrayChannel then
         Imaging.ConvertImage(WorkData, ifIndex8)
@@ -527,6 +534,7 @@ begin
 {$ELSE}
         Imaging.ConvertImage(WorkData, ifA8R8G8B8);
 {$ENDIF}
+    end;
 
     PF := DataFormatToPixelFormat(WorkData.Format);
     GetImageFormatInfo(WorkData.Format, Info);
@@ -693,9 +701,14 @@ begin
       RawImage.Description.LineEnd);
     // Copy scanlines
     for I := 0 to Data.Height - 1 do
+    begin
       Move(PByteArray(RawImage.Data)[I * LineLazBytes],
         PByteArray(Data.Bits)[I * LineBytes], LineBytes);
-    { If you get complitation error here upgrade to Lazarus 0.9.24+ }
+    end;
+    // May need to swap RB order, depends on wifget set
+    if RawImage.Description.BlueShift > RawImage.Description.RedShift then
+      SwapChannels(Data, ChannelRed, ChannelBlue);
+
     RawImage.FreeData;
   end;
 {$ENDIF}
@@ -768,17 +781,19 @@ procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const Image
 begin
   DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
 end;
-{$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}
+{$ELSEIF Defined(LCLGTK2)}
+  type
+    TDeviceContext = TGtk2DeviceContext;
 
   procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
     SrcWidth, SrcHeight: Integer; ImageData: TImageData);
   var
     P: TPoint;
   begin
-    P := TGtkDeviceContext(Dest).Offset;
+    P := TDeviceContext(Dest).Offset;
     Inc(DstX, P.X);
     Inc(DstY, P.Y);
-    gdk_draw_rgb_32_image(TGtkDeviceContext(Dest).Drawable, TGtkDeviceContext(Dest).GC,
+    gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
       DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
       @PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4);
   end;
@@ -1217,6 +1232,16 @@ finalization
   -- TODOS ----------------------------------------------------
     - nothing now
 
+  -- 0.77.1 ---------------------------------------------------
+    - Fixed bug in ConvertBitmapToData causing images from GTK2 bitmaps
+      to have swapped RB channels.
+    - LCL: Removed GTK1 support (deprecated).
+
+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Transparency of 8bit images (like loaded from 8bit PNG or GIF) is
+      kept intact during conversion to TBitmap in ConvertDataToBitmap
+      (32bit bitmap is created).
+
   -- 0.26.3 Changes/Bug Fixes ---------------------------------
     - Setting AlphaFormat property of TBitmap in ConvertDataToBitmap
       when using Delphi 2009+.