- Updated Vampyre Imaging Lib
- Added font rendering - Added height display in flat mode
This commit is contained in:
parent
a5128b0d05
commit
be3f8c05df
|
|
@ -56,7 +56,7 @@
|
||||||
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
|
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
|
||||||
</Item5>
|
</Item5>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="35">
|
<Units Count="36">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="CentrED.lpr"/>
|
<Filename Value="CentrED.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
|
|
@ -273,6 +273,11 @@
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="UTiledata"/>
|
<UnitName Value="UTiledata"/>
|
||||||
</Unit34>
|
</Unit34>
|
||||||
|
<Unit35>
|
||||||
|
<Filename Value="UGLFont.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UGLFont"/>
|
||||||
|
</Unit35>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
|
|
||||||
|
|
@ -40,7 +40,7 @@ uses
|
||||||
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
|
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
|
||||||
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
|
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
|
||||||
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
|
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
|
||||||
Logging, UMap, UWorldItem, UStatics, UTiledata;
|
Logging, UMap, UWorldItem, UStatics, UTiledata, UGLFont;
|
||||||
|
|
||||||
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
||||||
|
|
||||||
|
|
|
||||||
Binary file not shown.
Binary file not shown.
|
After Width: | Height: | Size: 5.0 KiB |
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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.
|
||||||
|
|
||||||
|
|
@ -30,11 +30,11 @@ unit ULandscape;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
SysUtils, Classes, math, LCLIntf, GL, GLU, ImagingOpenGL, Imaging,
|
SysUtils, Classes, math, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
|
||||||
ImagingClasses, ImagingTypes, ImagingUtility,
|
ImagingClasses, ImagingTypes, ImagingUtility,
|
||||||
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
|
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
|
||||||
UMulBlock,
|
UMulBlock,
|
||||||
UVector, UEnhancedMemoryStream,
|
UVector, UEnhancedMemoryStream, UGLFont,
|
||||||
UCacheManager;
|
UCacheManager;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
@ -196,6 +196,19 @@ type
|
||||||
procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
|
procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
|
||||||
end;
|
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);
|
TScreenState = (ssNormal, ssFiltered, ssGhost);
|
||||||
|
|
||||||
PBlockInfo = ^TBlockInfo;
|
PBlockInfo = ^TBlockInfo;
|
||||||
|
|
@ -212,6 +225,7 @@ type
|
||||||
HueOverride: Boolean;
|
HueOverride: Boolean;
|
||||||
CheckRealQuad: Boolean;
|
CheckRealQuad: Boolean;
|
||||||
Translucent: Boolean;
|
Translucent: Boolean;
|
||||||
|
Text: TGLText;
|
||||||
Next: PBlockInfo;
|
Next: PBlockInfo;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -1213,6 +1227,7 @@ begin
|
||||||
Result^.State := ssNormal;
|
Result^.State := ssNormal;
|
||||||
Result^.Highlighted := False;
|
Result^.Highlighted := False;
|
||||||
Result^.Translucent := False;
|
Result^.Translucent := False;
|
||||||
|
Result^.Text := nil;
|
||||||
Result^.Next := nil;
|
Result^.Next := nil;
|
||||||
|
|
||||||
if FShortCuts[0] = nil then //First element
|
if FShortCuts[0] = nil then //First element
|
||||||
|
|
@ -1239,6 +1254,7 @@ begin
|
||||||
current^.Item.Locked := False;
|
current^.Item.Locked := False;
|
||||||
current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
|
current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
|
||||||
if current^.Normals <> nil then Dispose(current^.Normals);
|
if current^.Normals <> nil then Dispose(current^.Normals);
|
||||||
|
current^.Text.Free;
|
||||||
Dispose(current);
|
Dispose(current);
|
||||||
current := next;
|
current := next;
|
||||||
end;
|
end;
|
||||||
|
|
@ -1266,6 +1282,7 @@ begin
|
||||||
if last <> nil then last^.Next := current^.Next;
|
if last <> nil then last^.Next := current^.Next;
|
||||||
|
|
||||||
if current^.Normals <> nil then Dispose(current^.Normals);
|
if current^.Normals <> nil then Dispose(current^.Normals);
|
||||||
|
current^.Text.Free;
|
||||||
|
|
||||||
Dispose(current);
|
Dispose(current);
|
||||||
Dec(FCount);
|
Dec(FCount);
|
||||||
|
|
@ -1356,6 +1373,7 @@ begin
|
||||||
Result^.State := ssNormal;
|
Result^.State := ssNormal;
|
||||||
Result^.Highlighted := False;
|
Result^.Highlighted := False;
|
||||||
Result^.Translucent := False;
|
Result^.Translucent := False;
|
||||||
|
Result^.Text := nil;
|
||||||
|
|
||||||
if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
|
if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
|
||||||
begin
|
begin
|
||||||
|
|
@ -1490,5 +1508,27 @@ begin
|
||||||
Delete(TWorldItem(ATile));
|
Delete(TWorldItem(ATile));
|
||||||
end;
|
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.
|
end.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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.
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -31,10 +31,10 @@ interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
|
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,
|
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
|
||||||
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, fgl,
|
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, fgl,
|
||||||
ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket;
|
ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, UGLFont;
|
||||||
|
|
||||||
type
|
type
|
||||||
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
|
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
|
||||||
|
|
@ -269,6 +269,7 @@ type
|
||||||
Node: PVirtualNode; Stream: TStream);
|
Node: PVirtualNode; Stream: TStream);
|
||||||
protected
|
protected
|
||||||
{ Members }
|
{ Members }
|
||||||
|
FAppDir: String;
|
||||||
FX: Integer;
|
FX: Integer;
|
||||||
FY: Integer;
|
FY: Integer;
|
||||||
FDrawDistance: Integer;
|
FDrawDistance: Integer;
|
||||||
|
|
@ -294,6 +295,7 @@ type
|
||||||
FRepaintNeeded: Boolean;
|
FRepaintNeeded: Boolean;
|
||||||
FSelection: TRect;
|
FSelection: TRect;
|
||||||
FUndoList: TPacketList;
|
FUndoList: TPacketList;
|
||||||
|
FGLFont: TGLFont;
|
||||||
{ Methods }
|
{ Methods }
|
||||||
procedure BuildTileList;
|
procedure BuildTileList;
|
||||||
function ConfirmAction: Boolean;
|
function ConfirmAction: Boolean;
|
||||||
|
|
@ -784,6 +786,8 @@ var
|
||||||
virtualLayerGraphic: TSingleImage;
|
virtualLayerGraphic: TSingleImage;
|
||||||
searchRec: TSearchRec;
|
searchRec: TSearchRec;
|
||||||
begin
|
begin
|
||||||
|
FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
|
||||||
|
|
||||||
FLandscape := ResMan.Landscape;
|
FLandscape := ResMan.Landscape;
|
||||||
FLandscape.OnChange := @OnLandscapeChanged;
|
FLandscape.OnChange := @OnLandscapeChanged;
|
||||||
FLandscape.OnMapChanged := @OnMapChanged;
|
FLandscape.OnMapChanged := @OnMapChanged;
|
||||||
|
|
@ -812,8 +816,7 @@ begin
|
||||||
vstChat.NodeDataSize := SizeOf(TChatInfo);
|
vstChat.NodeDataSize := SizeOf(TChatInfo);
|
||||||
pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
|
pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
|
||||||
|
|
||||||
FLocationsFile := IncludeTrailingPathDelimiter(ExtractFilePath(
|
FLocationsFile := FAppDir + 'Locations.dat';
|
||||||
Application.ExeName)) + 'Locations.dat';
|
|
||||||
vstLocations.NodeDataSize := SizeOf(TLocationInfo);
|
vstLocations.NodeDataSize := SizeOf(TLocationInfo);
|
||||||
if FileExists(FLocationsFile) then vstLocations.LoadFromFile(FLocationsFile);
|
if FileExists(FLocationsFile) then vstLocations.LoadFromFile(FLocationsFile);
|
||||||
|
|
||||||
|
|
@ -824,11 +827,14 @@ begin
|
||||||
virtualLayerGraphic.Height, virtualLayerGraphic);
|
virtualLayerGraphic.Height, virtualLayerGraphic);
|
||||||
virtualLayerGraphic.Free;
|
virtualLayerGraphic.Free;
|
||||||
|
|
||||||
|
FGLFont := TGLFont.Create;
|
||||||
|
FGLFont.LoadImage(ResourceManager.GetResource(3));
|
||||||
|
FGLFont.LoadFontInfo(ResourceManager.GetResource(4));
|
||||||
|
|
||||||
FVirtualTiles := TWorldItemList.Create(True);
|
FVirtualTiles := TWorldItemList.Create(True);
|
||||||
FUndoList := TPacketList.Create(True);
|
FUndoList := TPacketList.Create(True);
|
||||||
|
|
||||||
FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(
|
FRandomPresetLocation := FAppDir + 'RandomPresets' + PathDelim;
|
||||||
Application.ExeName)) + 'RandomPresets' + PathDelim;
|
|
||||||
if not DirectoryExists(FRandomPresetLocation) then
|
if not DirectoryExists(FRandomPresetLocation) then
|
||||||
CreateDir(FRandomPresetLocation);
|
CreateDir(FRandomPresetLocation);
|
||||||
|
|
||||||
|
|
@ -1116,6 +1122,7 @@ begin
|
||||||
FreeAndNil(FVLayerMaterial);
|
FreeAndNil(FVLayerMaterial);
|
||||||
FreeAndNil(FVirtualTiles);
|
FreeAndNil(FVirtualTiles);
|
||||||
FreeAndNil(FUndoList);
|
FreeAndNil(FUndoList);
|
||||||
|
FreeAndNil(FGLFont);
|
||||||
|
|
||||||
RegisterPacketHandler($0C, nil);
|
RegisterPacketHandler($0C, nil);
|
||||||
end;
|
end;
|
||||||
|
|
@ -1783,9 +1790,11 @@ procedure TfrmMain.InitSize;
|
||||||
begin
|
begin
|
||||||
glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
|
glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
|
||||||
glMatrixMode(GL_PROJECTION);
|
glMatrixMode(GL_PROJECTION);
|
||||||
|
glPushMatrix;
|
||||||
glLoadIdentity;
|
glLoadIdentity;
|
||||||
gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
|
gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
|
||||||
glMatrixMode(GL_MODELVIEW);
|
glMatrixMode(GL_MODELVIEW);
|
||||||
|
glPushMatrix;
|
||||||
glLoadIdentity;
|
glLoadIdentity;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -1923,6 +1932,10 @@ begin
|
||||||
CheckRealQuad := True;
|
CheckRealQuad := True;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
ABlockInfo^.Text.Free;
|
||||||
|
ABlockInfo^.Text := TGLText.Create(FGLFont, IntToStr(item.Z));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if not ABlockInfo^.CheckRealQuad then
|
if not ABlockInfo^.CheckRealQuad then
|
||||||
|
|
@ -2082,6 +2095,9 @@ begin
|
||||||
|
|
||||||
if highlight then
|
if highlight then
|
||||||
glDisable(GL_COLOR_LOGIC_OP);
|
glDisable(GL_COLOR_LOGIC_OP);
|
||||||
|
|
||||||
|
if (blockInfo^.Text <> nil) then
|
||||||
|
blockInfo^.Text.Render(blockInfo^.ScreenRect);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FOverlayUI.Draw(oglGameWindow);
|
FOverlayUI.Draw(oglGameWindow);
|
||||||
|
|
|
||||||
7038
Imaging/Imaging.pas
7038
Imaging/Imaging.pas
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||||
|
|
|
||||||
|
|
@ -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
|
Vampyre Imaging Library
|
||||||
by Marek Mauder
|
by Marek Mauder
|
||||||
http://imaginglib.sourceforge.net
|
http://imaginglib.sourceforge.net
|
||||||
|
|
@ -26,7 +26,7 @@
|
||||||
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 VCL/CLX/LCL TGraphic descendant which uses Imaging library
|
{ This unit contains VCL/LCL TGraphic descendant which uses Imaging library
|
||||||
for saving and loading.}
|
for saving and loading.}
|
||||||
unit ImagingComponents;
|
unit ImagingComponents;
|
||||||
|
|
||||||
|
|
@ -34,6 +34,17 @@ unit ImagingComponents;
|
||||||
|
|
||||||
interface
|
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
|
uses
|
||||||
SysUtils, Types, Classes,
|
SysUtils, Types, Classes,
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
|
|
@ -42,10 +53,6 @@ uses
|
||||||
{$IFDEF COMPONENT_SET_VCL}
|
{$IFDEF COMPONENT_SET_VCL}
|
||||||
Graphics,
|
Graphics,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF COMPONENT_SET_CLX}
|
|
||||||
Qt,
|
|
||||||
QGraphics,
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
InterfaceBase,
|
InterfaceBase,
|
||||||
GraphType,
|
GraphType,
|
||||||
|
|
@ -71,6 +78,8 @@ type
|
||||||
procedure ReadDataFromStream(Stream: TStream); virtual;
|
procedure ReadDataFromStream(Stream: TStream); virtual;
|
||||||
procedure AssignTo(Dest: TPersistent); override;
|
procedure AssignTo(Dest: TPersistent); override;
|
||||||
public
|
public
|
||||||
|
constructor Create; override;
|
||||||
|
|
||||||
{ Loads new image from the stream. It can load all image
|
{ Loads new image from the stream. It can load all image
|
||||||
file formats supported by Imaging (and enabled of course)
|
file formats supported by Imaging (and enabled of course)
|
||||||
even though it is called by descendant class capable of
|
even though it is called by descendant class capable of
|
||||||
|
|
@ -114,8 +123,7 @@ type
|
||||||
{ Returns file extensions of this graphic class.}
|
{ Returns file extensions of this graphic class.}
|
||||||
class function GetFileExtensions: string; override;
|
class function GetFileExtensions: string; override;
|
||||||
{ Returns default MIME type of this graphic class.}
|
{ 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}
|
{$ENDIF}
|
||||||
{ Default (the most common) file extension of this graphic class.}
|
{ Default (the most common) file extension of this graphic class.}
|
||||||
property DefaultFileExt: string read FDefaultFileExt;
|
property DefaultFileExt: string read FDefaultFileExt;
|
||||||
|
|
@ -123,7 +131,7 @@ type
|
||||||
|
|
||||||
TImagingGraphicForSaveClass = class of TImagingGraphicForSave;
|
TImagingGraphicForSaveClass = class of TImagingGraphicForSave;
|
||||||
|
|
||||||
{$IFDEF LINK_BITMAP}
|
{$IFNDEF DONT_LINK_BITMAP}
|
||||||
{ TImagingGraphic descendant for loading/saving Windows bitmaps.
|
{ TImagingGraphic descendant for loading/saving Windows bitmaps.
|
||||||
VCL/CLX/LCL all have native support for bitmaps so you might
|
VCL/CLX/LCL all have native support for bitmaps so you might
|
||||||
want to disable this class (although you can save bitmaps with
|
want to disable this class (although you can save bitmaps with
|
||||||
|
|
@ -140,7 +148,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_JPEG}
|
{$IFNDEF DONT_LINK_JPEG}
|
||||||
{ TImagingGraphic descendant for loading/saving JPEG images.}
|
{ TImagingGraphic descendant for loading/saving JPEG images.}
|
||||||
TImagingJpeg = class(TImagingGraphicForSave)
|
TImagingJpeg = class(TImagingGraphicForSave)
|
||||||
protected
|
protected
|
||||||
|
|
@ -151,8 +159,7 @@ type
|
||||||
procedure SaveToStream(Stream: TStream); override;
|
procedure SaveToStream(Stream: TStream); override;
|
||||||
class function GetFileFormat: TImageFileFormat; override;
|
class function GetFileFormat: TImageFileFormat; override;
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$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}
|
{$ENDIF}
|
||||||
{ See ImagingJpegQuality option for details.}
|
{ See ImagingJpegQuality option for details.}
|
||||||
property Quality: LongInt read FQuality write FQuality;
|
property Quality: LongInt read FQuality write FQuality;
|
||||||
|
|
@ -161,7 +168,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_PNG}
|
{$IFNDEF DONT_LINK_PNG}
|
||||||
{ TImagingGraphic descendant for loading/saving PNG images.}
|
{ TImagingGraphic descendant for loading/saving PNG images.}
|
||||||
TImagingPNG = class(TImagingGraphicForSave)
|
TImagingPNG = class(TImagingGraphicForSave)
|
||||||
protected
|
protected
|
||||||
|
|
@ -178,7 +185,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_GIF}
|
{$IFNDEF DONT_LINK_GIF}
|
||||||
{ TImagingGraphic descendant for loading/saving GIF images.}
|
{ TImagingGraphic descendant for loading/saving GIF images.}
|
||||||
TImagingGIF = class(TImagingGraphicForSave)
|
TImagingGIF = class(TImagingGraphicForSave)
|
||||||
public
|
public
|
||||||
|
|
@ -186,7 +193,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_TARGA}
|
{$IFNDEF DONT_LINK_TARGA}
|
||||||
{ TImagingGraphic descendant for loading/saving Targa images.}
|
{ TImagingGraphic descendant for loading/saving Targa images.}
|
||||||
TImagingTarga = class(TImagingGraphicForSave)
|
TImagingTarga = class(TImagingGraphicForSave)
|
||||||
protected
|
protected
|
||||||
|
|
@ -200,7 +207,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_DDS}
|
{$IFNDEF DONT_LINK_DDS}
|
||||||
{ Compresssion type used when saving DDS files by TImagingDds.}
|
{ Compresssion type used when saving DDS files by TImagingDds.}
|
||||||
TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5);
|
TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5);
|
||||||
|
|
||||||
|
|
@ -218,7 +225,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_MNG}
|
{$IFNDEF DONT_LINK_MNG}
|
||||||
{ TImagingGraphic descendant for loading/saving MNG images.}
|
{ TImagingGraphic descendant for loading/saving MNG images.}
|
||||||
TImagingMNG = class(TImagingGraphicForSave)
|
TImagingMNG = class(TImagingGraphicForSave)
|
||||||
protected
|
protected
|
||||||
|
|
@ -233,8 +240,7 @@ type
|
||||||
procedure SaveToStream(Stream: TStream); override;
|
procedure SaveToStream(Stream: TStream); override;
|
||||||
class function GetFileFormat: TImageFileFormat; override;
|
class function GetFileFormat: TImageFileFormat; override;
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$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}
|
{$ENDIF}
|
||||||
{ See ImagingMNGLossyCompression option for details.}
|
{ See ImagingMNGLossyCompression option for details.}
|
||||||
property LossyCompression: Boolean read FLossyCompression write FLossyCompression;
|
property LossyCompression: Boolean read FLossyCompression write FLossyCompression;
|
||||||
|
|
@ -251,7 +257,7 @@ type
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_JNG}
|
{$IFNDEF DONT_LINK_JNG}
|
||||||
{ TImagingGraphic descendant for loading/saving JNG images.}
|
{ TImagingGraphic descendant for loading/saving JNG images.}
|
||||||
TImagingJNG = class(TImagingGraphicForSave)
|
TImagingJNG = class(TImagingGraphicForSave)
|
||||||
protected
|
protected
|
||||||
|
|
@ -328,29 +334,29 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IF Defined(UNIX) and Defined(COMPONENT_SET_LCL)}
|
{$IF Defined(LCL)}
|
||||||
{$IFDEF LCLGTK2}
|
{$IF Defined(LCLGTK2)}
|
||||||
GLib2, GDK2, GTK2, GTKDef, GTKProc,
|
GLib2, GDK2, GTK2, GTKDef, GTKProc,
|
||||||
{$ELSE}
|
{$ELSEIF Defined(LCLGTK)}
|
||||||
GDK, GTK, GTKDef, GTKProc,
|
GDK, GTK, GTKDef, GTKProc,
|
||||||
{$ENDIF}
|
{$IFEND}
|
||||||
{$IFEND}
|
{$IFEND}
|
||||||
{$IFDEF LINK_BITMAP}
|
{$IFNDEF DONT_LINK_BITMAP}
|
||||||
ImagingBitmap,
|
ImagingBitmap,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_JPEG}
|
{$IFNDEF DONT_LINK_JPEG}
|
||||||
ImagingJpeg,
|
ImagingJpeg,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_GIF}
|
{$IFNDEF DONT_LINK_GIF}
|
||||||
ImagingGif,
|
ImagingGif,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_TARGA}
|
{$IFNDEF DONT_LINK_TARGA}
|
||||||
ImagingTarga,
|
ImagingTarga,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_DDS}
|
{$IFNDEF DONT_LINK_DDS}
|
||||||
ImagingDds,
|
ImagingDds,
|
||||||
{$ENDIF}
|
{$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,
|
ImagingNetworkGraphics,
|
||||||
{$IFEND}
|
{$IFEND}
|
||||||
ImagingUtility;
|
ImagingUtility;
|
||||||
|
|
@ -359,9 +365,10 @@ resourcestring
|
||||||
SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
|
SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
|
||||||
SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p';
|
SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p';
|
||||||
SBadFormatDisplay = 'Unsupported image format passed';
|
SBadFormatDisplay = 'Unsupported image format passed';
|
||||||
|
SUnsupportedLCLWidgetSet = 'This function is not implemented for current LCL widget set';
|
||||||
SImagingGraphicName = 'Imaging Graphic AllInOne';
|
SImagingGraphicName = 'Imaging Graphic AllInOne';
|
||||||
|
|
||||||
{ Registers types to VCL/CLX/LCL.}
|
{ Registers types to VCL/LCL.}
|
||||||
procedure RegisterTypes;
|
procedure RegisterTypes;
|
||||||
var
|
var
|
||||||
I: LongInt;
|
I: LongInt;
|
||||||
|
|
@ -387,87 +394,85 @@ var
|
||||||
begin
|
begin
|
||||||
for I := Imaging.GetFileFormatCount - 1 downto 0 do
|
for I := Imaging.GetFileFormatCount - 1 downto 0 do
|
||||||
RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I));
|
RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I));
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGraphic);{$ENDIF}
|
Classes.RegisterClass(TImagingGraphic);
|
||||||
|
|
||||||
{$IFDEF LINK_TARGA}
|
{$IFNDEF DONT_LINK_TARGA}
|
||||||
RegisterFileFormat(TImagingTarga);
|
RegisterFileFormat(TImagingTarga);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingTarga);{$ENDIF}
|
Classes.RegisterClass(TImagingTarga);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_DDS}
|
{$IFNDEF DONT_LINK_DDS}
|
||||||
RegisterFileFormat(TImagingDDS);
|
RegisterFileFormat(TImagingDDS);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingDDS);{$ENDIF}
|
Classes.RegisterClass(TImagingDDS);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_JNG}
|
{$IFNDEF DONT_LINK_JNG}
|
||||||
RegisterFileFormat(TImagingJNG);
|
RegisterFileFormat(TImagingJNG);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJNG);{$ENDIF}
|
Classes.RegisterClass(TImagingJNG);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_MNG}
|
{$IFNDEF DONT_LINK_MNG}
|
||||||
RegisterFileFormat(TImagingMNG);
|
RegisterFileFormat(TImagingMNG);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingMNG);{$ENDIF}
|
Classes.RegisterClass(TImagingMNG);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_GIF}
|
{$IFNDEF DONT_LINK_GIF}
|
||||||
RegisterFileFormat(TImagingGIF);
|
RegisterFileFormat(TImagingGIF);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGIF);{$ENDIF}
|
Classes.RegisterClass(TImagingGIF);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_PNG}
|
{$IFNDEF DONT_LINK_PNG}
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
// Unregister Lazarus´ default PNG loader which crashes on some PNG files
|
// Unregister Lazarus´ default PNG loader which crashes on some PNG files
|
||||||
TPicture.UnregisterGraphicClass(TPortableNetworkGraphic);
|
TPicture.UnregisterGraphicClass(TPortableNetworkGraphic);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
RegisterFileFormat(TImagingPNG);
|
RegisterFileFormat(TImagingPNG);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingPNG);{$ENDIF}
|
Classes.RegisterClass(TImagingPNG);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_JPEG}
|
{$IFNDEF DONT_LINK_JPEG}
|
||||||
RegisterFileFormat(TImagingJpeg);
|
RegisterFileFormat(TImagingJpeg);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJpeg);{$ENDIF}
|
Classes.RegisterClass(TImagingJpeg);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_BITMAP}
|
{$IFNDEF DONT_LINK_BITMAP}
|
||||||
RegisterFileFormat(TImagingBitmap);
|
RegisterFileFormat(TImagingBitmap);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingBitmap);{$ENDIF}
|
Classes.RegisterClass(TImagingBitmap);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ Unregisters types from VCL/CLX/LCL.}
|
{ Unregisters types from VCL/LCL.}
|
||||||
procedure UnRegisterTypes;
|
procedure UnRegisterTypes;
|
||||||
begin
|
begin
|
||||||
{$IFDEF LINK_BITMAP}
|
{$IFNDEF DONT_LINK_BITMAP}
|
||||||
TPicture.UnregisterGraphicClass(TImagingBitmap);
|
TPicture.UnregisterGraphicClass(TImagingBitmap);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingBitmap);{$ENDIF}
|
Classes.UnRegisterClass(TImagingBitmap);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_JPEG}
|
{$IFNDEF DONT_LINK_JPEG}
|
||||||
TPicture.UnregisterGraphicClass(TImagingJpeg);
|
TPicture.UnregisterGraphicClass(TImagingJpeg);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingJpeg);{$ENDIF}
|
Classes.UnRegisterClass(TImagingJpeg);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_PNG}
|
{$IFNDEF DONT_LINK_PNG}
|
||||||
TPicture.UnregisterGraphicClass(TImagingPNG);
|
TPicture.UnregisterGraphicClass(TImagingPNG);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingPNG);{$ENDIF}
|
Classes.UnRegisterClass(TImagingPNG);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_GIF}
|
{$IFNDEF DONT_LINK_GIF}
|
||||||
TPicture.UnregisterGraphicClass(TImagingGIF);
|
TPicture.UnregisterGraphicClass(TImagingGIF);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGIF);{$ENDIF}
|
Classes.UnRegisterClass(TImagingGIF);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_TARGA}
|
{$IFNDEF DONT_LINK_TARGA}
|
||||||
TPicture.UnregisterGraphicClass(TImagingTarga);
|
TPicture.UnregisterGraphicClass(TImagingTarga);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingTarga);{$ENDIF}
|
Classes.UnRegisterClass(TImagingTarga);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF LINK_DDS}
|
{$IFNDEF DONT_LINK_DDS}
|
||||||
TPicture.UnregisterGraphicClass(TImagingDDS);
|
TPicture.UnregisterGraphicClass(TImagingDDS);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingDDS);{$ENDIF}
|
Classes.UnRegisterClass(TImagingDDS);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
TPicture.UnregisterGraphicClass(TImagingGraphic);
|
TPicture.UnregisterGraphicClass(TImagingGraphic);
|
||||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGraphic);{$ENDIF}
|
Classes.UnRegisterClass(TImagingGraphic);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
|
function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
|
||||||
begin
|
begin
|
||||||
case Format of
|
case Format of
|
||||||
{$IFNDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_VCL}
|
||||||
ifIndex8: Result := pf8bit;
|
ifIndex8: Result := pf8bit;
|
||||||
{$ENDIF}
|
|
||||||
{$IF (not Defined(COMPONENT_SET_CLX)) and (not Defined(COMPONENT_SET_LCL))}
|
|
||||||
ifR5G6B5: Result := pf16bit;
|
ifR5G6B5: Result := pf16bit;
|
||||||
ifR8G8B8: Result := pf24bit;
|
ifR8G8B8: Result := pf24bit;
|
||||||
{$IFEND}
|
{$ENDIF}
|
||||||
ifA8R8G8B8,
|
ifA8R8G8B8,
|
||||||
ifX8R8G8B8: Result := pf32bit;
|
ifX8R8G8B8: Result := pf32bit;
|
||||||
else
|
else
|
||||||
|
|
@ -479,11 +484,9 @@ function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat;
|
||||||
begin
|
begin
|
||||||
case Format of
|
case Format of
|
||||||
pf8bit: Result := ifIndex8;
|
pf8bit: Result := ifIndex8;
|
||||||
{$IFNDEF COMPONENT_SET_CLX}
|
|
||||||
pf15bit: Result := ifA1R5G5B5;
|
pf15bit: Result := ifA1R5G5B5;
|
||||||
pf16bit: Result := ifR5G6B5;
|
pf16bit: Result := ifR5G6B5;
|
||||||
pf24bit: Result := ifR8G8B8;
|
pf24bit: Result := ifR8G8B8;
|
||||||
{$ENDIF}
|
|
||||||
pf32bit: Result := ifA8R8G8B8;
|
pf32bit: Result := ifA8R8G8B8;
|
||||||
else
|
else
|
||||||
Result := ifUnknown;
|
Result := ifUnknown;
|
||||||
|
|
@ -499,9 +502,6 @@ var
|
||||||
{$IFDEF COMPONENT_SET_VCL}
|
{$IFDEF COMPONENT_SET_VCL}
|
||||||
LogPalette: TMaxLogPalette;
|
LogPalette: TMaxLogPalette;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF COMPONENT_SET_CLX}
|
|
||||||
ColorTable: PPalette32;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
RawImage: TRawImage;
|
RawImage: TRawImage;
|
||||||
ImgHandle, ImgMaskHandle: HBitmap;
|
ImgHandle, ImgMaskHandle: HBitmap;
|
||||||
|
|
@ -517,19 +517,16 @@ begin
|
||||||
if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
|
if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
|
||||||
Imaging.ConvertImage(WorkData, ifA8R8G8B8)
|
Imaging.ConvertImage(WorkData, ifA8R8G8B8)
|
||||||
else
|
else
|
||||||
{$IFNDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_VCL}
|
||||||
if Info.IsIndexed or Info.HasGrayChannel then
|
if Info.IsIndexed or Info.HasGrayChannel then
|
||||||
Imaging.ConvertImage(WorkData, ifIndex8)
|
Imaging.ConvertImage(WorkData, ifIndex8)
|
||||||
|
else if Info.UsePixelFormat then
|
||||||
|
Imaging.ConvertImage(WorkData, ifR5G6B5)
|
||||||
else
|
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}
|
{$ELSE}
|
||||||
Imaging.ConvertImage(WorkData, ifA8R8G8B8);
|
Imaging.ConvertImage(WorkData, ifA8R8G8B8);
|
||||||
{$IFEND}
|
{$ENDIF}
|
||||||
|
|
||||||
PF := DataFormatToPixelFormat(WorkData.Format);
|
PF := DataFormatToPixelFormat(WorkData.Format);
|
||||||
GetImageFormatInfo(WorkData.Format, Info);
|
GetImageFormatInfo(WorkData.Format, Info);
|
||||||
|
|
@ -565,27 +562,13 @@ begin
|
||||||
// Copy scanlines
|
// Copy scanlines
|
||||||
for I := 0 to WorkData.Height - 1 do
|
for I := 0 to WorkData.Height - 1 do
|
||||||
Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
|
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}
|
{$ENDIF}
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
// Create 32bit raw image from image data
|
// Create 32bit raw image from image data
|
||||||
|
|
@ -594,9 +577,9 @@ begin
|
||||||
begin
|
begin
|
||||||
Width := WorkData.Width;
|
Width := WorkData.Width;
|
||||||
Height := WorkData.Height;
|
Height := WorkData.Height;
|
||||||
BitsPerPixel := Info.BytesPerPixel * 8;
|
BitsPerPixel := 32;
|
||||||
Format := ricfRGBA;
|
Format := ricfRGBA;
|
||||||
LineEnd := rileByteBoundary;
|
LineEnd := rileDWordBoundary;
|
||||||
BitOrder := riboBitsInOrder;
|
BitOrder := riboBitsInOrder;
|
||||||
ByteOrder := riboLSBFirst;
|
ByteOrder := riboLSBFirst;
|
||||||
LineOrder := riloTopToBottom;
|
LineOrder := riloTopToBottom;
|
||||||
|
|
@ -608,14 +591,13 @@ begin
|
||||||
RedShift := 16;
|
RedShift := 16;
|
||||||
GreenShift := 8;
|
GreenShift := 8;
|
||||||
BlueShift := 0;
|
BlueShift := 0;
|
||||||
Depth := 24;
|
Depth := 32; // Must be 32 for alpha blending (and for working in MacOSX Carbon)
|
||||||
end;
|
end;
|
||||||
RawImage.Data := WorkData.Bits;
|
RawImage.Data := WorkData.Bits;
|
||||||
RawImage.DataSize := WorkData.Size;
|
RawImage.DataSize := WorkData.Size;
|
||||||
|
|
||||||
// Create bitmap from raw image
|
// 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
|
begin
|
||||||
Bitmap.Handle := ImgHandle;
|
Bitmap.Handle := ImgHandle;
|
||||||
Bitmap.MaskHandle := ImgMaskHandle;
|
Bitmap.MaskHandle := ImgMaskHandle;
|
||||||
|
|
@ -634,9 +616,6 @@ var
|
||||||
Colors: Word;
|
Colors: Word;
|
||||||
LogPalette: TMaxLogPalette;
|
LogPalette: TMaxLogPalette;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$IFDEF COMPONENT_SET_CLX}
|
|
||||||
ColorTable: PPalette32;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
RawImage: TRawImage;
|
RawImage: TRawImage;
|
||||||
LineLazBytes: LongInt;
|
LineLazBytes: LongInt;
|
||||||
|
|
@ -650,7 +629,6 @@ begin
|
||||||
// trough RawImage api and cannot be changed to mirror some Imaging format
|
// trough RawImage api and cannot be changed to mirror some Imaging format
|
||||||
// (so formats with no coresponding Imaging format cannot be saved now).
|
// (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
|
if RawImage_DescriptionFromBitmap(Bitmap.Handle, RawImage.Description) then
|
||||||
case RawImage.Description.BitsPerPixel of
|
case RawImage.Description.BitsPerPixel of
|
||||||
8: Format := ifIndex8;
|
8: Format := ifIndex8;
|
||||||
|
|
@ -707,28 +685,9 @@ begin
|
||||||
for I := 0 to Data.Height - 1 do
|
for I := 0 to Data.Height - 1 do
|
||||||
Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
|
Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
|
||||||
{$ENDIF}
|
{$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}
|
{$IFDEF COMPONENT_SET_LCL}
|
||||||
// Get raw image from bitmap (mask handle must be 0 or expect violations)
|
// 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
|
begin
|
||||||
LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel,
|
LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel,
|
||||||
RawImage.Description.LineEnd);
|
RawImage.Description.LineEnd);
|
||||||
|
|
@ -757,6 +716,7 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
|
||||||
var
|
var
|
||||||
OldMode: Integer;
|
OldMode: Integer;
|
||||||
BitmapInfo: Windows.TBitmapInfo;
|
BitmapInfo: Windows.TBitmapInfo;
|
||||||
|
Bmp: TBitmap;
|
||||||
begin
|
begin
|
||||||
if TestImage(ImageData) then
|
if TestImage(ImageData) then
|
||||||
begin
|
begin
|
||||||
|
|
@ -780,62 +740,45 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
try
|
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,
|
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
|
finally
|
||||||
Windows.SetStretchBltMode(DC, OldMode);
|
Windows.SetStretchBltMode(DC, OldMode);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
|
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
|
begin
|
||||||
DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
|
DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
|
||||||
end;
|
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,
|
procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
|
||||||
SrcWidth, SrcHeight: Integer; ImageData: TImageData);
|
SrcWidth, SrcHeight: Integer; ImageData: TImageData);
|
||||||
var
|
var
|
||||||
P: TPoint;
|
P: TPoint;
|
||||||
begin
|
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 := TGtkDeviceContext(Dest).Offset;
|
||||||
//P := GetDCOffset(TDeviceContext(Dest));
|
|
||||||
Inc(DstX, P.X);
|
Inc(DstX, P.X);
|
||||||
Inc(DstY, P.Y);
|
Inc(DstY, P.Y);
|
||||||
gdk_draw_rgb_32_image(TGtkDeviceContext(Dest).Drawable, TGtkDeviceContext(Dest).GC,
|
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,
|
DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
|
||||||
@PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4);
|
@PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4);
|
||||||
end;
|
end;
|
||||||
|
|
@ -890,6 +833,10 @@ begin
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
begin
|
||||||
|
raise Exception.Create(SUnsupportedLCLWidgetSet);
|
||||||
|
end;
|
||||||
{$IFEND}
|
{$IFEND}
|
||||||
|
|
||||||
procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage);
|
procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage);
|
||||||
|
|
@ -911,6 +858,12 @@ end;
|
||||||
|
|
||||||
{ TImagingGraphic class implementation }
|
{ TImagingGraphic class implementation }
|
||||||
|
|
||||||
|
constructor TImagingGraphic.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
PixelFormat := pf24Bit;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TImagingGraphic.LoadFromStream(Stream: TStream);
|
procedure TImagingGraphic.LoadFromStream(Stream: TStream);
|
||||||
begin
|
begin
|
||||||
ReadDataFromStream(Stream);
|
ReadDataFromStream(Stream);
|
||||||
|
|
@ -1020,14 +973,13 @@ begin
|
||||||
Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]);
|
Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]);
|
||||||
end;
|
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
|
begin
|
||||||
Result := 'image/' + FDefaultFileExt;
|
Result := 'image/' + FDefaultFileExt;
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_BITMAP}
|
{$IFNDEF DONT_LINK_BITMAP}
|
||||||
|
|
||||||
{ TImagingBitmap class implementation }
|
{ TImagingBitmap class implementation }
|
||||||
|
|
||||||
|
|
@ -1051,7 +1003,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_JPEG}
|
{$IFNDEF DONT_LINK_JPEG}
|
||||||
|
|
||||||
{ TImagingJpeg class implementation }
|
{ TImagingJpeg class implementation }
|
||||||
|
|
||||||
|
|
@ -1068,8 +1020,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$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
|
begin
|
||||||
Result := 'image/jpeg';
|
Result := 'image/jpeg';
|
||||||
end;
|
end;
|
||||||
|
|
@ -1086,7 +1037,7 @@ end;
|
||||||
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_PNG}
|
{$IFNDEF DONT_LINK_PNG}
|
||||||
|
|
||||||
{ TImagingPNG class implementation }
|
{ TImagingPNG class implementation }
|
||||||
|
|
||||||
|
|
@ -1112,7 +1063,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_GIF}
|
{$IFNDEF DONT_LINK_GIF}
|
||||||
|
|
||||||
{ TImagingGIF class implementation}
|
{ TImagingGIF class implementation}
|
||||||
|
|
||||||
|
|
@ -1123,7 +1074,7 @@ end;
|
||||||
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_TARGA}
|
{$IFNDEF DONT_LINK_TARGA}
|
||||||
|
|
||||||
{ TImagingTarga class implementation }
|
{ TImagingTarga class implementation }
|
||||||
|
|
||||||
|
|
@ -1147,7 +1098,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_DDS}
|
{$IFNDEF DONT_LINK_DDS}
|
||||||
|
|
||||||
{ TImagingDDS class implementation }
|
{ TImagingDDS class implementation }
|
||||||
|
|
||||||
|
|
@ -1180,7 +1131,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_MNG}
|
{$IFNDEF DONT_LINK_MNG}
|
||||||
|
|
||||||
{ TImagingMNG class implementation }
|
{ TImagingMNG class implementation }
|
||||||
|
|
||||||
|
|
@ -1201,8 +1152,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFDEF COMPONENT_SET_LCL}
|
{$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
|
begin
|
||||||
Result := 'video/mng';
|
Result := 'video/mng';
|
||||||
end;
|
end;
|
||||||
|
|
@ -1222,7 +1172,7 @@ begin
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{$IFDEF LINK_JNG}
|
{$IFNDEF DONT_LINK_JNG}
|
||||||
|
|
||||||
{ TImagingJNG class implementation }
|
{ TImagingJNG class implementation }
|
||||||
|
|
||||||
|
|
@ -1259,12 +1209,30 @@ initialization
|
||||||
finalization
|
finalization
|
||||||
UnRegisterTypes;
|
UnRegisterTypes;
|
||||||
|
|
||||||
|
{$IFEND} // {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
|
||||||
|
|
||||||
{
|
{
|
||||||
File Notes:
|
File Notes:
|
||||||
|
|
||||||
-- TODOS ----------------------------------------------------
|
-- TODOS ----------------------------------------------------
|
||||||
- nothing now
|
- 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 ---------------------------------
|
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||||
- Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus
|
- Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus
|
||||||
with GTK2 target.
|
with GTK2 target.
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||||
|
|
|
||||||
|
|
@ -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
|
Vampyre Imaging Library
|
||||||
by Marek Mauder
|
by Marek Mauder
|
||||||
http://imaginglib.sourceforge.net
|
http://imaginglib.sourceforge.net
|
||||||
|
|
@ -56,9 +56,10 @@ type
|
||||||
TBooleanArray = array[0..MaxInt - 1] of Boolean;
|
TBooleanArray = array[0..MaxInt - 1] of Boolean;
|
||||||
PBooleanArray = ^TBooleanArray;
|
PBooleanArray = ^TBooleanArray;
|
||||||
|
|
||||||
|
TDynByteArray = array of Byte;
|
||||||
TDynIntegerArray = array of Integer;
|
TDynIntegerArray = array of Integer;
|
||||||
TDynBooleanArray = array of Boolean;
|
TDynBooleanArray = array of Boolean;
|
||||||
|
|
||||||
TWordRec = packed record
|
TWordRec = packed record
|
||||||
case Integer of
|
case Integer of
|
||||||
0: (WordValue: Word);
|
0: (WordValue: Word);
|
||||||
|
|
@ -98,23 +99,24 @@ type
|
||||||
end;
|
end;
|
||||||
PFloatHelper = ^TFloatHelper;
|
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:
|
{ 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.}
|
{ Frees class instance and sets its reference to nil.}
|
||||||
procedure FreeAndNil(var Obj);
|
procedure FreeAndNil(var Obj);
|
||||||
{ Frees pointer and sets it to nil.}
|
{ Frees pointer and sets it to nil.}
|
||||||
procedure FreeMemNil(var P); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
procedure FreeMemNil(var P); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
{ Replacement of standard System.FreeMem procedure which checks if P is nil
|
{ Replacement of standard System.FreeMem procedure which checks if P is nil
|
||||||
|
|
@ -135,32 +137,35 @@ function GetAppExe: string;
|
||||||
path delimiter at the end.}
|
path delimiter at the end.}
|
||||||
function GetAppDir: string;
|
function GetAppDir: string;
|
||||||
{ Returns True if FileName matches given Mask with optional case sensitivity.
|
{ 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;
|
function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean = False): Boolean;
|
||||||
{ This function fills Files string list with names of files found
|
{ 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>}
|
{ Clamps integer value to range <Min, Max>}
|
||||||
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||||
{ Clamps float value to range <Min, Max>}
|
{ Clamps float value to range <Min, Max>}
|
||||||
|
|
@ -397,7 +402,7 @@ end;
|
||||||
|
|
||||||
function GetTimeMilliseconds: Int64;
|
function GetTimeMilliseconds: Int64;
|
||||||
begin
|
begin
|
||||||
Result := GetTimeMicroseconds div 1000;
|
Result := GetTimeMicroseconds div 1000;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetFileExt(const FileName: string): string;
|
function GetFileExt(const FileName: string): string;
|
||||||
|
|
@ -439,359 +444,275 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean): Boolean;
|
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;
|
end;
|
||||||
|
|
||||||
function BuildFileList(Path: string; Attr: LongInt;
|
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;
|
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt;
|
||||||
begin
|
begin
|
||||||
Result := Number;
|
Result := Number;
|
||||||
if Result < Min then
|
if Result < Min then
|
||||||
Result := Min
|
Result := Min
|
||||||
else
|
else if Result > Max then
|
||||||
if Result > Max then
|
|
||||||
Result := Max;
|
Result := Max;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -800,8 +721,7 @@ begin
|
||||||
Result := Number;
|
Result := Number;
|
||||||
if Result < Min then
|
if Result < Min then
|
||||||
Result := Min
|
Result := Min
|
||||||
else
|
else if Result > Max then
|
||||||
if Result > Max then
|
|
||||||
Result := Max;
|
Result := Max;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -831,7 +751,7 @@ end;
|
||||||
function NextPow2(Num: LongInt): LongInt;
|
function NextPow2(Num: LongInt): LongInt;
|
||||||
begin
|
begin
|
||||||
Result := Num and -Num;
|
Result := Num and -Num;
|
||||||
while (Result < Num) do
|
while Result < Num do
|
||||||
Result := Result shl 1;
|
Result := Result shl 1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
@ -957,18 +877,18 @@ end;
|
||||||
|
|
||||||
function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer;
|
function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer;
|
||||||
begin
|
begin
|
||||||
if Condition then
|
if Condition then
|
||||||
Result := TruePart
|
Result := TruePart
|
||||||
else
|
else
|
||||||
Result := FalsePart;
|
Result := FalsePart;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64;
|
function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64;
|
||||||
begin
|
begin
|
||||||
if Condition then
|
if Condition then
|
||||||
Result := TruePart
|
Result := TruePart
|
||||||
else
|
else
|
||||||
Result := FalsePart;
|
Result := FalsePart;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single;
|
function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single;
|
||||||
|
|
@ -1062,8 +982,8 @@ end;
|
||||||
function MulDiv(Number, Numerator, Denominator: Word): Word;
|
function MulDiv(Number, Numerator, Denominator: Word): Word;
|
||||||
{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
|
{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
|
||||||
asm
|
asm
|
||||||
MUL DX
|
MUL DX
|
||||||
DIV CX
|
DIV CX
|
||||||
end;
|
end;
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
begin
|
begin
|
||||||
|
|
@ -1075,8 +995,8 @@ function IsLittleEndian: Boolean;
|
||||||
var
|
var
|
||||||
W: Word;
|
W: Word;
|
||||||
begin
|
begin
|
||||||
W := $00FF;
|
W := $00FF;
|
||||||
Result := PByte(@W)^ = $FF;
|
Result := PByte(@W)^ = $FF;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function SwapEndianWord(Value: Word): Word;
|
function SwapEndianWord(Value: Word): Word;
|
||||||
|
|
@ -1334,12 +1254,12 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt;
|
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;
|
end;
|
||||||
|
|
||||||
function BoundsToRect(X, Y, Width, Height: LongInt): TRect;
|
function BoundsToRect(X, Y, Width, Height: LongInt): TRect;
|
||||||
|
|
@ -1488,27 +1408,27 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function RectInRect(const R1, R2: TRect): Boolean;
|
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;
|
end;
|
||||||
|
|
||||||
function RectIntersects(const R1, R2: TRect): Boolean;
|
function RectIntersects(const R1, R2: TRect): Boolean;
|
||||||
begin
|
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;
|
function FormatExceptMsg(const Msg: string; const Args: array of const): string;
|
||||||
begin
|
begin
|
||||||
Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args);
|
Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure DebugMsg(const Msg: string; const Args: array of const);
|
procedure DebugMsg(const Msg: string; const Args: array of const);
|
||||||
var
|
var
|
||||||
|
|
@ -1552,6 +1472,12 @@ initialization
|
||||||
-- TODOS ----------------------------------------------------
|
-- TODOS ----------------------------------------------------
|
||||||
- nothing now
|
- 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 -----------------------------------
|
-- 0.25.0 Changes/Bug Fixes -----------------------------------
|
||||||
- Fixed error in ClipCopyBounds which was causing ... bad clipping!
|
- Fixed error in ClipCopyBounds which was causing ... bad clipping!
|
||||||
|
|
||||||
|
|
@ -1561,7 +1487,7 @@ initialization
|
||||||
|
|
||||||
-- 0.23 Changes/Bug Fixes -----------------------------------
|
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||||
- Added RectInRect and RectIntersects functions
|
- 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.
|
- Moved BuildFileList here from DemoUtils.
|
||||||
|
|
||||||
-- 0.21 Changes/Bug Fixes -----------------------------------
|
-- 0.21 Changes/Bug Fixes -----------------------------------
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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>
|
||||||
|
|
@ -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.
|
||||||
|
|
||||||
Loading…
Reference in New Issue