- Updated Vampyre Imaging Lib

- Added font rendering - Added height display in flat mode
2009-12-05 17:26:22 +01:00 · 2009-12-05 17:26:22 +01:00 · be3f8c05df
parent a5128b0d05
commit be3f8c05df
40 changed files with 34488 additions and 32762 deletions
--- a/Client/CentrED.lpi
+++ b/Client/CentrED.lpi
@ -56,7 +56,7 @@
        <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
      </Item5>
    </RequiredPackages>
-    <Units Count="35">
+    <Units Count="36">
      <Unit0>
        <Filename Value="CentrED.lpr"/>
        <IsPartOfProject Value="True"/>
@ -273,6 +273,11 @@
        <IsPartOfProject Value="True"/>
        <UnitName Value="UTiledata"/>
      </Unit34>
+      <Unit35>
+        <Filename Value="UGLFont.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UGLFont"/>
+      </Unit35>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
--- a/Client/CentrED.lpr
+++ b/Client/CentrED.lpr
@ -40,7 +40,7 @@ uses
  UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
  UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
  UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
-  Logging, UMap, UWorldItem, UStatics, UTiledata;
+  Logging, UMap, UWorldItem, UStatics, UTiledata, UGLFont;

 {$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}

--- a/Client/GLFont/DejaVu.fnt
+++ b/Client/GLFont/DejaVu.fnt
--- a/Client/GLFont/DejaVu.png
+++ b/Client/GLFont/DejaVu.png
--- a/Client/ResourceList.txt
+++ b/Client/ResourceList.txt
@ -1,3 +1,5 @@
 Overlay/LeftTopArrow.tga
 Overlay/TopArrow.tga
 Overlay/VirtualLayer.tga
+GLFont/DejaVu.png
+GLFont/DejaVu.fnt
--- a/Client/UGLFont.pas
+++ b/Client/UGLFont.pas
@ -0,0 +1,205 @@
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+unit UGLFont;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math, ImagingClasses, ImagingTypes, ImagingOpenGL, GL;
+
+type
+
+  TFontInfo = packed record
+    Character: Char;
+    LeftOffset: SmallInt;
+    CharWidth: Word;
+    Width: Word;
+    Height: Word;
+    X1: Single;
+    Y1: Single;
+    X2: Single;
+    Y2: Single;
+  end;
+
+  { TGLFont }
+
+  TGLFont = class
+    constructor Create;
+    destructor Destroy; override;
+  protected
+    FFontImage: TSingleImage;
+    FFontTexture: TGLuint;
+    FSpaceWidth: Word;
+    FFontInfo: array of TFontInfo;
+    function FindCharInfo(AChar: Char): Integer;
+  public
+    function GetTextHeight(AText: String): Integer;
+    function GetTextWidth(AText: String): Integer;
+    procedure DrawText(AX, AY: Integer; AText: String);
+    procedure LoadImage(AImage: TStream);
+    procedure LoadFontInfo(AFontInfo: TStream);
+    procedure UpdateTexture;
+  end;
+
+implementation
+
+uses
+  Logging;
+
+{ TGLFont }
+
+
+constructor TGLFont.Create;
+begin
+  FFontTexture := 0;
+end;
+
+destructor TGLFont.Destroy;
+begin
+  FreeAndNil(FFontImage);
+  if FFontTexture <> 0 then
+    glDeleteTextures(1, @FFontTexture);
+  inherited Destroy;
+end;
+
+function TGLFont.FindCharInfo(AChar: Char): Integer;
+var
+  i: Integer;
+begin
+  Result := -1;
+  i := 0;
+  while (i < Length(FFontInfo)) and (Result = -1) do
+  begin
+    if FFontInfo[i].Character = AChar then
+      Result := i
+    else
+      Inc(i);
+  end;
+end;
+
+function TGLFont.GetTextHeight(AText: String): Integer;
+var
+  i, charInfo: Integer;
+begin
+  Result := 0;
+  for i := 1 to Length(AText) do
+  begin
+    if AText[i] <> ' ' then
+    begin
+      charInfo := FindCharInfo(AText[i]);
+      if charInfo > -1 then
+        Result := Max(Result, FFontInfo[charInfo].Height);
+    end;
+  end;
+end;
+
+function TGLFont.GetTextWidth(AText: String): Integer;
+var
+  i, charInfo: Integer;
+begin
+  Result := 0;
+  for i := 1 to Length(AText) do
+  begin
+    if AText[i] = ' ' then
+      Inc(Result, FSpaceWidth)
+    else
+    begin
+      charInfo := FindCharInfo(AText[i]);
+      if charInfo > -1 then
+        Result := Result + FFontInfo[charInfo].LeftOffset +
+          FFontInfo[charInfo].CharWidth;
+    end;
+  end;
+end;
+
+procedure TGLFont.DrawText(AX, AY: Integer; AText: String);
+var
+  i, charInfo: Integer;
+  curX: Integer;
+  x1, y1, x2, y2: Single;
+begin
+  if FFontTexture = 0 then UpdateTexture;
+  glBindTexture(GL_TEXTURE_2D, FFontTexture);
+
+  curX := AX;
+  for i := 1 to Length(AText) do
+  begin
+    if AText[i] = ' ' then
+      Inc(curX, FSpaceWidth)
+    else
+    begin
+      charInfo := FindCharInfo(AText[i]);
+      if charInfo > -1 then
+      begin
+        x1 := FFontInfo[charInfo].X1;
+        y1 := FFontInfo[charInfo].Y1;
+        x2 := FFontInfo[charInfo].X2;
+        y2 := FFontInfo[charInfo].Y2;
+
+        Inc(curX, FFontInfo[charInfo].LeftOffset);
+        glBegin(GL_QUADS);
+          glTexCoord2f(x1, y1); glVertex2i(curX, AY);
+          glTexCoord2f(x2, y1); glVertex2i(curX + FFontInfo[charInfo].Width, AY);
+          glTexCoord2f(x2, y2); glVertex2i(curX + FFontInfo[charInfo].Width,
+                                           AY + FFontInfo[charInfo].Height);
+          glTexCoord2f(x1, y2); glVertex2i(curX, AY + FFontInfo[charInfo].Height);
+        glEnd;
+        Inc(curX, FFontInfo[charInfo].CharWidth);
+      end;
+    end;
+  end;
+end;
+
+procedure TGLFont.LoadImage(AImage: TStream);
+begin
+  FFontImage := TSingleImage.CreateFromStream(AImage);
+end;
+
+procedure TGLFont.LoadFontInfo(AFontInfo: TStream);
+begin
+  AFontInfo.Read(FSpaceWidth, SizeOf(FSpaceWidth));
+  SetLength(FFontInfo, (AFontInfo.Size - AFontInfo.Position) div
+    SizeOf(TFontInfo));
+  AFontInfo.Read(FFontInfo[0], Length(FFontInfo) * SizeOf(TFontInfo));
+end;
+
+procedure TGLFont.UpdateTexture;
+begin
+  Logger.Send('UpdateTexture');
+  if FFontTexture <> 0 then glDeleteTextures(1, @FFontTexture);
+
+  FFontTexture := CreateGLTextureFromImage(FFontImage.ImageDataPointer^, 0, 0,
+    True, ifUnknown);
+  glBindTexture(GL_TEXTURE_2D, FFontTexture);
+  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
+end;
+
+end.
+
--- a/Client/ULandscape.pas
+++ b/Client/ULandscape.pas
@ -30,11 +30,11 @@ unit ULandscape;
 interface

 uses
-  SysUtils, Classes, math, LCLIntf, GL, GLU, ImagingOpenGL, Imaging,
+  SysUtils, Classes, math, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
  ImagingClasses, ImagingTypes, ImagingUtility,
  UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
  UMulBlock,
-  UVector, UEnhancedMemoryStream,
+  UVector, UEnhancedMemoryStream, UGLFont,
  UCacheManager;

 type
@ -196,6 +196,19 @@ type
    procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
  end;

+  { TGLText }
+
+  TGLText = class
+    constructor Create(AFont: TGLFont; AText: String);
+  protected
+    FFont: TGLFont;
+    FText: String;
+    FWidth: Integer;
+    FHeight: Integer;
+  public
+    procedure Render(AScreenRect: TRect);
+  end;
+
  TScreenState = (ssNormal, ssFiltered, ssGhost);

  PBlockInfo = ^TBlockInfo;
@ -212,6 +225,7 @@ type
    HueOverride: Boolean;
    CheckRealQuad: Boolean;
    Translucent: Boolean;
+    Text: TGLText;
    Next: PBlockInfo;
  end;

@ -1213,6 +1227,7 @@ begin
  Result^.State := ssNormal;
  Result^.Highlighted := False;
  Result^.Translucent := False;
+  Result^.Text := nil;
  Result^.Next := nil;

  if FShortCuts[0] = nil then //First element
@ -1239,6 +1254,7 @@ begin
    current^.Item.Locked := False;
    current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
    if current^.Normals <> nil then Dispose(current^.Normals);
+    current^.Text.Free;
    Dispose(current);
    current := next;
  end;
@ -1266,6 +1282,7 @@ begin
      if last <> nil then last^.Next := current^.Next;

      if current^.Normals <> nil then Dispose(current^.Normals);
+      current^.Text.Free;

      Dispose(current);
      Dec(FCount);
@ -1356,6 +1373,7 @@ begin
  Result^.State := ssNormal;
  Result^.Highlighted := False;
  Result^.Translucent := False;
+  Result^.Text := nil;

  if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
  begin
@ -1490,5 +1508,27 @@ begin
  Delete(TWorldItem(ATile));
 end;

+{ TGLText }
+
+constructor TGLText.Create(AFont: TGLFont; AText: String);
+var
+  i: Integer;
+begin
+  FFont := AFont;
+  FText := AText;
+  FWidth := FFont.GetTextWidth(AText);
+  FHeight := FFont.GetTextHeight('A');
+end;
+
+procedure TGLText.Render(AScreenRect: TRect);
+var
+  x, y: Integer;
+  i: Integer;
+begin
+  y := AScreenRect.Top + (AScreenRect.Bottom - AScreenRect.Top - FHeight) div 2;
+  x := AScreenRect.Left + (AScreenRect.Right - AScreenRect.Left - FWidth) div 2;
+  FFont.DrawText(x, y, FText);
+end;
+
 end.

--- a/Client/UResourceManager.pas
+++ b/Client/UResourceManager.pas
@ -21,7 +21,7 @@
 * CDDL HEADER END
 *
 *
- *      Portions Copyright 2007 Andreas Schneider
+ *      Portions Copyright 2009 Andreas Schneider
 *)
 unit UResourceManager;

@ -69,8 +69,8 @@ end;

 destructor TResourceManager.Destroy;
 begin
-  if FFileStream <> nil then FreeAndNil(FFileStream);
-  if FResourceStream <> nil then FreeAndNil(FResourceStream);
+  FreeAndNil(FFileStream);
+  FreeAndNil(FResourceStream);
  inherited Destroy;
 end;

@ -81,7 +81,6 @@ begin
  if AIndex <> FCurrentResource then
  begin
    FFileStream.Position := FLookupTable[AIndex];
-    if FResourceStream <> nil then
    FResourceStream.Free;
    FResourceStream := TMemoryStream.Create;
    FFileStream.Read(size, SizeOf(Cardinal));
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@ -31,10 +31,10 @@ interface

 uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
-  ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
+  ComCtrls, OpenGLContext, GL, GLu, UGameResources, ULandscape, ExtCtrls,
  StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
  LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, fgl,
-  ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket;
+  ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, UGLFont;

 type
  TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@ -269,6 +269,7 @@ type
      Node: PVirtualNode; Stream: TStream);
  protected
    { Members }
+    FAppDir: String;
    FX: Integer;
    FY: Integer;
    FDrawDistance: Integer;
@ -294,6 +295,7 @@ type
    FRepaintNeeded: Boolean;
    FSelection: TRect;
    FUndoList: TPacketList;
+    FGLFont: TGLFont;
    { Methods }
    procedure BuildTileList;
    function  ConfirmAction: Boolean;
@ -784,6 +786,8 @@ var
  virtualLayerGraphic: TSingleImage;
  searchRec: TSearchRec;
 begin
+  FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
+
  FLandscape := ResMan.Landscape;
  FLandscape.OnChange := @OnLandscapeChanged;
  FLandscape.OnMapChanged := @OnMapChanged;
@ -812,8 +816,7 @@ begin
  vstChat.NodeDataSize := SizeOf(TChatInfo);
  pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
  
-  FLocationsFile := IncludeTrailingPathDelimiter(ExtractFilePath(
-                    Application.ExeName)) + 'Locations.dat';
+  FLocationsFile := FAppDir + 'Locations.dat';
  vstLocations.NodeDataSize := SizeOf(TLocationInfo);
  if FileExists(FLocationsFile) then vstLocations.LoadFromFile(FLocationsFile);

@ -824,11 +827,14 @@ begin
    virtualLayerGraphic.Height, virtualLayerGraphic);
  virtualLayerGraphic.Free;

+  FGLFont := TGLFont.Create;
+  FGLFont.LoadImage(ResourceManager.GetResource(3));
+  FGLFont.LoadFontInfo(ResourceManager.GetResource(4));
+
  FVirtualTiles := TWorldItemList.Create(True);
  FUndoList := TPacketList.Create(True);
  
-  FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(
-    Application.ExeName)) + 'RandomPresets' + PathDelim;
+  FRandomPresetLocation := FAppDir + 'RandomPresets' + PathDelim;
  if not DirectoryExists(FRandomPresetLocation) then
    CreateDir(FRandomPresetLocation);

@ -1116,6 +1122,7 @@ begin
  FreeAndNil(FVLayerMaterial);
  FreeAndNil(FVirtualTiles);
  FreeAndNil(FUndoList);
+  FreeAndNil(FGLFont);
  
  RegisterPacketHandler($0C, nil);
 end;
@ -1783,9 +1790,11 @@ procedure TfrmMain.InitSize;
 begin
  glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
  glMatrixMode(GL_PROJECTION);
+  glPushMatrix;
  glLoadIdentity;
  gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
  glMatrixMode(GL_MODELVIEW);
+  glPushMatrix;
  glLoadIdentity;
 end;

@ -1923,6 +1932,10 @@ begin
          CheckRealQuad := True;
        end;
      end;
+    end else
+    begin
+      ABlockInfo^.Text.Free;
+      ABlockInfo^.Text := TGLText.Create(FGLFont, IntToStr(item.Z));
    end;

    if not ABlockInfo^.CheckRealQuad then
@ -2082,6 +2095,9 @@ begin

    if highlight then
      glDisable(GL_COLOR_LOGIC_OP);
+
+    if (blockInfo^.Text <> nil) then
+      blockInfo^.Text.Render(blockInfo^.ScreenRect);
  end;

  FOverlayUI.Draw(oglGameWindow);
--- a/Imaging/Imaging.pas
+++ b/Imaging/Imaging.pas
@ -1,5 +1,5 @@
 {
-  $Id: Imaging.pas 124 2008-04-21 09:47:07Z galfar $
+  $Id: Imaging.pas 173 2009-09-04 17:05:52Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -203,9 +203,8 @@ function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray;
  Pal must be allocated to have at least MaxColors entries.}
 function MakePaletteForImages(var Images: TDynImageDataArray; Pal: PPalette32;
  MaxColors: LongInt; ConvertImages: Boolean): Boolean;
-{ Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.
-  Only multiples of 90 degrees are allowed.}
-function RotateImage(var Image: TImageData; Angle: LongInt): Boolean;
+{ Rotates image by Angle degrees counterclockwise. All angles are allowed.}
+function RotateImage(var Image: TImageData; Angle: Single): Boolean;

 { Drawing/Pixel functions }

@ -303,7 +302,7 @@ function PopOptions: Boolean;
 { Image Format Functions }

 { Returns short information about given image format.}
-function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
+function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean;
 { Returns size in bytes of Width x Height area of pixels. Works for all formats.}
 function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;

@ -534,28 +533,28 @@ procedure RaiseImaging(const Msg: string; const Args: array of const);
 implementation

 uses
-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}
  ImagingBitmap,
 {$ENDIF}
-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}
  ImagingJpeg,
 {$ENDIF}
-{$IF Defined(LINK_PNG) or Defined(LINK_MNG) or Defined(LINK_JNG)}
+{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
  ImagingNetworkGraphics,
 {$IFEND}
-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}
  ImagingGif,
 {$ENDIF}
-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}
  ImagingDds,
 {$ENDIF}
-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}
  ImagingTarga,
 {$ENDIF}
-{$IFDEF LINK_PNM}
+{$IFNDEF DONT_LINK_PNM}
  ImagingPortableMaps,
 {$ENDIF}
-{$IFDEF LINK_EXTRAS}
+{$IFNDEF DONT_LINK_EXTRAS}
  ImagingExtras,
 {$ENDIF}
  ImagingFormats, ImagingUtility, ImagingIO;
@ -606,8 +605,9 @@ resourcestring
  SErrorFreePalette = 'Error while freeing palette @%p';
  SErrorCopyPalette = 'Error while copying %d entries from palette @%p to @%p';
  SErrorReplaceColor = 'Error while replacing colors in rectangle X:%d Y:%d W:%d H:%d of image %s';
-  SErrorRotateImage = 'Error while rotating image %s by %d degrees';
+  SErrorRotateImage = 'Error while rotating image %s by %.2n degrees';
  SErrorStretchRect = 'Error while stretching rect from image %s to image %s.';
+  SErrorEmptyStream = 'Input stream has no data. Check Position property.';

 const
  // initial size of array with options information
@ -727,7 +727,7 @@ function NewImage(Width, Height: LongInt; Format: TImageFormat; var Image:
 var
  FInfo: PImageFormatInfo;
 begin
-  Assert((Width >= 0) and (Height >= 0));
+  Assert((Width > 0) and (Height >0));
  Assert(IsImageFormatValid(Format));
  Result := False;
  FreeImage(Image);
@ -996,6 +996,8 @@ var
  I: LongInt;
 begin
  Assert(Stream <> nil);
+  if Stream.Size - Stream.Position = 0 then
+    RaiseImaging(SErrorEmptyStream, []);
  Result := False;
  Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));
  if Format <> nil then
@ -1057,6 +1059,8 @@ var
  Format: TImageFileFormat;
 begin
  Assert(Stream <> nil);
+  if Stream.Size - Stream.Position = 0 then
+    RaiseImaging(SErrorEmptyStream, []);
  Result := False;
  Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));
  if Format <> nil then
@ -1416,7 +1420,10 @@ begin
    // Free old image and assign new image to it
    FreeMemNil(Image.Bits);
    if Image.Palette <> nil then
+    begin
+      FreeMem(WorkImage.Palette);
      WorkImage.Palette := Image.Palette;
+    end;
    Image := WorkImage;
    Result := True;
  except
@ -1854,33 +1861,154 @@ begin
  end;
 end;

-function RotateImage(var Image: TImageData; Angle: LongInt): Boolean;
+function RotateImage(var Image: TImageData; Angle: Single): Boolean;
 var
-  X, Y, BytesPerPixel: LongInt;
-  RotImage: TImageData;
-  Pix, RotPix: PByte;
  OldFmt: TImageFormat;
-begin
-  Assert(Angle mod 90 = 0);
-  Result := False;

-  if TestImage(Image) then
-  try
-    if (Angle < -360) or (Angle > 360) then Angle := Angle mod 360;
-    if (Angle = 0) or (Abs(Angle) = 360) then
+  procedure XShear(var Src, Dst: TImageData; Row, Offset, Weight, Bpp: Integer);
+  var
+    I, J, XPos: Integer;
+    PixSrc, PixLeft, PixOldLeft: TColor32Rec;
+    LineDst: PByteArray;
+    SrcPtr: PColor32;
  begin
-      Result := True;
-      Exit;
+    SrcPtr := @PByteArray(Src.Bits)[Row * Src.Width * Bpp];
+    LineDst := @PByteArray(Dst.Bits)[Row * Dst.Width * Bpp];
+    PixOldLeft.Color := 0;
+
+    for I := 0 to Src.Width - 1 do
+    begin
+      CopyPixel(SrcPtr, @PixSrc, Bpp);
+      for J := 0 to Bpp - 1 do
+        PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
+
+      XPos := I + Offset;
+      if (XPos >= 0) and (XPos < Dst.Width) then
+      begin
+        for J := 0 to Bpp - 1 do
+          PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
+        CopyPixel(@PixSrc, @LineDst[XPos * Bpp], Bpp);
+      end;
+      PixOldLeft := PixLeft;
+      Inc(PByte(SrcPtr), Bpp);
    end;

-    Angle := Iff(Angle = -90, 270, Angle);
-    Angle := Iff(Angle = -270, 90, Angle);
-    Angle := Iff(Angle = -180, 180, Angle);
+    XPos := Src.Width + Offset;
+    if XPos < Dst.Width then
+      CopyPixel(@PixOldLeft, @LineDst[XPos * Bpp], Bpp);
+  end;

-    OldFmt := Image.Format;
-    if ImageFormatInfos[Image.Format].IsSpecial then
-      ConvertImage(Image, ifDefault);
+  procedure YShear(var Src, Dst: TImageData; Col, Offset, Weight, Bpp: Integer);
+  var
+    I, J, YPos: Integer;
+    PixSrc, PixLeft, PixOldLeft: TColor32Rec;
+    SrcPtr: PByte;
+  begin
+    SrcPtr := @PByteArray(Src.Bits)[Col * Bpp];
+    PixOldLeft.Color := 0;

+    for I := 0 to Src.Height - 1 do
+    begin
+      CopyPixel(SrcPtr, @PixSrc, Bpp);
+      for J := 0 to Bpp - 1 do
+        PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
+
+      YPos := I + Offset;
+      if (YPos >= 0) and (YPos < Dst.Height) then
+      begin
+        for J := 0 to Bpp - 1 do
+          PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
+        CopyPixel(@PixSrc, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
+      end;
+      PixOldLeft := PixLeft;
+      Inc(SrcPtr, Src.Width * Bpp);
+    end;
+
+    YPos := Src.Height + Offset;
+    if YPos < Dst.Height then
+      CopyPixel(@PixOldLeft, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
+  end;
+
+  procedure Rotate45(var Image: TImageData; Angle: Single);
+  var
+    TempImage1, TempImage2: TImageData;
+    AngleRad, AngleTan, AngleSin, AngleCos, Shear: Single;
+    I, DstWidth, DstHeight, SrcWidth, SrcHeight, Bpp: Integer;
+    SrcFmt, TempFormat: TImageFormat;
+    Info: TImageFormatInfo;
+  begin
+    AngleRad := Angle * Pi / 180;
+    AngleSin := Sin(AngleRad);
+    AngleCos := Cos(AngleRad);
+    AngleTan := Sin(AngleRad / 2) / Cos(AngleRad / 2);
+    SrcWidth := Image.Width;
+    SrcHeight := Image.Height;
+    SrcFmt := Image.Format;
+
+    if not (SrcFmt in [ifR8G8B8..ifX8R8G8B8, ifGray8..ifGray32, ifA16Gray16]) then
+      ConvertImage(Image, ifA8R8G8B8);
+
+    TempFormat := Image.Format;
+    GetImageFormatInfo(TempFormat, Info);
+    Bpp := Info.BytesPerPixel;
+
+    // 1st shear (horizontal)
+    DstWidth := Trunc(SrcWidth + SrcHeight * Abs(AngleTan) + 0.5);
+    DstHeight := SrcHeight;
+    NewImage(DstWidth, DstHeight, TempFormat, TempImage1);
+
+    for I := 0 to DstHeight - 1 do
+    begin
+      if AngleTan >= 0 then
+        Shear := (I + 0.5) * AngleTan
+      else
+        Shear := (I - DstHeight + 0.5) * AngleTan;
+      XShear(Image, TempImage1, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
+    end;
+
+    // 2nd shear  (vertical)
+    FreeImage(Image);
+    DstHeight := Trunc(SrcWidth * Abs(AngleSin) + SrcHeight * AngleCos + 0.5) + 1;
+    NewImage(DstWidth, DstHeight, TempFormat, TempImage2);
+
+    if AngleSin >= 0 then
+      Shear := (SrcWidth - 1) * AngleSin
+    else
+      Shear := (SrcWidth - DstWidth) * -AngleSin;
+
+    for I := 0 to DstWidth - 1 do
+    begin
+      YShear(TempImage1, TempImage2, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
+      Shear := Shear - AngleSin;
+    end;
+
+    // 3rd shear (horizontal)
+    FreeImage(TempImage1);
+    DstWidth := Trunc(SrcHeight * Abs(AngleSin) + SrcWidth * AngleCos + 0.5) + 1;
+    NewImage(DstWidth, DstHeight, TempFormat, Image);
+
+    if AngleSin >= 0 then
+      Shear := (SrcWidth - 1) * AngleSin * -AngleTan
+    else
+      Shear := ((SrcWidth - 1) * -AngleSin + (1 - DstHeight)) * AngleTan;
+
+    for I := 0 to DstHeight - 1 do
+    begin
+      XShear(TempImage2, Image, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
+      Shear := Shear + AngleTan;
+    end;
+
+    FreeImage(TempImage2);
+    if Image.Format <> SrcFmt then
+      ConvertImage(Image, SrcFmt);
+  end;
+
+  procedure RotateMul90(var Image: TImageData; Angle: Integer);
+  var
+    RotImage: TImageData;
+    X, Y, BytesPerPixel: Integer;
+    RotPix, Pix: PByte;
+  begin
    InitImage(RotImage);
    BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel;

@ -1920,8 +2048,7 @@ begin
        begin
          for Y := 0 to RotImage.Height - 1 do
          begin
-            Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width +
-              Y) * BytesPerPixel];
+            Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width + Y) * BytesPerPixel];
            for X := 0 to RotImage.Width - 1 do
            begin
              CopyPixel(Pix, RotPix, BytesPerPixel);
@ -1935,6 +2062,46 @@ begin
    FreeMemNil(Image.Bits);
    RotImage.Palette := Image.Palette;
    Image := RotImage;
+  end;
+
+begin
+  Result := False;
+
+  if TestImage(Image) then
+  try
+    while Angle >= 360 do
+      Angle := Angle - 360;
+    while Angle < 0 do
+      Angle := Angle + 360;
+
+    if (Angle = 0) or (Abs(Angle) = 360) then
+    begin
+      Result := True;
+      Exit;
+    end;
+
+    OldFmt := Image.Format;
+    if ImageFormatInfos[Image.Format].IsSpecial then
+      ConvertImage(Image, ifDefault);
+
+    if (Angle > 45) and (Angle <= 135) then
+    begin
+      RotateMul90(Image, 90);
+      Angle := Angle - 90;
+    end
+    else if (Angle > 135) and (Angle <= 225) then
+    begin
+      RotateMul90(Image, 180);
+      Angle := Angle - 180;
+    end
+    else if (Angle > 225) and (Angle <= 315) then
+    begin
+      RotateMul90(Image, 270);
+      Angle := Angle - 270;
+    end;
+
+    if Angle <> 0 then
+      Rotate45(Image, Angle);

    if OldFmt <> Image.Format then
      ConvertImage(Image, OldFmt);
@ -2421,7 +2588,7 @@ end;

 { Image Format Functions }

-function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
+function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean;
 begin
  FillChar(Info, SizeOf(Info), 0);
  if ImageFormatInfos[Format] <> nil then
@ -2527,7 +2694,7 @@ begin

  if OptionId >= Length(Options) then
    SetLength(Options, OptionId + InitialOptions);
-  if (OptionId >= 0) and (OptionId < Length(Options)) and (Options[OptionId] = nil) then
+  if (OptionId >= 0) and (OptionId < Length(Options)) {and (Options[OptionId] = nil) - must be able to override existing } then
  begin
    Options[OptionId] := Variable;
    Result := True;
@ -2539,7 +2706,7 @@ var
  I: LongInt;
 begin
  Result := nil;
-  for I := 0 to ImageFileFormats.Count - 1 do
+  for I := ImageFileFormats.Count - 1 downto 0 do
    if TImageFileFormat(ImageFileFormats[I]).Extensions.IndexOf(Ext) >= 0 then
    begin
      Result := TImageFileFormat(ImageFileFormats[I]);
@ -2552,7 +2719,7 @@ var
  I: LongInt;
 begin
  Result := nil;
-  for I := 0 to ImageFileFormats.Count - 1 do
+  for I := ImageFileFormats.Count - 1 downto 0 do
    if TImageFileFormat(ImageFileFormats[I]).TestFileName(FileName) then
    begin
      Result := TImageFileFormat(ImageFileFormats[I]);
@ -3289,6 +3456,19 @@ finalization
  -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Extended RotateImage to allow arbitrary angle rotations.
+    - Reversed the order file formats list is searched so
+      if you register a new one it will be found sooner than
+      built in formats.
+    - Fixed memory leak in ResizeImage ocurring when resizing
+      indexed images.
+
+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - Added position/size checks to LoadFromStream functions.
+    - Changed conditional compilation in impl. uses section to reflect changes
+      in LINK symbols.
+
  -- 0.24.3 Changes/Bug Fixes ---------------------------------
    - GenerateMipMaps now generates all smaller levels from
      original big image (better results when using more advanced filters).
--- a/Imaging/ImagingCanvases.pas
+++ b/Imaging/ImagingCanvases.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingCanvases.pas 131 2008-08-14 15:14:24Z galfar $
+  $Id: ImagingCanvases.pas 174 2009-09-08 09:37:59Z galfar $
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net
@ -118,6 +118,8 @@ type

  TDynFPPixelArray = array of TColorFPRec;

+  THistogramArray = array[Byte] of Integer;
+
  TSelectPixelFunction = function(var Pixels: TDynFPPixelArray): TColorFPRec;

  { Base canvas class for drawing objects, applying effects, and other.
@ -128,7 +130,7 @@ type
    recompute some data size related stuff).

    TImagingCanvas works for all image data formats except special ones
-    (compressed). Because of this its methods are quite slow (they work
+    (compressed). Because of this its methods are quite slow (they usually work
    with colors in ifA32R32G32B32F format). If you want fast drawing you
    can use one of fast canvas clases. These descendants of TImagingCanvas
    work only for few select formats (or only one) but they are optimized thus
@ -216,6 +218,12 @@ type
      filled by using the current fill settings. Rect specifies bounding rectangle
      of ellipse to be drawn.}
    procedure Ellipse(const Rect: TRect);
+    { Fills area of canvas with current fill color starting at point [X, Y] and
+      coloring its neighbors. Default flood fill mode changes color of all
+      neighbors with the same color as pixel [X, Y]. With BoundaryFillMode
+      set to True neighbors are recolored regardless of their old color,
+      but area which will be recolored has boundary (specified by current pen color).}
+    procedure FloodFill(X, Y: Integer; BoundaryFillMode: Boolean = False);         

    { Draws contents of this canvas onto another canvas with pixel blending.
      Blending factors are chosen using TBlendingFactor parameters.
@ -225,7 +233,7 @@ type
      DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor);
    { Draws contents of this canvas onto another one with typical alpha
      blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
-    procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer);
+    procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); virtual;
    { Draws contents of this canvas onto another one using additive blending
      (source and dest factors are bfOne).}
    procedure DrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer);
@ -239,7 +247,7 @@ type
    { Draws contents of this canvas onto another one with typical alpha
      blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
    procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
-      const DestRect: TRect; Filter: TResizeFilter = rfBilinear);
+      const DestRect: TRect; Filter: TResizeFilter = rfBilinear); virtual;
    { Draws contents of this canvas onto another one using additive blending
      (source and dest factors are bfOne).}
    procedure StretchDrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas;
@ -286,10 +294,36 @@ type
    { Gamma correction of individual color channels. Range is (0, +inf),
      1.0 means no change.}
    procedure GammaCorection(Red, Green, Blue: Single);
-    { Inverts colors of all image pixels, makes negative image.}
-    procedure InvertColors;
-    { Simple single level thresholding with threshold level for each color channel.}
+    { Inverts colors of all image pixels, makes negative image. Ignores alpha channel.}
+    procedure InvertColors; virtual;
+    { Simple single level thresholding with threshold level (in range [0, 1])
+      for each color channel.}
    procedure Threshold(Red, Green, Blue: Single);
+    { Adjusts the color levels of the image by scaling the
+      colors falling between specified white and black points to full [0, 1] range.
+      The black point specifies the darkest color in the image, white point
+      specifies the lightest color, and mid point is gamma aplied to image.
+      Black and white point must be in range [0, 1].}
+    procedure AdjustColorLevels(BlackPoint, WhitePoint: Single; MidPoint: Single = 1.0);
+    { Premultiplies color channel values by alpha. Needed for some platforms/APIs
+      to display images with alpha properly.}
+    procedure PremultiplyAlpha;
+    { Reverses PremultiplyAlpha operation.}
+    procedure UnPremultiplyAlpha;
+
+    { Calculates image histogram for each channel and also gray values. Each
+      channel has 256 values available. Channel values of data formats with higher
+      precision are scaled and rounded. Example: Red[126] specifies number of pixels
+      in image with red channel = 126.}
+    procedure GetHistogram(out Red, Green, Blue, Alpha, Gray: THistogramArray);
+    { Fills image channel with given value leaving other channels intact.
+      Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
+      channel identifier.}
+    procedure FillChannel(ChannelId: Integer; NewChannelValue: Byte); overload;
+    { Fills image channel with given value leaving other channels intact.
+      Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
+      channel identifier.}
+    procedure FillChannelFP(ChannelId: Integer; NewChannelValue: Single); overload;

    { Color used when drawing lines, frames, and outlines of objects.}
    property PenColor32: TColor32 read FPenColor32 write SetPenColor32;
@ -337,6 +371,7 @@ type
  TFastARGB32Canvas = class(TImagingCanvas)
  protected
    FScanlines: PScanlineArray;
+    procedure AlphaBlendPixels(SrcPix, DestPix: PColor32Rec); {$IFDEF USE_INLINE}inline;{$ENDIF}
    function GetPixel32(X, Y: LongInt): TColor32; override;
    procedure SetPixel32(X, Y: LongInt; const Value: TColor32); override;
  public
@ -344,6 +379,11 @@ type

    procedure UpdateCanvasState; override;

+    procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); override;
+    procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
+      const DestRect: TRect; Filter: TResizeFilter = rfBilinear); override;
+    procedure InvertColors; override;
+
    property Scanlines: PScanlineArray read FScanlines;

    class function GetSupportedFormats: TImageFormats; override;
@ -600,13 +640,16 @@ procedure PixelAlphaProc(const SrcPix: TColorFPRec; DestPtr: PByte;
  DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
 var
  DestPix: TColorFPRec;
+  SrcAlpha, DestAlpha: Single;
 begin
  DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil);
  // Blend the two pixels (Src 'over' Dest alpha composition operation)
-  DestPix.R := SrcPix.R * SrcPix.A + DestPix.R * DestPix.A * (1.0 - SrcPix.A);
-  DestPix.G := SrcPix.G * SrcPix.A + DestPix.G * DestPix.A * (1.0 - SrcPix.A);
-  DestPix.B := SrcPix.B * SrcPix.A + DestPix.B * DestPix.A * (1.0 - SrcPix.A);
-  DestPix.A := SrcPix.A + DestPix.A * (1.0 - SrcPix.A);
+  DestPix.A := SrcPix.A + DestPix.A - SrcPix.A * DestPix.A;
+  SrcAlpha := IffFloat(DestPix.A = 0, 0, SrcPix.A / DestPix.A);
+  DestAlpha := 1.0 - SrcAlpha;
+  DestPix.R := SrcPix.R * SrcAlpha + DestPix.R * DestAlpha;
+  DestPix.G := SrcPix.G * SrcAlpha + DestPix.G * DestAlpha;
+  DestPix.B := SrcPix.B * SrcAlpha + DestPix.B * DestAlpha;
  // Write blended pixel
  DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix);
 end;
@ -691,7 +734,7 @@ begin
  end;
 end;

-function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, Ignore: Single): TColorFPRec;
+function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, P3: Single): TColorFPRec;
 begin
  Result.A := Pixel.A;
  Result.R := Pixel.R * C + B;
@ -707,7 +750,7 @@ begin
  Result.B := Power(Pixel.B, 1.0 / B);
 end;

-function TransformInvert(const Pixel: TColorFPRec; A, B, C: Single): TColorFPRec;
+function TransformInvert(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
 begin
  Result.A := Pixel.A;
  Result.R := 1.0 - Pixel.R;
@ -723,6 +766,49 @@ begin
  Result.B := IffFloat(Pixel.B >= B, 1.0, 0.0);
 end;

+function TransformLevels(const Pixel: TColorFPRec; BlackPoint, WhitePoint, Exp: Single): TColorFPRec;
+begin
+  Result.A := Pixel.A;
+  if Pixel.R > BlackPoint then
+    Result.R := Power((Pixel.R - BlackPoint) / (WhitePoint - BlackPoint), Exp)
+  else
+    Result.R := 0.0;
+  if Pixel.G > BlackPoint then
+    Result.G := Power((Pixel.G - BlackPoint) / (WhitePoint - BlackPoint), Exp)
+  else
+    Result.G := 0.0;
+  if Pixel.B > BlackPoint then
+    Result.B := Power((Pixel.B - BlackPoint) / (WhitePoint - BlackPoint), Exp)
+  else
+    Result.B := 0.0;
+end;
+
+function TransformPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
+begin
+  Result.A := Pixel.A;
+  Result.R := Result.R * Pixel.A;
+  Result.G := Result.G * Pixel.A;
+  Result.B := Result.B * Pixel.A;
+end;
+
+function TransformUnPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
+begin
+  Result.A := Pixel.A;
+  if Pixel.A <> 0.0 then
+  begin
+    Result.R := Result.R / Pixel.A;
+    Result.G := Result.G / Pixel.A;
+    Result.B := Result.B / Pixel.A;
+  end
+  else
+  begin
+    Result.R := 0;
+    Result.G := 0;
+    Result.B := 0;
+  end;
+end;
+
+
 { TImagingCanvas class implementation }

 constructor TImagingCanvas.CreateForData(ImageDataPointer: PImageData);
@ -1175,6 +1261,98 @@ begin
  end;
 end;

+procedure TImagingCanvas.FloodFill(X, Y: Integer; BoundaryFillMode: Boolean);
+var
+  Stack: array of TPoint;
+  StackPos, Y1: Integer;
+  OldColor: TColor32;
+  SpanLeft, SpanRight: Boolean;
+
+  procedure Push(AX, AY: Integer);
+  begin
+    if StackPos < High(Stack) then
+    begin
+      Inc(StackPos);
+      Stack[StackPos].X := AX;
+      Stack[StackPos].Y := AY;
+    end
+    else
+    begin
+      SetLength(Stack, Length(Stack) + FPData.Width);
+      Push(AX, AY);
+    end;
+  end;
+
+  function Pop(out AX, AY: Integer): Boolean;
+  begin
+    if StackPos > 0 then
+    begin
+      AX := Stack[StackPos].X;
+      AY := Stack[StackPos].Y;
+      Dec(StackPos);
+      Result := True;
+    end
+    else
+      Result := False;
+  end;
+
+  function Compare(AX, AY: Integer): Boolean;
+  var
+    Color: TColor32;
+  begin
+    Color := GetPixel32(AX, AY);
+    if BoundaryFillMode then
+      Result := (Color <> FFillColor32) and (Color <> FPenColor32)
+    else
+      Result := Color = OldColor;
+  end;
+
+begin
+  // Scanline Floodfill Algorithm With Stack
+  // http://student.kuleuven.be/~m0216922/CG/floodfill.html
+
+  if not PtInRect(FClipRect, Point(X, Y)) then Exit;
+
+  SetLength(Stack, FPData.Width * 4);
+  StackPos := 0;
+
+  OldColor := GetPixel32(X, Y);
+
+  Push(X, Y);
+
+  while Pop(X, Y) do
+  begin
+    Y1 := Y;
+    while (Y1 >= FClipRect.Top) and Compare(X, Y1) do
+      Dec(Y1);
+
+    Inc(Y1);
+    SpanLeft := False;
+    SpanRight := False;
+
+    while (Y1 < FClipRect.Bottom) and Compare(X, Y1) do
+    begin
+      SetPixel32(X, Y1, FFillColor32);
+      if not SpanLeft and (X > FClipRect.Left) and Compare(X - 1, Y1) then
+      begin
+        Push(X - 1, Y1);
+        SpanLeft := True;
+      end
+      else if SpanLeft and (X > FClipRect.Left) and not Compare(X - 1, Y1) then
+        SpanLeft := False
+      else if not SpanRight and (X < FClipRect.Right - 1) and Compare(X + 1, Y1)then
+      begin
+        Push(X + 1, Y1);
+        SpanRight := True;
+      end
+      else if SpanRight and (X < FClipRect.Right - 1) and not Compare(X + 1, Y1) then
+        SpanRight := False;
+
+      Inc(Y1);
+    end;
+  end;
+end;
+
 procedure TImagingCanvas.DrawInternal(const SrcRect: TRect;
  DestCanvas: TImagingCanvas; DestX, DestY: Integer; SrcFactor,
  DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc);
@ -1533,7 +1711,7 @@ end;
 procedure TImagingCanvas.ModifyContrastBrightness(Contrast, Brightness: Single);
 begin
  PointTransform(TransformContrastBrightness, 1.0 + Contrast / 100,
-    Brightness / 100, 0.0);
+    Brightness / 100, 0);
 end;

 procedure TImagingCanvas.GammaCorection(Red, Green, Blue: Single);
@ -1551,6 +1729,98 @@ begin
  PointTransform(TransformThreshold, Red, Green, Blue);
 end;

+procedure TImagingCanvas.AdjustColorLevels(BlackPoint, WhitePoint, MidPoint: Single);
+begin
+  PointTransform(TransformLevels, BlackPoint, WhitePoint, 1.0 / MidPoint);
+end;
+
+procedure TImagingCanvas.PremultiplyAlpha;
+begin
+  PointTransform(TransformPremultiplyAlpha, 0, 0, 0);
+end;
+
+procedure TImagingCanvas.UnPremultiplyAlpha;
+begin
+  PointTransform(TransformUnPremultiplyAlpha, 0, 0, 0);
+end;
+
+procedure TImagingCanvas.GetHistogram(out Red, Green, Blue, Alpha,
+  Gray: THistogramArray);
+var
+  X, Y, Bpp: Integer;
+  PixPointer: PByte;
+  Color32: TColor32Rec;
+begin
+  FillChar(Red,   SizeOf(Red), 0);
+  FillChar(Green, SizeOf(Green), 0);
+  FillChar(Blue,  SizeOf(Blue), 0);
+  FillChar(Alpha, SizeOf(Alpha), 0);
+  FillChar(Gray,  SizeOf(Gray), 0);
+
+  Bpp := FFormatInfo.BytesPerPixel;
+
+  for Y := FClipRect.Top to FClipRect.Bottom - 1 do
+  begin
+    PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
+    for X := FClipRect.Left to FClipRect.Right - 1 do
+    begin
+      Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
+
+      Inc(Red[Color32.R]);
+      Inc(Green[Color32.G]);
+      Inc(Blue[Color32.B]);
+      Inc(Alpha[Color32.A]);
+      Inc(Gray[Round(GrayConv.R * Color32.R + GrayConv.G * Color32.G + GrayConv.B * Color32.B)]);
+
+      Inc(PixPointer, Bpp);
+    end;
+  end;
+end;
+
+procedure TImagingCanvas.FillChannel(ChannelId: Integer; NewChannelValue: Byte);
+var
+  X, Y, Bpp: Integer;
+  PixPointer: PByte;
+  Color32: TColor32Rec;
+begin
+  Bpp := FFormatInfo.BytesPerPixel;
+
+  for Y := FClipRect.Top to FClipRect.Bottom - 1 do
+  begin
+    PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
+    for X := FClipRect.Left to FClipRect.Right - 1 do
+    begin
+      Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
+      Color32.Channels[ChannelId] := NewChannelValue;
+      FFormatInfo.SetPixel32(PixPointer, @FFormatInfo, FPData.Palette, Color32);
+
+      Inc(PixPointer, Bpp);
+    end;
+  end;
+end;
+
+procedure TImagingCanvas.FillChannelFP(ChannelId: Integer; NewChannelValue: Single);
+var
+  X, Y, Bpp: Integer;
+  PixPointer: PByte;
+  ColorFP: TColorFPRec;
+begin
+  Bpp := FFormatInfo.BytesPerPixel;
+
+  for Y := FClipRect.Top to FClipRect.Bottom - 1 do
+  begin
+    PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
+    for X := FClipRect.Left to FClipRect.Right - 1 do
+    begin
+      ColorFP := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette);
+      ColorFP.Channels[ChannelId] := NewChannelValue;
+      FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette, ColorFP);
+
+      Inc(PixPointer, Bpp);
+    end;
+  end;
+end;
+
 class function TImagingCanvas.GetSupportedFormats: TImageFormats;
 begin
  Result := [ifIndex8..Pred(ifDXT1)];
@ -1564,6 +1834,55 @@ begin
  inherited Destroy;
 end;

+procedure TFastARGB32Canvas.AlphaBlendPixels(SrcPix, DestPix: PColor32Rec);
+var
+  SrcAlpha, DestAlpha, FinalAlpha: Integer;
+begin
+  FinalAlpha := SrcPix.A + 1 + (DestPix.A * (256 - SrcPix.A)) shr 8;
+  if FinalAlpha = 0 then
+    SrcAlpha := 0
+  else
+    SrcAlpha := (SrcPix.A shl 8) div FinalAlpha;
+  DestAlpha := 256 - SrcAlpha;
+
+  DestPix.A := ClampToByte(FinalAlpha);
+  DestPix.R := (SrcPix.R * SrcAlpha + DestPix.R * DestAlpha) shr 8;
+  DestPix.G := (SrcPix.G * SrcAlpha + DestPix.G * DestAlpha) shr 8;
+  DestPix.B := (SrcPix.B * SrcAlpha + DestPix.B * DestAlpha) shr 8;
+end;
+
+procedure TFastARGB32Canvas.DrawAlpha(const SrcRect: TRect;
+  DestCanvas: TImagingCanvas; DestX, DestY: Integer);
+var
+  X, Y, SrcX, SrcY, Width, Height: Integer;
+  SrcPix, DestPix: PColor32Rec;
+begin
+  if DestCanvas.ClassType <> Self.ClassType then
+  begin
+    inherited;
+    Exit;
+  end;
+
+  SrcX := SrcRect.Left;
+  SrcY := SrcRect.Top;
+  Width := SrcRect.Right - SrcRect.Left;
+  Height := SrcRect.Bottom - SrcRect.Top;
+  ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY,
+    FPData.Width, FPData.Height, DestCanvas.ClipRect);
+
+  for Y := 0 to Height - 1 do
+  begin
+    SrcPix := @FScanlines[SrcY + Y, SrcX];
+    DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + Y, DestX];
+    for X := 0 to Width - 1 do
+    begin
+      AlphaBlendPixels(SrcPix, DestPix);
+      Inc(SrcPix);
+      Inc(DestPix);
+    end;
+  end;
+end;
+
 function TFastARGB32Canvas.GetPixel32(X, Y: LongInt): TColor32;
 begin
  Result := FScanlines[Y, X].Color;
@ -1578,6 +1897,189 @@ begin
  end;
 end;

+procedure TFastARGB32Canvas.StretchDrawAlpha(const SrcRect: TRect;
+  DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter);
+var
+  X, Y, ScaleX, ScaleY, Yp, Xp, Weight1, Weight2, Weight3, Weight4,
+    FracX, FracY, InvFracY, T1, T2: Integer;
+  SrcX, SrcY, SrcWidth, SrcHeight: Integer;
+  DestX, DestY, DestWidth, DestHeight: Integer;
+  SrcLine, SrcLine2: PColor32RecArray;
+  DestPix: PColor32Rec;
+  Accum: TColor32Rec;
+begin
+  if (Filter = rfBicubic) or (DestCanvas.ClassType <> Self.ClassType) then
+  begin
+    inherited;
+    Exit;
+  end;
+
+  SrcX := SrcRect.Left;
+  SrcY := SrcRect.Top;
+  SrcWidth := SrcRect.Right - SrcRect.Left;
+  SrcHeight := SrcRect.Bottom - SrcRect.Top;
+  DestX := DestRect.Left;
+  DestY := DestRect.Top;
+  DestWidth := DestRect.Right - DestRect.Left;
+  DestHeight := DestRect.Bottom - DestRect.Top;
+  // Clip src and dst rects
+  ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight,
+      FPData.Width, FPData.Height, DestCanvas.ClipRect);
+  ScaleX := (SrcWidth shl 16) div DestWidth;
+  ScaleY := (SrcHeight shl 16) div DestHeight;
+
+  // Nearest and linear filtering using fixed point math
+
+  if Filter = rfNearest then
+  begin
+    Yp := 0;
+    for Y := DestY to DestY + DestHeight - 1 do
+    begin
+      Xp := 0;
+      SrcLine := @FScanlines[SrcY + Yp shr 16, SrcX];
+      DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
+      for X := 0 to DestWidth - 1 do
+      begin
+        AlphaBlendPixels(@SrcLine[Xp shr 16], DestPix);
+        Inc(DestPix);
+        Inc(Xp, ScaleX);
+      end;
+      Inc(Yp, ScaleY);
+    end;
+  end
+  else
+  begin
+    Yp := (ScaleY shr 1) - $8000;
+    for Y := DestY to DestY + DestHeight - 1 do
+    begin
+      DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
+      if Yp < 0 then
+      begin
+        T1 := 0;
+        FracY := 0;
+        InvFracY := $10000;
+      end
+      else
+      begin
+        T1 := Yp shr 16;
+        FracY := Yp and $FFFF;
+        InvFracY := (not Yp and $FFFF) + 1;
+      end;
+
+      T2 := Iff(T1 < SrcHeight - 1, T1 + 1, T1);
+      SrcLine :=  @Scanlines[T1 + SrcY, SrcX];
+      SrcLine2 := @Scanlines[T2 + SrcY, SrcX];
+      Xp := (ScaleX shr 1) - $8000;
+
+      for X := 0 to DestWidth - 1 do
+      begin
+        if Xp < 0 then
+        begin
+          T1 := 0;
+          FracX := 0;
+        end
+        else
+        begin
+          T1 := Xp shr 16;
+          FracX := Xp and $FFFF;
+        end;
+
+        T2 := Iff(T1 < SrcWidth - 1, T1 + 1, T1);
+        Weight2:= (Cardinal(InvFracY) * FracX) shr 16; // cast to Card, Int can overflow gere
+        Weight1:= InvFracY - Weight2;
+        Weight4:= (Cardinal(FracY) * FracX) shr 16;
+        Weight3:= FracY - Weight4;
+
+        Accum.B := (SrcLine[T1].B * Weight1 + SrcLine[T2].B * Weight2 +
+          SrcLine2[T1].B * Weight3 + SrcLine2[T2].B * Weight4 + $8000) shr 16;
+        Accum.G := (SrcLine[T1].G * Weight1 + SrcLine[T2].G * Weight2 +
+          SrcLine2[T1].G * Weight3 + SrcLine2[T2].G * Weight4 + $8000) shr 16;
+        Accum.R := (SrcLine[T1].R * Weight1 + SrcLine[T2].R * Weight2 +
+          SrcLine2[T1].R * Weight3 + SrcLine2[T2].R * Weight4 + $8000) shr 16;
+        Accum.A := (SrcLine[T1].A * Weight1 + SrcLine[T2].A * Weight2 +
+          SrcLine2[T1].A * Weight3 + SrcLine2[T2].A * Weight4 + $8000) shr 16;
+
+        AlphaBlendPixels(@Accum, DestPix);
+
+        Inc(Xp, ScaleX);
+        Inc(DestPix);
+      end;
+      Inc(Yp, ScaleY);
+     end;
+  end;
+         {
+
+  // Generate mapping tables
+  MapX := BuildMappingTable(DestX, DestX + DestWidth, SrcX, SrcX + SrcWidth,
+    FPData.Width, FilterFunction, Radius, False);
+  MapY := BuildMappingTable(DestY, DestY + DestHeight, SrcY, SrcY + SrcHeight,
+    FPData.Height, FilterFunction, Radius, False);
+  FindExtremes(MapX, XMinimum, XMaximum);
+  SetLength(LineBuffer, XMaximum - XMinimum + 1);
+
+  for J := 0 to DestHeight - 1 do
+  begin
+    ClusterY := MapY[J];
+    for X := XMinimum to XMaximum do
+    begin
+      AccumA := 0;
+      AccumR := 0;
+      AccumG := 0;
+      AccumB := 0;
+      for Y := 0 to Length(ClusterY) - 1 do
+      begin
+        Weight := Round(ClusterY[Y].Weight * 256);
+        SrcColor := FScanlines[ClusterY[Y].Pos, X];
+
+        AccumB := AccumB + SrcColor.B * Weight;
+        AccumG := AccumG + SrcColor.G * Weight;
+        AccumR := AccumR + SrcColor.R * Weight;
+        AccumA := AccumA + SrcColor.A * Weight;
+      end;
+      with LineBuffer[X - XMinimum] do
+      begin
+        A := AccumA;
+        R := AccumR;
+        G := AccumG;
+        B := AccumB;
+      end;
+    end;
+
+    DestPtr := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + J, DestX];
+
+    for I := 0 to DestWidth - 1 do
+    begin
+      ClusterX := MapX[I];
+      AccumA := 0;
+      AccumR := 0;
+      AccumG := 0;
+      AccumB := 0;
+      for X := 0 to Length(ClusterX) - 1 do
+      begin
+        Weight := Round(ClusterX[X].Weight * 256);
+        with LineBuffer[ClusterX[X].Pos - XMinimum] do
+        begin
+          AccumB := AccumB + B * Weight;
+          AccumG := AccumG + G * Weight;
+          AccumR := AccumR + R * Weight;
+          AccumA := AccumA + A * Weight;
+        end;
+      end;
+
+      AccumA := ClampInt(AccumA, 0, $00FF0000);
+      AccumR := ClampInt(AccumR, 0, $00FF0000);
+      AccumG := ClampInt(AccumG, 0, $00FF0000);
+      AccumB := ClampInt(AccumB, 0, $00FF0000);
+      SrcColor.Color := (Cardinal(AccumA and $00FF0000) shl 8) or
+        (AccumR and $00FF0000) or ((AccumG and $00FF0000) shr 8) or ((AccumB and $00FF0000) shr 16);
+
+      AlphaBlendPixels(@SrcColor, DestPtr);
+
+      Inc(DestPtr);
+    end;
+  end;   }
+end;
+
 procedure TFastARGB32Canvas.UpdateCanvasState;
 var
  I: LongInt;
@ -1601,6 +2103,24 @@ begin
  Result := [ifA8R8G8B8];
 end;

+procedure TFastARGB32Canvas.InvertColors;
+var
+  X, Y: Integer;
+  PixPtr: PColor32Rec;
+begin
+  for Y := FClipRect.Top to FClipRect.Bottom - 1 do
+  begin
+    PixPtr := @FScanlines[Y, FClipRect.Left];
+    for X := FClipRect.Left to FClipRect.Right - 1 do
+    begin
+      PixPtr.R := not PixPtr.R;
+      PixPtr.G := not PixPtr.G;
+      PixPtr.B := not PixPtr.B;
+      Inc(PixPtr);
+    end;
+  end;
+end;
+
 initialization
  RegisterCanvas(TFastARGB32Canvas);

@ -1616,6 +2136,19 @@ finalization
    - add blending (*image and object drawing)
    - more objects (arc, polygon)

+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Added some methods to TFastARGB32Canvas (InvertColors, DrawAlpha/StretchDrawAlpha)
+    - Fixed DrawAlpha/StretchDrawAlpha destination alpha calculation.
+    - Added PremultiplyAlpha and UnPremultiplyAlpha methods.
+
+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - Added FillChannel methods.
+    - Added FloodFill method.
+    - Added GetHistogram method.
+    - Fixed "Invalid FP operation" in AdjustColorLevels in FPC compiled exes
+      (thanks to Carlos González).
+    - Added TImagingCanvas.AdjustColorLevels method.
+
  -- 0.25.0 Changes/Bug Fixes ---------------------------------
    - Fixed error that could cause AV in linear and nonlinear filters.
    - Added blended rect filling function FillRectBlend.
--- a/Imaging/ImagingClasses.pas
+++ b/Imaging/ImagingClasses.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingClasses.pas 124 2008-04-21 09:47:07Z galfar $
+  $Id: ImagingClasses.pas 173 2009-09-04 17:05:52Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -68,7 +68,7 @@ type
    constructor CreateFromImage(AImage: TBaseImage);
    destructor Destroy; override;
    { Returns info about current image.}
-    function ToString: string;
+    function ToString: string; {$IF Defined(DCC) and (CompilerVersion >= 20.0)}override;{$IFEND}

    { Creates a new image data with the given size and format. Old image
      data is lost. Works only for the current image of TMultiImage.}
@ -81,8 +81,8 @@ type
    { Mirrors current image. Reverses the image along its vertical axis the left
      side becomes the right and vice versa.}
    procedure Mirror;
-    { Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.}
-    procedure Rotate(Angle: LongInt);
+    { Rotates image by Angle degrees counterclockwise.}
+    procedure Rotate(Angle: Single);
    { Copies rectangular part of SrcImage to DstImage. No blending is performed -
      alpha is simply copied to destination image. Operates also with
      negative X and Y coordinates.
@ -451,7 +451,7 @@ begin
    DoPixelsChanged;
 end;

-procedure TBaseImage.Rotate(Angle: LongInt);
+procedure TBaseImage.Rotate(Angle: Single);
 begin
  if Valid and Imaging.RotateImage(FPData^, Angle) then
    DoPixelsChanged;
--- a/Imaging/ImagingColors.pas
+++ b/Imaging/ImagingColors.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingColors.pas 74 2007-03-12 15:04:04Z galfar $
+  $Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -68,6 +68,12 @@ procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
 { Converts CMYK to RGB color.}
 procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);

+{ Converts RGB color to YCoCg.}
+procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
+{ Converts YCoCg to RGB color.}
+procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
+
+
 implementation

 procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
@ -149,11 +155,17 @@ procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
 begin
  RGBToCMY(R, G, B, C, M, Y);
  K := Min(C, Min(M, Y));
-  if K > 0 then
+  if K = 255 then
  begin
-    C := C - K;
-    M := M - K;
-    Y := Y - K;
+    C := 0;
+    M := 0;
+    Y := 0;
+  end
+  else
+  begin
+    C := ClampToByte(Round((C - K) / (255 - K) * 255));
+    M := ClampToByte(Round((M - K) / (255 - K) * 255));
+    Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
  end;
 end;

@ -168,11 +180,17 @@ procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
 begin
  RGBToCMY16(R, G, B, C, M, Y);
  K := Min(C, Min(M, Y));
-  if K > 0 then
+  if K = 65535 then
  begin
-    C := C - K;
-    M := M - K;
-    Y := Y - K;
+    C := 0;
+    M := 0;
+    Y := 0;
+  end
+  else
+  begin
+    C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
+    M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
+    Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
  end;
 end;

@ -183,12 +201,35 @@ begin
  B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
 end;

+procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
+begin
+  // C and Delphi's SHR behaviour differs for negative numbers, use div instead.
+  Y  := ClampToByte(( R +     G shl 1 + B       + 2) div 4);
+  Co := ClampToByte(( R shl 1         - B shl 1 + 2) div 4 + 128);
+  Cg := ClampToByte((-R +     G shl 1 - B       + 2) div 4 + 128);
+end;
+
+procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
+var
+  CoInt, CgInt: Integer;
+begin
+  CoInt := Co - 128;
+  CgInt := Cg - 128;
+  R := ClampToByte(Y + CoInt - CgInt);
+  G := ClampToByte(Y + CgInt);
+  B := ClampToByte(Y - CoInt - CgInt);
+end;
+
 {
  File Notes:

  -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Added RGB<>YCoCg conversion functions.
+    - Fixed RGB>>CMYK conversions.
+
  -- 0.23 Changes/Bug Fixes -----------------------------------
    - Added RGB<>CMY(K) converion functions for 16 bit channels
      (needed by PSD loading code).
--- a/Imaging/ImagingComponents.pas
+++ b/Imaging/ImagingComponents.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingComponents.pas 132 2008-08-27 20:37:38Z galfar $
+  $Id: ImagingComponents.pas 171 2009-09-02 01:34:19Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -26,7 +26,7 @@
  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
 }

-{ This unit contains VCL/CLX/LCL TGraphic descendant which uses Imaging library
+{ This unit contains VCL/LCL TGraphic descendant which uses Imaging library
  for saving and loading.}
 unit ImagingComponents;

@ -34,6 +34,17 @@ unit ImagingComponents;

 interface

+{$IFDEF LCL}
+  {$DEFINE COMPONENT_SET_LCL}
+{$ENDIF}
+
+{$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
+// If no component sets should be used just include empty unit.
+//DOC-IGNORE-BEGIN
+implementation
+//DOC-IGNORE-END
+{$ELSE}
+
 uses
  SysUtils, Types, Classes,
 {$IFDEF MSWINDOWS}
@ -42,10 +53,6 @@ uses
 {$IFDEF COMPONENT_SET_VCL}
  Graphics,
 {$ENDIF}
-{$IFDEF COMPONENT_SET_CLX}
-  Qt,
-  QGraphics,
-{$ENDIF}
 {$IFDEF COMPONENT_SET_LCL}
  InterfaceBase,
  GraphType,
@ -71,6 +78,8 @@ type
    procedure ReadDataFromStream(Stream: TStream); virtual;
    procedure AssignTo(Dest: TPersistent); override;
  public
+    constructor Create; override;
+
    { Loads new image from the stream. It can load all image
      file formats supported by Imaging (and enabled of course)
      even though it is called by descendant class capable of
@ -114,8 +123,7 @@ type
    { Returns file extensions of this graphic class.}
    class function GetFileExtensions: string; override;
    { Returns default MIME type of this graphic class.}
-    function GetMimeType: string; override;  // uncomment for Laz 0.9.25 if you get error here
-    //function GetDefaultMimeType: string; override;
+    function GetMimeType: string; override;
  {$ENDIF}
    { Default (the most common) file extension of this graphic class.}
    property DefaultFileExt: string read FDefaultFileExt;
@ -123,7 +131,7 @@ type

  TImagingGraphicForSaveClass = class of TImagingGraphicForSave;

-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}
  { TImagingGraphic descendant for loading/saving Windows bitmaps.
    VCL/CLX/LCL all have native support for bitmaps so you might
    want to disable this class (although you can save bitmaps with
@ -140,7 +148,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}
  { TImagingGraphic descendant for loading/saving JPEG images.}
  TImagingJpeg = class(TImagingGraphicForSave)
  protected
@ -151,8 +159,7 @@ type
    procedure SaveToStream(Stream: TStream); override;
    class function GetFileFormat: TImageFileFormat; override;
  {$IFDEF COMPONENT_SET_LCL}
-    //function GetMimeType: string; override;  // uncomment for Laz 0.9.25 if you get error here
-    function GetDefaultMimeType: string; override;
+    function GetMimeType: string; override;
  {$ENDIF}
    { See ImagingJpegQuality option for details.}
    property Quality: LongInt read FQuality write FQuality;
@ -161,7 +168,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_PNG}
+{$IFNDEF DONT_LINK_PNG}
  { TImagingGraphic descendant for loading/saving PNG images.}
  TImagingPNG = class(TImagingGraphicForSave)
  protected
@ -178,7 +185,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}
  { TImagingGraphic descendant for loading/saving GIF images.}
  TImagingGIF = class(TImagingGraphicForSave)
  public
@ -186,7 +193,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}
  { TImagingGraphic descendant for loading/saving Targa images.}
  TImagingTarga = class(TImagingGraphicForSave)
  protected
@ -200,7 +207,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}
  { Compresssion type used when saving DDS files by TImagingDds.}
  TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5);

@ -218,7 +225,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_MNG}
+{$IFNDEF DONT_LINK_MNG}
  { TImagingGraphic descendant for loading/saving MNG images.}
  TImagingMNG = class(TImagingGraphicForSave)
  protected
@ -233,8 +240,7 @@ type
    procedure SaveToStream(Stream: TStream); override;
    class function GetFileFormat: TImageFileFormat; override;
  {$IFDEF COMPONENT_SET_LCL}
-    //function GetMimeType: string; override;  // uncomment for Laz 0.9.25 if you get error here
-    function GetDefaultMimeType: string; override;
+    function GetMimeType: string; override;
  {$ENDIF}
    { See ImagingMNGLossyCompression option for details.}
    property LossyCompression: Boolean read FLossyCompression write FLossyCompression;
@ -251,7 +257,7 @@ type
  end;
 {$ENDIF}

-{$IFDEF LINK_JNG}
+{$IFNDEF DONT_LINK_JNG}
  { TImagingGraphic descendant for loading/saving JNG images.}
  TImagingJNG = class(TImagingGraphicForSave)
  protected
@ -328,29 +334,29 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
 implementation

 uses
-{$IF Defined(UNIX) and Defined(COMPONENT_SET_LCL)}
-  {$IFDEF LCLGTK2}
+{$IF Defined(LCL)}
+  {$IF Defined(LCLGTK2)}
    GLib2, GDK2, GTK2, GTKDef, GTKProc,
-  {$ELSE}
+  {$ELSEIF Defined(LCLGTK)}
    GDK, GTK, GTKDef, GTKProc,
-  {$ENDIF}
+  {$IFEND}
 {$IFEND}
-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}
  ImagingBitmap,
 {$ENDIF}
-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}
  ImagingJpeg,
 {$ENDIF}
-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}
  ImagingGif,
 {$ENDIF}
-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}
  ImagingTarga,
 {$ENDIF}
-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}
  ImagingDds,
 {$ENDIF}
-{$IF Defined(LINK_PNG) or Defined(LINK_MNG) or Defined(LINK_JNG)}
+{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
  ImagingNetworkGraphics,
 {$IFEND}
  ImagingUtility;
@ -359,9 +365,10 @@ resourcestring
  SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
  SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p';
  SBadFormatDisplay = 'Unsupported image format passed';
+  SUnsupportedLCLWidgetSet = 'This function is not implemented for current LCL widget set';
  SImagingGraphicName = 'Imaging Graphic AllInOne';

-{ Registers types to VCL/CLX/LCL.}
+{ Registers types to VCL/LCL.}
 procedure RegisterTypes;
 var
  I: LongInt;
@ -387,87 +394,85 @@ var
 begin
  for I := Imaging.GetFileFormatCount - 1 downto 0 do
    RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I));
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGraphic);{$ENDIF}
+  Classes.RegisterClass(TImagingGraphic);

-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}
  RegisterFileFormat(TImagingTarga);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingTarga);{$ENDIF}
+  Classes.RegisterClass(TImagingTarga);
 {$ENDIF}
-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}
  RegisterFileFormat(TImagingDDS);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingDDS);{$ENDIF}
+  Classes.RegisterClass(TImagingDDS);
 {$ENDIF}
-{$IFDEF LINK_JNG}
+{$IFNDEF DONT_LINK_JNG}
  RegisterFileFormat(TImagingJNG);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJNG);{$ENDIF}
+  Classes.RegisterClass(TImagingJNG);
 {$ENDIF}
-{$IFDEF LINK_MNG}
+{$IFNDEF DONT_LINK_MNG}
  RegisterFileFormat(TImagingMNG);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingMNG);{$ENDIF}
+  Classes.RegisterClass(TImagingMNG);
 {$ENDIF}
-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}
  RegisterFileFormat(TImagingGIF);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGIF);{$ENDIF}
+  Classes.RegisterClass(TImagingGIF);
 {$ENDIF}
-{$IFDEF LINK_PNG}
+{$IFNDEF DONT_LINK_PNG}
  {$IFDEF COMPONENT_SET_LCL}
    // Unregister Lazarus´ default PNG loader which crashes on some PNG files
    TPicture.UnregisterGraphicClass(TPortableNetworkGraphic);
  {$ENDIF}
  RegisterFileFormat(TImagingPNG);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingPNG);{$ENDIF}
+  Classes.RegisterClass(TImagingPNG);
 {$ENDIF}
-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}
  RegisterFileFormat(TImagingJpeg);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJpeg);{$ENDIF}
+  Classes.RegisterClass(TImagingJpeg);
 {$ENDIF}
-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}
  RegisterFileFormat(TImagingBitmap);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingBitmap);{$ENDIF}
+  Classes.RegisterClass(TImagingBitmap);
 {$ENDIF}   
 end;

-{ Unregisters types from VCL/CLX/LCL.}
+{ Unregisters types from VCL/LCL.}
 procedure UnRegisterTypes;
 begin
-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}
  TPicture.UnregisterGraphicClass(TImagingBitmap);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingBitmap);{$ENDIF}
+  Classes.UnRegisterClass(TImagingBitmap);
 {$ENDIF}
-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}
  TPicture.UnregisterGraphicClass(TImagingJpeg);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingJpeg);{$ENDIF}
+  Classes.UnRegisterClass(TImagingJpeg);
 {$ENDIF}
-{$IFDEF LINK_PNG}
+{$IFNDEF DONT_LINK_PNG}
  TPicture.UnregisterGraphicClass(TImagingPNG);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingPNG);{$ENDIF}
+  Classes.UnRegisterClass(TImagingPNG);
 {$ENDIF}
-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}
  TPicture.UnregisterGraphicClass(TImagingGIF);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGIF);{$ENDIF}
+  Classes.UnRegisterClass(TImagingGIF);
 {$ENDIF}
-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}
  TPicture.UnregisterGraphicClass(TImagingTarga);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingTarga);{$ENDIF}
+  Classes.UnRegisterClass(TImagingTarga);
 {$ENDIF}
-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}
  TPicture.UnregisterGraphicClass(TImagingDDS);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingDDS);{$ENDIF}
+  Classes.UnRegisterClass(TImagingDDS);
 {$ENDIF}
  TPicture.UnregisterGraphicClass(TImagingGraphic);
-  {$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGraphic);{$ENDIF}
+  Classes.UnRegisterClass(TImagingGraphic);
 end;

 function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
 begin
  case Format of
-{$IFNDEF COMPONENT_SET_LCL}
+{$IFDEF COMPONENT_SET_VCL}
    ifIndex8: Result := pf8bit;
-{$ENDIF}
-{$IF (not Defined(COMPONENT_SET_CLX)) and (not Defined(COMPONENT_SET_LCL))}
    ifR5G6B5: Result := pf16bit;
    ifR8G8B8: Result := pf24bit;
-{$IFEND}
+{$ENDIF}
    ifA8R8G8B8,
    ifX8R8G8B8: Result := pf32bit;
  else
@ -479,11 +484,9 @@ function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat;
 begin
  case Format of
    pf8bit: Result := ifIndex8;
-{$IFNDEF COMPONENT_SET_CLX}
    pf15bit: Result := ifA1R5G5B5;
    pf16bit: Result := ifR5G6B5;
    pf24bit: Result := ifR8G8B8;
-{$ENDIF}
    pf32bit: Result := ifA8R8G8B8;
  else
    Result := ifUnknown;
@ -499,9 +502,6 @@ var
 {$IFDEF COMPONENT_SET_VCL}
  LogPalette: TMaxLogPalette;
 {$ENDIF}
-{$IFDEF COMPONENT_SET_CLX}
-  ColorTable: PPalette32;
-{$ENDIF}
 {$IFDEF COMPONENT_SET_LCL}
  RawImage: TRawImage;
  ImgHandle, ImgMaskHandle: HBitmap;
@ -517,19 +517,16 @@ begin
    if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
      Imaging.ConvertImage(WorkData, ifA8R8G8B8)
    else
-{$IFNDEF COMPONENT_SET_LCL}
+{$IFDEF COMPONENT_SET_VCL}
      if Info.IsIndexed or Info.HasGrayChannel then
        Imaging.ConvertImage(WorkData, ifIndex8)
-      else
-{$ENDIF}
-{$IF (not Defined(COMPONENT_SET_CLX)) and (not Defined(COMPONENT_SET_LCL))}
-        if Info.UsePixelFormat then
+      else if Info.UsePixelFormat then
        Imaging.ConvertImage(WorkData, ifR5G6B5)
      else
        Imaging.ConvertImage(WorkData, ifR8G8B8);
 {$ELSE}
        Imaging.ConvertImage(WorkData, ifA8R8G8B8);
-{$IFEND}
+{$ENDIF}

    PF := DataFormatToPixelFormat(WorkData.Format);
    GetImageFormatInfo(WorkData.Format, Info);
@ -565,27 +562,13 @@ begin
  // Copy scanlines
  for I := 0 to WorkData.Height - 1 do
    Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
-{$ENDIF}
-{$IFDEF COMPONENT_SET_CLX}
-  Bitmap.Width := WorkData.Width;
-  Bitmap.Height := WorkData.Height;
-  Bitmap.PixelFormat := PF;

-  if (PF = pf8bit) and (WorkData.Palette <> nil) then
-  begin
-    // Copy palette
-    ColorTable := Bitmap.ColorTable;
-    for I := 0 to Info.PaletteEntries - 1 do
-    with ColorTable[I] do
-    begin
-      R := WorkData.Palette[I].R;
-      G := WorkData.Palette[I].G;
-      B := WorkData.Palette[I].B;
-    end;
-  end;
-  // Copy scanlines
-  for I := 0 to WorkData.Height - 1 do
-    Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
+  // Delphi 2009 and newer support alpha transparency fro TBitmap
+{$IF Defined(DELPHI) and (CompilerVersion >= 20.0)}
+  if Bitmap.PixelFormat = pf32bit then
+    Bitmap.AlphaFormat := afDefined;
+{$IFEND}
+
 {$ENDIF}
 {$IFDEF COMPONENT_SET_LCL}
  // Create 32bit raw image from image data
@ -594,9 +577,9 @@ begin
  begin
    Width := WorkData.Width;
    Height := WorkData.Height;
-    BitsPerPixel := Info.BytesPerPixel * 8;
+    BitsPerPixel := 32;
    Format := ricfRGBA;
-    LineEnd := rileByteBoundary;
+    LineEnd := rileDWordBoundary;
    BitOrder := riboBitsInOrder;
    ByteOrder := riboLSBFirst;
    LineOrder := riloTopToBottom;
@ -608,14 +591,13 @@ begin
    RedShift := 16;
    GreenShift := 8;
    BlueShift := 0;
-    Depth := 24;
+    Depth := 32; // Must be 32 for alpha blending (and for working in MacOSX Carbon)
  end;
  RawImage.Data := WorkData.Bits;
  RawImage.DataSize := WorkData.Size;

  // Create bitmap from raw image
-  { If you get complitation error here upgrade to Lazarus 0.9.24+ }
-  if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle, False) then
+  if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle) then
  begin
    Bitmap.Handle := ImgHandle;
    Bitmap.MaskHandle := ImgMaskHandle;
@ -634,9 +616,6 @@ var
  Colors: Word;
  LogPalette: TMaxLogPalette;
 {$ENDIF}
-{$IFDEF COMPONENT_SET_CLX}
-  ColorTable: PPalette32;
-{$ENDIF}
 {$IFDEF COMPONENT_SET_LCL}
  RawImage: TRawImage;
  LineLazBytes: LongInt;
@ -650,7 +629,6 @@ begin
  // trough RawImage api and cannot be changed to mirror some Imaging format
  // (so formats with no coresponding Imaging format cannot be saved now).

-  { If you get complitation error here upgrade to Lazarus 0.9.24+ }
  if RawImage_DescriptionFromBitmap(Bitmap.Handle, RawImage.Description) then
    case RawImage.Description.BitsPerPixel of
      8: Format := ifIndex8;
@ -707,28 +685,9 @@ begin
  for I := 0 to Data.Height - 1 do
    Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
 {$ENDIF}
-{$IFDEF COMPONENT_SET_CLX}
-  if Format = ifIndex8 then
-  begin
-    // Copy palette
-    ColorTable := Bitmap.ColorTable;
-    for I := 0 to Info.PaletteEntries - 1 do
-    with ColorTable[I] do
-    begin
-      Data.Palette[I].A := $FF;
-      Data.Palette[I].R := R;
-      Data.Palette[I].G := G;
-      Data.Palette[I].B := B;
-    end;
-  end;
-  // Copy scanlines
-  for I := 0 to Data.Height - 1 do
-    Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
-{$ENDIF}
 {$IFDEF COMPONENT_SET_LCL}
  // Get raw image from bitmap (mask handle must be 0 or expect violations)
-  if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then // uncommnet for Laz 0.9.25 if you get error here
-  //if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, Classes.Rect(0, 0, Data.Width, Data.Height)) then
+  if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then
  begin
    LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel,
      RawImage.Description.LineEnd);
@ -757,6 +716,7 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
 var
  OldMode: Integer;
  BitmapInfo: Windows.TBitmapInfo;
+  Bmp: TBitmap;
 begin
  if TestImage(ImageData) then
  begin
@ -781,9 +741,21 @@ begin

    try
       with SrcRect, ImageData do
-        Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top,
+        if Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top,
          DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, Left,
-          Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY);
+          Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY) <> Height then
+        begin
+          // StretchDIBits may fail on some ocassions (error 487, http://support.microsoft.com/kb/269585).
+          // This fallback is slow but works every time. Thanks to Sergey Galezdinov for the fix.
+          Bmp := TBitmap.Create;
+          try
+            ConvertDataToBitmap(ImageData, Bmp);
+            StretchBlt(DC, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top,
+              Bmp.Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
+          finally
+            Bmp.Free;
+          end;
+        end;
    finally
      Windows.SetStretchBltMode(DC, OldMode);
    end;
@ -792,50 +764,21 @@ end;
 {$ENDIF}

 procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
-{$IF Defined(MSWINDOWS) and not Defined(COMPONENT_SET_CLX)}
+{$IF Defined(DCC) or Defined(LCLWIN32)} // Delphi or LCL Win32
 begin
  DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
 end;
-{$ELSEIF Defined(COMPONENT_SET_CLX)}
-var
-  Bitmap: TBitmap;
-  //Handle: LongWord;
-begin
-  (*
-  // It would be nice if this worked:
-  DstCanvas.Start;
-  Handle := QPainter_handle(DstCanvas.Handle);
-  {$IFDEF MSWINDOWS}
-  DisplayImageDataOnDC(Handle, DstRect, ImageData, SrcRect);
-  {$ELSE}
-  DisplayImageDataOnX(Handle, DstRect, ImageData, SrcRect);
-  {$ENDIF}
-  DstCanvas.Stop;
-  *)
-  Bitmap := TBitmap.Create;
-  try
-    ConvertDataToBitmap(ImageData, Bitmap);
-    DstCanvas.CopyRect(DstRect, Bitmap.Canvas, SrcRect);
-  finally
-    Bitmap.Free;
-  end;  
-end;
-{$ELSEIF Defined(UNIX) and Defined(COMPONENT_SET_LCL)}
+{$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}

  procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
    SrcWidth, SrcHeight: Integer; ImageData: TImageData);
  var
    P: TPoint;
  begin
-    // If you get compilation errors here with new Lazarus (rev 14368+)
-    // uncomment commented code and comment the active code below:
-
    P := TGtkDeviceContext(Dest).Offset;
-    //P := GetDCOffset(TDeviceContext(Dest));
    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;
@ -890,6 +833,10 @@ begin
    end;
  end;
 end;
+{$ELSE}
+begin
+  raise Exception.Create(SUnsupportedLCLWidgetSet);
+end;
 {$IFEND}

 procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage);
@ -911,6 +858,12 @@ end;

 { TImagingGraphic class implementation }

+constructor TImagingGraphic.Create;
+begin
+  inherited Create;
+  PixelFormat := pf24Bit;
+end;
+
 procedure TImagingGraphic.LoadFromStream(Stream: TStream);
 begin
  ReadDataFromStream(Stream);
@ -1020,14 +973,13 @@ begin
  Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]);
 end;

-function TImagingGraphicForSave.GetMimeType: string;  // uncomment for Laz 0.9.25 if you get error here
-//function TImagingGraphicForSave.GetDefaultMimeType: string;
+function TImagingGraphicForSave.GetMimeType: string;
 begin
  Result := 'image/' + FDefaultFileExt;
 end;
 {$ENDIF}

-{$IFDEF LINK_BITMAP}
+{$IFNDEF DONT_LINK_BITMAP}

 { TImagingBitmap class implementation }

@ -1051,7 +1003,7 @@ begin
 end;
 {$ENDIF}

-{$IFDEF LINK_JPEG}
+{$IFNDEF DONT_LINK_JPEG}

 { TImagingJpeg class implementation }

@ -1068,8 +1020,7 @@ begin
 end;

 {$IFDEF COMPONENT_SET_LCL}
-//function TImagingJpeg.GetMimeType: string;  // uncomment for Laz 0.9.25 if you get error here
-function TImagingJpeg.GetDefaultMimeType: string;
+function TImagingJpeg.GetMimeType: string;
 begin
  Result := 'image/jpeg';
 end;
@ -1086,7 +1037,7 @@ end;

 {$ENDIF}

-{$IFDEF LINK_PNG}
+{$IFNDEF DONT_LINK_PNG}

 { TImagingPNG class implementation }

@ -1112,7 +1063,7 @@ begin
 end;
 {$ENDIF}

-{$IFDEF LINK_GIF}
+{$IFNDEF DONT_LINK_GIF}

 { TImagingGIF class implementation}

@ -1123,7 +1074,7 @@ end;

 {$ENDIF}

-{$IFDEF LINK_TARGA}
+{$IFNDEF DONT_LINK_TARGA}

 { TImagingTarga class implementation }

@ -1147,7 +1098,7 @@ begin
 end;
 {$ENDIF}

-{$IFDEF LINK_DDS}
+{$IFNDEF DONT_LINK_DDS}

 { TImagingDDS class implementation }

@ -1180,7 +1131,7 @@ begin
 end;
 {$ENDIF}

-{$IFDEF LINK_MNG}
+{$IFNDEF DONT_LINK_MNG}

 { TImagingMNG class implementation }

@ -1201,8 +1152,7 @@ begin
 end;

 {$IFDEF COMPONENT_SET_LCL}
-//function TImagingMNG.GetMimeType: string;  // uncomment for Laz 0.9.25 if you get error here
-function TImagingMNG.GetDefaultMimeType: string;
+function TImagingMNG.GetMimeType: string;
 begin
  Result := 'video/mng';
 end;
@ -1222,7 +1172,7 @@ begin
 end;
 {$ENDIF}

-{$IFDEF LINK_JNG}
+{$IFNDEF DONT_LINK_JNG}

 { TImagingJNG class implementation }

@ -1259,12 +1209,30 @@ initialization
 finalization
  UnRegisterTypes;

+{$IFEND} // {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
+
 {
  File Notes:

  -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Setting AlphaFormat property of TBitmap in ConvertDataToBitmap
+      when using Delphi 2009+.
+    - Fixed garbled LCL TBitmaps created by ConvertDataToBitmap
+      in Mac OS X (Carbon).
+
+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - Added some more IFDEFs for Lazarus widget sets.
+    - Removed CLX code.
+    - GTK version of Unix DisplayImageData only used with LCL GTK so the
+      the rest of the unit can be used with Qt or other LCL interfaces. 
+    - Fallback mechanism for DisplayImageDataOnDC, it may fail on occasions.
+    - Changed file format conditional compilation to reflect changes
+      in LINK symbols.
+    - Lazarus 0.9.26 compatibility changes.
+
  -- 0.24.1 Changes/Bug Fixes ---------------------------------
    - Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus
      with GTK2 target.
--- a/Imaging/ImagingExport.pas
+++ b/Imaging/ImagingExport.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingExport.pas 71 2007-03-08 00:10:10Z galfar $
+  $Id: ImagingExport.pas 173 2009-09-04 17:05:52Z galfar $
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net
@ -52,14 +52,14 @@ function ImTestImage(var Image: TImageData): Boolean; cdecl;
 function ImFreeImage(var Image: TImageData): Boolean; cdecl;
 { Look at DetermineFileFormat for details. Ext should have enough space for
  result file extension.}
-function ImDetermineFileFormat(FileName, Ext: PChar): Boolean; cdecl;
+function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl;
 { Look at DetermineMemoryFormat for details. Ext should have enough space for
  result file extension.}
-function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean; cdecl;
+function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl;
 { Look at IsFileFormatSupported for details.}
-function ImIsFileFormatSupported(FileName: PChar): Boolean; cdecl;
+function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl;
 { Look at EnumFileFormats for details.}
-function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
+function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
  var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl;

 { Inits image list.}
@ -82,24 +82,24 @@ function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl;
 function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl;

 { Look at LoadImageFromFile for details.}
-function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean; cdecl;
+function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl;
 { Look at LoadImageFromMemory for details.}
 function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl;
 { Look at LoadMultiImageFromFile for details.}
-function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList): Boolean; cdecl;
+function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl;
 { Look at LoadMultiImageFromMemory for details.}
 function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
  var ImageList: TImageDataList): Boolean; cdecl;

 { Look at SaveImageToFile for details.}
-function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean; cdecl;
+function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl;
 { Look at SaveImageToMemory for details.}
-function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
+function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
  const Image: TImageData): Boolean; cdecl;
 { Look at SaveMultiImageToFile for details.}
-function ImSaveMultiImageToFile(FileName: PChar; ImageList: TImageDataList): Boolean; cdecl;
+function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl;
 { Look at SaveMultiImageToMemory for details.}
-function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
+function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
  ImageList: TImageDataList): Boolean; cdecl;

 { Look at CloneImage for details.}
@ -131,7 +131,7 @@ function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
 function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
  MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl;
 { Look at RotateImage for details.}
-function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean; cdecl;
+function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl;

 { Look at CopyRect for details.}
 function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
@ -262,33 +262,33 @@ begin
  end;
 end;

-function ImDetermineFileFormat(FileName, Ext: PChar): Boolean;
+function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean;
 var
  S: string;
 begin
  try
    S := Imaging.DetermineFileFormat(FileName);
    Result := S <> '';
-    StrCopy(Ext, PChar(S));
+    StrCopy(Ext, PAnsiChar(AnsiString(S)));
  except
    Result := False;
  end;
 end;

-function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean;
+function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean;
 var
  S: string;
 begin
  try
    S := Imaging.DetermineMemoryFormat(Data, Size);
    Result := S <> '';
-    StrCopy(Ext, PChar(S));
+    StrCopy(Ext, PAnsiChar(AnsiString(S)));
  except
    Result := False;
  end;
 end;

-function ImIsFileFormatSupported(FileName: PChar): Boolean;
+function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean;
 begin
  try
    Result := Imaging.IsFileFormatSupported(FileName);
@ -297,7 +297,7 @@ begin
  end;
 end;

-function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
+function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
  var CanSave, IsMultiImageFormat: Boolean): Boolean;
 var
  StrName, StrDefaultExt, StrMasks: string;
@ -305,9 +305,9 @@ begin
  try
    Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave,
      IsMultiImageFormat);
-    StrCopy(Name, PChar(StrName));
-    StrCopy(DefaultExt, PChar(StrDefaultExt));
-    StrCopy(Masks, PChar(StrMasks));
+    StrCopy(Name, PAnsiChar(AnsiString(StrName)));
+    StrCopy(DefaultExt, PAnsiChar(AnsiString(StrDefaultExt)));
+    StrCopy(Masks, PAnsiChar(AnsiString(StrMasks)));
  except
    Result := False;
  end;
@ -419,7 +419,7 @@ begin
  end;
 end;

-function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean;
+function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean;
 begin
  try
    Result := Imaging.LoadImageFromFile(FileName, Image);
@ -437,7 +437,7 @@ begin
  end;
 end;

-function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList):
+function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList):
  Boolean;
 begin
  try
@ -460,7 +460,7 @@ begin
  end;
 end;

-function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean;
+function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean;
 begin
  try
    Result := Imaging.SaveImageToFile(FileName, Image);
@ -469,7 +469,7 @@ begin
  end;
 end;

-function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
+function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
  const Image: TImageData): Boolean;
 begin
  try
@ -479,7 +479,7 @@ begin
  end;
 end;

-function ImSaveMultiImageToFile(FileName: PChar;
+function ImSaveMultiImageToFile(FileName: PAnsiChar;
  ImageList: TImageDataList): Boolean;
 begin
  try
@ -490,7 +490,7 @@ begin
  end;
 end;

-function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
+function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
  ImageList: TImageDataList): Boolean;
 begin
  try
@ -612,7 +612,7 @@ begin
  end;
 end;

-function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean;
+function ImRotateImage(var Image: TImageData; Angle: Single): Boolean;
 begin
  try
    Result := Imaging.RotateImage(Image, Angle);
@ -864,6 +864,10 @@ end;
  -- TODOS ----------------------------------------------------
    - nothing now 

+  -- 0.26.3 ---------------------------------------------------
+    - changed PChars to PAnsiChars and some more D2009 friendly
+      casts.
+
  -- 0.19 -----------------------------------------------------
    - updated to reflect changes in low level interface (added pixel set/get, ...)
    - changed ImInitImage to procedure to reflect change in Imaging.pas
--- a/Imaging/ImagingFormats.pas
+++ b/Imaging/ImagingFormats.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingFormats.pas 129 2008-08-06 20:01:30Z galfar $
+  $Id: ImagingFormats.pas 176 2009-10-12 10:53:17Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -388,6 +388,7 @@ var
    BytesPerPixel: 1;
    ChannelCount: 1;
    PaletteEntries: 256;
+    HasAlphaChannel: True;
    IsIndexed: True;
    GetPixelsSize: GetStdPixelsSize;
    CheckDimensions: CheckStdDimensions;
@ -1617,8 +1618,7 @@ begin
    Result[0][0].Pos := (SrcLow + SrcHigh) div 2;
    Result[0][0].Weight := 1.0;
  end
-  else
-  if Scale < 1.0 then
+  else if Scale < 1.0 then
  begin
    // Sub-sampling - scales from bigger to smaller 
    Radius := Radius / Scale;
@ -1649,8 +1649,7 @@ begin
        Result[I][0].Pos := Floor(Center);
        Result[I][0].Weight := 1.0;
      end
-      else
-      if Count <> 0.0 then
+      else if Count <> 0.0 then
        Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count;
    end;
  end
@ -1680,8 +1679,7 @@ begin
          begin
            if J < 0 then
              N := SrcImageWidth + J
-            else
-            if J >= SrcImageWidth then
+            else if J >= SrcImageWidth then
              N := J - SrcImageWidth
            else
              N := ClampInt(J, SrcLow, SrcHigh - 1);
@ -1723,13 +1721,19 @@ procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
  DstHeight: LongInt; Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean);
 const
  Channel8BitMax: Single = 255.0;
+type
+  TBufferItem = record
+    A, R, G, B: Integer;
+  end;
 var
  MapX, MapY: TMappingTable;
  I, J, X, Y: LongInt;
  XMinimum, XMaximum: LongInt;
-  LineBuffer: array of TColorFPRec;
+  LineBufferFP: array of TColorFPRec;
+  LineBufferInt: array of TBufferItem;
  ClusterX, ClusterY: TCluster;
  Weight, AccumA, AccumR, AccumG, AccumB: Single;
+  IWeight, IAccumA, IAccumR, IAccumG, IAccumB: Integer;
  DstLine: PByte;
  SrcColor: TColor32Rec;
  SrcFloat: TColorFPRec;
@ -1759,10 +1763,10 @@ begin
  try
    // Find min and max X coords of pixels that will contribute to target image
    FindExtremes(MapX, XMinimum, XMaximum);
-    SetLength(LineBuffer, XMaximum - XMinimum + 1);

    if not UseOptimizedVersion then
    begin
+      SetLength(LineBufferFP, XMaximum - XMinimum + 1);
      // Following code works for the rest of data formats
      for J := 0 to DstHeight - 1 do
      begin
@ -1773,10 +1777,10 @@ begin
        for X := XMinimum to XMaximum do
        begin
          // Clear accumulators
-          AccumA := 0.0;
-          AccumR := 0.0;
-          AccumG := 0.0;
-          AccumB := 0.0;
+          AccumA := 0;
+          AccumR := 0;
+          AccumG := 0;
+          AccumB := 0;
          // For each pixel in line compute weighted sum of pixels
          // in source column that will contribute to this pixel
          for Y := 0 to Length(ClusterY) - 1 do
@ -1790,7 +1794,7 @@ begin
            AccumA := AccumA + SrcFloat.A * Weight;
          end;
          // Store accumulated value for this pixel in buffer
-          with LineBuffer[X - XMinimum] do
+          with LineBufferFP[X - XMinimum] do
          begin
            A := AccumA;
            R := AccumR;
@ -1806,17 +1810,17 @@ begin
        begin
          ClusterX := MapX[I];
          // Clear accumulator
-          AccumA := 0.0;
-          AccumR := 0.0;
-          AccumG := 0.0;
-          AccumB := 0.0;
+          AccumA := 0;
+          AccumR := 0;
+          AccumG := 0;
+          AccumB := 0;
          // Compute weighted sum of values (which are already
          // computed weighted sums of pixels in source columns stored in LineBuffer)
          // that will contribute to the current target pixel
          for X := 0 to Length(ClusterX) - 1 do
          begin
            Weight := ClusterX[X].Weight;
-            with LineBuffer[ClusterX[X].Pos - XMinimum] do
+            with LineBufferFP[ClusterX[X].Pos - XMinimum] do
            begin
              AccumB := AccumB + B * Weight;
              AccumG := AccumG + G * Weight;
@ -1838,37 +1842,35 @@ begin
    end
    else
    begin
+      SetLength(LineBufferInt, XMaximum - XMinimum + 1);
      // Following code is optimized for images with 8 bit channels
      for J := 0 to DstHeight - 1 do
      begin
        ClusterY := MapY[J];
        for X := XMinimum to XMaximum do
        begin
-          AccumA := 0.0;
-          AccumR := 0.0;
-          AccumG := 0.0;
-          AccumB := 0.0;
+          IAccumA := 0;
+          IAccumR := 0;
+          IAccumG := 0;
+          IAccumB := 0;
          for Y := 0 to Length(ClusterY) - 1 do
          begin
-            Weight := ClusterY[Y].Weight;
+            IWeight := Round(256 * ClusterY[Y].Weight);
            CopyPixel(
              @PByteArray(SrcImage.Bits)[(ClusterY[Y].Pos * SrcImage.Width + X) * Info.BytesPerPixel],
              @SrcColor, Info.BytesPerPixel);

-            AccumB := AccumB + SrcColor.B * Weight;
-            if Info.ChannelCount > 1 then
-              AccumG := AccumG + SrcColor.G * Weight;
-            if Info.ChannelCount > 2 then
-              AccumR := AccumR + SrcColor.R * Weight;
-            if Info.ChannelCount > 3 then
-              AccumA := AccumA + SrcColor.A * Weight;
+            IAccumB := IAccumB + SrcColor.B * IWeight;
+            IAccumG := IAccumG + SrcColor.G * IWeight;
+            IAccumR := IAccumR + SrcColor.R * IWeight;
+            IAccumA := IAccumA + SrcColor.A * IWeight;
          end;
-          with LineBuffer[X - XMinimum] do
+          with LineBufferInt[X - XMinimum] do
          begin
-            A := AccumA;
-            R := AccumR;
-            G := AccumG;
-            B := AccumB;
+            A := IAccumA;
+            R := IAccumR;
+            G := IAccumG;
+            B := IAccumB;
          end;
        end;

@ -1877,31 +1879,26 @@ begin
        for I := 0 to DstWidth - 1 do
        begin
          ClusterX := MapX[I];
-          AccumA := 0.0;
-          AccumR := 0.0;
-          AccumG := 0.0;
-          AccumB := 0.0;
+          IAccumA := 0;
+          IAccumR := 0;
+          IAccumG := 0;
+          IAccumB := 0;
          for X := 0 to Length(ClusterX) - 1 do
          begin
-            Weight := ClusterX[X].Weight;
-            with LineBuffer[ClusterX[X].Pos - XMinimum] do
+            IWeight := Round(256 * ClusterX[X].Weight);
+            with LineBufferInt[ClusterX[X].Pos - XMinimum] do
            begin
-              AccumB := AccumB + B * Weight;
-              if Info.ChannelCount > 1 then
-                AccumG := AccumG + G * Weight;
-              if Info.ChannelCount > 2 then
-                AccumR := AccumR + R * Weight;
-              if Info.ChannelCount > 3 then
-                AccumA := AccumA + A * Weight;
+              IAccumB := IAccumB + B * IWeight;
+              IAccumG := IAccumG + G * IWeight;
+              IAccumR := IAccumR + R * IWeight;
+              IAccumA := IAccumA + A * IWeight;
            end;
          end;
-          SrcColor.B := ClampToByte(Round(AccumB));
-          if Info.ChannelCount > 1 then
-            SrcColor.G := ClampToByte(Round(AccumG));
-          if Info.ChannelCount > 2 then
-            SrcColor.R := ClampToByte(Round(AccumR));
-          if Info.ChannelCount > 3 then
-            SrcColor.A := ClampToByte(Round(AccumA));
+
+          SrcColor.B := ClampInt(IAccumB, 0, $00FF0000) shr 16;
+          SrcColor.G := ClampInt(IAccumG, 0, $00FF0000) shr 16;
+          SrcColor.R := ClampInt(IAccumR, 0, $00FF0000) shr 16;
+          SrcColor.A := ClampInt(IAccumA, 0, $00FF0000) shr 16;

          CopyPixel(@SrcColor, DstLine, Info.BytesPerPixel);
          Inc(DstLine, Info.BytesPerPixel);
@ -3234,11 +3231,11 @@ type

  TPixelBlock = array[0..15] of TPixelInfo;

-function DecodeCol(Color : Word): TColor32Rec;
+function DecodeCol(Color: Word): TColor32Rec;
 {$IFDEF USE_INLINE} inline; {$ENDIF}
 begin
  Result.A := $FF;
-  {Result.R := ((Color and $F800) shr 11) shl 3;
+{  Result.R := ((Color and $F800) shr 11) shl 3;
  Result.G := ((Color and $07E0) shr 5) shl 2;
  Result.B := (Color and $001F) shl 3;}
  // this color expansion is slower but gives better results
@ -3663,7 +3660,7 @@ begin
      GetBlock(Pixels, SrcBits, X, Y, Width, Height);
      for I := 0 to 7 do
        PByteArray(@AlphaBlock.Alphas)[I] :=
-          ((Pixels[I shl 1].Alpha shr 4) shl 4) or (Pixels[I shl 1 + 1].Alpha shr 4);
+          (Pixels[I shl 1].Alpha shr 4) or ((Pixels[I shl 1 + 1].Alpha shr 4) shl 4);
      GetEndpoints(Pixels, Block.Color0, Block.Color1);
      FixEndpoints(Block.Color0, Block.Color1, False);
      Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels);
@ -4222,7 +4219,11 @@ initialization

  -- TODOS ----------------------------------------------------
    - nothing now
-    - rewrite StretchRect for 8bit channels to use integer math?
+
+  -- 0.26.3 Changes/Bug Fixes -----------------------------------
+    - Filtered resampling ~10% faster now.
+    - Fixed DXT3 alpha encoding.
+    - ifIndex8 format now has HasAlphaChannel=True.

  -- 0.25.0 Changes/Bug Fixes -----------------------------------
    - Made some resampling stuff public so that it can be used in canvas class.
--- a/Imaging/ImagingGif.pas
+++ b/Imaging/ImagingGif.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingGif.pas 132 2008-08-27 20:37:38Z galfar $
+  $Id: ImagingGif.pas 157 2009-02-15 14:24:58Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -44,9 +44,11 @@ type
    its own color palette. GIF uses lossless LZW compression
    (patent expired few years ago).
    Imaging can load and save all GIFs with all frames and supports
-    transparency.}
+    transparency. Imaging can load just raw ifIndex8 frames or
+    also animate them in ifA8R8G8B8 format. See ImagingGIFLoadAnimated option.}
  TGIFFileFormat = class(TImageFileFormat)
  private
+    FLoadAnimated: LongBool;
    function InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
    procedure LZWDecompress(Stream: TStream; Handle: TImagingHandle;
      Width, Height: Integer; Interlaced: Boolean; Data: Pointer);
@ -62,6 +64,8 @@ type
  public
    constructor Create; override;
    function TestFormat(Handle: TImagingHandle): Boolean; override;
+  published
+    property LoadAnimated: LongBool read FLoadAnimated write FLoadAnimated;
  end;

 implementation
@ -70,10 +74,11 @@ const
  SGIFFormatName = 'Graphics Interchange Format';
  SGIFMasks      = '*.gif';
  GIFSupportedFormats: TImageFormats = [ifIndex8];
+  GIFDefaultLoadAnimated = True;

 type
  TGIFVersion = (gv87, gv89);
-  TDisposalMethod = (dmUndefined, dmLeave, dmRestoreBackground,
+  TDisposalMethod = (dmNoRemoval, dmLeave, dmRestoreBackground,
    dmRestorePrevious, dmReserved4, dmReserved5, dmReserved6, dmReserved7);

 const
@ -144,6 +149,19 @@ type
    Terminator: Byte;
  end;

+const
+  // Netscape sub block types
+  GIFAppLoopExtension = 1;
+  GIFAppBufferExtension = 2;
+
+type
+  TGIFIdentifierCode = array[0..7] of AnsiChar;
+  TGIFAuthenticationCode = array[0..2] of AnsiChar;
+  TGIFApplicationRec = packed record
+    Identifier: TGIFIdentifierCode;
+    Authentication: TGIFAuthenticationCode;
+  end;
+
 const
  CodeTableSize = 4096;
  HashTableSize = 17777;
@ -206,8 +224,10 @@ begin
  FCanSave := True;
  FIsMultiImageFormat := True;
  FSupportedFormats := GIFSupportedFormats;
+  FLoadAnimated := GIFDefaultLoadAnimated;

  AddMasks(SGIFMasks);
+  RegisterOption(ImagingGIFLoadAnimated, @FLoadAnimated);
 end;

 function TGIFFileFormat.InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
@ -644,28 +664,56 @@ end;

 function TGIFFileFormat.LoadData(Handle: TImagingHandle;
  var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
+type
+  TFrameInfo = record
+    Left, Top: Integer;
+    Width, Height: Integer;
+    Disposal: TDisposalMethod;
+    HasTransparency: Boolean;
+    HasLocalPal: Boolean;
+    TransIndex: Integer;
+    BackIndex: Integer;
+  end;
 var
  Header: TGIFHeader;
  HasGlobalPal: Boolean;
  GlobalPalLength: Integer;
  GlobalPal: TPalette32Size256;
-  I: Integer;
+  ScreenWidth, ScreenHeight, I, CachedIndex: Integer;
  BlockID: Byte;
  HasGraphicExt: Boolean;
  GraphicExt: TGraphicControlExtension;
-  Disposals: array of TDisposalMethod;
+  FrameInfos: array of TFrameInfo;
+  AppRead: Boolean;
+  CachedFrame: TImageData;
+  AnimFrames: TDynImageDataArray;

  function ReadBlockID: Byte;
  begin
    Result := GIFTrailer;
-    GetIO.Read(Handle, @Result, SizeOf(Result));
+    if GetIO.Read(Handle, @Result, SizeOf(Result)) < SizeOf(Result) then
+      Result := GIFTrailer;
  end;

  procedure ReadExtensions;
  var
-    BlockSize, ExtType: Byte;
+    BlockSize, BlockType, ExtType: Byte;
+    AppRec: TGIFApplicationRec;
+    LoopCount: SmallInt;
+
+    procedure SkipBytes;
+    begin
+      with GetIO do
+      repeat
+        // Read block sizes and skip them
+        Read(Handle, @BlockSize, SizeOf(BlockSize));
+        Seek(Handle, BlockSize, smFromCurrent);
+      until BlockSize = 0;
+    end;
+
  begin
    HasGraphicExt := False;
+    AppRead := False;

    // Read extensions until image descriptor is found. Only graphic extension
    // is stored now (for transparency), others are skipped.
@ -674,11 +722,58 @@ var
    begin
      Read(Handle, @ExtType, SizeOf(ExtType));

+      while ExtType in [GIFGraphicControlExtension, GIFCommentExtension, GIFApplicationExtension, GIFPlainText] do
+      begin
        if ExtType = GIFGraphicControlExtension then
        begin
          HasGraphicExt := True;
          Read(Handle, @GraphicExt, SizeOf(GraphicExt));
        end
+        else if (ExtType = GIFApplicationExtension) and not AppRead then
+        begin
+          Read(Handle, @BlockSize, SizeOf(BlockSize));
+          if BlockSize >= SizeOf(AppRec) then
+          begin
+            Read(Handle, @AppRec, SizeOf(AppRec));
+            if (AppRec.Identifier = 'NETSCAPE') and (AppRec.Authentication = '2.0') then
+            begin
+              Read(Handle, @BlockSize, SizeOf(BlockSize));
+              while BlockSize <> 0 do
+              begin
+                BlockType := ReadBlockID;
+                Dec(BlockSize);
+
+                case BlockType of
+                  GIFAppLoopExtension:
+                    if (BlockSize >= SizeOf(LoopCount)) then
+                    begin
+                      // Read loop count
+                      Read(Handle, @LoopCount, SizeOf(LoopCount));
+                      Dec(BlockSize, SizeOf(LoopCount));
+                    end;
+                  GIFAppBufferExtension:
+                    begin
+                      Dec(BlockSize, SizeOf(Word));
+                      Seek(Handle, SizeOf(Word), smFromCurrent);
+                    end;
+                end;
+              end;
+              SkipBytes;
+              AppRead := True;
+            end
+            else
+              begin
+                // Revert all bytes reading
+                Seek(Handle, - SizeOf(AppRec) - SizeOf(BlockSize), smFromCurrent);
+                SkipBytes;
+              end;
+          end
+          else
+            begin
+              Seek(Handle, - BlockSize - SizeOf(BlockSize), smFromCurrent);
+              SkipBytes;
+            end;
+        end
        else if ExtType in [GIFCommentExtension, GIFApplicationExtension, GIFPlainText] then
        repeat
          // Read block sizes and skip them
@ -688,33 +783,8 @@ var

        // Read ID of following block
        BlockID := ReadBlockID;
-    end;
-  end;
-
-  procedure CopyFrameTransparent(const Image, Frame: TImageData; Left, Top,
-    TransIndex: Integer; Disposal: TDisposalMethod);
-  var
-    X, Y: Integer;
-    Src, Dst: PByte;
-  begin
-    Src := Frame.Bits;
-
-    // Copy all pixels from frame to log screen but ignore the transparent ones
-    for Y := 0 to Frame.Height - 1 do
-    begin
-      Dst := @PByteArray(Image.Bits)[(Top + Y) * Image.Width + Left];
-      for X := 0 to Frame.Width - 1 do
-      begin
-        // If disposal methos is undefined copy all pixels regardless of
-        // transparency (transparency of whole image will be determined by TranspIndex
-        // in image palette) - same effect as filling the image with trasp color
-        // instead of backround color beforehand.
-        // For other methods don't copy transparent pixels from frame to image.
-        if (Src^ <> TransIndex) or (Disposal = dmUndefined) then
-          Dst^ := Src^;
-        Inc(Src);
-        Inc(Dst);
-      end;
+        ExtType := BlockID;
+      end
    end;
  end;

@ -743,33 +813,49 @@ var
  procedure ReadFrame;
  var
    ImageDesc: TImageDescriptor;
-    HasLocalPal, Interlaced, HasTransparency: Boolean;
-    I, Idx, LocalPalLength, TransIndex: Integer;
+    Interlaced: Boolean;
+    I, Idx, LocalPalLength: Integer;
    LocalPal: TPalette32Size256;
-    BlockTerm: Byte;
-    Frame: TImageData;
    LZWStream: TMemoryStream;
+
+    procedure RemoveBadFrame;
+    begin
+      FreeImage(Images[Idx]);
+      SetLength(Images, Length(Images) - 1);
+    end;
+
  begin
    Idx := Length(Images);
    SetLength(Images, Idx + 1);
+    SetLength(FrameInfos, Idx + 1);
    FillChar(LocalPal, SizeOf(LocalPal), 0);
+
    with GetIO do
    begin
      // Read and parse image descriptor
      Read(Handle, @ImageDesc, SizeOf(ImageDesc));
-      HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
+      FrameInfos[Idx].HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
      Interlaced := (ImageDesc.PackedFields and GIFInterlaced) = GIFInterlaced;
      LocalPalLength := ImageDesc.PackedFields and GIFColorTableSize;
      LocalPalLength := 1 shl (LocalPalLength + 1);   // Total pal length is 2^(n+1)

-      // Create new logical screen
-      NewImage(Header.ScreenWidth, Header.ScreenHeight, ifIndex8, Images[Idx]);
+      // From Mozilla source
+      if (ImageDesc.Width = 0) or (ImageDesc.Width > Header.ScreenWidth) then
+        ImageDesc.Width := Header.ScreenWidth;
+      if (ImageDesc.Height = 0) or (ImageDesc.Height > Header.ScreenHeight)  then
+        ImageDesc.Height := Header.ScreenHeight;
+
+      FrameInfos[Idx].Left := ImageDesc.Left;
+      FrameInfos[Idx].Top := ImageDesc.Top;
+      FrameInfos[Idx].Width := ImageDesc.Width;
+      FrameInfos[Idx].Height := ImageDesc.Height;
+      FrameInfos[Idx].BackIndex := Header.BackgroundColorIndex;
+
      // Create new image for this frame which would be later pasted onto logical screen
-      InitImage(Frame);
-      NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Frame);
+      NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Images[Idx]);

      // Load local palette if there is any
-      if HasLocalPal then
+      if FrameInfos[Idx].HasLocalPal then
        for I := 0 to LocalPalLength - 1 do
        begin
          LocalPal[I].A := 255;
@ -780,87 +866,174 @@ var

      // Use local pal if present or global pal if present or create
      // default pal if neither of them is present
-      if HasLocalPal then
+      if FrameInfos[Idx].HasLocalPal then
        Move(LocalPal, Images[Idx].Palette^, SizeOf(LocalPal))
      else if HasGlobalPal then
        Move(GlobalPal, Images[Idx].Palette^, SizeOf(GlobalPal))
      else
        FillCustomPalette(Images[Idx].Palette, GlobalPalLength, 3, 3, 2);

-      // Add default disposal method for this frame
-      SetLength(Disposals, Length(Disposals) + 1);
-      Disposals[High(Disposals)] := dmUndefined;
+      if (ImageDesc.Left <= Header.ScreenWidth + 1) and (ImageDesc.Top <= Header.ScreenHeight + 1) then
+      begin
+        // Resize the screen if needed to fit the frame
+        ScreenWidth := Max(ScreenWidth, ImageDesc.Width + ImageDesc.Left);
+        ScreenHeight := Max(ScreenHeight, ImageDesc.Height + ImageDesc.Top);
+      end
+      else
+      begin
+        // Remove frame outside logical screen
+        RemoveBadFrame;
+        Exit;
+      end;

      // If Grahic Control Extension is present make use of it
      if HasGraphicExt then
      begin
-        HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
-        Disposals[High(Disposals)] := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
-        if HasTransparency then
-          Images[Idx].Palette[GraphicExt.TransparentColorIndex].A := 0;
-      end
-      else
-        HasTransparency := False;
-
-      if Idx >= 1 then
+        FrameInfos[Idx].HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
+        FrameInfos[Idx].Disposal := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
+        if FrameInfos[Idx].HasTransparency then
        begin
-        // If previous frame had some special disposal method we take it into
-        // account now
-        case Disposals[Idx - 1] of
-          dmUndefined: ; // Do nothing
-          dmLeave:
-            begin
-              // Leave previous frame on log screen
-              CopyRect(Images[Idx - 1], 0, 0, Images[Idx].Width,
-                Images[Idx].Height, Images[Idx], 0, 0);
-            end;
-          dmRestoreBackground:
-            begin
-              // Clear log screen with background color
-              FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
-                @Header.BackgroundColorIndex);
-            end;
-          dmRestorePrevious:
-            if Idx >= 2 then
-            begin
-              // Set log screen to "previous of previous" frame
-              CopyRect(Images[Idx - 2], 0, 0, Images[Idx].Width,
-                Images[Idx].Height, Images[Idx], 0, 0);
-            end;
+          FrameInfos[Idx].TransIndex := GraphicExt.TransparentColorIndex;
+          Images[Idx].Palette[FrameInfos[Idx].TransIndex].A := 0;
        end;
      end
      else
-      begin
-        // First frame - just fill with background color
-        FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
-          @Header.BackgroundColorIndex);
-      end;
+        FrameInfos[Idx].HasTransparency := False;

      LZWStream := TMemoryStream.Create;
+      try
        try
          // Copy LZW data to temp stream, needed for correct decompression
          CopyLZWData(LZWStream);
          LZWStream.Position := 0;
          // Data decompression finally
-        LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Frame.Bits);
-        // Now copy frame to logical screen with skipping of transparent pixels (if enabled)
-        TransIndex := Iff(HasTransparency, GraphicExt.TransparentColorIndex, MaxInt);
-        CopyFrameTransparent(Images[Idx], Frame, ImageDesc.Left, ImageDesc.Top,
-          TransIndex, Disposals[Idx]);
+          LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Images[Idx].Bits);
+        except
+          RemoveBadFrame;
+          Exit;
+        end;
      finally
-        FreeImage(Frame);
        LZWStream.Free;
      end;
    end;
  end;

+  procedure CopyFrameTransparent32(const Image, Frame: TImageData; Left, Top: Integer);
+  var
+    X, Y: Integer;
+    Src: PByte;
+    Dst: PColor32;
+  begin
+    Src := Frame.Bits;
+
+    // Copy all pixels from frame to log screen but ignore the transparent ones
+    for Y := 0 to Frame.Height - 1 do
+    begin
+      Dst := @PColor32RecArray(Image.Bits)[(Top + Y) * Image.Width + Left];
+      for X := 0 to Frame.Width - 1 do
+      begin
+        if (Frame.Palette[Src^].A <> 0) then
+          Dst^ := Frame.Palette[Src^].Color;
+        Inc(Src);
+        Inc(Dst);
+      end;
+    end;
+  end;
+
+  procedure AnimateFrame(Index: Integer; var AnimFrame: TImageData);
+  var
+    I, First, Last: Integer;
+    UseCache: Boolean;
+    BGColor: TColor32;
+  begin
+    // We may need to use raw frame 0 to n to correctly animate n-th frame
+    Last := Index;
+    First := Max(0, Last);
+    // See if we can use last animate frame as a basis for this one
+    // (so we don't have to use previous raw frames).
+    UseCache := TestImage(CachedFrame) and (CachedIndex = Index - 1) and (CachedIndex >= 0) and
+      (FrameInfos[CachedIndex].Disposal <> dmRestorePrevious);
+
+    // Reuse or release cache
+    if UseCache then
+      CloneImage(CachedFrame, AnimFrame)
+    else
+      FreeImage(CachedFrame);
+
+    // Default color for clearing of the screen
+    BGColor := Images[Index].Palette[FrameInfos[Index].BackIndex].Color;
+
+    // Now prepare logical screen for drawing of raw frame at Index.
+    // We may need to use all previous raw frames to get the screen
+    // to proper state (according to their disposal methods).
+
+    if not UseCache then
+    begin
+      if FrameInfos[Index].HasTransparency then
+        BGColor := Images[Index].Palette[FrameInfos[Index].TransIndex].Color;
+      // Clear whole screen
+      FillMemoryLongWord(AnimFrame.Bits, AnimFrame.Size, BGColor);
+
+      // Try to maximize First so we don't have to use all 0 to n raw frames
+      while First > 0 do
+      begin
+        if (ScreenWidth = Images[First].Width) and (ScreenHeight = Images[First].Height) then
+        begin
+          if (FrameInfos[First].Disposal = dmRestoreBackground) and (First < Last) then
+            Break;
+        end;
+        Dec(First);
+      end;
+
+      for I := First to Last - 1 do
+      begin
+        case FrameInfos[I].Disposal of
+          dmNoRemoval, dmLeave:
+            begin
+              // Copy previous raw frame  onto screen
+              CopyFrameTransparent32(AnimFrame, Images[I], FrameInfos[I].Left, FrameInfos[I].Top);
+            end;
+          dmRestoreBackground:
+            if (I > First) then
+            begin
+              // Restore background color
+              FillRect(AnimFrame, FrameInfos[I].Left, FrameInfos[I].Top,
+                FrameInfos[I].Width, FrameInfos[I].Height, @BGColor);
+            end;
+          dmRestorePrevious: ; // Do nothing - previous state is already on screen
+        end;
+      end;
+    end
+    else if FrameInfos[CachedIndex].Disposal = dmRestoreBackground then
+    begin
+      // We have our cached result but also need to restore
+      // background in a place of cached frame
+      if FrameInfos[CachedIndex].HasTransparency then
+        BGColor := Images[CachedIndex].Palette[FrameInfos[CachedIndex].TransIndex].Color;
+      FillRect(AnimFrame, FrameInfos[CachedIndex].Left, FrameInfos[CachedIndex].Top,
+        FrameInfos[CachedIndex].Width, FrameInfos[CachedIndex].Height, @BGColor);
+    end;
+
+    // Copy current raw frame to prepared screen
+    CopyFrameTransparent32(AnimFrame, Images[Index], FrameInfos[Index].Left, FrameInfos[Index].Top);
+
+    // Cache animated result
+    CloneImage(AnimFrame, CachedFrame);
+    CachedIndex := Index;
+  end;
+
 begin
+  AppRead := False;
+
  SetLength(Images, 0);
  FillChar(GlobalPal, SizeOf(GlobalPal), 0);
+
  with GetIO do
  begin
    // Read GIF header
    Read(Handle, @Header, SizeOf(Header));
+    ScreenWidth := Header.ScreenWidth;
+    ScreenHeight := Header.ScreenHeight;
    HasGlobalPal := Header.PackedFields and GIFGlobalColorTable = GIFGlobalColorTable; // Bit 7
    GlobalPalLength := Header.PackedFields and GIFColorTableSize; // Bits 0-2
    GlobalPalLength := 1 shl (GlobalPalLength + 1);   // Total pal length is 2^(n+1)
@ -883,6 +1056,9 @@ begin
    // Now read all data blocks in the file until file trailer is reached
    while BlockID <> GIFTrailer do
    begin
+      // Read blocks until we find the one of known type
+      while not (BlockID in [GIFTrailer, GIFExtensionIntroducer, GIFImageDescriptor]) do
+        BlockID := ReadBlockID;
      // Read supported and skip unsupported extensions
      ReadExtensions;
      // If image frame is found read it
@ -895,6 +1071,31 @@ begin
        BlockID := GIFTrailer;
    end;

+    if FLoadAnimated then
+    begin
+      // Aniated frames will be stored in AnimFrames
+      SetLength(AnimFrames, Length(Images));
+      InitImage(CachedFrame);
+      CachedIndex := -1;
+
+      for I := 0 to High(Images) do
+      begin
+        // Create new logical screen
+        NewImage(ScreenWidth, ScreenHeight, ifA8R8G8B8, AnimFrames[I]);
+        // Animate frames to current log screen
+        AnimateFrame(I, AnimFrames[I]);
+      end;
+
+      // Now release raw 8bit frames and put animated 32bit ones
+      // to output array
+      FreeImage(CachedFrame);
+      for I := 0 to High(AnimFrames) do
+      begin
+        FreeImage(Images[I]);
+        Images[I] := AnimFrames[I];
+      end;
+    end;
+
    Result := True;
  end;
 end;
@ -1007,6 +1208,14 @@ initialization
 -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Fixed bug - loading of GIF with NETSCAPE app extensions
+      failed with Delphi 2009.
+
+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - GIF loading and animation mostly rewritten, based on
+      modification by Sergey Galezdinov (ExtraGIF in Extras/Contrib).
+
  -- 0.25.0 Changes/Bug Fixes ---------------------------------
    - Fixed loading of some rare GIFs, problems with LZW
      decompression.
--- a/Imaging/ImagingJpeg.pas
+++ b/Imaging/ImagingJpeg.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingJpeg.pas 128 2008-07-23 11:57:36Z galfar $
+  $Id: ImagingJpeg.pas 180 2009-10-16 01:07:26Z galfar $
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net
@ -43,22 +43,22 @@ unit ImagingJpeg;
 {$DEFINE IMJPEGLIB}
 { $DEFINE PASJPEG}

-{ Automatically use FPC's PasJpeg when compiling with Lazarus.}
-
-{$IFDEF LCL}
+{ Automatically use FPC's PasJpeg when compiling with Lazarus. But not when
+  WINDOWS is defined. See http://galfar.vevb.net/imaging/smf/index.php/topic,90.0.html}
+{$IF Defined(LCL) and not Defined(WINDOWS)}
  {$UNDEF IMJPEGLIB}
  {$DEFINE PASJPEG}
-{$ENDIF}
+{$IFEND}

 interface

 uses
  SysUtils, ImagingTypes, Imaging, ImagingColors,
 {$IF Defined(IMJPEGLIB)}
-  imjpeglib, imjmorecfg, imjcomapi, imjdapimin,
+  imjpeglib, imjmorecfg, imjcomapi, imjdapimin, imjdeferr, imjerror,
  imjdapistd, imjcapimin, imjcapistd, imjdmarker, imjcparam,
 {$ELSEIF Defined(PASJPEG)}
-  jpeglib, jmorecfg, jcomapi, jdapimin,
+  jpeglib, jmorecfg, jcomapi, jdapimin, jdeferr, jerror,
  jdapistd, jcapimin, jcapistd, jdmarker, jcparam,
 {$IFEND}
  ImagingUtility;
@ -70,7 +70,10 @@ uses

 type
  { Class for loading/saving Jpeg images. Supports load/save of
-    8 bit grayscale and 24 bit RGB images.}
+    8 bit grayscale and 24 bit RGB images. Jpegs can be saved with optional
+    progressive encoding.
+    Based on IJG's JpegLib so doesn't support alpha channels and lossless
+    coding.}
  TJpegFileFormat = class(TImageFileFormat)
  private
    FGrayScale: Boolean;
@ -110,10 +113,11 @@ const
 const
  { Jpeg file identifiers.}
  JpegMagic: TChar2 = #$FF#$D8;
-  JFIFSignature: TChar4 = 'JFIF';
-  EXIFSignature: TChar4 = 'Exif';
  BufferSize = 16384;

+resourcestring
+  SJpegError = 'JPEG Error';
+
 type
  TJpegContext = record
    case Byte of
@ -139,40 +143,23 @@ type

 var
  JIO: TIOFunctions;
-
+  JpegErrorMgr: jpeg_error_mgr;

 { Intenal unit jpeglib support functions }

-procedure JpegError(CurInfo: j_common_ptr);
-begin
-end;
-
-procedure EmitMessage(CurInfo: j_common_ptr; msg_level: Integer);
+procedure JpegError(CInfo: j_common_ptr);
+var
+  Buffer: string;
 begin
+  { Create the message and raise exception }
+  CInfo^.err^.format_message(CInfo, buffer);
+  raise EImagingError.CreateFmt(SJPEGError + ' %d: ' + Buffer, [CInfo.err^.msg_code]);
 end;

 procedure OutputMessage(CurInfo: j_common_ptr);
 begin
 end;

-procedure FormatMessage(CurInfo: j_common_ptr; var buffer: string);
-begin
-end;
-
-procedure ResetErrorMgr(CurInfo: j_common_ptr);
-begin
-  CurInfo^.err^.num_warnings := 0;
-  CurInfo^.err^.msg_code := 0;
-end;
-
-var
-  JpegErrorRec: jpeg_error_mgr = (
-    error_exit: JpegError;
-    emit_message: EmitMessage;
-    output_message: OutputMessage;
-    format_message: FormatMessage;
-    reset_error_mgr: ResetErrorMgr);
-
 procedure ReleaseContext(var jc: TJpegContext);
 begin
  if jc.common.err = nil then
@ -221,7 +208,7 @@ begin
      FillInputBuffer(cinfo);
    end;
    Src.Pub.next_input_byte := @PByteArray(Src.Pub.next_input_byte)[num_bytes];
-//    Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
+    //Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
    Dec(Src.Pub.bytes_in_buffer, num_bytes);
  end;
 end;
@ -311,7 +298,11 @@ end;
 procedure InitDecompressor(Handle: TImagingHandle; var jc: TJpegContext);
 begin
  FillChar(jc, sizeof(jc), 0);
-  jc.common.err := @JpegErrorRec;
+  // Set standard error handlers and then override some
+  jc.common.err := jpeg_std_error(JpegErrorMgr);
+  jc.common.err.error_exit := JpegError;
+  jc.common.err.output_message := OutputMessage;
+
  jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, sizeof(jc.d));
  JpegStdioSrc(jc.d, Handle);
  jpeg_read_header(@jc.d, True);
@ -329,15 +320,19 @@ procedure InitCompressor(Handle: TImagingHandle; var jc: TJpegContext;
  Saver: TJpegFileFormat);
 begin
  FillChar(jc, sizeof(jc), 0);
-  jc.common.err := @JpegErrorRec;
+  // Set standard error handlers and then override some
+  jc.common.err := jpeg_std_error(JpegErrorMgr);
+  jc.common.err.error_exit := JpegError;
+  jc.common.err.output_message := OutputMessage;
+
  jpeg_CreateCompress(@jc.c, JPEG_LIB_VERSION, sizeof(jc.c));
  JpegStdioDest(jc.c, Handle);
+  if Saver.FGrayScale then
+    jc.c.in_color_space := JCS_GRAYSCALE
+  else
+    jc.c.in_color_space := JCS_RGB;
  jpeg_set_defaults(@jc.c);
  jpeg_set_quality(@jc.c, Saver.FQuality, True);
-  if Saver.FGrayScale then
-    jpeg_set_colorspace(@jc.c, JCS_GRAYSCALE)
-  else
-    jpeg_set_colorspace(@jc.c, JCS_YCbCr);
  if Saver.FProgressive then
    jpeg_simple_progression(@jc.c);
 end;
@ -376,13 +371,14 @@ var
  jc: TJpegContext;
  Info: TImageFormatInfo;
  Col32: PColor32Rec;
-{$IFDEF RGBSWAPPED}
+  NeedsRedBlueSwap: Boolean;
  Pix: PColor24Rec;
-{$ENDIF}
 begin
  // Copy IO functions to global var used in JpegLib callbacks
+  Result := False;
  SetJpegIO(GetIO);
  SetLength(Images, 1);
+  
  with JIO, Images[0] do
  try
    InitDecompressor(Handle, jc);
@ -390,6 +386,8 @@ begin
      JCS_GRAYSCALE: Format := ifGray8;
      JCS_RGB:       Format := ifR8G8B8;
      JCS_CMYK:      Format := ifA8R8G8B8;
+    else
+      Exit;
    end;
    NewImage(jc.d.image_width, jc.d.image_height, Format, Images[0]);
    jpeg_start_decompress(@jc.d);
@ -398,11 +396,18 @@ begin
    LinesPerCall := 1;
    Dest := Bits;

+    // If Jpeg's colorspace is RGB and not YCbCr we need to swap
+    // R and B to get Imaging's native order
+    NeedsRedBlueSwap := jc.d.jpeg_color_space = JCS_RGB;
+  {$IFDEF RGBSWAPPED}
+    // Force R-B swap for FPC's PasJpeg
+    NeedsRedBlueSwap := True;
+  {$ENDIF}
+
    while jc.d.output_scanline < jc.d.output_height do
    begin
      LinesRead := jpeg_read_scanlines(@jc.d, @Dest, LinesPerCall);
-    {$IFDEF RGBSWAPPED}
-      if Format = ifR8G8B8 then
+      if NeedsRedBlueSwap and (Format = ifR8G8B8) then
      begin
        Pix := PColor24Rec(Dest);
        for I := 0 to Width - 1 do
@ -411,7 +416,6 @@ begin
          Inc(Pix);
        end;
      end;
-    {$ENDIF}
      Inc(Dest, PtrInc * LinesRead);
    end;

@ -526,7 +530,7 @@ end;
 function TJpegFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
 var
  ReadCount: LongInt;
-  ID: array[0..9] of Char;
+  ID: array[0..9] of AnsiChar;
 begin
  Result := False;
  if Handle <> nil then
@ -554,8 +558,20 @@ initialization
 -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.5 Changes/Bug Fixes ---------------------------------
+    - Fixed swapped Red-Blue order when loading Jpegs with
+      jc.d.jpeg_color_space = JCS_RGB.
+
+  -- 0.26.3 Changes/Bug Fixes ---------------------------------
+    - Changed the Jpeg error manager, messages were not properly formated.
+
+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - Fixed wrong color space setting in InitCompressor.
+    - Fixed problem with progressive Jpegs in FPC (modified JpegLib,
+      can't use FPC's PasJpeg in Windows).
+
  -- 0.25.0 Changes/Bug Fixes ---------------------------------
-    -- FPC's PasJpeg wasn't really used in last version, fixed.
+    - FPC's PasJpeg wasn't really used in last version, fixed.

  -- 0.24.1 Changes/Bug Fixes ---------------------------------
    - Fixed loading of CMYK jpeg images. Could cause heap corruption
--- a/Imaging/ImagingNetworkGraphics.pas
+++ b/Imaging/ImagingNetworkGraphics.pas
--- a/Imaging/ImagingOpenGL.pas
+++ b/Imaging/ImagingOpenGL.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingOpenGL.pas 128 2008-07-23 11:57:36Z galfar $
+  $Id: ImagingOpenGL.pas 165 2009-08-14 12:34:40Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -33,17 +33,20 @@ unit ImagingOpenGL;
 {$I ImagingOptions.inc}

 { Define this symbol if you want to use dglOpenGL header.}
-{.$DEFINE USE_DGL_HEADERS}
+{ $DEFINE USE_DGL_HEADERS}
+{ $DEFINE USE_GLSCENE_HEADERS}

 interface

 uses
  SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats,
-{$IFDEF USE_DGL_HEADERS}
+{$IF Defined(USE_DGL_HEADERS)}
  dglOpenGL,
+{$ELSEIF Defined(USE_GLSCENE_HEADERS)}
+  OpenGL1x,
 {$ELSE}
  gl, glext,
-{$ENDIF}
+{$IFEND}
 ImagingUtility;

 type
@ -278,6 +281,10 @@ const
  GL_UNSIGNED_INT_2_10_10_10_REV    = $8368;
  GL_HALF_FLOAT_ARB                 = $140B;

+  // Other GL constants
+  GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C;
+
+
 {$IFDEF MSWINDOWS}
  GLLibName = 'opengl32.dll';
 {$ENDIF}
@ -880,6 +887,9 @@ initialization
      not only A8R8G8B8
    - support for cube and 3D maps

+  -- 0.26.1 Changes/Bug Fixes ---------------------------------
+    - Added support for GLScene's OpenGL header.
+
  -- 0.25.0 Changes/Bug Fixes ---------------------------------
    - Added 3Dc compressed texture formats support.
    - Added detection of 3Dc formats to texture caps.
--- a/Imaging/ImagingOptions.inc
+++ b/Imaging/ImagingOptions.inc
@ -1,47 +1,53 @@
-{ $Id: ImagingOptions.inc 132 2008-08-27 20:37:38Z galfar $ }
+{ $Id: ImagingOptions.inc 174 2009-09-08 09:37:59Z galfar $ }

 {
  User Options
  Following defines and options can be changed by user.
 }

-{ Source options. }
+{ Source options }

-{$DEFINE USE_INLINE}          // use function inlining for some functions
-                              // works in Free Pascal and Delphi 9+
-{$DEFINE USE_ASM}             // if defined, assembler versions of some
-                              // functions will be used (only for x86)
-{ $DEFINE DEBUG}               // if defined, debug info, range/IO/overflow
+{$DEFINE USE_INLINE}          // Use function inlining for some functions
+                              // works in Free Pascal and Delphi 9+.
+{.$DEFINE USE_ASM}             // Ff defined, assembler versions of some
+                              // functions will be used (only for x86).
+
+                              // Debug options: If none of these two are defined
+                              // your project settings are used.
+{ $DEFINE IMAGING_DEBUG}      // If defined, debug info, range/IO/overflow
                              // checking, stack frames, assertions, and
-                              // other debugging options will be turned on
+                              // other debugging options will be turned on.
+{$DEFINE IMAGING_RELEASE}    // If defined, all debug info is off.

-{ File format support linking options. Undefine formats which you don't want
-  to be registred automatically. }

-{.$DEFINE LINK_JPEG}        // link support for Jpeg images
-{.$DEFINE LINK_PNG}         // link support for PNG images
-{$DEFINE LINK_TARGA}       // link support for Targa images
-{$DEFINE LINK_BITMAP}      // link support for Windows Bitmap images
-{.$DEFINE LINK_DDS}         // link support for DDS images
-{.$DEFINE LINK_GIF}         // link support for GIF images
-{.$DEFINE LINK_MNG}         // link support for MNG images
-{.$DEFINE LINK_JNG}         // link support for JNG images
-{.$DEFINE LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)

-{.$DEFINE LINK_EXTRAS}      // link support for file formats defined in
+(* File format support linking options.
+  Define formats which you don't want to be registred automatically.
+  Default: all formats are registered = no symbols defined.
+  Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
+*)
+
+//{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
+//{$DEFINE DONT_LINK_PNG}         // link support for PNG images
+//{$DEFINE DONT_LINK_TARGA}       // link support for Targa images
+//{$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
+{$DEFINE DONT_LINK_DDS}         // link support for DDS images
+{$DEFINE DONT_LINK_GIF}         // link support for GIF images
+{$DEFINE DONT_LINK_MNG}         // link support for MNG images
+{$DEFINE DONT_LINK_JNG}         // link support for JNG images
+{$DEFINE DONT_LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
+
+{$DEFINE DONT_LINK_EXTRAS}  // link support for file formats defined in
                             // Extras package. Exactly which formats will be
                             // registered depends on settings in
                             // ImagingExtras.pas unit.

 { Component set used in ImagignComponents.pas unit. You usually don't need
  to be concerned with this - proper component library is selected automatically
-  according to your compiler (only exception is using CLX in Delphi 6/7). }
+  according to your compiler. }

-{$DEFINE COMPONENT_SET_VCL}   // use Borland's VCL
-{ $DEFINE COMPONENT_SET_CLX}   // use Borland's CLX (set automatically when using Kylix,
-                              // must be se manually when compiling with Delphi 6/7)
-{ $DEFINE COMPONENT_SET_LCL}   // use Lazarus' LCL (set automatically when
-                              // compiling with FPC)
+{ $DEFINE COMPONENT_SET_VCL}   // use Delphi VCL
+{$DEFINE COMPONENT_SET_LCL}  // use Lazarus LCL (set automatically when compiling with FPC)

 {
  Auto Options
@ -85,7 +91,7 @@
  {$ENDIF}
 {$IFEND}

-{$IFDEF DEBUG}
+{$IF Defined(IMAGING_DEBUG)}
  {$ASSERTIONS ON}
  {$DEBUGINFO ON}
  {$RANGECHECKS ON}
@ -95,13 +101,13 @@
    {$OPTIMIZATION OFF}
    {$STACKFRAMES ON}
    {$LOCALSYMBOLS ON}
-    { $DEFINE MEMCHECK}
+    {$DEFINE MEMCHECK}
  {$ENDIF}
  {$IFDEF FPC}
    {$S+}
    {$CHECKPOINTER ON}
  {$ENDIF}
-{$ELSE}
+{$ELSEIF Defined(IMAGING_RELEASE)}
  {$ASSERTIONS OFF}
  {$DEBUGINFO OFF}
  {$RANGECHECKS OFF}
@ -115,7 +121,8 @@
  {$IFDEF FPC}
    {$S-}
  {$ENDIF}
-{$ENDIF}
+{$IFEND}
+

 { Compiler capabilities }

@ -151,40 +158,11 @@
 {$IFDEF FPC}
  {$DEFINE COMPONENT_SET_LCL}
  {$UNDEF COMPONENT_SET_VCL}
-  {$UNDEF COMPONENT_SET_CLX}
-{$ENDIF}
-
-{$IFDEF KYLIX}
-  {$DEFINE COMPONENT_SET_CLX}
-  {$UNDEF COMPONENT_SET_VCL}
-  {$UNDEF COMPONENT_SET_LCL}
 {$ENDIF}

 {$IFDEF DELPHI}
  {$UNDEF COMPONENT_SET_LCL}
-  {$IF CompilerVersion >= 17}
-    {$UNDEF COMPONENT_SET_CLX}     // Delphi 9+ has no CLX
-  {$IFEND}
-  {$IFNDEF COMPONENT_SET_VCL}
-    {$IFNDEF COMPONENT_SET_CLX}
-      {$DEFINE COMPONENT_SET_VCL}  // use VCL as default if not set
-    {$ENDIF}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF COMPONENT_SET_VCL}
-  {$UNDEF COMPONENT_SET_CLX}
-  {$UNDEF COMPONENT_SET_LCL}
-{$ENDIF}
-
-{$IFDEF COMPONENT_SET_CLX}
-  {$UNDEF COMPONENT_SET_VCL}
-  {$UNDEF COMPONENT_SET_LCL}
-{$ENDIF}
-
-{$IFDEF COMPONENT_SET_LCL}
-  {$UNDEF COMPONENT_SET_VCL}
-  {$UNDEF COMPONENT_SET_CLX}
+  {$DEFINE COMPONENT_SET_VCL}
 {$ENDIF}

 { Platform options }
@ -220,16 +198,4 @@
  {$INLINE ON}             // turns inlining on for compilers that support it
 {$ENDIF}

-{ Extension dependencies check }
-
-{$IFDEF LINK_MNG}          // MNG uses internaly both PNG and JNG
-  {$DEFINE LINK_JNG}
-  {$DEFINE LINK_PNG}
-{$ENDIF}
-
-{$IFDEF LINK_JNG}          // JNG uses internaly both PNG and JPEG
-  {$DEFINE LINK_PNG}
-  {$DEFINE LINK_JPEG}
-{$ENDIF}
-

--- a/Imaging/ImagingPortableMaps.pas
+++ b/Imaging/ImagingPortableMaps.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingPortableMaps.pas 127 2008-05-31 01:57:13Z galfar $
+  $Id: ImagingPortableMaps.pas 163 2009-07-28 21:44:10Z galfar $
  Vampyre Imaging Library
  by Marek Mauder
  http://imaginglib.sourceforge.net
@ -46,7 +46,7 @@ type
  TPortableMapInfo = record
    Width: LongInt;
    Height: LongInt;
-    FormatId: Char;
+    FormatId: AnsiChar;
    MaxVal: LongInt;
    BitCount: LongInt;
    Depth: LongInt;
@ -200,7 +200,7 @@ var
  MonoData: Pointer;
  Info: TImageFormatInfo;
  PixelFP: TColorFPRec;
-  LineBuffer: array[0..LineBufferCapacity - 1] of Char;
+  LineBuffer: array[0..LineBufferCapacity - 1] of AnsiChar;
  LineEnd, LinePos: LongInt;
  MapInfo: TPortableMapInfo;
  LineBreak: string;
@ -228,7 +228,7 @@ var
  function ReadString: string;
  var
    S: AnsiString;
-    C: Char;
+    C: AnsiChar;
  begin
    // First skip all whitespace chars
    SetLength(S, 1);
@ -266,7 +266,7 @@ var
    // Dec pos, current is the begining of the the string
    Dec(LinePos);

-    Result := S;
+    Result := string(S);
  end;

  function ReadIntValue: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
@ -276,7 +276,7 @@ var

  procedure FindLineBreak;
  var
-    C: Char;
+    C: AnsiChar;
  begin
    LineBreak := #10;
    repeat
@ -586,7 +586,11 @@ var
  begin
    SetLength(S, Length(S) + 1);
    S[Length(S)] := Delimiter;
+  {$IF Defined(DCC) and Defined(UNICODE)}
+    GetIO.Write(Handle, @AnsiString(S)[1], Length(S));
+  {$ELSE}
    GetIO.Write(Handle, @S[1], Length(S));
+  {$IFEND}
    Inc(LineLength, Length(S));
  end;

@ -807,7 +811,6 @@ begin
  FName := SPGMFormatName;
  FSupportedFormats := PGMSupportedFormats;
  AddMasks(SPGMMasks);
-
  RegisterOption(ImagingPGMSaveBinary, @FSaveBinary);
  FIdNumbers := '25';
 end;
@ -818,7 +821,10 @@ var
  MapInfo: TPortableMapInfo;
 begin
  FillChar(MapInfo, SizeOf(MapInfo), 0);
-  MapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
+  if FSaveBinary then
+    MapInfo.FormatId := FIdNumbers[1]
+  else
+    MapInfo.FormatId := FIdNumbers[0];
  MapInfo.Binary := FSaveBinary;
  Result := SaveDataInternal(Handle, Images, Index, MapInfo);
 end;
@ -853,7 +859,6 @@ begin
  FName := SPPMFormatName;
  FSupportedFormats := PPMSupportedFormats;
  AddMasks(SPPMMasks);
-
  RegisterOption(ImagingPPMSaveBinary, @FSaveBinary);
  FIdNumbers := '36';
 end;
@ -864,7 +869,10 @@ var
  MapInfo: TPortableMapInfo;
 begin
  FillChar(MapInfo, SizeOf(MapInfo), 0);
-  MapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
+  if FSaveBinary then
+    MapInfo.FormatId := FIdNumbers[1]
+  else
+    MapInfo.FormatId := FIdNumbers[0];
  MapInfo.Binary := FSaveBinary;
  Result := SaveDataInternal(Handle, Images, Index, MapInfo);
 end;
@ -952,11 +960,17 @@ var
 begin
  FillChar(MapInfo, SizeOf(MapInfo), 0);
  Info := GetFormatInfo(Images[Index].Format);
+
  if (Info.ChannelCount > 1) or Info.IsIndexed then
    MapInfo.TupleType := ttRGBFP
  else
    MapInfo.TupleType := ttGrayScaleFP;
-  MapInfo.FormatId := Iff(MapInfo.TupleType = ttGrayScaleFP, FIdNumbers[1], FIdNumbers[0]);
+
+  if MapInfo.TupleType = ttGrayScaleFP then
+    MapInfo.FormatId := FIdNumbers[1]
+  else
+    MapInfo.FormatId := FIdNumbers[0];
+
  MapInfo.Binary := True;
  Result := SaveDataInternal(Handle, Images, Index, MapInfo);
 end;
@ -983,6 +997,9 @@ initialization
  -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.3 Changes/Bug Fixes -----------------------------------
+    - Fixed D2009 Unicode related bug in PNM saving.
+
  -- 0.24.3 Changes/Bug Fixes -----------------------------------
    - Improved compatibility of 16bit/component image loading.
    - Changes for better thread safety.
--- a/Imaging/ImagingTarga.pas
+++ b/Imaging/ImagingTarga.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingTarga.pas 84 2007-05-27 13:54:27Z galfar $
+  $Id: ImagingTarga.pas 139 2008-09-18 02:01:42Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -91,7 +91,7 @@ type
  TTargaFooter = packed record
    ExtOff: LongWord;             // Extension Area Offset
    DevDirOff: LongWord;          // Developer Directory Offset
-    Signature: array[0..15] of Char;  // TRUEVISION-XFILE
+    Signature: TChar16;           // TRUEVISION-XFILE
    Reserved: Byte;               // ASCII period '.'
    NullChar: Byte;               // 0
  end;
--- a/Imaging/ImagingTypes.pas
+++ b/Imaging/ImagingTypes.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingTypes.pas 132 2008-08-27 20:37:38Z galfar $
+  $Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -39,7 +39,7 @@ const
  { Current Minor version of Imaging.}
  ImagingVersionMinor = 26;
  { Current patch of Imaging.}
-  ImagingVersionPatch = 0;
+  ImagingVersionPatch = 4;

  { Imaging Option Ids whose values can be set/get by SetOption/
    GetOption functions.}
@ -91,6 +91,11 @@ const
    Allowed values are in range 0 (no compresstion) to 9 (best compression).
    Default value is 5.}
  ImagingPNGCompressLevel      = 26;
+  { Boolean option that specifies whether PNG images with more frames (APNG format)
+    are animated by Imaging (according to frame disposal/blend methods) or just
+    raw frames are loaded and sent to user (if you want to animate APNG yourself).
+    Default value is 1.}
+  ImagingPNGLoadAnimated       = 27;

  { Specifies whether MNG animation frames are saved with lossy or lossless
    compression. Lossless frames are saved as PNG images and lossy frames are
@ -140,10 +145,11 @@ const
  { Boolean option that specifies whether GIF images with more frames
    are animated by Imaging (according to frame disposal methods) or just
    raw frames are loaded and sent to user (if you want to animate GIF yourself).
-    Default value is 1.}
+    Default value is 1.
+    Raw frames are 256 color indexed images (ifIndex8), whereas
+    animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
  ImagingGIFLoadAnimated       = 56;

-
  { This option is used when reducing number of colors used in
    image (mainly when converting from ARGB image to indexed
    format). Mask is 'anded' (bitwise AND) with every pixel's
--- a/Imaging/ImagingUtility.pas
+++ b/Imaging/ImagingUtility.pas
@ -1,5 +1,5 @@
 {
-  $Id: ImagingUtility.pas 128 2008-07-23 11:57:36Z galfar $
+  $Id: ImagingUtility.pas 175 2009-10-06 11:55:15Z galfar $
  Vampyre Imaging Library
  by Marek Mauder 
  http://imaginglib.sourceforge.net
@ -56,6 +56,7 @@ type
  TBooleanArray = array[0..MaxInt - 1] of Boolean;
  PBooleanArray = ^TBooleanArray;

+  TDynByteArray = array of Byte;
  TDynIntegerArray = array of Integer;
  TDynBooleanArray = array of Boolean;
  
@ -98,10 +99,11 @@ type
   end;
  PFloatHelper = ^TFloatHelper;

-  TChar2 = array[0..1] of Char;
-  TChar3 = array[0..2] of Char;
-  TChar4 = array[0..3] of Char;
-  TChar8 = array[0..7] of Char;
+  TChar2 = array[0..1] of AnsiChar;
+  TChar3 = array[0..2] of AnsiChar;
+  TChar4 = array[0..3] of AnsiChar;
+  TChar8 = array[0..7] of AnsiChar;
+  TChar16 = array[0..15] of AnsiChar;

  { Options for BuildFileList function:
    flFullNames - file names in result will have full path names
@ -156,10 +158,13 @@ function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFD
 function StrToken(var S: string; Sep: Char): string;
 { Same as StrToken but searches from the end of S string.}
 function StrTokenEnd(var S: string; Sep: Char): string;
+{ Fills instance of TStrings with tokens from string S where tokens are separated by
+  one of Seps characters.}
+procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
 { Returns string representation of integer number (with digit grouping).}
-function IntToStrFmt(const I: Int64): string;
+function IntToStrFmt(const I: Int64): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
 { Returns string representation of float number (with digit grouping).}
-function FloatToStrFmt(const F: Double; Precision: Integer = 2): string;
+function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF}

 { Clamps integer value to range <Min, Max>}
 function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
@ -447,7 +452,7 @@ var
    if CaseSensitive then
      Result := A = B
    else
-      Result := UpCase(A) = UpCase(B);
+      Result := AnsiUpperCase (A) = AnsiUpperCase (B);
  end;

  function MatchAt(MaskPos, KeyPos: LongInt): Boolean;
@ -609,101 +614,6 @@ begin
 end;

 function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
-{$IFDEF USE_ASM}
-asm
-  // The Original ASM Code is (C) Fastcode project.
-       test  eax, eax
-       jz    @Nil
-       test  edx, edx
-       jz    @Nil
-       dec   ecx
-       jl    @Nil
-
-       push  esi
-       push  ebx
-
-       mov   esi, [edx-4]  //Length(Str)
-       mov   ebx, [eax-4]  //Length(Substr)
-       sub   esi, ecx      //effective length of Str
-       add   edx, ecx      //addr of the first char at starting position
-       cmp   esi, ebx
-       jl    @Past         //jump if EffectiveLength(Str)<Length(Substr)
-       test  ebx, ebx
-       jle   @Past         //jump if Length(Substr)<=0
-
-       add   esp, -12
-       add   ebx, -1       //Length(Substr)-1
-       add   esi, edx      //addr of the terminator
-       add   edx, ebx      //addr of the last char at starting position
-       mov   [esp+8], esi  //save addr of the terminator
-       add   eax, ebx      //addr of the last char of Substr
-       sub   ecx, edx      //-@Str[Length(Substr)]
-       neg   ebx           //-(Length(Substr)-1)
-       mov   [esp+4], ecx  //save -@Str[Length(Substr)]
-       mov   [esp], ebx    //save -(Length(Substr)-1)
-       movzx ecx, byte ptr [eax] //the last char of Substr
-
-@Loop:
-       cmp   cl, [edx]
-       jz    @Test0
-@AfterTest0:
-       cmp   cl, [edx+1]
-       jz    @TestT
-@AfterTestT:
-       add   edx, 4
-       cmp   edx, [esp+8]
-       jb   @Continue
-@EndLoop:
-       add   edx, -2
-       cmp   edx, [esp+8]
-       jb    @Loop
-@Exit:
-       add   esp, 12
-@Past:
-       pop   ebx
-       pop   esi
-@Nil:
-       xor   eax, eax
-       ret
-@Continue:
-       cmp   cl, [edx-2]
-       jz    @Test2
-       cmp   cl, [edx-1]
-       jnz   @Loop
-@Test1:
-       add   edx,  1
-@Test2:
-       add   edx, -2
-@Test0:
-       add   edx, -1
-@TestT:
-       mov   esi, [esp]
-       test  esi, esi
-       jz    @Found
-@String:
-       movzx ebx, word ptr [esi+eax]
-       cmp   bx, word ptr [esi+edx+1]
-       jnz   @AfterTestT
-       cmp   esi, -2
-       jge   @Found
-       movzx ebx, word ptr [esi+eax+2]
-       cmp   bx, word ptr [esi+edx+3]
-       jnz   @AfterTestT
-       add   esi, 4
-       jl    @String
-@Found:
-       mov   eax, [esp+4]
-       add   edx, 2
-
-       cmp   edx, [esp+8]
-       ja    @Exit
-
-       add   esp, 12
-       add   eax, edx
-       pop   ebx
-       pop   esi
-end;
-{$ELSE}
 var
  I, X: LongInt;
  Len, LenSubStr: LongInt;
@ -728,11 +638,10 @@ begin
  end;
  Result := 0;
 end;
-{$ENDIF}

 function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt;
 begin
-  Result := PosEx(LowerCase(SubStr), LowerCase(S), Offset);
+  Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset);
 end;

 function StrToken(var S: string; Sep: Char): string;
@ -775,6 +684,19 @@ begin
  end;
 end;

+procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
+var
+  Token, Str: string;
+begin
+  Tokens.Clear;
+  Str := S;
+  while Str <> '' do
+  begin
+    Token := StrToken(Str, Sep);
+    Tokens.Add(Token);
+  end;
+end;
+
 function IntToStrFmt(const I: Int64): string;
 begin
  Result := Format('%.0n', [I * 1.0]);
@ -790,8 +712,7 @@ begin
  Result := Number;
  if Result < Min then
    Result := Min
-  else
-  if Result > Max then
+  else if Result > Max then
    Result := Max;
 end;

@ -800,8 +721,7 @@ begin
  Result := Number;
  if Result < Min then
    Result := Min
-  else
-  if Result > Max then
+  else if Result > Max then
    Result := Max;
 end;

@ -831,7 +751,7 @@ end;
 function NextPow2(Num: LongInt): LongInt;
 begin
  Result := Num and -Num;
-  while (Result < Num) do
+  while Result < Num do
    Result := Result shl 1;
 end;

@ -1552,6 +1472,12 @@ initialization
  -- TODOS ----------------------------------------------------
    - nothing now

+  -- 0.26.1 Changes/Bug Fixes -----------------------------------
+    - Some formatting changes.
+    - Changed some string functions to work with localized strings.
+    - ASM version of PosEx had bugs, removed it.
+    - Added StrTokensToList function.
+
  -- 0.25.0 Changes/Bug Fixes -----------------------------------
    - Fixed error in ClipCopyBounds which was causing ... bad clipping!

--- a/Imaging/JpegLib/imjmemmgr.pas
+++ b/Imaging/JpegLib/imjmemmgr.pas
@ -492,6 +492,7 @@ begin
  { Calculate max # of rows allowed in one allocation chunk }
  ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div
 	  (long(blocksperrow) * SIZEOF(JBLOCK));
+
  if (ltemp <= 0) then
    ERREXIT(cinfo, JERR_WIDTH_OVERFLOW);
  if (ltemp < long(numrows)) then
--- a/Imaging/JpegLib/imjmemnobs.pas
+++ b/Imaging/JpegLib/imjmemnobs.pas
@ -27,13 +27,8 @@ uses
  NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
  size_t and will be a multiple of sizeof(align_type). }

-{$IFDEF WINDOWS}
-const
-  MAX_ALLOC_CHUNK = long(32752);
-{$ELSE}
 const
  MAX_ALLOC_CHUNK = long(1000000000);
-{$ENDIF}

 {GLOBAL}
 procedure jpeg_open_backing_store (cinfo : j_common_ptr;
--- a/Imaging/ZLib/dzlib.pas
+++ b/Imaging/ZLib/dzlib.pas
@ -124,7 +124,7 @@ type
    FStrmPos: Integer;
    FOnProgress: TNotifyEvent;
    FZRec: TZStreamRec;
-    FBuffer: array [Word] of Char;
+    FBuffer: array [Word] of Byte;
  protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
@ -228,7 +228,7 @@ type
 implementation

 const
-  ZErrorMessages: array[0..9] of PChar = (
+  ZErrorMessages: array[0..9] of PAnsiChar = (
    'need dictionary',        // Z_NEED_DICT      (2)
    'stream end',             // Z_STREAM_END     (1)
    '',                       // Z_OK             (0)
@ -491,7 +491,7 @@ end;
 function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
 var
  I: Integer;
-  Buf: array [0..4095] of Char;
+  Buf: array [0..4095] of Byte;
 begin
  if (Offset = 0) and (Origin = soFromBeginning) then
  begin
--- a/Imaging/ZLib/iminfcodes.pas
+++ b/Imaging/ZLib/iminfcodes.pas
@ -172,7 +172,7 @@ begin
        c^.sub.lit := t^.base;
       {$IFDEF DEBUG}
        if (t^.base >= $20) and (t^.base < $7f) then
-          Tracevv('inflate:         literal '+char(t^.base))
+          Tracevv('inflate:         literal '+AnsiChar(t^.base))
        else
          Tracevv('inflate:         literal '+IntToStr(t^.base));
        {$ENDIF}          
--- a/Imaging/ZLib/iminffast.pas
+++ b/Imaging/ZLib/iminffast.pas
@ -99,7 +99,7 @@ begin
      Dec(k, t^.bits);
     {$IFDEF DEBUG}
      if (t^.base >= $20) and (t^.base < $7f) then
-        Tracevv('inflate:         * literal '+char(t^.base))
+        Tracevv('inflate:         * literal '+AnsiChar(t^.base))
      else
        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
      {$ENDIF}
@ -241,7 +241,7 @@ begin

         {$IFDEF DEBUG}
          if (t^.base >= $20) and (t^.base < $7f) then
-            Tracevv('inflate:         * literal '+char(t^.base))
+            Tracevv('inflate:         * literal '+AnsiChar(t^.base))
          else
            Tracevv('inflate:         * literal '+IntToStr(t^.base));
          {$ENDIF}            
--- a/Imaging/ZLib/impaszlib.pas
+++ b/Imaging/ZLib/impaszlib.pas
@ -376,23 +376,23 @@ const


  {$IFDEF DEBUG}
-  procedure Assert(cond : boolean; msg : string);
+  procedure Assert(cond : boolean; msg : AnsiString);
  {$ENDIF}

-  procedure Trace(x : string);
-  procedure Tracev(x : string);
-  procedure Tracevv(x : string);
-  procedure Tracevvv(x : string);
-  procedure Tracec(c : boolean; x : string);
-  procedure Tracecv(c : boolean; x : string);
+  procedure Trace(x : AnsiString);
+  procedure Tracev(x : AnsiString);
+  procedure Tracevv(x : AnsiString);
+  procedure Tracevvv(x : AnsiString);
+  procedure Tracec(c : boolean; x : AnsiString);
+  procedure Tracecv(c : boolean; x : AnsiString);

-function zlibVersion : string;
+function zlibVersion : AnsiString;
 { The application can compare zlibVersion and ZLIB_VERSION for consistency.
  If the first character differs, the library code actually used is
  not compatible with the zlib.h header file used by the application.
  This check is automatically made by deflateInit and inflateInit. }

-function zError(err : int) : string;
+function zError(err : int) : AnsiString;
 function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
 procedure ZFREE (var strm : z_stream; ptr : voidpf);
 procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
@ -416,9 +416,9 @@ const
 const
  z_verbose : int = 1;

-function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
+function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
  Stream_size: LongInt): LongInt;
-function inflateInit_(var Stream: z_stream; const Version: string;
+function inflateInit_(var Stream: z_stream; const Version: AnsiString;
  Stream_size: Longint): LongInt;
  
 {$IFDEF DEBUG}
@ -430,29 +430,29 @@ implementation
 uses
  imzdeflate, imzinflate;

-function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
+function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
  Stream_size: LongInt): LongInt;
 begin
  Result := imzdeflate.deflateInit_(@Stream, Level, Version, Stream_size);
 end;

-function inflateInit_(var Stream: z_stream; const Version: string;
+function inflateInit_(var Stream: z_stream; const Version: AnsiString;
  Stream_size: Longint): LongInt;
 begin
  Result := imzinflate.inflateInit_(@Stream, Version, Stream_size);
 end;

-function zError(err : int) : string;
+function zError(err : int) : AnsiString;
 begin
  zError := z_errmsg[Z_NEED_DICT-err];
 end;

-function zlibVersion : string;
+function zlibVersion : AnsiString;
 begin
  zlibVersion := ZLIB_VERSION;
 end;

-procedure z_error (m : string);
+procedure z_error (m : AnsiString);
 begin
  WriteLn(output, m);
  Write('Zlib - Halt...');
@ -460,42 +460,42 @@ begin
  Halt(1);
 end;

-procedure Assert(cond : boolean; msg : string);
+procedure Assert(cond : boolean; msg : AnsiString);
 begin
  if not cond then
    z_error(msg);
 end;

-procedure Trace(x : string);
+procedure Trace(x : AnsiString);
 begin
  WriteLn(x);
 end;

-procedure Tracev(x : string);
+procedure Tracev(x : AnsiString);
 begin
 if (z_verbose>0) then
   WriteLn(x);
 end;

-procedure Tracevv(x : string);
+procedure Tracevv(x : AnsiString);
 begin
  if (z_verbose>1) then
    WriteLn(x);
 end;

-procedure Tracevvv(x : string);
+procedure Tracevvv(x : AnsiString);
 begin
  if (z_verbose>2) then
    WriteLn(x);
 end;

-procedure Tracec(c : boolean; x : string);
+procedure Tracec(c : boolean; x : AnsiString);
 begin
  if (z_verbose>0) and (c) then
    WriteLn(x);
 end;

-procedure Tracecv(c : boolean; x : string);
+procedure Tracecv(c : boolean; x : AnsiString);
 begin
  if (z_verbose>1) and c then
    WriteLn(x);
--- a/Imaging/ZLib/imtrees.pas
+++ b/Imaging/ZLib/imtrees.pas
@ -637,7 +637,7 @@ const
 }

 const
-  Buf_size = (8 * 2*sizeof(char));
+  Buf_size = (8 * 2*sizeof(uch));
 { Number of bits used within bi_buf. (bi_buf might be implemented on
  more than 16 bits on some systems.) }

@ -916,7 +916,7 @@ begin
    {$ifdef DEBUG}
    if (n>31) and (n<128) then
      Tracecv(tree <> tree_ptr(@static_ltree),
-       (^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
+       (^M'n #'+IntToStr(n)+' '+AnsiChar(n)+' l '+IntToStr(len)+' c '+
         IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
    else
      Tracecv(tree <> tree_ptr(@static_ltree),
@ -1962,7 +1962,7 @@ begin
      { send a literal byte }
      {$ifdef DEBUG}
      Tracevvv(#13'cd '+IntToStr(lc));
-      Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
+      Tracecv((lc > 31) and (lc < 128), ' '+AnsiChar(lc)+' ');
      {$ENDIF}
      send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len);
    end
@ -2106,7 +2106,7 @@ begin
 {$endif} { STORED_FILE_OK }

 {$ifdef FORCE_STORED}
-  if (buf <> pchar(0)) then
+  if (buf <> pcharf(0)) then
  begin { force stored block }
 {$else}
  if (stored_len+4 <= opt_lenb) and (buf <> pcharf(0)) then
--- a/Imaging/ZLib/imzdeflate.pas
+++ b/Imaging/ZLib/imzdeflate.pas
@ -61,7 +61,7 @@ uses

 function deflateInit_(strm : z_streamp;
                      level : int;
-                      const version : string;
+                      const version : AnsiString;
                      stream_size : int) : int;


@ -499,7 +499,7 @@ function deflateInit2_(var strm : z_stream;
                       windowBits : int;
                       memLevel : int;
                       strategy : int;
-                       const version : string;
+                       const version : AnsiString;
                       stream_size : int) : int;
 var
  s : deflate_state_ptr;
@ -622,7 +622,7 @@ end;

 function deflateInit_(strm : z_streamp;
                      level : int;
-                      const version : string;
+                      const version : AnsiString;
                      stream_size : int) : int;
 begin
  if (strm = Z_NULL) then
@ -1528,7 +1528,7 @@ begin
  begin
    WriteLn(' start ',start,', match ',match ,' length ', length);
    repeat
-      Write(char(s.window^[match]), char(s.window^[start]));
+      Write(AnsiChar(s.window^[match]), AnsiChar(s.window^[start]));
      Inc(match);
      Inc(start);
      Dec(length);
@ -1539,7 +1539,7 @@ begin
  begin
    Write('\\[',start-match,',',length,']');
    repeat
-       Write(char(s.window^[start]));
+       Write(AnsiChar(s.window^[start]));
       Inc(start);
       Dec(length);
    Until (length = 0);
@ -1910,7 +1910,7 @@ end;
    begin
      { No match, output a literal byte }
      {$IFDEF DEBUG}
-      Tracevv(char(s.window^[s.strstart]));
+      Tracevv(AnsiChar(s.window^[s.strstart]));
      {$ENDIF}
      {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
      bflush := _tr_tally (s, 0, s.window^[s.strstart]);
@ -2071,7 +2071,7 @@ begin
          single literal. If there was a match but the current match
          is longer, truncate the previous match to a single literal. }
        {$IFDEF DEBUG}
-        Tracevv(char(s.window^[s.strstart-1]));
+        Tracevv(AnsiChar(s.window^[s.strstart-1]));
        {$ENDIF}
        bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);

@ -2104,7 +2104,7 @@ begin
  if (s.match_available) then
  begin
    {$IFDEF DEBUG}
-    Tracevv(char(s.window^[s.strstart-1]));
+    Tracevv(AnsiChar(s.window^[s.strstart-1]));
    bflush :=
    {$ENDIF}
      _tr_tally (s, 0, s.window^[s.strstart-1]);
--- a/Imaging/ZLib/imzinflate.pas
+++ b/Imaging/ZLib/imzinflate.pas
@ -31,13 +31,13 @@ function inflateInit(var z : z_stream) : int;


 function inflateInit_(z : z_streamp;
-                      const version : string;
+                      const version : AnsiString;
                      stream_size : int) : int; 


 function inflateInit2_(var z: z_stream;
                       w : int;
-                       const version : string;
+                       const version : AnsiString;
                       stream_size : int) : int;

 function inflateInit2(var z: z_stream;
@ -246,7 +246,7 @@ end;

 function inflateInit2_(var z: z_stream;
                       w : int;
-                       const version : string;
+                       const version : AnsiString;
                       stream_size : int) : int;
 begin
  if (version = '') or (version[1] <> ZLIB_VERSION[1]) or
@ -333,7 +333,7 @@ begin
 end;

 function inflateInit_(z : z_streamp;
-                      const version : string;
+                      const version : AnsiString;
                      stream_size : int) : int;
 begin
  { initialize state }
--- a/Tools/convertfontmap/ConvertFontMap.lpi
+++ b/Tools/convertfontmap/ConvertFontMap.lpi
@ -0,0 +1,88 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <Icon Value="0"/>
+      <UseXPManifest Value="True"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="ConvertFontMap.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ConvertFontMap"/>
+        <CursorPos X="25" Y="38"/>
+        <TopLine Value="33"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit0>
+    </Units>
+    <JumpHistory Count="1" HistoryIndex="0">
+      <Position1>
+        <Filename Value="ConvertFontMap.lpr"/>
+        <Caret Line="82" Column="17" TopLine="54"/>
+      </Position1>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="..\..\bin\ConvertFontMap"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)\"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <UseLineInfoUnit Value="False"/>
+        <StripSymbols Value="True"/>
+      </Debugging>
+      <LinkSmart Value="True"/>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/Tools/convertfontmap/ConvertFontMap.lpr
+++ b/Tools/convertfontmap/ConvertFontMap.lpr
@ -0,0 +1,91 @@
+(*
+ * CDDL HEADER START
+ *
+ * The contents of this file are subject to the terms of the
+ * Common Development and Distribution License, Version 1.0 only
+ * (the "License").  You may not use this file except in compliance
+ * with the License.
+ *
+ * You can obtain a copy of the license at
+ * http://www.opensource.org/licenses/cddl1.php.
+ * See the License for the specific language governing permissions
+ * and limitations under the License.
+ *
+ * When distributing Covered Code, include this CDDL HEADER in each
+ * file and include the License file at
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * add the following below this CDDL HEADER, with the fields enclosed
+ * by brackets "[]" replaced with your own identifying * information:
+ *      Portions Copyright [yyyy] [name of copyright owner]
+ *
+ * CDDL HEADER END
+ *
+ *
+ *      Portions Copyright 2009 Andreas Schneider
+ *)
+program ConvertFontMap;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, sysutils, DOM, XMLRead;
+
+{$IFDEF WINDOWS}{$R ConvertFontMap.rc}{$ENDIF}
+
+type
+  TFontInfo = packed record
+    Character: char;
+    LeftOffset: SmallInt;
+    CharWidth: Word;
+    Width: Word;
+    Height: Word;
+    X1: Single;
+    Y1: Single;
+    X2: Single;
+    Y2: Single;
+  end;
+
+var
+  xmlDoc: TXMLDocument;
+  chars: TDOMNodeList;
+  root, parent, charNode: TDOMElement;
+  outFile: TFileStream;
+  spaceWidth: Word;
+  fontInfo: TFontInfo;
+  i: Integer;
+
+begin
+  if ParamCount = 2 then
+  begin
+    ReadXMLFile(xmlDoc, ParamStr(1));
+    outFile := TFileStream.Create(ParamStr(2), fmCreate);
+
+    root := xmlDoc.DocumentElement;
+    parent := TDOMElement(root.FindNode('characters'));
+    chars := parent.ChildNodes;
+
+    spaceWidth := StrToInt(root.AttribStrings['spacewidth']);
+    outFile.Write(spaceWidth, SizeOf(spaceWidth));
+
+    for i := 0 to chars.Count - 1 do
+    begin
+      charNode := TDOMElement(chars[i]);
+      fontInfo.Character := Char(StrToInt(charNode.AttribStrings['char']));
+      fontInfo.LeftOffset := StrToInt(charNode.AttribStrings['A']);
+      fontInfo.CharWidth := StrToInt(charNode.AttribStrings['C']);
+      fontInfo.Width := StrToInt(charNode.AttribStrings['wid']);
+      fontInfo.Height := StrToInt(charNode.AttribStrings['hgt']);
+      fontInfo.X1 := StrToFloat(charNode.AttribStrings['X1']);
+      fontInfo.Y1 := StrToFloat(charNode.AttribStrings['Y1']);
+      fontInfo.X2 := StrToFloat(charNode.AttribStrings['X2']);
+      fontInfo.Y2 := StrToFloat(charNode.AttribStrings['Y2']);
+      outFile.Write(fontInfo, SizeOf(fontInfo));
+    end;
+
+    outFile.Free;
+    xmlDoc.Free;
+
+  end else
+    Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' <In Font XML> <Out Font Bin>');
+end.
+