- Updated Vampyre Imaging Lib

- Added font rendering
- Added height display in flat mode

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>

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}
 

Client/ResourceList.txt

@@ -1,3 +1,5 @@
-Overlay/LeftTopArrow.tga
+Overlay/LeftTopArrow.tga
-Overlay/TopArrow.tga
+Overlay/TopArrow.tga
-Overlay/VirtualLayer.tga
+Overlay/VirtualLayer.tga
+GLFont/DejaVu.png
+GLFont/DejaVu.fnt

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.
+

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.
 

Client/UResourceManager.pas

@@ -1,106 +1,105 @@
-(*
+(*
- * CDDL HEADER START
+ * CDDL HEADER START
- *
+ *
- * The contents of this file are subject to the terms of the
+ * The contents of this file are subject to the terms of the
- * Common Development and Distribution License, Version 1.0 only
+ * Common Development and Distribution License, Version 1.0 only
- * (the "License").  You may not use this file except in compliance
+ * (the "License").  You may not use this file except in compliance
- * with the License.
+ * with the License.
- *
+ *
- * You can obtain a copy of the license at
+ * You can obtain a copy of the license at
- * http://www.opensource.org/licenses/cddl1.php.
+ * http://www.opensource.org/licenses/cddl1.php.
- * See the License for the specific language governing permissions
+ * See the License for the specific language governing permissions
- * and limitations under the License.
+ * and limitations under the License.
- *
+ *
- * When distributing Covered Code, include this CDDL HEADER in each
+ * When distributing Covered Code, include this CDDL HEADER in each
- * file and include the License file at
+ * file and include the License file at
- * http://www.opensource.org/licenses/cddl1.php.  If applicable,
+ * http://www.opensource.org/licenses/cddl1.php.  If applicable,
- * add the following below this CDDL HEADER, with the fields enclosed
+ * add the following below this CDDL HEADER, with the fields enclosed
- * by brackets "[]" replaced with your own identifying * information:
+ * by brackets "[]" replaced with your own identifying * information:
- *      Portions Copyright [yyyy] [name of copyright owner]
+ *      Portions Copyright [yyyy] [name of copyright owner]
- *
+ *
- * CDDL HEADER END
+ * CDDL HEADER END
- *
+ *
- *
+ *
- *      Portions Copyright 2007 Andreas Schneider
+ *      Portions Copyright 2009 Andreas Schneider
- *)
+ *)
-unit UResourceManager;
+unit UResourceManager;
-
+
-{$mode objfpc}{$H+}
+{$mode objfpc}{$H+}
-
+
-interface
+interface
-
+
-uses
+uses
-  Classes, SysUtils;
+  Classes, SysUtils;
-  
+  
-type
+type
-
+
-  { TResourceManager }
+  { TResourceManager }
-
+
-  TResourceManager = class(TObject)
+  TResourceManager = class(TObject)
-    constructor Create(AFileName: string);
+    constructor Create(AFileName: string);
-    destructor Destroy; override;
+    destructor Destroy; override;
-  protected
+  protected
-    FFileStream: TFileStream;
+    FFileStream: TFileStream;
-    FCount: Integer;
+    FCount: Integer;
-    FLookupTable: array of Cardinal;
+    FLookupTable: array of Cardinal;
-    FCurrentResource: Integer;
+    FCurrentResource: Integer;
-    FResourceStream: TMemoryStream;
+    FResourceStream: TMemoryStream;
-  public
+  public
-    function GetResource(AIndex: Integer): TStream;
+    function GetResource(AIndex: Integer): TStream;
-  end;
+  end;
-  
+  
-var
+var
-  ResourceManager: TResourceManager;
+  ResourceManager: TResourceManager;
-
+
-implementation
+implementation
-
+
-{ TResourceManager }
+{ TResourceManager }
-
+
-constructor TResourceManager.Create(AFileName: string);
+constructor TResourceManager.Create(AFileName: string);
-begin
+begin
-  inherited Create;
+  inherited Create;
-  FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
+  FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
-  FFileStream.Position := 0;
+  FFileStream.Position := 0;
-  FFileStream.Read(FCount, SizeOf(Integer));
+  FFileStream.Read(FCount, SizeOf(Integer));
-  SetLength(FLookupTable, FCount);
+  SetLength(FLookupTable, FCount);
-  FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
+  FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
-  FCurrentResource := -1;
+  FCurrentResource := -1;
-end;
+end;
-
+
-destructor TResourceManager.Destroy;
+destructor TResourceManager.Destroy;
-begin
+begin
-  if FFileStream <> nil then FreeAndNil(FFileStream);
+  FreeAndNil(FFileStream);
-  if FResourceStream <> nil then FreeAndNil(FResourceStream);
+  FreeAndNil(FResourceStream);
-  inherited Destroy;
+  inherited Destroy;
-end;
+end;
-
+
-function TResourceManager.GetResource(AIndex: Integer): TStream;
+function TResourceManager.GetResource(AIndex: Integer): TStream;
-var
+var
-  size: Cardinal;
+  size: Cardinal;
-begin
+begin
-  if AIndex <> FCurrentResource then
+  if AIndex <> FCurrentResource then
-  begin
+  begin
-    FFileStream.Position := FLookupTable[AIndex];
+    FFileStream.Position := FLookupTable[AIndex];
-    if FResourceStream <> nil then
+    FResourceStream.Free;
-      FResourceStream.Free;
+    FResourceStream := TMemoryStream.Create;
-    FResourceStream := TMemoryStream.Create;
+    FFileStream.Read(size, SizeOf(Cardinal));
-    FFileStream.Read(size, SizeOf(Cardinal));
+    FResourceStream.CopyFrom(FFileStream, size);
-    FResourceStream.CopyFrom(FFileStream, size);
+    FCurrentResource := AIndex;
-    FCurrentResource := AIndex;
+  end;
-  end;
+  FResourceStream.Position := 0;
-  FResourceStream.Position := 0;
+  Result := FResourceStream;
-  Result := FResourceStream;
+end;
-end;
+
-
+initialization
-initialization
+begin
-begin
+  ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
-  ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
+end;
-end;
+
-
+finalization
-finalization
+begin
-begin
+  if ResourceManager <> nil then FreeAndNil(ResourceManager);
-  if ResourceManager <> nil then FreeAndNil(ResourceManager);
+end;
-end;
+
-
+end.
-end.
+
-

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(
+  FLocationsFile := FAppDir + 'Locations.dat';
-                    Application.ExeName)) + '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(
+  FRandomPresetLocation := FAppDir + 'RandomPresets' + PathDelim;
-    Application.ExeName)) + '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);

Imaging/ImagingColors.pas

@@ -1,204 +1,245 @@
-{
+{
-  $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
+  Vampyre Imaging Library
-  by Marek Mauder 
+  by Marek Mauder 
-  http://imaginglib.sourceforge.net
+  http://imaginglib.sourceforge.net
-
+
-  The contents of this file are used with permission, subject to the Mozilla
+  The contents of this file are used with permission, subject to the Mozilla
-  Public License Version 1.1 (the "License"); you may not use this file except
+  Public License Version 1.1 (the "License"); you may not use this file except
-  in compliance with the License. You may obtain a copy of the License at
+  in compliance with the License. You may obtain a copy of the License at
-  http://www.mozilla.org/MPL/MPL-1.1.html
+  http://www.mozilla.org/MPL/MPL-1.1.html
-
+
-  Software distributed under the License is distributed on an "AS IS" basis,
+  Software distributed under the License is distributed on an "AS IS" basis,
-  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
-  the specific language governing rights and limitations under the License.
+  the specific language governing rights and limitations under the License.
-
+
-  Alternatively, the contents of this file may be used under the terms of the
+  Alternatively, the contents of this file may be used under the terms of the
-  GNU Lesser General Public License (the  "LGPL License"), in which case the
+  GNU Lesser General Public License (the  "LGPL License"), in which case the
-  provisions of the LGPL License are applicable instead of those above.
+  provisions of the LGPL License are applicable instead of those above.
-  If you wish to allow use of your version of this file only under the terms
+  If you wish to allow use of your version of this file only under the terms
-  of the LGPL License and not to allow others to use your version of this file
+  of the LGPL License and not to allow others to use your version of this file
-  under the MPL, indicate your decision by deleting  the provisions above and
+  under the MPL, indicate your decision by deleting  the provisions above and
-  replace  them with the notice and other provisions required by the LGPL
+  replace  them with the notice and other provisions required by the LGPL
-  License.  If you do not delete the provisions above, a recipient may use
+  License.  If you do not delete the provisions above, a recipient may use
-  your version of this file under either the MPL or the LGPL License.
+  your version of this file under either the MPL or the LGPL License.
-
+
-  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
+  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
-}
+}
-
+
-{ This unit contains functions for manipulating and converting color values.}
+{ This unit contains functions for manipulating and converting color values.}
-unit ImagingColors;
+unit ImagingColors;
-
+
-interface
+interface
-
+
-{$I ImagingOptions.inc}
+{$I ImagingOptions.inc}
-
+
-uses
+uses
-  SysUtils, ImagingTypes, ImagingUtility;
+  SysUtils, ImagingTypes, ImagingUtility;
-
+
-{ Converts RGB color to YUV.}
+{ Converts RGB color to YUV.}
-procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
+procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
-{ Converts YIV to RGB color.}
+{ Converts YIV to RGB color.}
-procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
+procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
-
+
-{ Converts RGB color to YCbCr as used in JPEG.}
+{ Converts RGB color to YCbCr as used in JPEG.}
-procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
+procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
-{ Converts YCbCr as used in JPEG to RGB color.}
+{ Converts YCbCr as used in JPEG to RGB color.}
-procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
+procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
-{ Converts RGB color to YCbCr as used in JPEG.}
+{ Converts RGB color to YCbCr as used in JPEG.}
-procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
+procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
-{ Converts YCbCr as used in JPEG to RGB color.}
+{ Converts YCbCr as used in JPEG to RGB color.}
-procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
+procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
-
+
-{ Converts RGB color to CMY.}
+{ Converts RGB color to CMY.}
-procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
+procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
-{ Converts CMY to RGB color.}
+{ Converts CMY to RGB color.}
-procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
+procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
-{ Converts RGB color to CMY.}
+{ Converts RGB color to CMY.}
-procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
+procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
-{ Converts CMY to RGB color.}
+{ Converts CMY to RGB color.}
-procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
+procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
-
+
-{ Converts RGB color to CMYK.}
+{ Converts RGB color to CMYK.}
-procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
+procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
-{ Converts CMYK to RGB color.}
+{ Converts CMYK to RGB color.}
-procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
+procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
-{ Converts RGB color to CMYK.}
+{ Converts RGB color to CMYK.}
-procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
+procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
-{ Converts CMYK to RGB color.}
+{ Converts CMYK to RGB color.}
-procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
+procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
-
+
-implementation
+{ Converts RGB color to YCoCg.}
-
+procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
-procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
+{ Converts YCoCg to RGB color.}
-begin
+procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
-  Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
+
-  V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
+
-  U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
+implementation
-end;
+
-
+procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
-procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
+begin
-var
+  Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
-  CY, CU, CV: LongInt;
+  V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
-begin
+  U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
-  CY := Y - 16;
+end;
-  CU := U - 128;
+
-  CV := V - 128;
+procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
-  R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
+var
-  G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
+  CY, CU, CV: LongInt;
-  B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
+begin
-end;
+  CY := Y - 16;
-
+  CU := U - 128;
-procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
+  CV := V - 128;
-begin
+  R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
-  Y  := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
+  G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
-  Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 128));
+  B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
-  Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 128));
+end;
-end;
+
-
+procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
-procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
+begin
-begin
+  Y  := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
-  R := ClampToByte(Round(Y                        + 1.40200 * (Cr - 128)));
+  Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 128));
-  G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
+  Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 128));
-  B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
+end;
-end;
+
-
+procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
-procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
+begin
-begin
+  R := ClampToByte(Round(Y                        + 1.40200 * (Cr - 128)));
-  Y  := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
+  G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
-  Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 32768));
+  B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
-  Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 32768));
+end;
-end;
+
-
+procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
-procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
+begin
-begin
+  Y  := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
-  R := ClampToWord(Round(Y                          + 1.40200 * (Cr - 32768)));
+  Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B  + 32768));
-  G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
+  Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B  + 32768));
-  B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
+end;
-end;
+
-
+procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
-procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
+begin
-begin
+  R := ClampToWord(Round(Y                          + 1.40200 * (Cr - 32768)));
-  C := 255 - R;
+  G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
-  M := 255 - G;
+  B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
-  Y := 255 - B;
+end;
-end;
+
-
+procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
-procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
+begin
-begin
+  C := 255 - R;
-  R := 255 - C;
+  M := 255 - G;
-  G := 255 - M;
+  Y := 255 - B;
-  B := 255 - Y;
+end;
-end;
+
-
+procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
-procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
+begin
-begin
+  R := 255 - C;
-  C := 65535 - R;
+  G := 255 - M;
-  M := 65535 - G;
+  B := 255 - Y;
-  Y := 65535 - B;
+end;
-end;
+
-
+procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
-procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
+begin
-begin
+  C := 65535 - R;
-  R := 65535 - C;
+  M := 65535 - G;
-  G := 65535 - M;
+  Y := 65535 - B;
-  B := 65535 - Y;
+end;
-end;
+
-
+procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
-procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
+begin
-begin
+  R := 65535 - C;
-  RGBToCMY(R, G, B, C, M, Y);
+  G := 65535 - M;
-  K := Min(C, Min(M, Y));
+  B := 65535 - Y;
-  if K > 0 then
+end;
-  begin
+
-    C := C - K;
+procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
-    M := M - K;
+begin
-    Y := Y - K;
+  RGBToCMY(R, G, B, C, M, Y);
-  end;
+  K := Min(C, Min(M, Y));
-end;
+  if K = 255 then
-
+  begin
-procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
+    C := 0;
-begin
+    M := 0;
-   R := (255 - (C - MulDiv(C, K, 255) + K));
+    Y := 0;
-   G := (255 - (M - MulDiv(M, K, 255) + K));
+  end
-   B := (255 - (Y - MulDiv(Y, K, 255) + K));
+  else
-end;
+  begin
-
+    C := ClampToByte(Round((C - K) / (255 - K) * 255));
-procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
+    M := ClampToByte(Round((M - K) / (255 - K) * 255));
-begin
+    Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
-  RGBToCMY16(R, G, B, C, M, Y);
+  end;
-  K := Min(C, Min(M, Y));
+end;
-  if K > 0 then
+
-  begin
+procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
-    C := C - K;
+begin
-    M := M - K;
+   R := (255 - (C - MulDiv(C, K, 255) + K));
-    Y := Y - K;
+   G := (255 - (M - MulDiv(M, K, 255) + K));
-  end;
+   B := (255 - (Y - MulDiv(Y, K, 255) + K));
-end;
+end;
-
+
-procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
+procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
-begin
+begin
-  R := 65535 - (C - MulDiv(C, K, 65535) + K);
+  RGBToCMY16(R, G, B, C, M, Y);
-  G := 65535 - (M - MulDiv(M, K, 65535) + K);
+  K := Min(C, Min(M, Y));
-  B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
+  if K = 65535 then
-end;
+  begin
-
+    C := 0;
-{
+    M := 0;
-  File Notes:
+    Y := 0;
-
+  end
-  -- TODOS ----------------------------------------------------
+  else
-    - nothing now
+  begin
-
+    C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
-  -- 0.23 Changes/Bug Fixes -----------------------------------
+    M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
-    - Added RGB<>CMY(K) converion functions for 16 bit channels
+    Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
-      (needed by PSD loading code).
+  end;
-
+end;
-  -- 0.21 Changes/Bug Fixes -----------------------------------
+
-    - Added some color space conversion functions and LUTs
+procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
-      (RGB/YUV/YCrCb/CMY/CMYK).
+begin
-
+  R := 65535 - (C - MulDiv(C, K, 65535) + K);
-  -- 0.17 Changes/Bug Fixes -----------------------------------
+  G := 65535 - (M - MulDiv(M, K, 65535) + K);
-    - unit created (empty!)
+  B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
-}
+end;
-
+
-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).
+
+  -- 0.21 Changes/Bug Fixes -----------------------------------
+    - Added some color space conversion functions and LUTs
+      (RGB/YUV/YCrCb/CMY/CMYK).
+
+  -- 0.17 Changes/Bug Fixes -----------------------------------
+    - unit created (empty!)
+}
+
+end.

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 GetMimeType: string; override;
-    //function GetDefaultMimeType: 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 GetMimeType: string; override;
-    function GetDefaultMimeType: 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 GetMimeType: string; override;
-    function GetDefaultMimeType: 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)}
+{$IF Defined(LCL)}
-  {$IFDEF LCLGTK2}
+  {$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 if Info.UsePixelFormat then
+        Imaging.ConvertImage(WorkData, ifR5G6B5)
       else
-{$ENDIF}
+        Imaging.ConvertImage(WorkData, ifR8G8B8);
-{$IF (not Defined(COMPONENT_SET_CLX)) and (not Defined(COMPONENT_SET_LCL))}
-        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
+  // Delphi 2009 and newer support alpha transparency fro TBitmap
-  begin
+{$IF Defined(DELPHI) and (CompilerVersion >= 20.0)}
-    // Copy palette
+  if Bitmap.PixelFormat = pf32bit then
-    ColorTable := Bitmap.ColorTable;
+    Bitmap.AlphaFormat := afDefined;
-    for I := 0 to Info.PaletteEntries - 1 do
+{$IFEND}
-    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);
 {$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) then
-  if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle, False) 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, nil) then
-  //if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, Classes.Rect(0, 0, Data.Width, Data.Height)) 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
@@ -780,62 +740,45 @@ begin
     end;
 
     try
-      with SrcRect, ImageData do
+       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;
-  end;  
+  end;
 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)}
+{$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}
-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)}
 
   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.GetMimeType: string;
-//function TImagingGraphicForSave.GetDefaultMimeType: 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.GetMimeType: string;
-function TImagingJpeg.GetDefaultMimeType: 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.GetMimeType: string;
-function TImagingMNG.GetDefaultMimeType: 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.

Imaging/ImagingOptions.inc

@@ -1,235 +1,201 @@
-{ $Id: ImagingOptions.inc 132 2008-08-27 20:37:38Z galfar $ }
+{ $Id: ImagingOptions.inc 174 2009-09-08 09:37:59Z galfar $ }
-
+
-{
+{
-  User Options
+  User Options
-  Following defines and options can be changed by user.
+  Following defines and options can be changed by user.
-}
+}
-
+
-{ Source options. }
+{ Source options }
-
+
-{$DEFINE USE_INLINE}          // use function inlining for some functions
+{$DEFINE USE_INLINE}          // Use function inlining for some functions
-                              // works in Free Pascal and Delphi 9+
+                              // works in Free Pascal and Delphi 9+.
-{$DEFINE USE_ASM}             // if defined, assembler versions of some
+{.$DEFINE USE_ASM}             // Ff defined, assembler versions of some
-                              // functions will be used (only for x86)
+                              // functions will be used (only for x86).
-{ $DEFINE DEBUG}               // if defined, debug info, range/IO/overflow
+
-                              // checking, stack frames, assertions, and
+                              // Debug options: If none of these two are defined
-                              // other debugging options will be turned on
+                              // your project settings are used.
-
+{ $DEFINE IMAGING_DEBUG}      // If defined, debug info, range/IO/overflow
-{ File format support linking options. Undefine formats which you don't want
+                              // checking, stack frames, assertions, and
-  to be registred automatically. }
+                              // other debugging options will be turned on.
-
+{$DEFINE IMAGING_RELEASE}    // If defined, all debug info is off.
-{.$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
+(* File format support linking options.
-{.$DEFINE LINK_DDS}         // link support for DDS images
+  Define formats which you don't want to be registred automatically.
-{.$DEFINE LINK_GIF}         // link support for GIF images
+  Default: all formats are registered = no symbols defined.
-{.$DEFINE LINK_MNG}         // link support for MNG images
+  Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
-{.$DEFINE LINK_JNG}         // link support for JNG images
+*)
-{.$DEFINE LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
+
-
+//{$DEFINE DONT_LINK_JPEG}        // link support for Jpeg images
-{.$DEFINE LINK_EXTRAS}      // link support for file formats defined in
+//{$DEFINE DONT_LINK_PNG}         // link support for PNG images
-                           // Extras package. Exactly which formats will be
+//{$DEFINE DONT_LINK_TARGA}       // link support for Targa images
-                           // registered depends on settings in
+//{$DEFINE DONT_LINK_BITMAP}      // link support for Windows Bitmap images
-                           // ImagingExtras.pas unit.
+{$DEFINE DONT_LINK_DDS}         // link support for DDS images
-
+{$DEFINE DONT_LINK_GIF}         // link support for GIF images
-{ Component set used in ImagignComponents.pas unit. You usually don't need
+{$DEFINE DONT_LINK_MNG}         // link support for MNG images
-  to be concerned with this - proper component library is selected automatically
+{$DEFINE DONT_LINK_JNG}         // link support for JNG images
-  according to your compiler (only exception is using CLX in Delphi 6/7). }
+{$DEFINE DONT_LINK_PNM}         // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
-
+
-{$DEFINE COMPONENT_SET_VCL}   // use Borland's VCL
+{$DEFINE DONT_LINK_EXTRAS}  // link support for file formats defined in
-{ $DEFINE COMPONENT_SET_CLX}   // use Borland's CLX (set automatically when using Kylix,
+                             // Extras package. Exactly which formats will be
-                              // must be se manually when compiling with Delphi 6/7)
+                             // registered depends on settings in
-{ $DEFINE COMPONENT_SET_LCL}   // use Lazarus' LCL (set automatically when
+                             // ImagingExtras.pas unit.
-                              // compiling with FPC)
+
-
+{ Component set used in ImagignComponents.pas unit. You usually don't need
-{
+  to be concerned with this - proper component library is selected automatically
-  Auto Options
+  according to your compiler. }
-  Following options and defines are set automatically and some
+
-  are required for Imaging to compile successfully. Do not change
+{ $DEFINE COMPONENT_SET_VCL}   // use Delphi VCL
-  anything here if you don't know what you are doing.
+{$DEFINE COMPONENT_SET_LCL}  // use Lazarus LCL (set automatically when compiling with FPC)
-}
+
-
+{
-{ Compiler options }
+  Auto Options
-
+  Following options and defines are set automatically and some
-{$ALIGN ON}               // Field alignment: 8 Bytes (in D6+)
+  are required for Imaging to compile successfully. Do not change
-{$BOOLEVAL OFF}           // Boolean eval: off
+  anything here if you don't know what you are doing.
-{$EXTENDEDSYNTAX ON}      // Extended syntax: on
+}
-{$LONGSTRINGS ON}         // string = AnsiString: on
+
-{$MINENUMSIZE 4}          // Min enum size: 4 B
+{ Compiler options }
-{$TYPEDADDRESS OFF}       // Typed pointers: off
+
-{$WRITEABLECONST OFF}     // Writeable constants: off
+{$ALIGN ON}               // Field alignment: 8 Bytes (in D6+)
-
+{$BOOLEVAL OFF}           // Boolean eval: off
-{$IFNDEF FPC}
+{$EXTENDEDSYNTAX ON}      // Extended syntax: on
-  {$DEFINE DCC}           // if not using FPC then DCC compiler is used (Delphi/Kylix)
+{$LONGSTRINGS ON}         // string = AnsiString: on
-                          // others are not supported
+{$MINENUMSIZE 4}          // Min enum size: 4 B
-{$ENDIF}
+{$TYPEDADDRESS OFF}       // Typed pointers: off
-
+{$WRITEABLECONST OFF}     // Writeable constants: off
-{$IFDEF DCC}
+
-  {$IFDEF LINUX}
+{$IFNDEF FPC}
-    {$DEFINE KYLIX}       // using Kylix
+  {$DEFINE DCC}           // if not using FPC then DCC compiler is used (Delphi/Kylix)
-  {$ENDIF}
+                          // others are not supported
-{$ENDIF}
+{$ENDIF}
-
+
-{$IFDEF DCC}
+{$IFDEF DCC}
-  {$IFNDEF KYLIX}
+  {$IFDEF LINUX}
-    {$DEFINE DELPHI}      // using Delphi
+    {$DEFINE KYLIX}       // using Kylix
-  {$ENDIF}
+  {$ENDIF}
-{$ENDIF}
+{$ENDIF}
-
+
-{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
+{$IFDEF DCC}
-  {$IFDEF RELEASE}
+  {$IFNDEF KYLIX}
-    {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
+    {$DEFINE DELPHI}      // using Delphi
-                   // DEBUG/RELEASE mode in project options and RELEASE
+  {$ENDIF}
-                   // is currently set we undef DEBUG mode
+{$ENDIF}
-  {$ENDIF}
+
-{$IFEND}
+{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
-
+  {$IFDEF RELEASE}
-{$IFDEF DEBUG}
+    {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
-  {$ASSERTIONS ON}
+                   // DEBUG/RELEASE mode in project options and RELEASE
-  {$DEBUGINFO ON}
+                   // is currently set we undef DEBUG mode
-  {$RANGECHECKS ON}
+  {$ENDIF}
-  {$IOCHECKS ON}
+{$IFEND}
-  {$OVERFLOWCHECKS ON}
+
-  {$IFDEF DCC}
+{$IF Defined(IMAGING_DEBUG)}
-    {$OPTIMIZATION OFF}
+  {$ASSERTIONS ON}
-    {$STACKFRAMES ON}
+  {$DEBUGINFO ON}
-    {$LOCALSYMBOLS ON}
+  {$RANGECHECKS ON}
-    { $DEFINE MEMCHECK}
+  {$IOCHECKS ON}
-  {$ENDIF}
+  {$OVERFLOWCHECKS ON}
-  {$IFDEF FPC}
+  {$IFDEF DCC}
-    {$S+}
+    {$OPTIMIZATION OFF}
-    {$CHECKPOINTER ON}
+    {$STACKFRAMES ON}
-  {$ENDIF}
+    {$LOCALSYMBOLS ON}
-{$ELSE}
+    {$DEFINE MEMCHECK}
-  {$ASSERTIONS OFF}
+  {$ENDIF}
-  {$DEBUGINFO OFF}
+  {$IFDEF FPC}
-  {$RANGECHECKS OFF}
+    {$S+}
-  {$IOCHECKS OFF}
+    {$CHECKPOINTER ON}
-  {$OVERFLOWCHECKS OFF}
+  {$ENDIF}
-  {$IFDEF DCC}
+{$ELSEIF Defined(IMAGING_RELEASE)}
-    {$OPTIMIZATION ON}
+  {$ASSERTIONS OFF}
-    {$STACKFRAMES OFF}
+  {$DEBUGINFO OFF}
-    {$LOCALSYMBOLS OFF}
+  {$RANGECHECKS OFF}
-  {$ENDIF}
+  {$IOCHECKS OFF}
-  {$IFDEF FPC}
+  {$OVERFLOWCHECKS OFF}
-    {$S-}
+  {$IFDEF DCC}
-  {$ENDIF}
+    {$OPTIMIZATION ON}
-{$ENDIF}
+    {$STACKFRAMES OFF}
-
+    {$LOCALSYMBOLS OFF}
-{ Compiler capabilities }
+  {$ENDIF}
-
+  {$IFDEF FPC}
-// Define if compiler supports inlining of functions and procedures
+    {$S-}
-// Note that FPC inline support crashed in older versions (1.9.8)
+  {$ENDIF}
-{$IF (Defined(DCC) and (CompilerVersion >= 17)) or (Defined(FPC) and Defined(CPU86))}
+{$IFEND}
-  {$DEFINE HAS_INLINE}
+
-{$IFEND}
+
-
+{ Compiler capabilities }
-// Define if compiler supports advanced records with methods
+
-{$IF (Defined(DCC) and (CompilerVersion >= 18)) }
+// Define if compiler supports inlining of functions and procedures
-  {$DEFINE HAS_ADVANCED_RECORDS}
+// Note that FPC inline support crashed in older versions (1.9.8)
-{$IFEND}
+{$IF (Defined(DCC) and (CompilerVersion >= 17)) or (Defined(FPC) and Defined(CPU86))}
-
+  {$DEFINE HAS_INLINE}
-// Define if compiler supports operator overloading
+{$IFEND}
-// (unfortunately Delphi and FPC operator overloaing is not compatible)
+
-{$IF (Defined(DCC) and (CompilerVersion >= 18)) or Defined(FPC)}
+// Define if compiler supports advanced records with methods
-  {$DEFINE HAS_OPERATOR_OVERLOADING}
+{$IF (Defined(DCC) and (CompilerVersion >= 18)) }
-{$IFEND}
+  {$DEFINE HAS_ADVANCED_RECORDS}
-
+{$IFEND}
-{ Imaging options check}
+
-
+// Define if compiler supports operator overloading
-{$IFNDEF HAS_INLINE}
+// (unfortunately Delphi and FPC operator overloaing is not compatible)
-  {$UNDEF USE_INLINE}
+{$IF (Defined(DCC) and (CompilerVersion >= 18)) or Defined(FPC)}
-{$ENDIF}
+  {$DEFINE HAS_OPERATOR_OVERLOADING}
-
+{$IFEND}
-{$IFDEF FPC}
+
-  {$IFNDEF CPU86}
+{ Imaging options check}
-    {$UNDEF USE_ASM}
+
-  {$ENDIF}
+{$IFNDEF HAS_INLINE}
-{$ENDIF}
+  {$UNDEF USE_INLINE}
-
+{$ENDIF}
-{$IFDEF FPC}
+
-  {$DEFINE COMPONENT_SET_LCL}
+{$IFDEF FPC}
-  {$UNDEF COMPONENT_SET_VCL}
+  {$IFNDEF CPU86}
-  {$UNDEF COMPONENT_SET_CLX}
+    {$UNDEF USE_ASM}
-{$ENDIF}
+  {$ENDIF}
-
+{$ENDIF}
-{$IFDEF KYLIX}
+
-  {$DEFINE COMPONENT_SET_CLX}
+{$IFDEF FPC}
-  {$UNDEF COMPONENT_SET_VCL}
+  {$DEFINE COMPONENT_SET_LCL}
-  {$UNDEF COMPONENT_SET_LCL}
+  {$UNDEF COMPONENT_SET_VCL}
-{$ENDIF}
+{$ENDIF}
-
+
-{$IFDEF DELPHI}
+{$IFDEF DELPHI}
-  {$UNDEF COMPONENT_SET_LCL}
+  {$UNDEF COMPONENT_SET_LCL}
-  {$IF CompilerVersion >= 17}
+  {$DEFINE COMPONENT_SET_VCL}
-    {$UNDEF COMPONENT_SET_CLX}     // Delphi 9+ has no CLX
+{$ENDIF}
-  {$IFEND}
+
-  {$IFNDEF COMPONENT_SET_VCL}
+{ Platform options }
-    {$IFNDEF COMPONENT_SET_CLX}
+
-      {$DEFINE COMPONENT_SET_VCL}  // use VCL as default if not set
+{$IFDEF WIN32}
-    {$ENDIF}
+  {$DEFINE MSWINDOWS}
-  {$ENDIF}
+{$ENDIF}
-{$ENDIF}
+
-
+{$IFDEF DPMI}
-{$IFDEF COMPONENT_SET_VCL}
+  {$DEFINE MSDOS}
-  {$UNDEF COMPONENT_SET_CLX}
+{$ENDIF}
-  {$UNDEF COMPONENT_SET_LCL}
+
-{$ENDIF}
+{$IFDEF LINUX}
-
+  {$DEFINE UNIX}
-{$IFDEF COMPONENT_SET_CLX}
+{$ENDIF}
-  {$UNDEF COMPONENT_SET_VCL}
+
-  {$UNDEF COMPONENT_SET_LCL}
+{ More compiler options }
-{$ENDIF}
+
-
+{$IFDEF FPC}               // Free Pascal options - some options set above (like min enum size)
-{$IFDEF COMPONENT_SET_LCL}
+                           // are reset to defaults by setting {$MODE} so they are
-  {$UNDEF COMPONENT_SET_VCL}
+                           // redeclared here 
-  {$UNDEF COMPONENT_SET_CLX}
+  {$MODE DELPHI}           // compatible with delphi
-{$ENDIF}
+  {$GOTO ON}               // alow goto
-
+  {$PACKRECORDS 8}         // same as ALING 8 for Delphi
-{ Platform options }
+  {$PACKENUM 4}            // Min enum size: 4 B
-
+  {$CALLING REGISTER}      // default calling convention is register
-{$IFDEF WIN32}
+  {$IFDEF CPU86}
-  {$DEFINE MSWINDOWS}
+    {$ASMMODE INTEL}       // intel assembler mode
-{$ENDIF}
+  {$ENDIF}
-
+{$ENDIF}
-{$IFDEF DPMI}
+
-  {$DEFINE MSDOS}
+{$IFDEF HAS_INLINE}        
-{$ENDIF}
+  {$INLINE ON}             // turns inlining on for compilers that support it
-
+{$ENDIF}
-{$IFDEF LINUX}
+
-  {$DEFINE UNIX}
+
-{$ENDIF}
-
-{ More compiler options }
-
-{$IFDEF FPC}               // Free Pascal options - some options set above (like min enum size)
-                           // are reset to defaults by setting {$MODE} so they are
-                           // redeclared here 
-  {$MODE DELPHI}           // compatible with delphi
-  {$GOTO ON}               // alow goto
-  {$PACKRECORDS 8}         // same as ALING 8 for Delphi
-  {$PACKENUM 4}            // Min enum size: 4 B
-  {$CALLING REGISTER}      // default calling convention is register
-  {$IFDEF CPU86}
-    {$ASMMODE INTEL}       // intel assembler mode
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF HAS_INLINE}        
-  {$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}
-
-

Imaging/ImagingTypes.pas

@@ -1,493 +1,499 @@
-{
+{
-  $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
+  Vampyre Imaging Library
-  by Marek Mauder 
+  by Marek Mauder 
-  http://imaginglib.sourceforge.net
+  http://imaginglib.sourceforge.net
-
+
-  The contents of this file are used with permission, subject to the Mozilla
+  The contents of this file are used with permission, subject to the Mozilla
-  Public License Version 1.1 (the "License"); you may not use this file except
+  Public License Version 1.1 (the "License"); you may not use this file except
-  in compliance with the License. You may obtain a copy of the License at
+  in compliance with the License. You may obtain a copy of the License at
-  http://www.mozilla.org/MPL/MPL-1.1.html
+  http://www.mozilla.org/MPL/MPL-1.1.html
-
+
-  Software distributed under the License is distributed on an "AS IS" basis,
+  Software distributed under the License is distributed on an "AS IS" basis,
-  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
-  the specific language governing rights and limitations under the License.
+  the specific language governing rights and limitations under the License.
-
+
-  Alternatively, the contents of this file may be used under the terms of the
+  Alternatively, the contents of this file may be used under the terms of the
-  GNU Lesser General Public License (the  "LGPL License"), in which case the
+  GNU Lesser General Public License (the  "LGPL License"), in which case the
-  provisions of the LGPL License are applicable instead of those above.
+  provisions of the LGPL License are applicable instead of those above.
-  If you wish to allow use of your version of this file only under the terms
+  If you wish to allow use of your version of this file only under the terms
-  of the LGPL License and not to allow others to use your version of this file
+  of the LGPL License and not to allow others to use your version of this file
-  under the MPL, indicate your decision by deleting  the provisions above and
+  under the MPL, indicate your decision by deleting  the provisions above and
-  replace  them with the notice and other provisions required by the LGPL
+  replace  them with the notice and other provisions required by the LGPL
-  License.  If you do not delete the provisions above, a recipient may use
+  License.  If you do not delete the provisions above, a recipient may use
-  your version of this file under either the MPL or the LGPL License.
+  your version of this file under either the MPL or the LGPL License.
-
+
-  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
+  For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
-}
+}
-
+
-{ This unit contains basic types and constants used by Imaging library.}
+{ This unit contains basic types and constants used by Imaging library.}
-unit ImagingTypes;
+unit ImagingTypes;
-
+
-{$I ImagingOptions.inc}
+{$I ImagingOptions.inc}
-
+
-interface
+interface
-
+
-const
+const
-  { Current Major version of Imaging.}
+  { Current Major version of Imaging.}
-  ImagingVersionMajor = 0;
+  ImagingVersionMajor = 0;
-  { Current Minor version of Imaging.}
+  { Current Minor version of Imaging.}
-  ImagingVersionMinor = 26;
+  ImagingVersionMinor = 26;
-  { Current patch of Imaging.}
+  { Current patch of Imaging.}
-  ImagingVersionPatch = 0;
+  ImagingVersionPatch = 4;
-
+
-  { Imaging Option Ids whose values can be set/get by SetOption/
+  { Imaging Option Ids whose values can be set/get by SetOption/
-    GetOption functions.}
+    GetOption functions.}
-
+
-  { Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large).
+  { Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large).
-    Default value is 90.}
+    Default value is 90.}
-  ImagingJpegQuality           = 10;
+  ImagingJpegQuality           = 10;
-  { Specifies whether Jpeg images are saved in progressive format,
+  { Specifies whether Jpeg images are saved in progressive format,
-    can be 0 or 1. Default value is 0.}
+    can be 0 or 1. Default value is 0.}
-  ImagingJpegProgressive       = 11;
+  ImagingJpegProgressive       = 11;
-
+
-  { Specifies whether Windows Bitmaps are saved using RLE compression
+  { Specifies whether Windows Bitmaps are saved using RLE compression
-    (only for 1/4/8 bit images), can be 0 or 1. Default value is 1.}
+    (only for 1/4/8 bit images), can be 0 or 1. Default value is 1.}
-  ImagingBitmapRLE             = 12;
+  ImagingBitmapRLE             = 12;
-
+
-  { Specifies whether Targa images are saved using RLE compression,
+  { Specifies whether Targa images are saved using RLE compression,
-    can be 0 or 1. Default value is 0.}
+    can be 0 or 1. Default value is 0.}
-  ImagingTargaRLE              = 13;
+  ImagingTargaRLE              = 13;
-
+
-  { Value of this option is non-zero if last loaded DDS file was cube map.}
+  { Value of this option is non-zero if last loaded DDS file was cube map.}
-  ImagingDDSLoadedCubeMap      = 14;
+  ImagingDDSLoadedCubeMap      = 14;
-  { Value of this option is non-zero if last loaded DDS file was volume texture.}
+  { Value of this option is non-zero if last loaded DDS file was volume texture.}
-  ImagingDDSLoadedVolume       = 15;
+  ImagingDDSLoadedVolume       = 15;
-  { Value of this option is number of mipmap levels of last loaded DDS image.}
+  { Value of this option is number of mipmap levels of last loaded DDS image.}
-  ImagingDDSLoadedMipMapCount  = 16;
+  ImagingDDSLoadedMipMapCount  = 16;
-  { Value of this option is depth (slices of volume texture or faces of
+  { Value of this option is depth (slices of volume texture or faces of
-    cube map) of last loaded DDS image.}
+    cube map) of last loaded DDS image.}
-  ImagingDDSLoadedDepth        = 17;
+  ImagingDDSLoadedDepth        = 17;
-  { If it is non-zero next saved DDS file should be stored as cube map.}
+  { If it is non-zero next saved DDS file should be stored as cube map.}
-  ImagingDDSSaveCubeMap        = 18;
+  ImagingDDSSaveCubeMap        = 18;
-  { If it is non-zero next saved DDS file should be stored as volume texture.}
+  { If it is non-zero next saved DDS file should be stored as volume texture.}
-  ImagingDDSSaveVolume         = 19;
+  ImagingDDSSaveVolume         = 19;
-  { Sets the number of mipmaps which should be stored in the next saved DDS file.
+  { Sets the number of mipmaps which should be stored in the next saved DDS file.
-    Only applies to cube maps and volumes, ordinary 2D textures save all
+    Only applies to cube maps and volumes, ordinary 2D textures save all
-    levels present in input.}
+    levels present in input.}
-  ImagingDDSSaveMipMapCount    = 20;
+  ImagingDDSSaveMipMapCount    = 20;
-  { Sets the depth (slices of volume texture or faces of cube map)
+  { Sets the depth (slices of volume texture or faces of cube map)
-    of the next saved DDS file.}
+    of the next saved DDS file.}
-  ImagingDDSSaveDepth          = 21;
+  ImagingDDSSaveDepth          = 21;
-
+
-  { Sets precompression filter used when saving PNG images. Allowed values
+  { Sets precompression filter used when saving PNG images. Allowed values
-    are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
+    are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
-    5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
+    5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
-    6 (adaptive filtering - use best filter for each scanline - very slow).
+    6 (adaptive filtering - use best filter for each scanline - very slow).
-    Note that filters 3 and 4 are much slower than filters 1 and 2.
+    Note that filters 3 and 4 are much slower than filters 1 and 2.
-    Default value is 5.}
+    Default value is 5.}
-  ImagingPNGPreFilter          = 25;
+  ImagingPNGPreFilter          = 25;
-  { Sets ZLib compression level used when saving PNG images.
+  { Sets ZLib compression level used when saving PNG images.
-    Allowed values are in range 0 (no compresstion) to 9 (best compression).
+    Allowed values are in range 0 (no compresstion) to 9 (best compression).
-    Default value is 5.}
+    Default value is 5.}
-  ImagingPNGCompressLevel      = 26;
+  ImagingPNGCompressLevel      = 26;
-
+  { Boolean option that specifies whether PNG images with more frames (APNG format)
-  { Specifies whether MNG animation frames are saved with lossy or lossless
+    are animated by Imaging (according to frame disposal/blend methods) or just
-    compression. Lossless frames are saved as PNG images and lossy frames are
+    raw frames are loaded and sent to user (if you want to animate APNG yourself).
-    saved as JNG images. Allowed values are 0 (False) and 1 (True).
+    Default value is 1.}
-    Default value is 0.}
+  ImagingPNGLoadAnimated       = 27;
-  ImagingMNGLossyCompression   = 28;
+
-  { Defines whether alpha channel of lossy compressed MNG frames
+  { Specifies whether MNG animation frames are saved with lossy or lossless
-    (when ImagingMNGLossyCompression is 1) is lossy compressed too.
+    compression. Lossless frames are saved as PNG images and lossy frames are
-    Allowed values are 0 (False) and 1 (True). Default value is 0.}
+    saved as JNG images. Allowed values are 0 (False) and 1 (True).
-  ImagingMNGLossyAlpha         = 29;
+    Default value is 0.}
-  { Sets precompression filter used when saving MNG frames as PNG images.
+  ImagingMNGLossyCompression   = 28;
-    For details look at ImagingPNGPreFilter.}
+  { Defines whether alpha channel of lossy compressed MNG frames
-  ImagingMNGPreFilter          = 30;
+    (when ImagingMNGLossyCompression is 1) is lossy compressed too.
-  { Sets ZLib compression level used when saving MNG frames as PNG images.
+    Allowed values are 0 (False) and 1 (True). Default value is 0.}
-    For details look at ImagingPNGCompressLevel.}
+  ImagingMNGLossyAlpha         = 29;
-  ImagingMNGCompressLevel      = 31;
+  { Sets precompression filter used when saving MNG frames as PNG images.
-  { Specifies compression quality used when saving MNG frames as JNG images.
+    For details look at ImagingPNGPreFilter.}
-    For details look at ImagingJpegQuality.}
+  ImagingMNGPreFilter          = 30;
-  ImagingMNGQuality            = 32;
+  { Sets ZLib compression level used when saving MNG frames as PNG images.
-  { Specifies whether images are saved in progressive format when saving MNG
+    For details look at ImagingPNGCompressLevel.}
-    frames as JNG images. For details look at ImagingJpegProgressive.}
+  ImagingMNGCompressLevel      = 31;
-  ImagingMNGProgressive        = 33;
+  { Specifies compression quality used when saving MNG frames as JNG images.
-
+    For details look at ImagingJpegQuality.}
-  { Specifies whether alpha channels of JNG images are lossy compressed.
+  ImagingMNGQuality            = 32;
-    Allowed values are 0 (False) and 1 (True). Default value is 0.}
+  { Specifies whether images are saved in progressive format when saving MNG
-  ImagingJNGLossyAlpha         = 40;
+    frames as JNG images. For details look at ImagingJpegProgressive.}
-  { Sets precompression filter used when saving lossless alpha channels.
+  ImagingMNGProgressive        = 33;
-    For details look at ImagingPNGPreFilter.}
+
-  ImagingJNGAlphaPreFilter     = 41;
+  { Specifies whether alpha channels of JNG images are lossy compressed.
-  { Sets ZLib compression level used when saving lossless alpha channels.
+    Allowed values are 0 (False) and 1 (True). Default value is 0.}
-    For details look at ImagingPNGCompressLevel.}
+  ImagingJNGLossyAlpha         = 40;
-  ImagingJNGAlphaCompressLevel = 42;
+  { Sets precompression filter used when saving lossless alpha channels.
-  { Defines compression quality used when saving JNG images (and lossy alpha channels).
+    For details look at ImagingPNGPreFilter.}
-    For details look at ImagingJpegQuality.}
+  ImagingJNGAlphaPreFilter     = 41;
-  ImagingJNGQuality            = 43;
+  { Sets ZLib compression level used when saving lossless alpha channels.
-  { Specifies whether JNG images are saved in progressive format.
+    For details look at ImagingPNGCompressLevel.}
-    For details look at ImagingJpegProgressive.}
+  ImagingJNGAlphaCompressLevel = 42;
-  ImagingJNGProgressive        = 44;
+  { Defines compression quality used when saving JNG images (and lossy alpha channels).
-  { Specifies whether PGM files are stored in text or in binary format.
+    For details look at ImagingJpegQuality.}
-    Allowed values are 0 (store as text - very! large files) and 1 (save binary).
+  ImagingJNGQuality            = 43;
-    Default value is 1.}
+  { Specifies whether JNG images are saved in progressive format.
-  ImagingPGMSaveBinary         = 50;
+    For details look at ImagingJpegProgressive.}
-  { Specifies whether PPM files are stored in text or in binary format.
+  ImagingJNGProgressive        = 44;
-    Allowed values are 0 (store as text - very! large files) and 1 (save binary).
+  { Specifies whether PGM files are stored in text or in binary format.
-    Default value is 1.}
+    Allowed values are 0 (store as text - very! large files) and 1 (save binary).
-  ImagingPPMSaveBinary         = 51;
+    Default value is 1.}
-  { Boolean option that specifies whether GIF images with more frames
+  ImagingPGMSaveBinary         = 50;
-    are animated by Imaging (according to frame disposal methods) or just
+  { Specifies whether PPM files are stored in text or in binary format.
-    raw frames are loaded and sent to user (if you want to animate GIF yourself).
+    Allowed values are 0 (store as text - very! large files) and 1 (save binary).
-    Default value is 1.}
+    Default value is 1.}
-  ImagingGIFLoadAnimated       = 56;
+  ImagingPPMSaveBinary         = 51;
-
+  { Boolean option that specifies whether GIF images with more frames
-
+    are animated by Imaging (according to frame disposal methods) or just
-  { This option is used when reducing number of colors used in
+    raw frames are loaded and sent to user (if you want to animate GIF yourself).
-    image (mainly when converting from ARGB image to indexed
+    Default value is 1.
-    format). Mask is 'anded' (bitwise AND) with every pixel's
+    Raw frames are 256 color indexed images (ifIndex8), whereas
-    channel value when creating color histogram. If $FF is used
+    animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
-    all 8bits of color channels are used which can result in very
+  ImagingGIFLoadAnimated       = 56;
-    slow proccessing of large images with many colors so you can
+
-    use lower masks to speed it up (FC, F8 and F0 are good
+  { This option is used when reducing number of colors used in
-    choices). Allowed values are in range <0, $FF> and default is
+    image (mainly when converting from ARGB image to indexed
-    $FE.                                                          }
+    format). Mask is 'anded' (bitwise AND) with every pixel's
-  ImagingColorReductionMask   = 128;
+    channel value when creating color histogram. If $FF is used
-  { This option can be used to override image data format during image
+    all 8bits of color channels are used which can result in very
-    loading. If set to format different from ifUnknown all loaded images
+    slow proccessing of large images with many colors so you can
-    are automaticaly converted to this format. Useful when you have
+    use lower masks to speed it up (FC, F8 and F0 are good
-    many files in various formats but you want them all in one format for
+    choices). Allowed values are in range <0, $FF> and default is
-    further proccessing. Allowed values are in
+    $FE.                                                          }
-    range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> and
+  ImagingColorReductionMask   = 128;
-    default value is ifUnknown.}
+  { This option can be used to override image data format during image
-  ImagingLoadOverrideFormat   = 129;
+    loading. If set to format different from ifUnknown all loaded images
-  { This option can be used to override image data format during image
+    are automaticaly converted to this format. Useful when you have
-    saving. If set to format different from ifUnknown all images
+    many files in various formats but you want them all in one format for
-    to be saved are automaticaly internaly converted to this format.
+    further proccessing. Allowed values are in
-    Note that image file formats support only a subset of Imaging data formats
+    range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> and
-    so final saved file may in different format than this override.
+    default value is ifUnknown.}
-    Allowed values are in range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))>
+  ImagingLoadOverrideFormat   = 129;
-    and default value is ifUnknown.}
+  { This option can be used to override image data format during image
-  ImagingSaveOverrideFormat   = 130;
+    saving. If set to format different from ifUnknown all images
-  { Specifies resampling filter used when generating mipmaps. It is used
+    to be saved are automaticaly internaly converted to this format.
-    in GenerateMipMaps low level function and Direct3D and OpenGL extensions.
+    Note that image file formats support only a subset of Imaging data formats
-    Allowed values are in range
+    so final saved file may in different format than this override.
-    <Ord(Low(ImagingFormats.TSamplingFilter)), Ord(High(ImagingFormats.TSamplingFilter))>
+    Allowed values are in range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))>
-    and default value is 1 (linear filter).}
+    and default value is ifUnknown.}
-  ImagingMipMapFilter         = 131;
+  ImagingSaveOverrideFormat   = 130;
-
+  { Specifies resampling filter used when generating mipmaps. It is used
-  { Returned by GetOption if given Option Id is invalid.}
+    in GenerateMipMaps low level function and Direct3D and OpenGL extensions.
-  InvalidOption = -$7FFFFFFF;
+    Allowed values are in range
-
+    <Ord(Low(ImagingFormats.TSamplingFilter)), Ord(High(ImagingFormats.TSamplingFilter))>
-  { Indices that can be used to access channel values in array parts
+    and default value is 1 (linear filter).}
-    of structures like TColor32Rec. Note that this order can be
+  ImagingMipMapFilter         = 131;
-    used only for ARGB images. For ABGR image you must swap Red and Blue.}
+
-  ChannelBlue  = 0;
+  { Returned by GetOption if given Option Id is invalid.}
-  ChannelGreen = 1;
+  InvalidOption = -$7FFFFFFF;
-  ChannelRed   = 2;
+
-  ChannelAlpha = 3;
+  { Indices that can be used to access channel values in array parts
-
+    of structures like TColor32Rec. Note that this order can be
-type
+    used only for ARGB images. For ABGR image you must swap Red and Blue.}
-  { Enum defining image data format. In formats with more channels,
+  ChannelBlue  = 0;
-    first channel after "if" is stored in the most significant bits and channel
+  ChannelGreen = 1;
-    before end is stored in the least significant.}
+  ChannelRed   = 2;
-  TImageFormat = (
+  ChannelAlpha = 3;
-    ifUnknown        = 0,
+
-    ifDefault        = 1,
+type
-    { Indexed formats using palette.}
+  { Enum defining image data format. In formats with more channels,
-    ifIndex8         = 10,
+    first channel after "if" is stored in the most significant bits and channel
-    { Grayscale/Luminance formats.}
+    before end is stored in the least significant.}
-    ifGray8          = 40,
+  TImageFormat = (
-    ifA8Gray8        = 41,
+    ifUnknown        = 0,
-    ifGray16         = 42,
+    ifDefault        = 1,
-    ifGray32         = 43,
+    { Indexed formats using palette.}
-    ifGray64         = 44,
+    ifIndex8         = 10,
-    ifA16Gray16      = 45,
+    { Grayscale/Luminance formats.}
-    { ARGB formats.}
+    ifGray8          = 40,
-    ifX5R1G1B1       = 80,
+    ifA8Gray8        = 41,
-    ifR3G3B2         = 81,
+    ifGray16         = 42,
-    ifR5G6B5         = 82,
+    ifGray32         = 43,
-    ifA1R5G5B5       = 83,
+    ifGray64         = 44,
-    ifA4R4G4B4       = 84,
+    ifA16Gray16      = 45,
-    ifX1R5G5B5       = 85,
+    { ARGB formats.}
-    ifX4R4G4B4       = 86,
+    ifX5R1G1B1       = 80,
-    ifR8G8B8         = 87,
+    ifR3G3B2         = 81,
-    ifA8R8G8B8       = 88,
+    ifR5G6B5         = 82,
-    ifX8R8G8B8       = 89,
+    ifA1R5G5B5       = 83,
-    ifR16G16B16      = 90,
+    ifA4R4G4B4       = 84,
-    ifA16R16G16B16   = 91,
+    ifX1R5G5B5       = 85,
-    ifB16G16R16      = 92,
+    ifX4R4G4B4       = 86,
-    ifA16B16G16R16   = 93,
+    ifR8G8B8         = 87,
-    { Floating point formats.}
+    ifA8R8G8B8       = 88,
-    ifR32F           = 170,
+    ifX8R8G8B8       = 89,
-    ifA32R32G32B32F  = 171,
+    ifR16G16B16      = 90,
-    ifA32B32G32R32F  = 172,
+    ifA16R16G16B16   = 91,
-    ifR16F           = 173,
+    ifB16G16R16      = 92,
-    ifA16R16G16B16F  = 174,
+    ifA16B16G16R16   = 93,
-    ifA16B16G16R16F  = 175,
+    { Floating point formats.}
-    { Special formats.}
+    ifR32F           = 170,
-    ifDXT1           = 220,
+    ifA32R32G32B32F  = 171,
-    ifDXT3           = 221,
+    ifA32B32G32R32F  = 172,
-    ifDXT5           = 222,
+    ifR16F           = 173,
-    ifBTC            = 223,
+    ifA16R16G16B16F  = 174,
-    ifATI1N          = 224,
+    ifA16B16G16R16F  = 175,
-    ifATI2N          = 225);
+    { Special formats.}
-
+    ifDXT1           = 220,
-  { Color value for 32 bit images.}
+    ifDXT3           = 221,
-  TColor32 = LongWord;
+    ifDXT5           = 222,
-  PColor32 = ^TColor32;
+    ifBTC            = 223,
-
+    ifATI1N          = 224,
-  { Color value for 64 bit images.}
+    ifATI2N          = 225);
-  TColor64 = type Int64;
+
-  PColor64 = ^TColor64;
+  { Color value for 32 bit images.}
-
+  TColor32 = LongWord;
-  { Color record for 24 bit images, which allows access to individual color
+  PColor32 = ^TColor32;
-    channels.}
+
-  TColor24Rec = packed record
+  { Color value for 64 bit images.}
-    case LongInt of
+  TColor64 = type Int64;
-      0: (B, G, R: Byte);
+  PColor64 = ^TColor64;
-      1: (Channels: array[0..2] of Byte);
+
-  end;
+  { Color record for 24 bit images, which allows access to individual color
-  PColor24Rec = ^TColor24Rec;
+    channels.}
-  TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec;
+  TColor24Rec = packed record
-  PColor24RecArray = ^TColor24RecArray;
+    case LongInt of
-
+      0: (B, G, R: Byte);
-  { Color record for 32 bit images, which allows access to individual color
+      1: (Channels: array[0..2] of Byte);
-    channels.}
+  end;
-  TColor32Rec = packed record
+  PColor24Rec = ^TColor24Rec;
-    case LongInt of
+  TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec;
-      0: (Color: TColor32);
+  PColor24RecArray = ^TColor24RecArray;
-      1: (B, G, R, A: Byte);
+
-      2: (Channels: array[0..3] of Byte);
+  { Color record for 32 bit images, which allows access to individual color
-      3: (Color24Rec: TColor24Rec);
+    channels.}
-  end;
+  TColor32Rec = packed record
-  PColor32Rec = ^TColor32Rec;
+    case LongInt of
-  TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec;
+      0: (Color: TColor32);
-  PColor32RecArray = ^TColor32RecArray;
+      1: (B, G, R, A: Byte);
-
+      2: (Channels: array[0..3] of Byte);
-  { Color record for 48 bit images, which allows access to individual color
+      3: (Color24Rec: TColor24Rec);
-    channels.}
+  end;
-  TColor48Rec = packed record
+  PColor32Rec = ^TColor32Rec;
-    case LongInt of
+  TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec;
-      0: (B, G, R: Word);
+  PColor32RecArray = ^TColor32RecArray;
-      1: (Channels: array[0..2] of Word);
+
-  end;
+  { Color record for 48 bit images, which allows access to individual color
-  PColor48Rec = ^TColor48Rec;
+    channels.}
-  TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec;
+  TColor48Rec = packed record
-  PColor48RecArray = ^TColor48RecArray;
+    case LongInt of
-
+      0: (B, G, R: Word);
-  { Color record for 64 bit images, which allows access to individual color
+      1: (Channels: array[0..2] of Word);
-    channels.}
+  end;
-  TColor64Rec = packed record
+  PColor48Rec = ^TColor48Rec;
-    case LongInt of
+  TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec;
-      0: (Color: TColor64);
+  PColor48RecArray = ^TColor48RecArray;
-      1: (B, G, R, A: Word);
+
-      2: (Channels: array[0..3] of Word);
+  { Color record for 64 bit images, which allows access to individual color
-      3: (Color48Rec: TColor48Rec);
+    channels.}
-  end;
+  TColor64Rec = packed record
-  PColor64Rec = ^TColor64Rec;
+    case LongInt of
-  TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec;
+      0: (Color: TColor64);
-  PColor64RecArray = ^TColor64RecArray;
+      1: (B, G, R, A: Word);
-
+      2: (Channels: array[0..3] of Word);
-  { Color record for 128 bit floating point images, which allows access to
+      3: (Color48Rec: TColor48Rec);
-    individual color channels.}
+  end;
-  TColorFPRec = packed record
+  PColor64Rec = ^TColor64Rec;
-    case LongInt of
+  TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec;
-      0: (B, G, R, A: Single);
+  PColor64RecArray = ^TColor64RecArray;
-      1: (Channels: array[0..3] of Single);
+
-  end;
+  { Color record for 128 bit floating point images, which allows access to
-  PColorFPRec = ^TColorFPRec;
+    individual color channels.}
-  TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec;
+  TColorFPRec = packed record
-  PColorFPRecArray = ^TColorFPRecArray;
+    case LongInt of
-
+      0: (B, G, R, A: Single);
-  { 16 bit floating-point value. It has 1 sign bit, 5 exponent bits,
+      1: (Channels: array[0..3] of Single);
-    and 10 mantissa bits.}
+  end;
-  THalfFloat = type Word;
+  PColorFPRec = ^TColorFPRec;
-  PHalfFloat = ^THalfFloat;
+  TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec;
-
+  PColorFPRecArray = ^TColorFPRecArray;
-  { Color record for 64 bit floating point images, which allows access to
+
-    individual color channels.}
+  { 16 bit floating-point value. It has 1 sign bit, 5 exponent bits,
-  TColorHFRec = packed record
+    and 10 mantissa bits.}
-    case LongInt of
+  THalfFloat = type Word;
-      0: (B, G, R, A: THalfFloat);
+  PHalfFloat = ^THalfFloat;
-      1: (Channels: array[0..3] of THalfFloat);
+
-  end;
+  { Color record for 64 bit floating point images, which allows access to
-  PColorHFRec = ^TColorHFRec;
+    individual color channels.}
-  TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec;
+  TColorHFRec = packed record
-  PColorHFRecArray = ^TColorHFRecArray;
+    case LongInt of
-
+      0: (B, G, R, A: THalfFloat);
-  { Palette for indexed mode images with 32 bit colors.}
+      1: (Channels: array[0..3] of THalfFloat);
-  TPalette32 = TColor32RecArray;
+  end;
-  TPalette32Size256 = array[0..255] of TColor32Rec;
+  PColorHFRec = ^TColorHFRec;
-  PPalette32 = ^TPalette32;
+  TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec;
-
+  PColorHFRecArray = ^TColorHFRecArray;
-  { Palette for indexd mode images with 24 bit colors.}
+
-  TPalette24 = TColor24RecArray;
+  { Palette for indexed mode images with 32 bit colors.}
-  TPalette24Size256 = array[0..255] of TColor24Rec;
+  TPalette32 = TColor32RecArray;
-  PPalette24 = ^TPalette24;
+  TPalette32Size256 = array[0..255] of TColor32Rec;
-
+  PPalette32 = ^TPalette32;
-  { Record that stores single image data and information describing it.}
+
-  TImageData = packed record
+  { Palette for indexd mode images with 24 bit colors.}
-    Width: LongInt;       // Width of image in pixels
+  TPalette24 = TColor24RecArray;
-    Height: LongInt;      // Height of image in pixels
+  TPalette24Size256 = array[0..255] of TColor24Rec;
-    Format: TImageFormat; // Data format of image
+  PPalette24 = ^TPalette24;
-    Size: LongInt;        // Size of image bits in Bytes
+
-    Bits: Pointer;        // Pointer to memory containing image bits
+  { Record that stores single image data and information describing it.}
-    Palette: PPalette32;  // Image palette for indexed images
+  TImageData = packed record
-  end;
+    Width: LongInt;       // Width of image in pixels
-  PImageData = ^TImageData;
+    Height: LongInt;      // Height of image in pixels
-
+    Format: TImageFormat; // Data format of image
-  { Pixel format information used in conversions to/from 16 and 8 bit ARGB
+    Size: LongInt;        // Size of image bits in Bytes
-    image formats.}
+    Bits: Pointer;        // Pointer to memory containing image bits
-  TPixelFormatInfo = packed record
+    Palette: PPalette32;  // Image palette for indexed images
-    ABitCount, RBitCount, GBitCount, BBitCount: Byte;
+  end;
-    ABitMask, RBitMask, GBitMask, BBitMask: LongWord;
+  PImageData = ^TImageData;
-    AShift, RShift, GShift, BShift: Byte;
+
-    ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte;
+  { Pixel format information used in conversions to/from 16 and 8 bit ARGB
-  end;
+    image formats.}
-  PPixelFormatInfo = ^TPixelFormatInfo;
+  TPixelFormatInfo = packed record
-
+    ABitCount, RBitCount, GBitCount, BBitCount: Byte;
-  PImageFormatInfo = ^TImageFormatInfo;
+    ABitMask, RBitMask, GBitMask, BBitMask: LongWord;
-
+    AShift, RShift, GShift, BShift: Byte;
-  { Look at TImageFormatInfo.GetPixelsSize for details.}
+    ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte;
-  TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width,
+  end;
-    Height: LongInt): LongInt;
+  PPixelFormatInfo = ^TPixelFormatInfo;
-  { Look at TImageFormatInfo.CheckDimensions for details.}
+
-  TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width,
+  PImageFormatInfo = ^TImageFormatInfo;
-    Height: LongInt);
+
-  { Function for getting pixel colors. Native pixel is read from Image and
+  { Look at TImageFormatInfo.GetPixelsSize for details.}
-    then translated to 32 bit ARGB.}
+  TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width,
-  TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo;
+    Height: LongInt): LongInt;
-    Palette: PPalette32): TColor32Rec;
+  { Look at TImageFormatInfo.CheckDimensions for details.}
-  { Function for getting pixel colors. Native pixel is read from Image and
+  TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width,
-    then translated to FP ARGB.}
+    Height: LongInt);
-  TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo;
+  { Function for getting pixel colors. Native pixel is read from Image and
-    Palette: PPalette32): TColorFPRec;
+    then translated to 32 bit ARGB.}
-  { Procedure for setting pixel colors. Input 32 bit ARGB color is translated to
+  TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo;
-    native format and then written to Image.}
+    Palette: PPalette32): TColor32Rec;
-  TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo;
+  { Function for getting pixel colors. Native pixel is read from Image and
-    Palette: PPalette32;const Color: TColor32Rec);
+    then translated to FP ARGB.}
-  { Procedure for setting pixel colors. Input FP ARGB color is translated to
+  TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo;
-    native format and then written to Image.}
+    Palette: PPalette32): TColorFPRec;
-  TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo; 
+  { Procedure for setting pixel colors. Input 32 bit ARGB color is translated to
-    Palette: PPalette32; const Color: TColorFPRec);
+    native format and then written to Image.}
-
+  TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo;
-  { Additional information for each TImageFormat value.}
+    Palette: PPalette32;const Color: TColor32Rec);
-  TImageFormatInfo = packed record
+  { Procedure for setting pixel colors. Input FP ARGB color is translated to
-    Format: TImageFormat;             // Format described by this record
+    native format and then written to Image.}
-    Name: array[0..15] of Char;       // Symbolic name of format
+  TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo; 
-    BytesPerPixel: LongInt;           // Number of bytes per pixel (note: it is
+    Palette: PPalette32; const Color: TColorFPRec);
-                                      // 0 for formats where BitsPerPixel < 8 (e.g. DXT).
+
-                                      // Use GetPixelsSize function to get size of
+  { Additional information for each TImageFormat value.}
-                                      // image data.
+  TImageFormatInfo = packed record
-    ChannelCount: LongInt;            // Number of image channels (R, G, B, A, Gray)
+    Format: TImageFormat;             // Format described by this record
-    PaletteEntries: LongInt;          // Number of palette entries
+    Name: array[0..15] of Char;       // Symbolic name of format
-    HasGrayChannel: Boolean;          // True if image has grayscale channel
+    BytesPerPixel: LongInt;           // Number of bytes per pixel (note: it is
-    HasAlphaChannel: Boolean;         // True if image has alpha channel
+                                      // 0 for formats where BitsPerPixel < 8 (e.g. DXT).
-    IsFloatingPoint: Boolean;         // True if image has floating point pixels
+                                      // Use GetPixelsSize function to get size of
-    UsePixelFormat: Boolean;          // True if image uses pixel format
+                                      // image data.
-    IsRBSwapped: Boolean;             // True if Red and Blue channels are swapped
+    ChannelCount: LongInt;            // Number of image channels (R, G, B, A, Gray)
-                                      // e.g. A16B16G16R16 has IsRBSwapped True
+    PaletteEntries: LongInt;          // Number of palette entries
-    RBSwapFormat: TImageFormat;       // Indicates supported format with swapped
+    HasGrayChannel: Boolean;          // True if image has grayscale channel
-                                      // Red and Blue channels, ifUnknown if such
+    HasAlphaChannel: Boolean;         // True if image has alpha channel
-                                      // format does not exist
+    IsFloatingPoint: Boolean;         // True if image has floating point pixels
-    IsIndexed: Boolean;               // True if image uses palette
+    UsePixelFormat: Boolean;          // True if image uses pixel format
-    IsSpecial: Boolean;               // True if image is in special format
+    IsRBSwapped: Boolean;             // True if Red and Blue channels are swapped
-    PixelFormat: PPixelFormatInfo;    // Pixel format structure
+                                      // e.g. A16B16G16R16 has IsRBSwapped True
-    GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of
+    RBSwapFormat: TImageFormat;       // Indicates supported format with swapped
-                                      // Width * Height pixels of image
+                                      // Red and Blue channels, ifUnknown if such
-    CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited
+                                      // format does not exist
-                                      // values of Width and Height. This
+    IsIndexed: Boolean;               // True if image uses palette
-                                      // procedure checks and changes dimensions
+    IsSpecial: Boolean;               // True if image is in special format
-                                      // to be valid for given format.
+    PixelFormat: PPixelFormatInfo;    // Pixel format structure
-    GetPixel32: TGetPixel32Func;      // 32bit ARGB pixel get function
+    GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of
-    GetPixelFP: TGetPixelFPFunc;      // FP ARGB pixel get function
+                                      // Width * Height pixels of image
-    SetPixel32: TSetPixel32Proc;      // 32bit ARGB pixel set procedure
+    CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited
-    SetPixelFP: TSetPixelFPProc;      // FP ARGB pixel set procedure
+                                      // values of Width and Height. This
-    SpecialNearestFormat: TImageFormat; // Regular image format used when
+                                      // procedure checks and changes dimensions
-                                      // compressing/decompressing special images
+                                      // to be valid for given format.
-                                      // as source/target
+    GetPixel32: TGetPixel32Func;      // 32bit ARGB pixel get function
-  end;
+    GetPixelFP: TGetPixelFPFunc;      // FP ARGB pixel get function
-
+    SetPixel32: TSetPixel32Proc;      // 32bit ARGB pixel set procedure
-  { Handle to list of image data records.}
+    SetPixelFP: TSetPixelFPProc;      // FP ARGB pixel set procedure
-  TImageDataList = Pointer;
+    SpecialNearestFormat: TImageFormat; // Regular image format used when
-  PImageDataList = ^TImageDataList;
+                                      // compressing/decompressing special images
-
+                                      // as source/target
-  { Handle to input/output.}
+  end;
-  TImagingHandle = Pointer;
+
-
+  { Handle to list of image data records.}
-  { Filters used in functions that resize images or their portions.}
+  TImageDataList = Pointer;
-  TResizeFilter = (
+  PImageDataList = ^TImageDataList;
-    rfNearest  = 0,
+
-    rfBilinear = 1,
+  { Handle to input/output.}
-    rfBicubic  = 2);
+  TImagingHandle = Pointer;
-
+
-  { Seek origin mode for IO function Seek.}
+  { Filters used in functions that resize images or their portions.}
-  TSeekMode = (
+  TResizeFilter = (
-   smFromBeginning = 0,
+    rfNearest  = 0,
-   smFromCurrent   = 1,
+    rfBilinear = 1,
-   smFromEnd       = 2);
+    rfBicubic  = 2);
-
+
-  { IO functions used for reading and writing images from/to input/output.}
+  { Seek origin mode for IO function Seek.}
-  TOpenReadProc = function(Source: PChar): TImagingHandle; cdecl;
+  TSeekMode = (
-  TOpenWriteProc = function(Source: PChar): TImagingHandle; cdecl;
+   smFromBeginning = 0,
-  TCloseProc = procedure(Handle: TImagingHandle); cdecl;
+   smFromCurrent   = 1,
-  TEofProc = function(Handle: TImagingHandle): Boolean; cdecl;
+   smFromEnd       = 2);
-  TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl;
+
-  TTellProc = function(Handle: TImagingHandle): LongInt; cdecl;
+  { IO functions used for reading and writing images from/to input/output.}
-  TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
+  TOpenReadProc = function(Source: PChar): TImagingHandle; cdecl;
-  TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
+  TOpenWriteProc = function(Source: PChar): TImagingHandle; cdecl;
-       
+  TCloseProc = procedure(Handle: TImagingHandle); cdecl;
-implementation
+  TEofProc = function(Handle: TImagingHandle): Boolean; cdecl;
-
+  TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl;
-{
+  TTellProc = function(Handle: TImagingHandle): LongInt; cdecl;
-  File Notes:
+  TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
-
+  TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
-  -- TODOS ----------------------------------------------------
+       
-    - add lookup tables to pixel formats for fast conversions
+implementation
-
+
-  -- 0.24.3 Changes/Bug Fixes ---------------------------------
+{
-    - Added ifATI1N and ifATI2N image data formats.
+  File Notes:
-
+
-  -- 0.23 Changes/Bug Fixes -----------------------------------
+  -- TODOS ----------------------------------------------------
-    - Added ifBTC image format and SpecialNearestFormat field
+    - add lookup tables to pixel formats for fast conversions
-      to TImageFormatInfo.
+
-
+  -- 0.24.3 Changes/Bug Fixes ---------------------------------
-  -- 0.21 Changes/Bug Fixes -----------------------------------
+    - Added ifATI1N and ifATI2N image data formats.
-    - Added option constants for PGM and PPM file formats.
+
-    - Added TPalette32Size256 and TPalette24Size256 types.
+  -- 0.23 Changes/Bug Fixes -----------------------------------
-
+    - Added ifBTC image format and SpecialNearestFormat field
-  -- 0.19 Changes/Bug Fixes -----------------------------------
+      to TImageFormatInfo.
-    - added ImagingVersionPatch constant so bug fix only releases
+
-      can be distinguished from ordinary major/minor releases
+  -- 0.21 Changes/Bug Fixes -----------------------------------
-    - renamed TPixelFormat to TPixelFormatInfo to avoid name collisions
+    - Added option constants for PGM and PPM file formats.
-      with Graphics.TPixelFormat
+    - Added TPalette32Size256 and TPalette24Size256 types.
-    - added new image data formats:  ifR16F, ifA16R16G16B16F,
+
-      ifA16B16G16R16F
+  -- 0.19 Changes/Bug Fixes -----------------------------------
-    - added pixel get/set function pointers to TImageFormatInfo
+    - added ImagingVersionPatch constant so bug fix only releases
-    - added 16bit half float type and color record
+      can be distinguished from ordinary major/minor releases
-    - renamed TColorFRec to TColorFPRec (and related types too)
+    - renamed TPixelFormat to TPixelFormatInfo to avoid name collisions
-
+      with Graphics.TPixelFormat
-  -- 0.17 Changes/Bug Fixes -----------------------------------
+    - added new image data formats:  ifR16F, ifA16R16G16B16F,
-    - added option ImagingMipMapFilter which now controls resampling filter
+      ifA16B16G16R16F
-      used when generating mipmaps
+    - added pixel get/set function pointers to TImageFormatInfo
-    - added TResizeFilter type
+    - added 16bit half float type and color record
-    - added ChannelCount to TImageFormatInfo
+    - renamed TColorFRec to TColorFPRec (and related types too)
-    - added new option constants for MNG and JNG images
+
-
+  -- 0.17 Changes/Bug Fixes -----------------------------------
-  -- 0.15 Changes/Bug Fixes -----------------------------------
+    - added option ImagingMipMapFilter which now controls resampling filter
-    - added RBSwapFormat to TImageFormatInfo for faster conversions
+      used when generating mipmaps
-      between swapped formats (it just calls SwapChannels now if
+    - added TResizeFilter type
-      RBSwapFormat is not ifUnknown)
+    - added ChannelCount to TImageFormatInfo
-    - moved TImageFormatInfo and required types from Imaging unit
+    - added new option constants for MNG and JNG images
-      here, removed TImageFormatShortInfo
+
-    - added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat
+  -- 0.15 Changes/Bug Fixes -----------------------------------
-
+    - added RBSwapFormat to TImageFormatInfo for faster conversions
-  -- 0.13 Changes/Bug Fixes -----------------------------------
+      between swapped formats (it just calls SwapChannels now if
-    - new ImagingColorReductionMask option added
+      RBSwapFormat is not ifUnknown)
-    - new image format added: ifA16Gray16
+    - moved TImageFormatInfo and required types from Imaging unit
-
+      here, removed TImageFormatShortInfo
-}
+    - added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat
-
+
-end. 
+  -- 0.13 Changes/Bug Fixes -----------------------------------
+    - new ImagingColorReductionMask option added
+    - new image format added: ifA16Gray16
+
+}
+
+end. 

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,9 +56,10 @@ type
   TBooleanArray = array[0..MaxInt - 1] of Boolean;
   PBooleanArray = ^TBooleanArray;
 
+  TDynByteArray = array of Byte;
   TDynIntegerArray = array of Integer;
   TDynBooleanArray = array of Boolean;
-
+  
   TWordRec = packed record
     case Integer of
       0: (WordValue: Word);
@@ -98,23 +99,24 @@ type
    end;
   PFloatHelper = ^TFloatHelper;
 
-  TChar2 = array[0..1] of Char;
+  TChar2 = array[0..1] of AnsiChar;
-  TChar3 = array[0..2] of Char;
+  TChar3 = array[0..2] of AnsiChar;
-  TChar4 = array[0..3] of Char;
+  TChar4 = array[0..3] of AnsiChar;
-  TChar8 = array[0..7] of Char;
+  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
+    flFullNames - file names in result will have full path names
-                (ExtractFileDir(Path) + FileName)
+                (ExtractFileDir(Path) + FileName)
-    flRelNames  - file names in result will have names relative to
+    flRelNames  - file names in result will have names relative to
-                ExtractFileDir(Path) dir
+                ExtractFileDir(Path) dir
-    flRecursive - adds files in subdirectories found in Path.}
+    flRecursive - adds files in subdirectories found in Path.}
-  TFileListOption = (flFullNames, flRelNames, flRecursive);
+  TFileListOption = (flFullNames, flRelNames, flRecursive);
-  TFileListOptions = set of TFileListOption;
+  TFileListOptions = set of TFileListOption;
 
 
 { Frees class instance and sets its reference to nil.}
-procedure FreeAndNil(var Obj); 
+procedure FreeAndNil(var Obj);
 { Frees pointer and sets it to nil.}
 procedure FreeMemNil(var P); {$IFDEF USE_INLINE}inline;{$ENDIF}
 { Replacement of standard System.FreeMem procedure which checks if P is nil
@@ -135,32 +137,35 @@ function GetAppExe: string;
   path delimiter at the end.}
 function GetAppDir: string;
 { Returns True if FileName matches given Mask with optional case sensitivity.
-  Mask can contain ? and * special characters: ? matches
+  Mask can contain ? and * special characters: ? matches
-  one character, * matches zero or more characters.}
+  one character, * matches zero or more characters.}
 function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean = False): Boolean;
 { This function fills Files string list with names of files found
-  with FindFirst/FindNext functions (See details on Path/Atrr here).
+  with FindFirst/FindNext functions (See details on Path/Atrr here).
-  - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns
+  - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns
-    list of all files (only name.ext - no path) on C drive
+    list of all files (only name.ext - no path) on C drive
-  - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns
+  - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns
-    list of all directories (d:\dirxxx) in root of D drive.}
+    list of all directories (d:\dirxxx) in root of D drive.}
-function BuildFileList(Path: string; Attr: LongInt; Files: TStrings;
+function BuildFileList(Path: string; Attr: LongInt; Files: TStrings;
-  Options: TFileListOptions = []): Boolean;
+  Options: TFileListOptions = []): Boolean;
-{ Similar to RTL's Pos function but with optional Offset where search will start.
+{ Similar to RTL's Pos function but with optional Offset where search will start.
-  This function is in the RTL StrUtils unit but }
+  This function is in the RTL StrUtils unit but }
-function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
+function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
-{ Same as PosEx but without case sensitivity.}
+{ Same as PosEx but without case sensitivity.}
-function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
+function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
-{ Returns a sub-string from S which is followed by
+{ Returns a sub-string from S which is followed by
-  Sep separator and deletes the sub-string from S including the separator.}
+  Sep separator and deletes the sub-string from S including the separator.}
-function StrToken(var S: string; Sep: Char): string;
+function StrToken(var S: string; Sep: Char): string;
-{ Same as StrToken but searches from the end of S string.}
+{ Same as StrToken but searches from the end of S string.}
-function StrTokenEnd(var S: string; Sep: Char): string;
+function StrTokenEnd(var S: string; Sep: Char): string;
-{ Returns string representation of integer number (with digit grouping).}
+{ Fills instance of TStrings with tokens from string S where tokens are separated by
-function IntToStrFmt(const I: Int64): string;
+  one of Seps characters.}
-{ Returns string representation of float number (with digit grouping).}
+procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
-function FloatToStrFmt(const F: Double; Precision: Integer = 2): string;
+{ Returns string representation of integer number (with digit grouping).}
-
+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; {$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}
 { Clamps float value to range <Min, Max>}
@@ -397,7 +402,7 @@ end;
 
 function GetTimeMilliseconds: Int64;
 begin
-  Result := GetTimeMicroseconds div 1000;
+  Result := GetTimeMicroseconds div 1000;
 end;
 
 function GetFileExt(const FileName: string): string;
@@ -439,359 +444,275 @@ begin
 end;
 
 function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean): Boolean;
-var
+var
-  MaskLen, KeyLen : LongInt;
+  MaskLen, KeyLen : LongInt;
-
+
-  function CharMatch(A, B: Char): Boolean;
+  function CharMatch(A, B: Char): Boolean;
-  begin
+  begin
-    if CaseSensitive then
+    if CaseSensitive then
-      Result := A = B
+      Result := A = B
-    else
+    else
-      Result := UpCase(A) = UpCase(B);
+      Result := AnsiUpperCase (A) = AnsiUpperCase (B);
-  end;
+  end;
-
+
-  function MatchAt(MaskPos, KeyPos: LongInt): Boolean;
+  function MatchAt(MaskPos, KeyPos: LongInt): Boolean;
-  begin
+  begin
-    while (MaskPos <= MaskLen) and (KeyPos <= KeyLen) do
+    while (MaskPos <= MaskLen) and (KeyPos <= KeyLen) do
-    begin
+    begin
-      case Mask[MaskPos] of
+      case Mask[MaskPos] of
-        '?' :
+        '?' :
-          begin
+          begin
-            Inc(MaskPos);
+            Inc(MaskPos);
-            Inc(KeyPos);
+            Inc(KeyPos);
-          end;
+          end;
-        '*' :
+        '*' :
-          begin
+          begin
-            while (MaskPos <= MaskLen) and (Mask[MaskPos] = '*') do
+            while (MaskPos <= MaskLen) and (Mask[MaskPos] = '*') do
-              Inc(MaskPos);
+              Inc(MaskPos);
-            if MaskPos > MaskLen then
+            if MaskPos > MaskLen then
-            begin
+            begin
-              Result := True;
+              Result := True;
-              Exit;
+              Exit;
-            end;
+            end;
-            repeat
+            repeat
-              if MatchAt(MaskPos, KeyPos) then
+              if MatchAt(MaskPos, KeyPos) then
-              begin
+              begin
-                Result := True;
+                Result := True;
-                Exit;
+                Exit;
-              end;
+              end;
-              Inc(KeyPos);
+              Inc(KeyPos);
-            until KeyPos > KeyLen;
+            until KeyPos > KeyLen;
-            Result := False;
+            Result := False;
-            Exit;
+            Exit;
-          end;
+          end;
-        else
+        else
-          if not CharMatch(Mask[MaskPos], FileName[KeyPos]) then
+          if not CharMatch(Mask[MaskPos], FileName[KeyPos]) then
-          begin
+          begin
-            Result := False;
+            Result := False;
-            Exit;
+            Exit;
-          end
+          end
-          else
+          else
-          begin
+          begin
-            Inc(MaskPos);
+            Inc(MaskPos);
-            Inc(KeyPos);
+            Inc(KeyPos);
-          end;
+          end;
-      end;
+      end;
-    end;  
+    end;  
-
+
-    while (MaskPos <= MaskLen) and (Mask[MaskPos] in ['?', '*']) do
+    while (MaskPos <= MaskLen) and (Mask[MaskPos] in ['?', '*']) do
-      Inc(MaskPos);
+      Inc(MaskPos);
-    if (MaskPos <= MaskLen) or (KeyPos <= KeyLen) then
+    if (MaskPos <= MaskLen) or (KeyPos <= KeyLen) then
-    begin
+    begin
-      Result := False;
+      Result := False;
-      Exit;
+      Exit;
-    end;
+    end;
-
+
-    Result := True;
+    Result := True;
-  end;
+  end;
-
+
-begin
+begin
-  MaskLen := Length(Mask);
+  MaskLen := Length(Mask);
-  KeyLen := Length(FileName);
+  KeyLen := Length(FileName);
-  if MaskLen = 0 then
+  if MaskLen = 0 then
-  begin
+  begin
-    Result := True;
+    Result := True;
-    Exit;
+    Exit;
-  end;
+  end;
-  Result := MatchAt(1, 1);
+  Result := MatchAt(1, 1);
 end;
 
 function BuildFileList(Path: string; Attr: LongInt;
-  Files: TStrings; Options: TFileListOptions): Boolean;
+  Files: TStrings; Options: TFileListOptions): Boolean;
-var
+var
-  FileMask: string;
+  FileMask: string;
-  RootDir: string;
+  RootDir: string;
-  Folders: TStringList;
+  Folders: TStringList;
-  CurrentItem: LongInt;
+  CurrentItem: LongInt;
-  Counter: LongInt;
+  Counter: LongInt;
-  LocAttr: LongInt;
+  LocAttr: LongInt;
-
+
-  procedure BuildFolderList;
+  procedure BuildFolderList;
-  var
+  var
-    FindInfo: TSearchRec;
+    FindInfo: TSearchRec;
-    Rslt: LongInt;
+    Rslt: LongInt;
-  begin
+  begin
-    Counter := Folders.Count - 1;
+    Counter := Folders.Count - 1;
-    CurrentItem := 0;
+    CurrentItem := 0;
-    while CurrentItem <= Counter do
+    while CurrentItem <= Counter do
-    begin
+    begin
-      // Searching for subfolders
+      // Searching for subfolders
-      Rslt := SysUtils.FindFirst(Folders[CurrentItem] + '*', faDirectory, FindInfo);
+      Rslt := SysUtils.FindFirst(Folders[CurrentItem] + '*', faDirectory, FindInfo);
-      try
+      try
-        while Rslt = 0 do
+        while Rslt = 0 do
-        begin
+        begin
-          if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and
+          if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and
-            (FindInfo.Attr and faDirectory = faDirectory) then
+            (FindInfo.Attr and faDirectory = faDirectory) then
-            Folders.Add(Folders[CurrentItem] + FindInfo.Name + PathDelim);
+            Folders.Add(Folders[CurrentItem] + FindInfo.Name + PathDelim);
-          Rslt := SysUtils.FindNext(FindInfo);
+          Rslt := SysUtils.FindNext(FindInfo);
-        end;
+        end;
-      finally
+      finally
-        SysUtils.FindClose(FindInfo);
+        SysUtils.FindClose(FindInfo);
-      end;
+      end;
-      Counter := Folders.Count - 1;
+      Counter := Folders.Count - 1;
-      Inc(CurrentItem);
+      Inc(CurrentItem);
-    end;
+    end;
-  end;
+  end;
-
+
-  procedure FillFileList(CurrentCounter: LongInt);
+  procedure FillFileList(CurrentCounter: LongInt);
-  var
+  var
-    FindInfo: TSearchRec;
+    FindInfo: TSearchRec;
-    Res: LongInt;
+    Res: LongInt;
-    CurrentFolder: string;
+    CurrentFolder: string;
-  begin
+  begin
-    CurrentFolder := Folders[CurrentCounter];
+    CurrentFolder := Folders[CurrentCounter];
-    Res := SysUtils.FindFirst(CurrentFolder + FileMask, LocAttr, FindInfo);
+    Res := SysUtils.FindFirst(CurrentFolder + FileMask, LocAttr, FindInfo);
-    if flRelNames in Options then
+    if flRelNames in Options then
-      CurrentFolder := ExtractRelativePath(RootDir, CurrentFolder);
+      CurrentFolder := ExtractRelativePath(RootDir, CurrentFolder);
-    try
+    try
-      while Res = 0 do
+      while Res = 0 do
-      begin
+      begin
-        if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') then
+        if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') then
-        begin
+        begin
-          if (flFullNames in Options) or (flRelNames in Options) then
+          if (flFullNames in Options) or (flRelNames in Options) then
-            Files.Add(CurrentFolder + FindInfo.Name)
+            Files.Add(CurrentFolder + FindInfo.Name)
-          else
+          else
-            Files.Add(FindInfo.Name);
+            Files.Add(FindInfo.Name);
-        end;
+        end;
-        Res := SysUtils.FindNext(FindInfo);
+        Res := SysUtils.FindNext(FindInfo);
-      end;
+      end;
-    finally
+    finally
-      SysUtils.FindClose(FindInfo);
+      SysUtils.FindClose(FindInfo);
-    end;
+    end;
-  end;
+  end;
-
+
-begin
+begin
-  FileMask := ExtractFileName(Path);
+  FileMask := ExtractFileName(Path);
-  RootDir := ExtractFilePath(Path);
+  RootDir := ExtractFilePath(Path);
-  Folders := TStringList.Create;
+  Folders := TStringList.Create;
-  Folders.Add(RootDir);
+  Folders.Add(RootDir);
-  Files.Clear;
+  Files.Clear;
-{$IFDEF DCC}
+{$IFDEF DCC}
-  {$WARN SYMBOL_PLATFORM OFF}
+  {$WARN SYMBOL_PLATFORM OFF}
-{$ENDIF}
+{$ENDIF}
-  if Attr = faAnyFile then
+  if Attr = faAnyFile then
-    LocAttr := faSysFile or faHidden or faArchive or faReadOnly
+    LocAttr := faSysFile or faHidden or faArchive or faReadOnly
-  else
+  else
-    LocAttr := Attr;
+    LocAttr := Attr;
-{$IFDEF DCC}
+{$IFDEF DCC}
-  {$WARN SYMBOL_PLATFORM ON}
+  {$WARN SYMBOL_PLATFORM ON}
-{$ENDIF}
+{$ENDIF}
-  // Here's the recursive search for nested folders
+  // Here's the recursive search for nested folders
-  if flRecursive in Options then
+  if flRecursive in Options then
-    BuildFolderList;
+    BuildFolderList;
-  if Attr <> faDirectory then
+  if Attr <> faDirectory then
-    for Counter := 0 to Folders.Count - 1 do
+    for Counter := 0 to Folders.Count - 1 do
-      FillFileList(Counter)
+      FillFileList(Counter)
-  else
+  else
-    Files.AddStrings(Folders);
+    Files.AddStrings(Folders);
-  Folders.Free;
+  Folders.Free;
-  Result := True;
+  Result := True;
-end;
+end;
-
+
-function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
+function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
-{$IFDEF USE_ASM}
+var
-asm
+  I, X: LongInt;
-  // The Original ASM Code is (C) Fastcode project.
+  Len, LenSubStr: LongInt;
-       test  eax, eax
+begin
-       jz    @Nil
+  I := Offset;
-       test  edx, edx
+  LenSubStr := Length(SubStr);
-       jz    @Nil
+  Len := Length(S) - LenSubStr + 1;
-       dec   ecx
+  while I <= Len do
-       jl    @Nil
+  begin
-
+    if S[I] = SubStr[1] then
-       push  esi
+    begin
-       push  ebx
+      X := 1;
-
+      while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
-       mov   esi, [edx-4]  //Length(Str)
+        Inc(X);
-       mov   ebx, [eax-4]  //Length(Substr)
+      if (X = LenSubStr) then
-       sub   esi, ecx      //effective length of Str
+      begin
-       add   edx, ecx      //addr of the first char at starting position
+        Result := I;
-       cmp   esi, ebx
+        Exit;
-       jl    @Past         //jump if EffectiveLength(Str)<Length(Substr)
+      end;
-       test  ebx, ebx
+    end;
-       jle   @Past         //jump if Length(Substr)<=0
+    Inc(I);
-
+  end;
-       add   esp, -12
+  Result := 0;
-       add   ebx, -1       //Length(Substr)-1
+end;
-       add   esi, edx      //addr of the terminator
+
-       add   edx, ebx      //addr of the last char at starting position
+function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt;
-       mov   [esp+8], esi  //save addr of the terminator
+begin
-       add   eax, ebx      //addr of the last char of Substr
+  Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset);
-       sub   ecx, edx      //-@Str[Length(Substr)]
+end;
-       neg   ebx           //-(Length(Substr)-1)
+
-       mov   [esp+4], ecx  //save -@Str[Length(Substr)]
+function StrToken(var S: string; Sep: Char): string;
-       mov   [esp], ebx    //save -(Length(Substr)-1)
+var
-       movzx ecx, byte ptr [eax] //the last char of Substr
+  I: LongInt;
-
+begin
-@Loop:
+  I := Pos(Sep, S);
-       cmp   cl, [edx]
+  if I <> 0 then
-       jz    @Test0
+  begin
-@AfterTest0:
+    Result := Copy(S, 1, I - 1);
-       cmp   cl, [edx+1]
+    Delete(S, 1, I);
-       jz    @TestT
+  end
-@AfterTestT:
+  else
-       add   edx, 4
+  begin
-       cmp   edx, [esp+8]
+    Result := S;
-       jb   @Continue
+    S := '';
-@EndLoop:
+  end;
-       add   edx, -2
+end;
-       cmp   edx, [esp+8]
+
-       jb    @Loop
+function StrTokenEnd(var S: string; Sep: Char): string;
-@Exit:
+var
-       add   esp, 12
+  I, J: LongInt;
-@Past:
+begin
-       pop   ebx
+  J := 0;
-       pop   esi
+  I := Pos(Sep, S);
-@Nil:
+  while I <> 0 do
-       xor   eax, eax
+  begin
-       ret
+    J := I;
-@Continue:
+    I := PosEx(Sep, S, J + 1);
-       cmp   cl, [edx-2]
+  end;
-       jz    @Test2
+  if J <> 0 then
-       cmp   cl, [edx-1]
+  begin
-       jnz   @Loop
+    Result := Copy(S, J + 1, MaxInt);
-@Test1:
+    Delete(S, J, MaxInt);
-       add   edx,  1
+  end
-@Test2:
+  else
-       add   edx, -2
+  begin
-@Test0:
+    Result := S;
-       add   edx, -1
+    S := '';
-@TestT:
+  end;
-       mov   esi, [esp]
+end;
-       test  esi, esi
+
-       jz    @Found
+procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
-@String:
+var
-       movzx ebx, word ptr [esi+eax]
+  Token, Str: string;
-       cmp   bx, word ptr [esi+edx+1]
+begin
-       jnz   @AfterTestT
+  Tokens.Clear;
-       cmp   esi, -2
+  Str := S;
-       jge   @Found
+  while Str <> '' do
-       movzx ebx, word ptr [esi+eax+2]
+  begin
-       cmp   bx, word ptr [esi+edx+3]
+    Token := StrToken(Str, Sep);
-       jnz   @AfterTestT
+    Tokens.Add(Token);
-       add   esi, 4
+  end;
-       jl    @String
+end;
-@Found:
+
-       mov   eax, [esp+4]
+function IntToStrFmt(const I: Int64): string;
-       add   edx, 2
+begin
-
+  Result := Format('%.0n', [I * 1.0]);
-       cmp   edx, [esp+8]
+end;
-       ja    @Exit
+
-
+function FloatToStrFmt(const F: Double; Precision: Integer): string;
-       add   esp, 12
+begin
-       add   eax, edx
+  Result := Format('%.' + IntToStr(Precision) + 'n', [F]);
-       pop   ebx
+end;
-       pop   esi
+
-end;
-{$ELSE}
-var
-  I, X: LongInt;
-  Len, LenSubStr: LongInt;
-begin
-  I := Offset;
-  LenSubStr := Length(SubStr);
-  Len := Length(S) - LenSubStr + 1;
-  while I <= Len do
-  begin
-    if S[I] = SubStr[1] then
-    begin
-      X := 1;
-      while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
-        Inc(X);
-      if (X = LenSubStr) then
-      begin
-        Result := I;
-        Exit;
-      end;
-    end;
-    Inc(I);
-  end;
-  Result := 0;
-end;
-{$ENDIF}
-
-function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt;
-begin
-  Result := PosEx(LowerCase(SubStr), LowerCase(S), Offset);
-end;
-
-function StrToken(var S: string; Sep: Char): string;
-var
-  I: LongInt;
-begin
-  I := Pos(Sep, S);
-  if I <> 0 then
-  begin
-    Result := Copy(S, 1, I - 1);
-    Delete(S, 1, I);
-  end
-  else
-  begin
-    Result := S;
-    S := '';
-  end;
-end;
-
-function StrTokenEnd(var S: string; Sep: Char): string;
-var
-  I, J: LongInt;
-begin
-  J := 0;
-  I := Pos(Sep, S);
-  while I <> 0 do
-  begin
-    J := I;
-    I := PosEx(Sep, S, J + 1);
-  end;
-  if J <> 0 then
-  begin
-    Result := Copy(S, J + 1, MaxInt);
-    Delete(S, J, MaxInt);
-  end
-  else
-  begin
-    Result := S;
-    S := '';
-  end;
-end;
-
-function IntToStrFmt(const I: Int64): string;
-begin
-  Result := Format('%.0n', [I * 1.0]);
-end;
-
-function FloatToStrFmt(const F: Double; Precision: Integer): string;
-begin
-  Result := Format('%.' + IntToStr(Precision) + 'n', [F]);
-end;
-
 function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt;
 begin
   Result := Number;
   if Result < Min then
     Result := Min
-  else
+  else if Result > Max then
-  if Result > Max then
     Result := Max;
 end;
 
@@ -800,8 +721,7 @@ begin
   Result := Number;
   if Result < Min then
     Result := Min
-  else
+  else if Result > Max then
-  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;
 
@@ -957,18 +877,18 @@ end;
 
 function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer;
 begin
-  if Condition then
+  if Condition then
     Result := TruePart
   else
-    Result := FalsePart;
+    Result := FalsePart;
 end;
 
 function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64;
 begin
-  if Condition then
+  if Condition then
     Result := TruePart
   else
-    Result := FalsePart;
+    Result := FalsePart;
 end;
 
 function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single;
@@ -1062,8 +982,8 @@ end;
 function MulDiv(Number, Numerator, Denominator: Word): Word;
 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
 asm
-         MUL DX
+         MUL DX
-         DIV CX
+         DIV CX
 end;
 {$ELSE}
 begin
@@ -1075,8 +995,8 @@ function IsLittleEndian: Boolean;
 var
   W: Word;
 begin
-  W := $00FF;
+  W := $00FF;
-  Result := PByte(@W)^ = $FF;
+  Result := PByte(@W)^ = $FF;
 end;
 
 function SwapEndianWord(Value: Word): Word;
@@ -1334,12 +1254,12 @@ begin
 end;
 
 function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt;
-var
+var
-    I: LongInt;
+  I: LongInt;
-begin
+begin
-    Result := Depth;
+  Result := Depth;
-    for I := 1 to MipMaps - 1 do
+  for I := 1 to MipMaps - 1 do
-      Inc(Result, ClampInt(Depth shr I, 1, Depth));
+    Inc(Result, ClampInt(Depth shr I, 1, Depth));
 end;
 
 function BoundsToRect(X, Y, Width, Height: LongInt): TRect;
@@ -1488,27 +1408,27 @@ begin
 end;
 
 function RectInRect(const R1, R2: TRect): Boolean;
-begin
+begin
-  Result:=
+  Result:=
-    (R1.Left >= R2.Left) and
+    (R1.Left >= R2.Left) and
-    (R1.Top >= R2.Top) and
+    (R1.Top >= R2.Top) and
-    (R1.Right <= R2.Right) and
+    (R1.Right <= R2.Right) and
-    (R1.Bottom <= R2.Bottom);
+    (R1.Bottom <= R2.Bottom);
 end;
 
 function RectIntersects(const R1, R2: TRect): Boolean;
 begin
-  Result :=
+  Result :=
-    not (R1.Left > R2.Right) and
+    not (R1.Left > R2.Right) and
-    not (R1.Top > R2.Bottom) and
+    not (R1.Top > R2.Bottom) and
-    not (R1.Right < R2.Left) and
+    not (R1.Right < R2.Left) and
-    not (R1.Bottom < R2.Top);
+    not (R1.Bottom < R2.Top);
-end;
+end;
 
 function FormatExceptMsg(const Msg: string; const Args: array of const): string;
 begin
   Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args);
-end;
+end;
 
 procedure DebugMsg(const Msg: string; const Args: array of const);
 var
@@ -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!
 
@@ -1561,7 +1487,7 @@ initialization
     
   -- 0.23 Changes/Bug Fixes -----------------------------------
     - Added RectInRect and RectIntersects functions
-    - Added some string utils: StrToken, StrTokenEnd, PosEx, PosNoCase. 
+    - Added some string utils: StrToken, StrTokenEnd, PosEx, PosNoCase.
     - Moved BuildFileList here from DemoUtils.
 
   -- 0.21 Changes/Bug Fixes -----------------------------------

Imaging/JpegLib/imjmemnobs.pas

@@ -1,264 +1,259 @@
-unit imjmemnobs;
+unit imjmemnobs;
-{ Delphi3 -- > jmemnobs from jmemwin }
+{ Delphi3 -- > jmemnobs from jmemwin }
-{ This file provides an Win32-compatible implementation of the system-
+{ This file provides an Win32-compatible implementation of the system-
-  dependent portion of the JPEG memory manager. }
+  dependent portion of the JPEG memory manager. }
-
+
-{ Check jmemnobs.c }
+{ Check jmemnobs.c }
-{ Copyright (C) 1996, Jacques Nomssi Nzali }
+{ Copyright (C) 1996, Jacques Nomssi Nzali }
-
+
-
+
-interface
+interface
-
+
-{$I imjconfig.inc}
+{$I imjconfig.inc}
-
+
-uses
+uses
-  imjmorecfg,
+  imjmorecfg,
-  imjdeferr,
+  imjdeferr,
-  imjerror,
+  imjerror,
-  imjpeglib;
+  imjpeglib;
-
+
-{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may
+{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may
-  be requested in a single call to jpeg_get_large (and jpeg_get_small for that
+  be requested in a single call to jpeg_get_large (and jpeg_get_small for that
-  matter, but that case should never come into play).  This macro is needed
+  matter, but that case should never come into play).  This macro is needed
-  to model the 64Kb-segment-size limit of far addressing on 80x86 machines.
+  to model the 64Kb-segment-size limit of far addressing on 80x86 machines.
-  On those machines, we expect that jconfig.h will provide a proper value.
+  On those machines, we expect that jconfig.h will provide a proper value.
-  On machines with 32-bit flat address spaces, any large constant may be used.
+  On machines with 32-bit flat address spaces, any large constant may be used.
-
+
-  NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
+  NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
-  size_t and will be a multiple of sizeof(align_type). }
+  size_t and will be a multiple of sizeof(align_type). }
-
+
-{$IFDEF WINDOWS}
+const
-const
+  MAX_ALLOC_CHUNK = long(1000000000);
-  MAX_ALLOC_CHUNK = long(32752);
+
-{$ELSE}
+{GLOBAL}
-const
+procedure jpeg_open_backing_store (cinfo : j_common_ptr;
-  MAX_ALLOC_CHUNK = long(1000000000);
+                                   info : backing_store_ptr;
-{$ENDIF}
+                                   total_bytes_needed : long);
-
+
-{GLOBAL}
+{ These routines take care of any system-dependent initialization and
-procedure jpeg_open_backing_store (cinfo : j_common_ptr;
+  cleanup required. }
-                                   info : backing_store_ptr;
+
-                                   total_bytes_needed : long);
+{GLOBAL}
-
+function jpeg_mem_init (cinfo : j_common_ptr) : long;
-{ These routines take care of any system-dependent initialization and
+
-  cleanup required. }
+{GLOBAL}
-
+procedure jpeg_mem_term (cinfo : j_common_ptr);
-{GLOBAL}
+
-function jpeg_mem_init (cinfo : j_common_ptr) : long;
+{ These two functions are used to allocate and release small chunks of
-
+  memory.  (Typically the total amount requested through jpeg_get_small is
-{GLOBAL}
+  no more than 20K or so; this will be requested in chunks of a few K each.)
-procedure jpeg_mem_term (cinfo : j_common_ptr);
+  Behavior should be the same as for the standard library functions malloc
-
+  and free; in particular, jpeg_get_small must return NIL on failure.
-{ These two functions are used to allocate and release small chunks of
+  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
-  memory.  (Typically the total amount requested through jpeg_get_small is
+  size of the object being freed, just in case it's needed.
-  no more than 20K or so; this will be requested in chunks of a few K each.)
+  On an 80x86 machine using small-data memory model, these manage near heap. }
-  Behavior should be the same as for the standard library functions malloc
+
-  and free; in particular, jpeg_get_small must return NIL on failure.
+
-  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
+{ Near-memory allocation and freeing are controlled by the regular library
-  size of the object being freed, just in case it's needed.
+  routines malloc() and free(). }
-  On an 80x86 machine using small-data memory model, these manage near heap. }
+
-
+{GLOBAL}
-
+function jpeg_get_small (cinfo : j_common_ptr;
-{ Near-memory allocation and freeing are controlled by the regular library
+                         sizeofobject : size_t) : pointer;
-  routines malloc() and free(). }
+
-
+{GLOBAL}
-{GLOBAL}
+{object is a reserved word in Borland Pascal }
-function jpeg_get_small (cinfo : j_common_ptr;
+procedure jpeg_free_small (cinfo : j_common_ptr;
-                         sizeofobject : size_t) : pointer;
+                           an_object : pointer;
-
+                           sizeofobject : size_t);
-{GLOBAL}
+
-{object is a reserved word in Borland Pascal }
+{ These two functions are used to allocate and release large chunks of
-procedure jpeg_free_small (cinfo : j_common_ptr;
+  memory (up to the total free space designated by jpeg_mem_available).
-                           an_object : pointer;
+  The interface is the same as above, except that on an 80x86 machine,
-                           sizeofobject : size_t);
+  far pointers are used.  On most other machines these are identical to
-
+  the jpeg_get/free_small routines; but we keep them separate anyway,
-{ These two functions are used to allocate and release large chunks of
+  in case a different allocation strategy is desirable for large chunks. }
-  memory (up to the total free space designated by jpeg_mem_available).
+
-  The interface is the same as above, except that on an 80x86 machine,
+
-  far pointers are used.  On most other machines these are identical to
+{ "Large" objects are allocated in far memory, if possible }
-  the jpeg_get/free_small routines; but we keep them separate anyway,
+
-  in case a different allocation strategy is desirable for large chunks. }
+
-
+{GLOBAL}
-
+function jpeg_get_large (cinfo : j_common_ptr;
-{ "Large" objects are allocated in far memory, if possible }
+                         sizeofobject : size_t) : voidp; {far}
-
+
-
+{GLOBAL}
-{GLOBAL}
+procedure jpeg_free_large (cinfo : j_common_ptr;
-function jpeg_get_large (cinfo : j_common_ptr;
+                          {var?} an_object : voidp; {FAR}
-                         sizeofobject : size_t) : voidp; {far}
+                          sizeofobject : size_t);
-
+
-{GLOBAL}
+{ This routine computes the total memory space available for allocation.
-procedure jpeg_free_large (cinfo : j_common_ptr;
+  It's impossible to do this in a portable way; our current solution is
-                          {var?} an_object : voidp; {FAR}
+  to make the user tell us (with a default value set at compile time).
-                          sizeofobject : size_t);
+  If you can actually get the available space, it's a good idea to subtract
-
+  a slop factor of 5% or so. }
-{ This routine computes the total memory space available for allocation.
+
-  It's impossible to do this in a portable way; our current solution is
+{GLOBAL}
-  to make the user tell us (with a default value set at compile time).
+function jpeg_mem_available (cinfo : j_common_ptr;
-  If you can actually get the available space, it's a good idea to subtract
+                             min_bytes_needed : long;
-  a slop factor of 5% or so. }
+                             max_bytes_needed : long;
-
+                             already_allocated : long) : long;
-{GLOBAL}
+
-function jpeg_mem_available (cinfo : j_common_ptr;
+
-                             min_bytes_needed : long;
+implementation
-                             max_bytes_needed : long;
+
-                             already_allocated : long) : long;
+{ This structure holds whatever state is needed to access a single
-
+  backing-store object.  The read/write/close method pointers are called
-
+  by jmemmgr.c to manipulate the backing-store object; all other fields
-implementation
+  are private to the system-dependent backing store routines. }
-
+
-{ This structure holds whatever state is needed to access a single
+
-  backing-store object.  The read/write/close method pointers are called
+
-  by jmemmgr.c to manipulate the backing-store object; all other fields
+{ These two functions are used to allocate and release small chunks of
-  are private to the system-dependent backing store routines. }
+  memory.  (Typically the total amount requested through jpeg_get_small is
-
+  no more than 20K or so; this will be requested in chunks of a few K each.)
-
+  Behavior should be the same as for the standard library functions malloc
-
+  and free; in particular, jpeg_get_small must return NIL on failure.
-{ These two functions are used to allocate and release small chunks of
+  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
-  memory.  (Typically the total amount requested through jpeg_get_small is
+  size of the object being freed, just in case it's needed.
-  no more than 20K or so; this will be requested in chunks of a few K each.)
+  On an 80x86 machine using small-data memory model, these manage near heap. }
-  Behavior should be the same as for the standard library functions malloc
+
-  and free; in particular, jpeg_get_small must return NIL on failure.
+
-  On most systems, these ARE malloc and free.  jpeg_free_small is passed the
+{ Near-memory allocation and freeing are controlled by the regular library
-  size of the object being freed, just in case it's needed.
+  routines malloc() and free(). }
-  On an 80x86 machine using small-data memory model, these manage near heap. }
+
-
+{GLOBAL}
-
+function jpeg_get_small (cinfo : j_common_ptr;
-{ Near-memory allocation and freeing are controlled by the regular library
+                         sizeofobject : size_t) : pointer;
-  routines malloc() and free(). }
+var
-
+  p : pointer;
-{GLOBAL}
+begin
-function jpeg_get_small (cinfo : j_common_ptr;
+  GetMem(p, sizeofobject);
-                         sizeofobject : size_t) : pointer;
+  jpeg_get_small := p;
-var
+end;
-  p : pointer;
+
-begin
+{GLOBAL}
-  GetMem(p, sizeofobject);
+{object is a reserved word in Object Pascal }
-  jpeg_get_small := p;
+procedure jpeg_free_small (cinfo : j_common_ptr;
-end;
+                           an_object : pointer;
-
+                           sizeofobject : size_t);
-{GLOBAL}
+begin
-{object is a reserved word in Object Pascal }
+  FreeMem(an_object, sizeofobject);
-procedure jpeg_free_small (cinfo : j_common_ptr;
+end;
-                           an_object : pointer;
+
-                           sizeofobject : size_t);
+{ These two functions are used to allocate and release large chunks of
-begin
+  memory (up to the total free space designated by jpeg_mem_available).
-  FreeMem(an_object, sizeofobject);
+  The interface is the same as above, except that on an 80x86 machine,
-end;
+  far pointers are used.  On most other machines these are identical to
-
+  the jpeg_get/free_small routines; but we keep them separate anyway,
-{ These two functions are used to allocate and release large chunks of
+  in case a different allocation strategy is desirable for large chunks. }
-  memory (up to the total free space designated by jpeg_mem_available).
+
-  The interface is the same as above, except that on an 80x86 machine,
+
-  far pointers are used.  On most other machines these are identical to
+
-  the jpeg_get/free_small routines; but we keep them separate anyway,
+{GLOBAL}
-  in case a different allocation strategy is desirable for large chunks. }
+function jpeg_get_large (cinfo : j_common_ptr;
-
+                         sizeofobject : size_t) : voidp; {far}
-
+var
-
+  p : pointer;
-{GLOBAL}
+begin
-function jpeg_get_large (cinfo : j_common_ptr;
+  GetMem(p, sizeofobject);
-                         sizeofobject : size_t) : voidp; {far}
+  jpeg_get_large := p;
-var
+end;
-  p : pointer;
+
-begin
+{GLOBAL}
-  GetMem(p, sizeofobject);
+procedure jpeg_free_large (cinfo : j_common_ptr;
-  jpeg_get_large := p;
+                          {var?} an_object : voidp; {FAR}
-end;
+                          sizeofobject : size_t);
-
+begin
-{GLOBAL}
+  Freemem(an_object, sizeofobject);
-procedure jpeg_free_large (cinfo : j_common_ptr;
+end;
-                          {var?} an_object : voidp; {FAR}
+
-                          sizeofobject : size_t);
+{ This routine computes the total space still available for allocation by
-begin
+  jpeg_get_large.  If more space than this is needed, backing store will be
-  Freemem(an_object, sizeofobject);
+  used.  NOTE: any memory already allocated must not be counted.
-end;
+
-
+  There is a minimum space requirement, corresponding to the minimum
-{ This routine computes the total space still available for allocation by
+  feasible buffer sizes; jmemmgr.c will request that much space even if
-  jpeg_get_large.  If more space than this is needed, backing store will be
+  jpeg_mem_available returns zero.  The maximum space needed, enough to hold
-  used.  NOTE: any memory already allocated must not be counted.
+  all working storage in memory, is also passed in case it is useful.
-
+  Finally, the total space already allocated is passed.  If no better
-  There is a minimum space requirement, corresponding to the minimum
+  method is available, cinfo^.mem^.max_memory_to_use - already_allocated
-  feasible buffer sizes; jmemmgr.c will request that much space even if
+  is often a suitable calculation.
-  jpeg_mem_available returns zero.  The maximum space needed, enough to hold
+
-  all working storage in memory, is also passed in case it is useful.
+  It is OK for jpeg_mem_available to underestimate the space available
-  Finally, the total space already allocated is passed.  If no better
+  (that'll just lead to more backing-store access than is really necessary).
-  method is available, cinfo^.mem^.max_memory_to_use - already_allocated
+  However, an overestimate will lead to failure.  Hence it's wise to subtract
-  is often a suitable calculation.
+  a slop factor from the true available space.  5% should be enough.
-
+
-  It is OK for jpeg_mem_available to underestimate the space available
+  On machines with lots of virtual memory, any large constant may be returned.
-  (that'll just lead to more backing-store access than is really necessary).
+  Conversely, zero may be returned to always use the minimum amount of memory.}
-  However, an overestimate will lead to failure.  Hence it's wise to subtract
+
-  a slop factor from the true available space.  5% should be enough.
+
-
+
-  On machines with lots of virtual memory, any large constant may be returned.
+{ This routine computes the total memory space available for allocation.
-  Conversely, zero may be returned to always use the minimum amount of memory.}
+  It's impossible to do this in a portable way; our current solution is
-
+  to make the user tell us (with a default value set at compile time).
-
+  If you can actually get the available space, it's a good idea to subtract
-
+  a slop factor of 5% or so. }
-{ This routine computes the total memory space available for allocation.
+
-  It's impossible to do this in a portable way; our current solution is
+const
-  to make the user tell us (with a default value set at compile time).
+  DEFAULT_MAX_MEM = long(300000);   { for total usage about 450K }
-  If you can actually get the available space, it's a good idea to subtract
+
-  a slop factor of 5% or so. }
+{GLOBAL}
-
+function jpeg_mem_available (cinfo : j_common_ptr;
-const
+                             min_bytes_needed : long;
-  DEFAULT_MAX_MEM = long(300000);   { for total usage about 450K }
+                             max_bytes_needed : long;
-
+                             already_allocated : long) : long;
-{GLOBAL}
+begin
-function jpeg_mem_available (cinfo : j_common_ptr;
+  {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
-                             min_bytes_needed : long;
+  jpeg_mem_available := max_bytes_needed;
-                             max_bytes_needed : long;
+end;
-                             already_allocated : long) : long;
+
-begin
+
-  {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
+{ Initial opening of a backing-store object.  This must fill in the
-  jpeg_mem_available := max_bytes_needed;
+  read/write/close pointers in the object.  The read/write routines
-end;
+  may take an error exit if the specified maximum file size is exceeded.
-
+  (If jpeg_mem_available always returns a large value, this routine can
-
+  just take an error exit.) }
-{ Initial opening of a backing-store object.  This must fill in the
+
-  read/write/close pointers in the object.  The read/write routines
+
-  may take an error exit if the specified maximum file size is exceeded.
+
-  (If jpeg_mem_available always returns a large value, this routine can
+{ Initial opening of a backing-store object. }
-  just take an error exit.) }
+
-
+{GLOBAL}
-
+procedure jpeg_open_backing_store (cinfo : j_common_ptr;
-
+                                   info : backing_store_ptr;
-{ Initial opening of a backing-store object. }
+                                   total_bytes_needed : long);
-
+begin
-{GLOBAL}
+  ERREXIT(cinfo, JERR_NO_BACKING_STORE);
-procedure jpeg_open_backing_store (cinfo : j_common_ptr;
+end;
-                                   info : backing_store_ptr;
+
-                                   total_bytes_needed : long);
+{ These routines take care of any system-dependent initialization and
-begin
+  cleanup required.  jpeg_mem_init will be called before anything is
-  ERREXIT(cinfo, JERR_NO_BACKING_STORE);
+  allocated (and, therefore, nothing in cinfo is of use except the error
-end;
+  manager pointer).  It should return a suitable default value for
-
+  max_memory_to_use; this may subsequently be overridden by the surrounding
-{ These routines take care of any system-dependent initialization and
+  application.  (Note that max_memory_to_use is only important if
-  cleanup required.  jpeg_mem_init will be called before anything is
+  jpeg_mem_available chooses to consult it ... no one else will.)
-  allocated (and, therefore, nothing in cinfo is of use except the error
+  jpeg_mem_term may assume that all requested memory has been freed and that
-  manager pointer).  It should return a suitable default value for
+  all opened backing-store objects have been closed. }
-  max_memory_to_use; this may subsequently be overridden by the surrounding
+
-  application.  (Note that max_memory_to_use is only important if
+
-  jpeg_mem_available chooses to consult it ... no one else will.)
+{ These routines take care of any system-dependent initialization and
-  jpeg_mem_term may assume that all requested memory has been freed and that
+  cleanup required. }
-  all opened backing-store objects have been closed. }
+
-
+
-
+{GLOBAL}
-{ These routines take care of any system-dependent initialization and
+function jpeg_mem_init (cinfo : j_common_ptr) : long;
-  cleanup required. }
+begin
-
+  jpeg_mem_init := DEFAULT_MAX_MEM;   { default for max_memory_to_use }
-
+end;
-{GLOBAL}
+
-function jpeg_mem_init (cinfo : j_common_ptr) : long;
+{GLOBAL}
-begin
+procedure jpeg_mem_term (cinfo : j_common_ptr);
-  jpeg_mem_init := DEFAULT_MAX_MEM;   { default for max_memory_to_use }
+begin
-end;
+
-
+end;
-{GLOBAL}
+
-procedure jpeg_mem_term (cinfo : j_common_ptr);
+
-begin
+end.
-
-end;
-
-
-end.

Imaging/ZLib/iminffast.pas

@@ -1,318 +1,318 @@
-Unit iminffast;
+Unit iminffast;
-
+
-{
+{
-  inffast.h and
+  inffast.h and
-  inffast.c -- process literals and length/distance pairs fast
+  inffast.c -- process literals and length/distance pairs fast
-  Copyright (C) 1995-1998 Mark Adler
+  Copyright (C) 1995-1998 Mark Adler
-
+
-  Pascal tranlastion
+  Pascal tranlastion
-  Copyright (C) 1998 by Jacques Nomssi Nzali
+  Copyright (C) 1998 by Jacques Nomssi Nzali
-  For conditions of distribution and use, see copyright notice in readme.txt
+  For conditions of distribution and use, see copyright notice in readme.txt
-}
+}
-
+
-
+
-interface
+interface
-
+
-{$I imzconf.inc}
+{$I imzconf.inc}
-
+
-uses
+uses
-  {$ifdef DEBUG}
+  {$ifdef DEBUG}
-  SysUtils, strutils,
+  SysUtils, strutils,
-  {$ENDIF}
+  {$ENDIF}
-  imzutil, impaszlib;
+  imzutil, impaszlib;
-
+
-function inflate_fast( bl : uInt;
+function inflate_fast( bl : uInt;
-                       bd : uInt;
+                       bd : uInt;
-                       tl : pInflate_huft;
+                       tl : pInflate_huft;
-                       td : pInflate_huft;
+                       td : pInflate_huft;
-                      var s : inflate_blocks_state;
+                      var s : inflate_blocks_state;
-                      var z : z_stream) : int;
+                      var z : z_stream) : int;
-
+
-
+
-implementation
+implementation
-
+
-uses
+uses
-  iminfutil;
+  iminfutil;
-
+
-
+
-{ Called with number of bytes left to write in window at least 258
+{ Called with number of bytes left to write in window at least 258
-  (the maximum string length) and number of input bytes available
+  (the maximum string length) and number of input bytes available
-  at least ten.  The ten bytes are six bytes for the longest length/
+  at least ten.  The ten bytes are six bytes for the longest length/
-  distance pair plus four bytes for overloading the bit buffer. }
+  distance pair plus four bytes for overloading the bit buffer. }
-
+
-function inflate_fast( bl : uInt;
+function inflate_fast( bl : uInt;
-                       bd : uInt;
+                       bd : uInt;
-                       tl : pInflate_huft;
+                       tl : pInflate_huft;
-                       td : pInflate_huft;
+                       td : pInflate_huft;
-                      var s : inflate_blocks_state;
+                      var s : inflate_blocks_state;
-                      var z : z_stream) : int;
+                      var z : z_stream) : int;
-
+
-var
+var
-  t : pInflate_huft;      { temporary pointer }
+  t : pInflate_huft;      { temporary pointer }
-  e : uInt;               { extra bits or operation }
+  e : uInt;               { extra bits or operation }
-  b : uLong;              { bit buffer }
+  b : uLong;              { bit buffer }
-  k : uInt;               { bits in bit buffer }
+  k : uInt;               { bits in bit buffer }
-  p : pBytef;             { input data pointer }
+  p : pBytef;             { input data pointer }
-  n : uInt;               { bytes available there }
+  n : uInt;               { bytes available there }
-  q : pBytef;             { output window write pointer }
+  q : pBytef;             { output window write pointer }
-  m : uInt;               { bytes to end of window or read pointer }
+  m : uInt;               { bytes to end of window or read pointer }
-  ml : uInt;              { mask for literal/length tree }
+  ml : uInt;              { mask for literal/length tree }
-  md : uInt;              { mask for distance tree }
+  md : uInt;              { mask for distance tree }
-  c : uInt;               { bytes to copy }
+  c : uInt;               { bytes to copy }
-  d : uInt;               { distance back to copy from }
+  d : uInt;               { distance back to copy from }
-  r : pBytef;             { copy source pointer }
+  r : pBytef;             { copy source pointer }
-begin
+begin
-  { load input, output, bit values (macro LOAD) }
+  { load input, output, bit values (macro LOAD) }
-  p := z.next_in;
+  p := z.next_in;
-  n := z.avail_in;
+  n := z.avail_in;
-  b := s.bitb;
+  b := s.bitb;
-  k := s.bitk;
+  k := s.bitk;
-  q := s.write;
+  q := s.write;
-  if ptr2int(q) < ptr2int(s.read) then
+  if ptr2int(q) < ptr2int(s.read) then
-    m := uInt(ptr2int(s.read)-ptr2int(q)-1)
+    m := uInt(ptr2int(s.read)-ptr2int(q)-1)
-  else
+  else
-    m := uInt(ptr2int(s.zend)-ptr2int(q));
+    m := uInt(ptr2int(s.zend)-ptr2int(q));
-
+
-  { initialize masks }
+  { initialize masks }
-  ml := inflate_mask[bl];
+  ml := inflate_mask[bl];
-  md := inflate_mask[bd];
+  md := inflate_mask[bd];
-
+
-  { do until not enough input or output space for fast loop }
+  { do until not enough input or output space for fast loop }
-  repeat                      { assume called with (m >= 258) and (n >= 10) }
+  repeat                      { assume called with (m >= 258) and (n >= 10) }
-    { get literal/length code }
+    { get literal/length code }
-    {GRABBITS(20);}             { max bits for literal/length code }
+    {GRABBITS(20);}             { max bits for literal/length code }
-    while (k < 20) do
+    while (k < 20) do
-    begin
+    begin
-      Dec(n);
+      Dec(n);
-      b := b or (uLong(p^) shl k);
+      b := b or (uLong(p^) shl k);
-      Inc(p);
+      Inc(p);
-      Inc(k, 8);
+      Inc(k, 8);
-    end;
+    end;
-
+
-    t := @(huft_ptr(tl)^[uInt(b) and ml]);
+    t := @(huft_ptr(tl)^[uInt(b) and ml]);
-
+
-    e := t^.exop;
+    e := t^.exop;
-    if (e = 0) then
+    if (e = 0) then
-    begin
+    begin
-      {DUMPBITS(t^.bits);}
+      {DUMPBITS(t^.bits);}
-      b := b shr t^.bits;
+      b := b shr t^.bits;
-      Dec(k, t^.bits);
+      Dec(k, t^.bits);
-     {$IFDEF DEBUG}
+     {$IFDEF DEBUG}
-      if (t^.base >= $20) and (t^.base < $7f) then
+      if (t^.base >= $20) and (t^.base < $7f) then
-        Tracevv('inflate:         * literal '+char(t^.base))
+        Tracevv('inflate:         * literal '+AnsiChar(t^.base))
-      else
+      else
-        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
+        Tracevv('inflate:         * literal '+ IntToStr(t^.base));
-      {$ENDIF}
+      {$ENDIF}
-      q^ := Byte(t^.base);
+      q^ := Byte(t^.base);
-      Inc(q);
+      Inc(q);
-      Dec(m);
+      Dec(m);
-      continue;
+      continue;
-    end;
+    end;
-    repeat
+    repeat
-      {DUMPBITS(t^.bits);}
+      {DUMPBITS(t^.bits);}
-      b := b shr t^.bits;
+      b := b shr t^.bits;
-      Dec(k, t^.bits);
+      Dec(k, t^.bits);
-
+
-      if (e and 16 <> 0) then
+      if (e and 16 <> 0) then
-      begin
+      begin
-        { get extra bits for length }
+        { get extra bits for length }
-        e := e and 15;
+        e := e and 15;
-        c := t^.base + (uInt(b) and inflate_mask[e]);
+        c := t^.base + (uInt(b) and inflate_mask[e]);
-        {DUMPBITS(e);}
+        {DUMPBITS(e);}
-        b := b shr e;
+        b := b shr e;
-        Dec(k, e);
+        Dec(k, e);
-        {$IFDEF DEBUG}
+        {$IFDEF DEBUG}
-        Tracevv('inflate:         * length ' + IntToStr(c));
+        Tracevv('inflate:         * length ' + IntToStr(c));
-        {$ENDIF}
+        {$ENDIF}
-        { decode distance base of block to copy }
+        { decode distance base of block to copy }
-        {GRABBITS(15);}           { max bits for distance code }
+        {GRABBITS(15);}           { max bits for distance code }
-        while (k < 15) do
+        while (k < 15) do
-        begin
+        begin
-          Dec(n);
+          Dec(n);
-          b := b or (uLong(p^) shl k);
+          b := b or (uLong(p^) shl k);
-          Inc(p);
+          Inc(p);
-          Inc(k, 8);
+          Inc(k, 8);
-        end;
+        end;
-
+
-        t := @huft_ptr(td)^[uInt(b) and md];
+        t := @huft_ptr(td)^[uInt(b) and md];
-        e := t^.exop;
+        e := t^.exop;
-        repeat
+        repeat
-          {DUMPBITS(t^.bits);}
+          {DUMPBITS(t^.bits);}
-          b := b shr t^.bits;
+          b := b shr t^.bits;
-          Dec(k, t^.bits);
+          Dec(k, t^.bits);
-
+
-          if (e and 16 <> 0) then
+          if (e and 16 <> 0) then
-          begin
+          begin
-            { get extra bits to add to distance base }
+            { get extra bits to add to distance base }
-            e := e and 15;
+            e := e and 15;
-            {GRABBITS(e);}         { get extra bits (up to 13) }
+            {GRABBITS(e);}         { get extra bits (up to 13) }
-            while (k < e) do
+            while (k < e) do
-            begin
+            begin
-              Dec(n);
+              Dec(n);
-              b := b or (uLong(p^) shl k);
+              b := b or (uLong(p^) shl k);
-              Inc(p);
+              Inc(p);
-              Inc(k, 8);
+              Inc(k, 8);
-            end;
+            end;
-
+
-            d := t^.base + (uInt(b) and inflate_mask[e]);
+            d := t^.base + (uInt(b) and inflate_mask[e]);
-            {DUMPBITS(e);}
+            {DUMPBITS(e);}
-            b := b shr e;
+            b := b shr e;
-            Dec(k, e);
+            Dec(k, e);
-
+
-            {$IFDEF DEBUG}
+            {$IFDEF DEBUG}
-            Tracevv('inflate:         * distance '+IntToStr(d));
+            Tracevv('inflate:         * distance '+IntToStr(d));
-            {$ENDIF}
+            {$ENDIF}
-            { do the copy }
+            { do the copy }
-            Dec(m, c);
+            Dec(m, c);
-            if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then     { offset before dest }
+            if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then     { offset before dest }
-            begin                                  {  just copy }
+            begin                                  {  just copy }
-              r := q;
+              r := q;
-              Dec(r, d);
+              Dec(r, d);
-              q^ := r^;  Inc(q); Inc(r); Dec(c); { minimum count is three, }
+              q^ := r^;  Inc(q); Inc(r); Dec(c); { minimum count is three, }
-              q^ := r^;  Inc(q); Inc(r); Dec(c); { so unroll loop a little }
+              q^ := r^;  Inc(q); Inc(r); Dec(c); { so unroll loop a little }
-            end
+            end
-            else                        { else offset after destination }
+            else                        { else offset after destination }
-            begin
+            begin
-              e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
+              e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
-              r := s.zend;
+              r := s.zend;
-              Dec(r, e);                  { pointer to offset }
+              Dec(r, e);                  { pointer to offset }
-              if (c > e) then             { if source crosses, }
+              if (c > e) then             { if source crosses, }
-              begin
+              begin
-                Dec(c, e);                { copy to end of window }
+                Dec(c, e);                { copy to end of window }
-                repeat
+                repeat
-                  q^ := r^;
+                  q^ := r^;
-                  Inc(q);
+                  Inc(q);
-                  Inc(r);
+                  Inc(r);
-                  Dec(e);
+                  Dec(e);
-                until (e=0);
+                until (e=0);
-                r := s.window;           { copy rest from start of window }
+                r := s.window;           { copy rest from start of window }
-              end;
+              end;
-            end;
+            end;
-            repeat                       { copy all or what's left }
+            repeat                       { copy all or what's left }
-              q^ := r^;
+              q^ := r^;
-              Inc(q);
+              Inc(q);
-              Inc(r);
+              Inc(r);
-              Dec(c);
+              Dec(c);
-            until (c = 0);
+            until (c = 0);
-            break;
+            break;
-          end
+          end
-          else
+          else
-            if (e and 64 = 0) then
+            if (e and 64 = 0) then
-            begin
+            begin
-              Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
+              Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
-              e := t^.exop;
+              e := t^.exop;
-            end
+            end
-          else
+          else
-          begin
+          begin
-            z.msg := 'invalid distance code';
+            z.msg := 'invalid distance code';
-            {UNGRAB}
+            {UNGRAB}
-            c := z.avail_in-n;
+            c := z.avail_in-n;
-            if (k shr 3) < c then
+            if (k shr 3) < c then
-              c := k shr 3;
+              c := k shr 3;
-            Inc(n, c);
+            Inc(n, c);
-            Dec(p, c);
+            Dec(p, c);
-            Dec(k, c shl 3);
+            Dec(k, c shl 3);
-            {UPDATE}
+            {UPDATE}
-            s.bitb := b;
+            s.bitb := b;
-            s.bitk := k;
+            s.bitk := k;
-            z.avail_in := n;
+            z.avail_in := n;
-            Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+            Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-            z.next_in := p;
+            z.next_in := p;
-            s.write := q;
+            s.write := q;
-
+
-            inflate_fast := Z_DATA_ERROR;
+            inflate_fast := Z_DATA_ERROR;
-            exit;
+            exit;
-          end;
+          end;
-        until FALSE;
+        until FALSE;
-        break;
+        break;
-      end;
+      end;
-      if (e and 64 = 0) then
+      if (e and 64 = 0) then
-      begin
+      begin
-         {t += t->base;
+         {t += t->base;
-          e = (t += ((uInt)b & inflate_mask[e]))->exop;}
+          e = (t += ((uInt)b & inflate_mask[e]))->exop;}
-
+
-        Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
+        Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
-        e := t^.exop;
+        e := t^.exop;
-        if (e = 0) then
+        if (e = 0) then
-        begin
+        begin
-          {DUMPBITS(t^.bits);}
+          {DUMPBITS(t^.bits);}
-          b := b shr t^.bits;
+          b := b shr t^.bits;
-          Dec(k, t^.bits);
+          Dec(k, t^.bits);
-
+
-         {$IFDEF DEBUG}
+         {$IFDEF DEBUG}
-          if (t^.base >= $20) and (t^.base < $7f) then
+          if (t^.base >= $20) and (t^.base < $7f) then
-            Tracevv('inflate:         * literal '+char(t^.base))
+            Tracevv('inflate:         * literal '+AnsiChar(t^.base))
-          else
+          else
-            Tracevv('inflate:         * literal '+IntToStr(t^.base));
+            Tracevv('inflate:         * literal '+IntToStr(t^.base));
-          {$ENDIF}            
+          {$ENDIF}            
-          q^ := Byte(t^.base);
+          q^ := Byte(t^.base);
-          Inc(q);
+          Inc(q);
-          Dec(m);
+          Dec(m);
-          break;
+          break;
-        end;
+        end;
-      end
+      end
-      else
+      else
-        if (e and 32 <> 0) then
+        if (e and 32 <> 0) then
-        begin
+        begin
-          {$IFDEF DEBUG}
+          {$IFDEF DEBUG}
-          Tracevv('inflate:         * end of block');
+          Tracevv('inflate:         * end of block');
-          {$ENDIF}
+          {$ENDIF}
-          {UNGRAB}
+          {UNGRAB}
-          c := z.avail_in-n;
+          c := z.avail_in-n;
-          if (k shr 3) < c then
+          if (k shr 3) < c then
-            c := k shr 3;
+            c := k shr 3;
-          Inc(n, c);
+          Inc(n, c);
-          Dec(p, c);
+          Dec(p, c);
-          Dec(k, c shl 3);
+          Dec(k, c shl 3);
-          {UPDATE}
+          {UPDATE}
-          s.bitb := b;
+          s.bitb := b;
-          s.bitk := k;
+          s.bitk := k;
-          z.avail_in := n;
+          z.avail_in := n;
-          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-          z.next_in := p;
+          z.next_in := p;
-          s.write := q;
+          s.write := q;
-          inflate_fast := Z_STREAM_END;
+          inflate_fast := Z_STREAM_END;
-          exit;
+          exit;
-        end
+        end
-        else
+        else
-        begin
+        begin
-          z.msg := 'invalid literal/length code';
+          z.msg := 'invalid literal/length code';
-          {UNGRAB}
+          {UNGRAB}
-          c := z.avail_in-n;
+          c := z.avail_in-n;
-          if (k shr 3) < c then
+          if (k shr 3) < c then
-            c := k shr 3;
+            c := k shr 3;
-          Inc(n, c);
+          Inc(n, c);
-          Dec(p, c);
+          Dec(p, c);
-          Dec(k, c shl 3);
+          Dec(k, c shl 3);
-          {UPDATE}
+          {UPDATE}
-          s.bitb := b;
+          s.bitb := b;
-          s.bitk := k;
+          s.bitk := k;
-          z.avail_in := n;
+          z.avail_in := n;
-          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+          Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-          z.next_in := p;
+          z.next_in := p;
-          s.write := q;
+          s.write := q;
-          inflate_fast := Z_DATA_ERROR;
+          inflate_fast := Z_DATA_ERROR;
-          exit;
+          exit;
-        end;
+        end;
-    until FALSE;
+    until FALSE;
-  until (m < 258) or (n < 10);
+  until (m < 258) or (n < 10);
-
+
-  { not enough input or output--restore pointers and return }
+  { not enough input or output--restore pointers and return }
-  {UNGRAB}
+  {UNGRAB}
-  c := z.avail_in-n;
+  c := z.avail_in-n;
-  if (k shr 3) < c then
+  if (k shr 3) < c then
-    c := k shr 3;
+    c := k shr 3;
-  Inc(n, c);
+  Inc(n, c);
-  Dec(p, c);
+  Dec(p, c);
-  Dec(k, c shl 3);
+  Dec(k, c shl 3);
-  {UPDATE}
+  {UPDATE}
-  s.bitb := b;
+  s.bitb := b;
-  s.bitk := k;
+  s.bitk := k;
-  z.avail_in := n;
+  z.avail_in := n;
-  Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
+  Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
-  z.next_in := p;
+  z.next_in := p;
-  s.write := q;
+  s.write := q;
-  inflate_fast := Z_OK;
+  inflate_fast := Z_OK;
-end;
+end;
-
+
-end.
+end.

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>

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.
+