- 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"/>
|
||||
</Item5>
|
||||
</RequiredPackages>
|
||||
<Units Count="35">
|
||||
<Units Count="36">
|
||||
<Unit0>
|
||||
<Filename Value="CentrED.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
@ -273,6 +273,11 @@
|
|||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UTiledata"/>
|
||||
</Unit34>
|
||||
<Unit35>
|
||||
<Filename Value="UGLFont.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UGLFont"/>
|
||||
</Unit35>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
|
@ -40,7 +40,7 @@ uses
|
|||
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
|
||||
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
|
||||
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
|
||||
Logging, UMap, UWorldItem, UStatics, UTiledata;
|
||||
Logging, UMap, UWorldItem, UStatics, UTiledata, UGLFont;
|
||||
|
||||
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
||||
|
||||
|
|
Binary file not shown.
Binary file not shown.
After Width: | Height: | Size: 5.0 KiB |
|
@ -1,3 +1,5 @@
|
|||
Overlay/LeftTopArrow.tga
|
||||
Overlay/TopArrow.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
|
||||
|
||||
uses
|
||||
SysUtils, Classes, math, LCLIntf, GL, GLU, ImagingOpenGL, Imaging,
|
||||
SysUtils, Classes, math, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
|
||||
ImagingClasses, ImagingTypes, ImagingUtility,
|
||||
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
|
||||
UMulBlock,
|
||||
UVector, UEnhancedMemoryStream,
|
||||
UVector, UEnhancedMemoryStream, UGLFont,
|
||||
UCacheManager;
|
||||
|
||||
type
|
||||
|
@ -196,6 +196,19 @@ type
|
|||
procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
|
||||
end;
|
||||
|
||||
{ TGLText }
|
||||
|
||||
TGLText = class
|
||||
constructor Create(AFont: TGLFont; AText: String);
|
||||
protected
|
||||
FFont: TGLFont;
|
||||
FText: String;
|
||||
FWidth: Integer;
|
||||
FHeight: Integer;
|
||||
public
|
||||
procedure Render(AScreenRect: TRect);
|
||||
end;
|
||||
|
||||
TScreenState = (ssNormal, ssFiltered, ssGhost);
|
||||
|
||||
PBlockInfo = ^TBlockInfo;
|
||||
|
@ -212,6 +225,7 @@ type
|
|||
HueOverride: Boolean;
|
||||
CheckRealQuad: Boolean;
|
||||
Translucent: Boolean;
|
||||
Text: TGLText;
|
||||
Next: PBlockInfo;
|
||||
end;
|
||||
|
||||
|
@ -1213,6 +1227,7 @@ begin
|
|||
Result^.State := ssNormal;
|
||||
Result^.Highlighted := False;
|
||||
Result^.Translucent := False;
|
||||
Result^.Text := nil;
|
||||
Result^.Next := nil;
|
||||
|
||||
if FShortCuts[0] = nil then //First element
|
||||
|
@ -1239,6 +1254,7 @@ begin
|
|||
current^.Item.Locked := False;
|
||||
current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
|
||||
if current^.Normals <> nil then Dispose(current^.Normals);
|
||||
current^.Text.Free;
|
||||
Dispose(current);
|
||||
current := next;
|
||||
end;
|
||||
|
@ -1266,6 +1282,7 @@ begin
|
|||
if last <> nil then last^.Next := current^.Next;
|
||||
|
||||
if current^.Normals <> nil then Dispose(current^.Normals);
|
||||
current^.Text.Free;
|
||||
|
||||
Dispose(current);
|
||||
Dec(FCount);
|
||||
|
@ -1356,6 +1373,7 @@ begin
|
|||
Result^.State := ssNormal;
|
||||
Result^.Highlighted := False;
|
||||
Result^.Translucent := False;
|
||||
Result^.Text := nil;
|
||||
|
||||
if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then
|
||||
begin
|
||||
|
@ -1490,5 +1508,27 @@ begin
|
|||
Delete(TWorldItem(ATile));
|
||||
end;
|
||||
|
||||
{ TGLText }
|
||||
|
||||
constructor TGLText.Create(AFont: TGLFont; AText: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FFont := AFont;
|
||||
FText := AText;
|
||||
FWidth := FFont.GetTextWidth(AText);
|
||||
FHeight := FFont.GetTextHeight('A');
|
||||
end;
|
||||
|
||||
procedure TGLText.Render(AScreenRect: TRect);
|
||||
var
|
||||
x, y: Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
y := AScreenRect.Top + (AScreenRect.Bottom - AScreenRect.Top - FHeight) div 2;
|
||||
x := AScreenRect.Left + (AScreenRect.Right - AScreenRect.Left - FWidth) div 2;
|
||||
FFont.DrawText(x, y, FText);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
@ -21,7 +21,7 @@
|
|||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UResourceManager;
|
||||
|
||||
|
@ -69,8 +69,8 @@ end;
|
|||
|
||||
destructor TResourceManager.Destroy;
|
||||
begin
|
||||
if FFileStream <> nil then FreeAndNil(FFileStream);
|
||||
if FResourceStream <> nil then FreeAndNil(FResourceStream);
|
||||
FreeAndNil(FFileStream);
|
||||
FreeAndNil(FResourceStream);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
@ -81,8 +81,7 @@ begin
|
|||
if AIndex <> FCurrentResource then
|
||||
begin
|
||||
FFileStream.Position := FLookupTable[AIndex];
|
||||
if FResourceStream <> nil then
|
||||
FResourceStream.Free;
|
||||
FResourceStream.Free;
|
||||
FResourceStream := TMemoryStream.Create;
|
||||
FFileStream.Read(size, SizeOf(Cardinal));
|
||||
FResourceStream.CopyFrom(FFileStream, size);
|
||||
|
|
|
@ -31,10 +31,10 @@ interface
|
|||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
|
||||
ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
|
||||
ComCtrls, OpenGLContext, GL, GLu, UGameResources, ULandscape, ExtCtrls,
|
||||
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
|
||||
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, fgl,
|
||||
ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket;
|
||||
ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, UGLFont;
|
||||
|
||||
type
|
||||
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
|
||||
|
@ -269,6 +269,7 @@ type
|
|||
Node: PVirtualNode; Stream: TStream);
|
||||
protected
|
||||
{ Members }
|
||||
FAppDir: String;
|
||||
FX: Integer;
|
||||
FY: Integer;
|
||||
FDrawDistance: Integer;
|
||||
|
@ -294,6 +295,7 @@ type
|
|||
FRepaintNeeded: Boolean;
|
||||
FSelection: TRect;
|
||||
FUndoList: TPacketList;
|
||||
FGLFont: TGLFont;
|
||||
{ Methods }
|
||||
procedure BuildTileList;
|
||||
function ConfirmAction: Boolean;
|
||||
|
@ -784,6 +786,8 @@ var
|
|||
virtualLayerGraphic: TSingleImage;
|
||||
searchRec: TSearchRec;
|
||||
begin
|
||||
FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
|
||||
|
||||
FLandscape := ResMan.Landscape;
|
||||
FLandscape.OnChange := @OnLandscapeChanged;
|
||||
FLandscape.OnMapChanged := @OnMapChanged;
|
||||
|
@ -812,8 +816,7 @@ begin
|
|||
vstChat.NodeDataSize := SizeOf(TChatInfo);
|
||||
pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
|
||||
|
||||
FLocationsFile := IncludeTrailingPathDelimiter(ExtractFilePath(
|
||||
Application.ExeName)) + 'Locations.dat';
|
||||
FLocationsFile := FAppDir + 'Locations.dat';
|
||||
vstLocations.NodeDataSize := SizeOf(TLocationInfo);
|
||||
if FileExists(FLocationsFile) then vstLocations.LoadFromFile(FLocationsFile);
|
||||
|
||||
|
@ -824,11 +827,14 @@ begin
|
|||
virtualLayerGraphic.Height, virtualLayerGraphic);
|
||||
virtualLayerGraphic.Free;
|
||||
|
||||
FGLFont := TGLFont.Create;
|
||||
FGLFont.LoadImage(ResourceManager.GetResource(3));
|
||||
FGLFont.LoadFontInfo(ResourceManager.GetResource(4));
|
||||
|
||||
FVirtualTiles := TWorldItemList.Create(True);
|
||||
FUndoList := TPacketList.Create(True);
|
||||
|
||||
FRandomPresetLocation := IncludeTrailingPathDelimiter(ExtractFilePath(
|
||||
Application.ExeName)) + 'RandomPresets' + PathDelim;
|
||||
FRandomPresetLocation := FAppDir + 'RandomPresets' + PathDelim;
|
||||
if not DirectoryExists(FRandomPresetLocation) then
|
||||
CreateDir(FRandomPresetLocation);
|
||||
|
||||
|
@ -1116,6 +1122,7 @@ begin
|
|||
FreeAndNil(FVLayerMaterial);
|
||||
FreeAndNil(FVirtualTiles);
|
||||
FreeAndNil(FUndoList);
|
||||
FreeAndNil(FGLFont);
|
||||
|
||||
RegisterPacketHandler($0C, nil);
|
||||
end;
|
||||
|
@ -1783,9 +1790,11 @@ procedure TfrmMain.InitSize;
|
|||
begin
|
||||
glViewport(0, 0, oglGameWindow.Width, oglGameWindow.Height);
|
||||
glMatrixMode(GL_PROJECTION);
|
||||
glPushMatrix;
|
||||
glLoadIdentity;
|
||||
gluOrtho2D(0, oglGameWindow.Width, oglGameWindow.Height, 0);
|
||||
glMatrixMode(GL_MODELVIEW);
|
||||
glPushMatrix;
|
||||
glLoadIdentity;
|
||||
end;
|
||||
|
||||
|
@ -1923,6 +1932,10 @@ begin
|
|||
CheckRealQuad := True;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
ABlockInfo^.Text.Free;
|
||||
ABlockInfo^.Text := TGLText.Create(FGLFont, IntToStr(item.Z));
|
||||
end;
|
||||
|
||||
if not ABlockInfo^.CheckRealQuad then
|
||||
|
@ -2082,6 +2095,9 @@ begin
|
|||
|
||||
if highlight then
|
||||
glDisable(GL_COLOR_LOGIC_OP);
|
||||
|
||||
if (blockInfo^.Text <> nil) then
|
||||
blockInfo^.Text.Render(blockInfo^.ScreenRect);
|
||||
end;
|
||||
|
||||
FOverlayUI.Draw(oglGameWindow);
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: Imaging.pas 124 2008-04-21 09:47:07Z galfar $
|
||||
$Id: Imaging.pas 173 2009-09-04 17:05:52Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -203,9 +203,8 @@ function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray;
|
|||
Pal must be allocated to have at least MaxColors entries.}
|
||||
function MakePaletteForImages(var Images: TDynImageDataArray; Pal: PPalette32;
|
||||
MaxColors: LongInt; ConvertImages: Boolean): Boolean;
|
||||
{ Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.
|
||||
Only multiples of 90 degrees are allowed.}
|
||||
function RotateImage(var Image: TImageData; Angle: LongInt): Boolean;
|
||||
{ Rotates image by Angle degrees counterclockwise. All angles are allowed.}
|
||||
function RotateImage(var Image: TImageData; Angle: Single): Boolean;
|
||||
|
||||
{ Drawing/Pixel functions }
|
||||
|
||||
|
@ -303,7 +302,7 @@ function PopOptions: Boolean;
|
|||
{ Image Format Functions }
|
||||
|
||||
{ Returns short information about given image format.}
|
||||
function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
|
||||
function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean;
|
||||
{ Returns size in bytes of Width x Height area of pixels. Works for all formats.}
|
||||
function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
|
||||
|
||||
|
@ -534,28 +533,28 @@ procedure RaiseImaging(const Msg: string; const Args: array of const);
|
|||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
ImagingBitmap,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
ImagingJpeg,
|
||||
{$ENDIF}
|
||||
{$IF Defined(LINK_PNG) or Defined(LINK_MNG) or Defined(LINK_JNG)}
|
||||
{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
|
||||
ImagingNetworkGraphics,
|
||||
{$IFEND}
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
ImagingGif,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
ImagingDds,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
ImagingTarga,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_PNM}
|
||||
{$IFNDEF DONT_LINK_PNM}
|
||||
ImagingPortableMaps,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_EXTRAS}
|
||||
{$IFNDEF DONT_LINK_EXTRAS}
|
||||
ImagingExtras,
|
||||
{$ENDIF}
|
||||
ImagingFormats, ImagingUtility, ImagingIO;
|
||||
|
@ -606,8 +605,9 @@ resourcestring
|
|||
SErrorFreePalette = 'Error while freeing palette @%p';
|
||||
SErrorCopyPalette = 'Error while copying %d entries from palette @%p to @%p';
|
||||
SErrorReplaceColor = 'Error while replacing colors in rectangle X:%d Y:%d W:%d H:%d of image %s';
|
||||
SErrorRotateImage = 'Error while rotating image %s by %d degrees';
|
||||
SErrorRotateImage = 'Error while rotating image %s by %.2n degrees';
|
||||
SErrorStretchRect = 'Error while stretching rect from image %s to image %s.';
|
||||
SErrorEmptyStream = 'Input stream has no data. Check Position property.';
|
||||
|
||||
const
|
||||
// initial size of array with options information
|
||||
|
@ -727,7 +727,7 @@ function NewImage(Width, Height: LongInt; Format: TImageFormat; var Image:
|
|||
var
|
||||
FInfo: PImageFormatInfo;
|
||||
begin
|
||||
Assert((Width >= 0) and (Height >= 0));
|
||||
Assert((Width > 0) and (Height >0));
|
||||
Assert(IsImageFormatValid(Format));
|
||||
Result := False;
|
||||
FreeImage(Image);
|
||||
|
@ -996,6 +996,8 @@ var
|
|||
I: LongInt;
|
||||
begin
|
||||
Assert(Stream <> nil);
|
||||
if Stream.Size - Stream.Position = 0 then
|
||||
RaiseImaging(SErrorEmptyStream, []);
|
||||
Result := False;
|
||||
Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));
|
||||
if Format <> nil then
|
||||
|
@ -1057,6 +1059,8 @@ var
|
|||
Format: TImageFileFormat;
|
||||
begin
|
||||
Assert(Stream <> nil);
|
||||
if Stream.Size - Stream.Position = 0 then
|
||||
RaiseImaging(SErrorEmptyStream, []);
|
||||
Result := False;
|
||||
Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream));
|
||||
if Format <> nil then
|
||||
|
@ -1416,7 +1420,10 @@ begin
|
|||
// Free old image and assign new image to it
|
||||
FreeMemNil(Image.Bits);
|
||||
if Image.Palette <> nil then
|
||||
begin
|
||||
FreeMem(WorkImage.Palette);
|
||||
WorkImage.Palette := Image.Palette;
|
||||
end;
|
||||
Image := WorkImage;
|
||||
Result := True;
|
||||
except
|
||||
|
@ -1854,33 +1861,154 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function RotateImage(var Image: TImageData; Angle: LongInt): Boolean;
|
||||
function RotateImage(var Image: TImageData; Angle: Single): Boolean;
|
||||
var
|
||||
X, Y, BytesPerPixel: LongInt;
|
||||
RotImage: TImageData;
|
||||
Pix, RotPix: PByte;
|
||||
OldFmt: TImageFormat;
|
||||
begin
|
||||
Assert(Angle mod 90 = 0);
|
||||
Result := False;
|
||||
|
||||
if TestImage(Image) then
|
||||
try
|
||||
if (Angle < -360) or (Angle > 360) then Angle := Angle mod 360;
|
||||
if (Angle = 0) or (Abs(Angle) = 360) then
|
||||
procedure XShear(var Src, Dst: TImageData; Row, Offset, Weight, Bpp: Integer);
|
||||
var
|
||||
I, J, XPos: Integer;
|
||||
PixSrc, PixLeft, PixOldLeft: TColor32Rec;
|
||||
LineDst: PByteArray;
|
||||
SrcPtr: PColor32;
|
||||
begin
|
||||
SrcPtr := @PByteArray(Src.Bits)[Row * Src.Width * Bpp];
|
||||
LineDst := @PByteArray(Dst.Bits)[Row * Dst.Width * Bpp];
|
||||
PixOldLeft.Color := 0;
|
||||
|
||||
for I := 0 to Src.Width - 1 do
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
CopyPixel(SrcPtr, @PixSrc, Bpp);
|
||||
for J := 0 to Bpp - 1 do
|
||||
PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
|
||||
|
||||
XPos := I + Offset;
|
||||
if (XPos >= 0) and (XPos < Dst.Width) then
|
||||
begin
|
||||
for J := 0 to Bpp - 1 do
|
||||
PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
|
||||
CopyPixel(@PixSrc, @LineDst[XPos * Bpp], Bpp);
|
||||
end;
|
||||
PixOldLeft := PixLeft;
|
||||
Inc(PByte(SrcPtr), Bpp);
|
||||
end;
|
||||
|
||||
Angle := Iff(Angle = -90, 270, Angle);
|
||||
Angle := Iff(Angle = -270, 90, Angle);
|
||||
Angle := Iff(Angle = -180, 180, Angle);
|
||||
XPos := Src.Width + Offset;
|
||||
if XPos < Dst.Width then
|
||||
CopyPixel(@PixOldLeft, @LineDst[XPos * Bpp], Bpp);
|
||||
end;
|
||||
|
||||
OldFmt := Image.Format;
|
||||
if ImageFormatInfos[Image.Format].IsSpecial then
|
||||
ConvertImage(Image, ifDefault);
|
||||
procedure YShear(var Src, Dst: TImageData; Col, Offset, Weight, Bpp: Integer);
|
||||
var
|
||||
I, J, YPos: Integer;
|
||||
PixSrc, PixLeft, PixOldLeft: TColor32Rec;
|
||||
SrcPtr: PByte;
|
||||
begin
|
||||
SrcPtr := @PByteArray(Src.Bits)[Col * Bpp];
|
||||
PixOldLeft.Color := 0;
|
||||
|
||||
for I := 0 to Src.Height - 1 do
|
||||
begin
|
||||
CopyPixel(SrcPtr, @PixSrc, Bpp);
|
||||
for J := 0 to Bpp - 1 do
|
||||
PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
|
||||
|
||||
YPos := I + Offset;
|
||||
if (YPos >= 0) and (YPos < Dst.Height) then
|
||||
begin
|
||||
for J := 0 to Bpp - 1 do
|
||||
PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
|
||||
CopyPixel(@PixSrc, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
|
||||
end;
|
||||
PixOldLeft := PixLeft;
|
||||
Inc(SrcPtr, Src.Width * Bpp);
|
||||
end;
|
||||
|
||||
YPos := Src.Height + Offset;
|
||||
if YPos < Dst.Height then
|
||||
CopyPixel(@PixOldLeft, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
|
||||
end;
|
||||
|
||||
procedure Rotate45(var Image: TImageData; Angle: Single);
|
||||
var
|
||||
TempImage1, TempImage2: TImageData;
|
||||
AngleRad, AngleTan, AngleSin, AngleCos, Shear: Single;
|
||||
I, DstWidth, DstHeight, SrcWidth, SrcHeight, Bpp: Integer;
|
||||
SrcFmt, TempFormat: TImageFormat;
|
||||
Info: TImageFormatInfo;
|
||||
begin
|
||||
AngleRad := Angle * Pi / 180;
|
||||
AngleSin := Sin(AngleRad);
|
||||
AngleCos := Cos(AngleRad);
|
||||
AngleTan := Sin(AngleRad / 2) / Cos(AngleRad / 2);
|
||||
SrcWidth := Image.Width;
|
||||
SrcHeight := Image.Height;
|
||||
SrcFmt := Image.Format;
|
||||
|
||||
if not (SrcFmt in [ifR8G8B8..ifX8R8G8B8, ifGray8..ifGray32, ifA16Gray16]) then
|
||||
ConvertImage(Image, ifA8R8G8B8);
|
||||
|
||||
TempFormat := Image.Format;
|
||||
GetImageFormatInfo(TempFormat, Info);
|
||||
Bpp := Info.BytesPerPixel;
|
||||
|
||||
// 1st shear (horizontal)
|
||||
DstWidth := Trunc(SrcWidth + SrcHeight * Abs(AngleTan) + 0.5);
|
||||
DstHeight := SrcHeight;
|
||||
NewImage(DstWidth, DstHeight, TempFormat, TempImage1);
|
||||
|
||||
for I := 0 to DstHeight - 1 do
|
||||
begin
|
||||
if AngleTan >= 0 then
|
||||
Shear := (I + 0.5) * AngleTan
|
||||
else
|
||||
Shear := (I - DstHeight + 0.5) * AngleTan;
|
||||
XShear(Image, TempImage1, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
|
||||
end;
|
||||
|
||||
// 2nd shear (vertical)
|
||||
FreeImage(Image);
|
||||
DstHeight := Trunc(SrcWidth * Abs(AngleSin) + SrcHeight * AngleCos + 0.5) + 1;
|
||||
NewImage(DstWidth, DstHeight, TempFormat, TempImage2);
|
||||
|
||||
if AngleSin >= 0 then
|
||||
Shear := (SrcWidth - 1) * AngleSin
|
||||
else
|
||||
Shear := (SrcWidth - DstWidth) * -AngleSin;
|
||||
|
||||
for I := 0 to DstWidth - 1 do
|
||||
begin
|
||||
YShear(TempImage1, TempImage2, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
|
||||
Shear := Shear - AngleSin;
|
||||
end;
|
||||
|
||||
// 3rd shear (horizontal)
|
||||
FreeImage(TempImage1);
|
||||
DstWidth := Trunc(SrcHeight * Abs(AngleSin) + SrcWidth * AngleCos + 0.5) + 1;
|
||||
NewImage(DstWidth, DstHeight, TempFormat, Image);
|
||||
|
||||
if AngleSin >= 0 then
|
||||
Shear := (SrcWidth - 1) * AngleSin * -AngleTan
|
||||
else
|
||||
Shear := ((SrcWidth - 1) * -AngleSin + (1 - DstHeight)) * AngleTan;
|
||||
|
||||
for I := 0 to DstHeight - 1 do
|
||||
begin
|
||||
XShear(TempImage2, Image, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
|
||||
Shear := Shear + AngleTan;
|
||||
end;
|
||||
|
||||
FreeImage(TempImage2);
|
||||
if Image.Format <> SrcFmt then
|
||||
ConvertImage(Image, SrcFmt);
|
||||
end;
|
||||
|
||||
procedure RotateMul90(var Image: TImageData; Angle: Integer);
|
||||
var
|
||||
RotImage: TImageData;
|
||||
X, Y, BytesPerPixel: Integer;
|
||||
RotPix, Pix: PByte;
|
||||
begin
|
||||
InitImage(RotImage);
|
||||
BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel;
|
||||
|
||||
|
@ -1920,8 +2048,7 @@ begin
|
|||
begin
|
||||
for Y := 0 to RotImage.Height - 1 do
|
||||
begin
|
||||
Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width +
|
||||
Y) * BytesPerPixel];
|
||||
Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width + Y) * BytesPerPixel];
|
||||
for X := 0 to RotImage.Width - 1 do
|
||||
begin
|
||||
CopyPixel(Pix, RotPix, BytesPerPixel);
|
||||
|
@ -1935,6 +2062,46 @@ begin
|
|||
FreeMemNil(Image.Bits);
|
||||
RotImage.Palette := Image.Palette;
|
||||
Image := RotImage;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if TestImage(Image) then
|
||||
try
|
||||
while Angle >= 360 do
|
||||
Angle := Angle - 360;
|
||||
while Angle < 0 do
|
||||
Angle := Angle + 360;
|
||||
|
||||
if (Angle = 0) or (Abs(Angle) = 360) then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
OldFmt := Image.Format;
|
||||
if ImageFormatInfos[Image.Format].IsSpecial then
|
||||
ConvertImage(Image, ifDefault);
|
||||
|
||||
if (Angle > 45) and (Angle <= 135) then
|
||||
begin
|
||||
RotateMul90(Image, 90);
|
||||
Angle := Angle - 90;
|
||||
end
|
||||
else if (Angle > 135) and (Angle <= 225) then
|
||||
begin
|
||||
RotateMul90(Image, 180);
|
||||
Angle := Angle - 180;
|
||||
end
|
||||
else if (Angle > 225) and (Angle <= 315) then
|
||||
begin
|
||||
RotateMul90(Image, 270);
|
||||
Angle := Angle - 270;
|
||||
end;
|
||||
|
||||
if Angle <> 0 then
|
||||
Rotate45(Image, Angle);
|
||||
|
||||
if OldFmt <> Image.Format then
|
||||
ConvertImage(Image, OldFmt);
|
||||
|
@ -2421,7 +2588,7 @@ end;
|
|||
|
||||
{ Image Format Functions }
|
||||
|
||||
function GetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
|
||||
function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean;
|
||||
begin
|
||||
FillChar(Info, SizeOf(Info), 0);
|
||||
if ImageFormatInfos[Format] <> nil then
|
||||
|
@ -2527,7 +2694,7 @@ begin
|
|||
|
||||
if OptionId >= Length(Options) then
|
||||
SetLength(Options, OptionId + InitialOptions);
|
||||
if (OptionId >= 0) and (OptionId < Length(Options)) and (Options[OptionId] = nil) then
|
||||
if (OptionId >= 0) and (OptionId < Length(Options)) {and (Options[OptionId] = nil) - must be able to override existing } then
|
||||
begin
|
||||
Options[OptionId] := Variable;
|
||||
Result := True;
|
||||
|
@ -2539,7 +2706,7 @@ var
|
|||
I: LongInt;
|
||||
begin
|
||||
Result := nil;
|
||||
for I := 0 to ImageFileFormats.Count - 1 do
|
||||
for I := ImageFileFormats.Count - 1 downto 0 do
|
||||
if TImageFileFormat(ImageFileFormats[I]).Extensions.IndexOf(Ext) >= 0 then
|
||||
begin
|
||||
Result := TImageFileFormat(ImageFileFormats[I]);
|
||||
|
@ -2552,7 +2719,7 @@ var
|
|||
I: LongInt;
|
||||
begin
|
||||
Result := nil;
|
||||
for I := 0 to ImageFileFormats.Count - 1 do
|
||||
for I := ImageFileFormats.Count - 1 downto 0 do
|
||||
if TImageFileFormat(ImageFileFormats[I]).TestFileName(FileName) then
|
||||
begin
|
||||
Result := TImageFileFormat(ImageFileFormats[I]);
|
||||
|
@ -3289,6 +3456,19 @@ finalization
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Extended RotateImage to allow arbitrary angle rotations.
|
||||
- Reversed the order file formats list is searched so
|
||||
if you register a new one it will be found sooner than
|
||||
built in formats.
|
||||
- Fixed memory leak in ResizeImage ocurring when resizing
|
||||
indexed images.
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- Added position/size checks to LoadFromStream functions.
|
||||
- Changed conditional compilation in impl. uses section to reflect changes
|
||||
in LINK symbols.
|
||||
|
||||
-- 0.24.3 Changes/Bug Fixes ---------------------------------
|
||||
- GenerateMipMaps now generates all smaller levels from
|
||||
original big image (better results when using more advanced filters).
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingCanvases.pas 131 2008-08-14 15:14:24Z galfar $
|
||||
$Id: ImagingCanvases.pas 174 2009-09-08 09:37:59Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -118,6 +118,8 @@ type
|
|||
|
||||
TDynFPPixelArray = array of TColorFPRec;
|
||||
|
||||
THistogramArray = array[Byte] of Integer;
|
||||
|
||||
TSelectPixelFunction = function(var Pixels: TDynFPPixelArray): TColorFPRec;
|
||||
|
||||
{ Base canvas class for drawing objects, applying effects, and other.
|
||||
|
@ -128,7 +130,7 @@ type
|
|||
recompute some data size related stuff).
|
||||
|
||||
TImagingCanvas works for all image data formats except special ones
|
||||
(compressed). Because of this its methods are quite slow (they work
|
||||
(compressed). Because of this its methods are quite slow (they usually work
|
||||
with colors in ifA32R32G32B32F format). If you want fast drawing you
|
||||
can use one of fast canvas clases. These descendants of TImagingCanvas
|
||||
work only for few select formats (or only one) but they are optimized thus
|
||||
|
@ -216,6 +218,12 @@ type
|
|||
filled by using the current fill settings. Rect specifies bounding rectangle
|
||||
of ellipse to be drawn.}
|
||||
procedure Ellipse(const Rect: TRect);
|
||||
{ Fills area of canvas with current fill color starting at point [X, Y] and
|
||||
coloring its neighbors. Default flood fill mode changes color of all
|
||||
neighbors with the same color as pixel [X, Y]. With BoundaryFillMode
|
||||
set to True neighbors are recolored regardless of their old color,
|
||||
but area which will be recolored has boundary (specified by current pen color).}
|
||||
procedure FloodFill(X, Y: Integer; BoundaryFillMode: Boolean = False);
|
||||
|
||||
{ Draws contents of this canvas onto another canvas with pixel blending.
|
||||
Blending factors are chosen using TBlendingFactor parameters.
|
||||
|
@ -225,7 +233,7 @@ type
|
|||
DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor);
|
||||
{ Draws contents of this canvas onto another one with typical alpha
|
||||
blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
|
||||
procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer);
|
||||
procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); virtual;
|
||||
{ Draws contents of this canvas onto another one using additive blending
|
||||
(source and dest factors are bfOne).}
|
||||
procedure DrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer);
|
||||
|
@ -239,7 +247,7 @@ type
|
|||
{ Draws contents of this canvas onto another one with typical alpha
|
||||
blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)}
|
||||
procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
|
||||
const DestRect: TRect; Filter: TResizeFilter = rfBilinear);
|
||||
const DestRect: TRect; Filter: TResizeFilter = rfBilinear); virtual;
|
||||
{ Draws contents of this canvas onto another one using additive blending
|
||||
(source and dest factors are bfOne).}
|
||||
procedure StretchDrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas;
|
||||
|
@ -286,10 +294,36 @@ type
|
|||
{ Gamma correction of individual color channels. Range is (0, +inf),
|
||||
1.0 means no change.}
|
||||
procedure GammaCorection(Red, Green, Blue: Single);
|
||||
{ Inverts colors of all image pixels, makes negative image.}
|
||||
procedure InvertColors;
|
||||
{ Simple single level thresholding with threshold level for each color channel.}
|
||||
{ Inverts colors of all image pixels, makes negative image. Ignores alpha channel.}
|
||||
procedure InvertColors; virtual;
|
||||
{ Simple single level thresholding with threshold level (in range [0, 1])
|
||||
for each color channel.}
|
||||
procedure Threshold(Red, Green, Blue: Single);
|
||||
{ Adjusts the color levels of the image by scaling the
|
||||
colors falling between specified white and black points to full [0, 1] range.
|
||||
The black point specifies the darkest color in the image, white point
|
||||
specifies the lightest color, and mid point is gamma aplied to image.
|
||||
Black and white point must be in range [0, 1].}
|
||||
procedure AdjustColorLevels(BlackPoint, WhitePoint: Single; MidPoint: Single = 1.0);
|
||||
{ Premultiplies color channel values by alpha. Needed for some platforms/APIs
|
||||
to display images with alpha properly.}
|
||||
procedure PremultiplyAlpha;
|
||||
{ Reverses PremultiplyAlpha operation.}
|
||||
procedure UnPremultiplyAlpha;
|
||||
|
||||
{ Calculates image histogram for each channel and also gray values. Each
|
||||
channel has 256 values available. Channel values of data formats with higher
|
||||
precision are scaled and rounded. Example: Red[126] specifies number of pixels
|
||||
in image with red channel = 126.}
|
||||
procedure GetHistogram(out Red, Green, Blue, Alpha, Gray: THistogramArray);
|
||||
{ Fills image channel with given value leaving other channels intact.
|
||||
Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
|
||||
channel identifier.}
|
||||
procedure FillChannel(ChannelId: Integer; NewChannelValue: Byte); overload;
|
||||
{ Fills image channel with given value leaving other channels intact.
|
||||
Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as
|
||||
channel identifier.}
|
||||
procedure FillChannelFP(ChannelId: Integer; NewChannelValue: Single); overload;
|
||||
|
||||
{ Color used when drawing lines, frames, and outlines of objects.}
|
||||
property PenColor32: TColor32 read FPenColor32 write SetPenColor32;
|
||||
|
@ -337,6 +371,7 @@ type
|
|||
TFastARGB32Canvas = class(TImagingCanvas)
|
||||
protected
|
||||
FScanlines: PScanlineArray;
|
||||
procedure AlphaBlendPixels(SrcPix, DestPix: PColor32Rec); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
function GetPixel32(X, Y: LongInt): TColor32; override;
|
||||
procedure SetPixel32(X, Y: LongInt; const Value: TColor32); override;
|
||||
public
|
||||
|
@ -344,6 +379,11 @@ type
|
|||
|
||||
procedure UpdateCanvasState; override;
|
||||
|
||||
procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); override;
|
||||
procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas;
|
||||
const DestRect: TRect; Filter: TResizeFilter = rfBilinear); override;
|
||||
procedure InvertColors; override;
|
||||
|
||||
property Scanlines: PScanlineArray read FScanlines;
|
||||
|
||||
class function GetSupportedFormats: TImageFormats; override;
|
||||
|
@ -600,13 +640,16 @@ procedure PixelAlphaProc(const SrcPix: TColorFPRec; DestPtr: PByte;
|
|||
DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor);
|
||||
var
|
||||
DestPix: TColorFPRec;
|
||||
SrcAlpha, DestAlpha: Single;
|
||||
begin
|
||||
DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil);
|
||||
// Blend the two pixels (Src 'over' Dest alpha composition operation)
|
||||
DestPix.R := SrcPix.R * SrcPix.A + DestPix.R * DestPix.A * (1.0 - SrcPix.A);
|
||||
DestPix.G := SrcPix.G * SrcPix.A + DestPix.G * DestPix.A * (1.0 - SrcPix.A);
|
||||
DestPix.B := SrcPix.B * SrcPix.A + DestPix.B * DestPix.A * (1.0 - SrcPix.A);
|
||||
DestPix.A := SrcPix.A + DestPix.A * (1.0 - SrcPix.A);
|
||||
DestPix.A := SrcPix.A + DestPix.A - SrcPix.A * DestPix.A;
|
||||
SrcAlpha := IffFloat(DestPix.A = 0, 0, SrcPix.A / DestPix.A);
|
||||
DestAlpha := 1.0 - SrcAlpha;
|
||||
DestPix.R := SrcPix.R * SrcAlpha + DestPix.R * DestAlpha;
|
||||
DestPix.G := SrcPix.G * SrcAlpha + DestPix.G * DestAlpha;
|
||||
DestPix.B := SrcPix.B * SrcAlpha + DestPix.B * DestAlpha;
|
||||
// Write blended pixel
|
||||
DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix);
|
||||
end;
|
||||
|
@ -691,7 +734,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, Ignore: Single): TColorFPRec;
|
||||
function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, P3: Single): TColorFPRec;
|
||||
begin
|
||||
Result.A := Pixel.A;
|
||||
Result.R := Pixel.R * C + B;
|
||||
|
@ -707,7 +750,7 @@ begin
|
|||
Result.B := Power(Pixel.B, 1.0 / B);
|
||||
end;
|
||||
|
||||
function TransformInvert(const Pixel: TColorFPRec; A, B, C: Single): TColorFPRec;
|
||||
function TransformInvert(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
|
||||
begin
|
||||
Result.A := Pixel.A;
|
||||
Result.R := 1.0 - Pixel.R;
|
||||
|
@ -723,6 +766,49 @@ begin
|
|||
Result.B := IffFloat(Pixel.B >= B, 1.0, 0.0);
|
||||
end;
|
||||
|
||||
function TransformLevels(const Pixel: TColorFPRec; BlackPoint, WhitePoint, Exp: Single): TColorFPRec;
|
||||
begin
|
||||
Result.A := Pixel.A;
|
||||
if Pixel.R > BlackPoint then
|
||||
Result.R := Power((Pixel.R - BlackPoint) / (WhitePoint - BlackPoint), Exp)
|
||||
else
|
||||
Result.R := 0.0;
|
||||
if Pixel.G > BlackPoint then
|
||||
Result.G := Power((Pixel.G - BlackPoint) / (WhitePoint - BlackPoint), Exp)
|
||||
else
|
||||
Result.G := 0.0;
|
||||
if Pixel.B > BlackPoint then
|
||||
Result.B := Power((Pixel.B - BlackPoint) / (WhitePoint - BlackPoint), Exp)
|
||||
else
|
||||
Result.B := 0.0;
|
||||
end;
|
||||
|
||||
function TransformPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
|
||||
begin
|
||||
Result.A := Pixel.A;
|
||||
Result.R := Result.R * Pixel.A;
|
||||
Result.G := Result.G * Pixel.A;
|
||||
Result.B := Result.B * Pixel.A;
|
||||
end;
|
||||
|
||||
function TransformUnPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec;
|
||||
begin
|
||||
Result.A := Pixel.A;
|
||||
if Pixel.A <> 0.0 then
|
||||
begin
|
||||
Result.R := Result.R / Pixel.A;
|
||||
Result.G := Result.G / Pixel.A;
|
||||
Result.B := Result.B / Pixel.A;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result.R := 0;
|
||||
Result.G := 0;
|
||||
Result.B := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TImagingCanvas class implementation }
|
||||
|
||||
constructor TImagingCanvas.CreateForData(ImageDataPointer: PImageData);
|
||||
|
@ -1175,6 +1261,98 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.FloodFill(X, Y: Integer; BoundaryFillMode: Boolean);
|
||||
var
|
||||
Stack: array of TPoint;
|
||||
StackPos, Y1: Integer;
|
||||
OldColor: TColor32;
|
||||
SpanLeft, SpanRight: Boolean;
|
||||
|
||||
procedure Push(AX, AY: Integer);
|
||||
begin
|
||||
if StackPos < High(Stack) then
|
||||
begin
|
||||
Inc(StackPos);
|
||||
Stack[StackPos].X := AX;
|
||||
Stack[StackPos].Y := AY;
|
||||
end
|
||||
else
|
||||
begin
|
||||
SetLength(Stack, Length(Stack) + FPData.Width);
|
||||
Push(AX, AY);
|
||||
end;
|
||||
end;
|
||||
|
||||
function Pop(out AX, AY: Integer): Boolean;
|
||||
begin
|
||||
if StackPos > 0 then
|
||||
begin
|
||||
AX := Stack[StackPos].X;
|
||||
AY := Stack[StackPos].Y;
|
||||
Dec(StackPos);
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function Compare(AX, AY: Integer): Boolean;
|
||||
var
|
||||
Color: TColor32;
|
||||
begin
|
||||
Color := GetPixel32(AX, AY);
|
||||
if BoundaryFillMode then
|
||||
Result := (Color <> FFillColor32) and (Color <> FPenColor32)
|
||||
else
|
||||
Result := Color = OldColor;
|
||||
end;
|
||||
|
||||
begin
|
||||
// Scanline Floodfill Algorithm With Stack
|
||||
// http://student.kuleuven.be/~m0216922/CG/floodfill.html
|
||||
|
||||
if not PtInRect(FClipRect, Point(X, Y)) then Exit;
|
||||
|
||||
SetLength(Stack, FPData.Width * 4);
|
||||
StackPos := 0;
|
||||
|
||||
OldColor := GetPixel32(X, Y);
|
||||
|
||||
Push(X, Y);
|
||||
|
||||
while Pop(X, Y) do
|
||||
begin
|
||||
Y1 := Y;
|
||||
while (Y1 >= FClipRect.Top) and Compare(X, Y1) do
|
||||
Dec(Y1);
|
||||
|
||||
Inc(Y1);
|
||||
SpanLeft := False;
|
||||
SpanRight := False;
|
||||
|
||||
while (Y1 < FClipRect.Bottom) and Compare(X, Y1) do
|
||||
begin
|
||||
SetPixel32(X, Y1, FFillColor32);
|
||||
if not SpanLeft and (X > FClipRect.Left) and Compare(X - 1, Y1) then
|
||||
begin
|
||||
Push(X - 1, Y1);
|
||||
SpanLeft := True;
|
||||
end
|
||||
else if SpanLeft and (X > FClipRect.Left) and not Compare(X - 1, Y1) then
|
||||
SpanLeft := False
|
||||
else if not SpanRight and (X < FClipRect.Right - 1) and Compare(X + 1, Y1)then
|
||||
begin
|
||||
Push(X + 1, Y1);
|
||||
SpanRight := True;
|
||||
end
|
||||
else if SpanRight and (X < FClipRect.Right - 1) and not Compare(X + 1, Y1) then
|
||||
SpanRight := False;
|
||||
|
||||
Inc(Y1);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.DrawInternal(const SrcRect: TRect;
|
||||
DestCanvas: TImagingCanvas; DestX, DestY: Integer; SrcFactor,
|
||||
DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc);
|
||||
|
@ -1533,7 +1711,7 @@ end;
|
|||
procedure TImagingCanvas.ModifyContrastBrightness(Contrast, Brightness: Single);
|
||||
begin
|
||||
PointTransform(TransformContrastBrightness, 1.0 + Contrast / 100,
|
||||
Brightness / 100, 0.0);
|
||||
Brightness / 100, 0);
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.GammaCorection(Red, Green, Blue: Single);
|
||||
|
@ -1551,6 +1729,98 @@ begin
|
|||
PointTransform(TransformThreshold, Red, Green, Blue);
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.AdjustColorLevels(BlackPoint, WhitePoint, MidPoint: Single);
|
||||
begin
|
||||
PointTransform(TransformLevels, BlackPoint, WhitePoint, 1.0 / MidPoint);
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.PremultiplyAlpha;
|
||||
begin
|
||||
PointTransform(TransformPremultiplyAlpha, 0, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.UnPremultiplyAlpha;
|
||||
begin
|
||||
PointTransform(TransformUnPremultiplyAlpha, 0, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.GetHistogram(out Red, Green, Blue, Alpha,
|
||||
Gray: THistogramArray);
|
||||
var
|
||||
X, Y, Bpp: Integer;
|
||||
PixPointer: PByte;
|
||||
Color32: TColor32Rec;
|
||||
begin
|
||||
FillChar(Red, SizeOf(Red), 0);
|
||||
FillChar(Green, SizeOf(Green), 0);
|
||||
FillChar(Blue, SizeOf(Blue), 0);
|
||||
FillChar(Alpha, SizeOf(Alpha), 0);
|
||||
FillChar(Gray, SizeOf(Gray), 0);
|
||||
|
||||
Bpp := FFormatInfo.BytesPerPixel;
|
||||
|
||||
for Y := FClipRect.Top to FClipRect.Bottom - 1 do
|
||||
begin
|
||||
PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
|
||||
for X := FClipRect.Left to FClipRect.Right - 1 do
|
||||
begin
|
||||
Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
|
||||
|
||||
Inc(Red[Color32.R]);
|
||||
Inc(Green[Color32.G]);
|
||||
Inc(Blue[Color32.B]);
|
||||
Inc(Alpha[Color32.A]);
|
||||
Inc(Gray[Round(GrayConv.R * Color32.R + GrayConv.G * Color32.G + GrayConv.B * Color32.B)]);
|
||||
|
||||
Inc(PixPointer, Bpp);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.FillChannel(ChannelId: Integer; NewChannelValue: Byte);
|
||||
var
|
||||
X, Y, Bpp: Integer;
|
||||
PixPointer: PByte;
|
||||
Color32: TColor32Rec;
|
||||
begin
|
||||
Bpp := FFormatInfo.BytesPerPixel;
|
||||
|
||||
for Y := FClipRect.Top to FClipRect.Bottom - 1 do
|
||||
begin
|
||||
PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
|
||||
for X := FClipRect.Left to FClipRect.Right - 1 do
|
||||
begin
|
||||
Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette);
|
||||
Color32.Channels[ChannelId] := NewChannelValue;
|
||||
FFormatInfo.SetPixel32(PixPointer, @FFormatInfo, FPData.Palette, Color32);
|
||||
|
||||
Inc(PixPointer, Bpp);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TImagingCanvas.FillChannelFP(ChannelId: Integer; NewChannelValue: Single);
|
||||
var
|
||||
X, Y, Bpp: Integer;
|
||||
PixPointer: PByte;
|
||||
ColorFP: TColorFPRec;
|
||||
begin
|
||||
Bpp := FFormatInfo.BytesPerPixel;
|
||||
|
||||
for Y := FClipRect.Top to FClipRect.Bottom - 1 do
|
||||
begin
|
||||
PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp];
|
||||
for X := FClipRect.Left to FClipRect.Right - 1 do
|
||||
begin
|
||||
ColorFP := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette);
|
||||
ColorFP.Channels[ChannelId] := NewChannelValue;
|
||||
FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette, ColorFP);
|
||||
|
||||
Inc(PixPointer, Bpp);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TImagingCanvas.GetSupportedFormats: TImageFormats;
|
||||
begin
|
||||
Result := [ifIndex8..Pred(ifDXT1)];
|
||||
|
@ -1564,6 +1834,55 @@ begin
|
|||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFastARGB32Canvas.AlphaBlendPixels(SrcPix, DestPix: PColor32Rec);
|
||||
var
|
||||
SrcAlpha, DestAlpha, FinalAlpha: Integer;
|
||||
begin
|
||||
FinalAlpha := SrcPix.A + 1 + (DestPix.A * (256 - SrcPix.A)) shr 8;
|
||||
if FinalAlpha = 0 then
|
||||
SrcAlpha := 0
|
||||
else
|
||||
SrcAlpha := (SrcPix.A shl 8) div FinalAlpha;
|
||||
DestAlpha := 256 - SrcAlpha;
|
||||
|
||||
DestPix.A := ClampToByte(FinalAlpha);
|
||||
DestPix.R := (SrcPix.R * SrcAlpha + DestPix.R * DestAlpha) shr 8;
|
||||
DestPix.G := (SrcPix.G * SrcAlpha + DestPix.G * DestAlpha) shr 8;
|
||||
DestPix.B := (SrcPix.B * SrcAlpha + DestPix.B * DestAlpha) shr 8;
|
||||
end;
|
||||
|
||||
procedure TFastARGB32Canvas.DrawAlpha(const SrcRect: TRect;
|
||||
DestCanvas: TImagingCanvas; DestX, DestY: Integer);
|
||||
var
|
||||
X, Y, SrcX, SrcY, Width, Height: Integer;
|
||||
SrcPix, DestPix: PColor32Rec;
|
||||
begin
|
||||
if DestCanvas.ClassType <> Self.ClassType then
|
||||
begin
|
||||
inherited;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SrcX := SrcRect.Left;
|
||||
SrcY := SrcRect.Top;
|
||||
Width := SrcRect.Right - SrcRect.Left;
|
||||
Height := SrcRect.Bottom - SrcRect.Top;
|
||||
ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY,
|
||||
FPData.Width, FPData.Height, DestCanvas.ClipRect);
|
||||
|
||||
for Y := 0 to Height - 1 do
|
||||
begin
|
||||
SrcPix := @FScanlines[SrcY + Y, SrcX];
|
||||
DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + Y, DestX];
|
||||
for X := 0 to Width - 1 do
|
||||
begin
|
||||
AlphaBlendPixels(SrcPix, DestPix);
|
||||
Inc(SrcPix);
|
||||
Inc(DestPix);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFastARGB32Canvas.GetPixel32(X, Y: LongInt): TColor32;
|
||||
begin
|
||||
Result := FScanlines[Y, X].Color;
|
||||
|
@ -1578,6 +1897,189 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TFastARGB32Canvas.StretchDrawAlpha(const SrcRect: TRect;
|
||||
DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter);
|
||||
var
|
||||
X, Y, ScaleX, ScaleY, Yp, Xp, Weight1, Weight2, Weight3, Weight4,
|
||||
FracX, FracY, InvFracY, T1, T2: Integer;
|
||||
SrcX, SrcY, SrcWidth, SrcHeight: Integer;
|
||||
DestX, DestY, DestWidth, DestHeight: Integer;
|
||||
SrcLine, SrcLine2: PColor32RecArray;
|
||||
DestPix: PColor32Rec;
|
||||
Accum: TColor32Rec;
|
||||
begin
|
||||
if (Filter = rfBicubic) or (DestCanvas.ClassType <> Self.ClassType) then
|
||||
begin
|
||||
inherited;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SrcX := SrcRect.Left;
|
||||
SrcY := SrcRect.Top;
|
||||
SrcWidth := SrcRect.Right - SrcRect.Left;
|
||||
SrcHeight := SrcRect.Bottom - SrcRect.Top;
|
||||
DestX := DestRect.Left;
|
||||
DestY := DestRect.Top;
|
||||
DestWidth := DestRect.Right - DestRect.Left;
|
||||
DestHeight := DestRect.Bottom - DestRect.Top;
|
||||
// Clip src and dst rects
|
||||
ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight,
|
||||
FPData.Width, FPData.Height, DestCanvas.ClipRect);
|
||||
ScaleX := (SrcWidth shl 16) div DestWidth;
|
||||
ScaleY := (SrcHeight shl 16) div DestHeight;
|
||||
|
||||
// Nearest and linear filtering using fixed point math
|
||||
|
||||
if Filter = rfNearest then
|
||||
begin
|
||||
Yp := 0;
|
||||
for Y := DestY to DestY + DestHeight - 1 do
|
||||
begin
|
||||
Xp := 0;
|
||||
SrcLine := @FScanlines[SrcY + Yp shr 16, SrcX];
|
||||
DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
|
||||
for X := 0 to DestWidth - 1 do
|
||||
begin
|
||||
AlphaBlendPixels(@SrcLine[Xp shr 16], DestPix);
|
||||
Inc(DestPix);
|
||||
Inc(Xp, ScaleX);
|
||||
end;
|
||||
Inc(Yp, ScaleY);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Yp := (ScaleY shr 1) - $8000;
|
||||
for Y := DestY to DestY + DestHeight - 1 do
|
||||
begin
|
||||
DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX];
|
||||
if Yp < 0 then
|
||||
begin
|
||||
T1 := 0;
|
||||
FracY := 0;
|
||||
InvFracY := $10000;
|
||||
end
|
||||
else
|
||||
begin
|
||||
T1 := Yp shr 16;
|
||||
FracY := Yp and $FFFF;
|
||||
InvFracY := (not Yp and $FFFF) + 1;
|
||||
end;
|
||||
|
||||
T2 := Iff(T1 < SrcHeight - 1, T1 + 1, T1);
|
||||
SrcLine := @Scanlines[T1 + SrcY, SrcX];
|
||||
SrcLine2 := @Scanlines[T2 + SrcY, SrcX];
|
||||
Xp := (ScaleX shr 1) - $8000;
|
||||
|
||||
for X := 0 to DestWidth - 1 do
|
||||
begin
|
||||
if Xp < 0 then
|
||||
begin
|
||||
T1 := 0;
|
||||
FracX := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
T1 := Xp shr 16;
|
||||
FracX := Xp and $FFFF;
|
||||
end;
|
||||
|
||||
T2 := Iff(T1 < SrcWidth - 1, T1 + 1, T1);
|
||||
Weight2:= (Cardinal(InvFracY) * FracX) shr 16; // cast to Card, Int can overflow gere
|
||||
Weight1:= InvFracY - Weight2;
|
||||
Weight4:= (Cardinal(FracY) * FracX) shr 16;
|
||||
Weight3:= FracY - Weight4;
|
||||
|
||||
Accum.B := (SrcLine[T1].B * Weight1 + SrcLine[T2].B * Weight2 +
|
||||
SrcLine2[T1].B * Weight3 + SrcLine2[T2].B * Weight4 + $8000) shr 16;
|
||||
Accum.G := (SrcLine[T1].G * Weight1 + SrcLine[T2].G * Weight2 +
|
||||
SrcLine2[T1].G * Weight3 + SrcLine2[T2].G * Weight4 + $8000) shr 16;
|
||||
Accum.R := (SrcLine[T1].R * Weight1 + SrcLine[T2].R * Weight2 +
|
||||
SrcLine2[T1].R * Weight3 + SrcLine2[T2].R * Weight4 + $8000) shr 16;
|
||||
Accum.A := (SrcLine[T1].A * Weight1 + SrcLine[T2].A * Weight2 +
|
||||
SrcLine2[T1].A * Weight3 + SrcLine2[T2].A * Weight4 + $8000) shr 16;
|
||||
|
||||
AlphaBlendPixels(@Accum, DestPix);
|
||||
|
||||
Inc(Xp, ScaleX);
|
||||
Inc(DestPix);
|
||||
end;
|
||||
Inc(Yp, ScaleY);
|
||||
end;
|
||||
end;
|
||||
{
|
||||
|
||||
// Generate mapping tables
|
||||
MapX := BuildMappingTable(DestX, DestX + DestWidth, SrcX, SrcX + SrcWidth,
|
||||
FPData.Width, FilterFunction, Radius, False);
|
||||
MapY := BuildMappingTable(DestY, DestY + DestHeight, SrcY, SrcY + SrcHeight,
|
||||
FPData.Height, FilterFunction, Radius, False);
|
||||
FindExtremes(MapX, XMinimum, XMaximum);
|
||||
SetLength(LineBuffer, XMaximum - XMinimum + 1);
|
||||
|
||||
for J := 0 to DestHeight - 1 do
|
||||
begin
|
||||
ClusterY := MapY[J];
|
||||
for X := XMinimum to XMaximum do
|
||||
begin
|
||||
AccumA := 0;
|
||||
AccumR := 0;
|
||||
AccumG := 0;
|
||||
AccumB := 0;
|
||||
for Y := 0 to Length(ClusterY) - 1 do
|
||||
begin
|
||||
Weight := Round(ClusterY[Y].Weight * 256);
|
||||
SrcColor := FScanlines[ClusterY[Y].Pos, X];
|
||||
|
||||
AccumB := AccumB + SrcColor.B * Weight;
|
||||
AccumG := AccumG + SrcColor.G * Weight;
|
||||
AccumR := AccumR + SrcColor.R * Weight;
|
||||
AccumA := AccumA + SrcColor.A * Weight;
|
||||
end;
|
||||
with LineBuffer[X - XMinimum] do
|
||||
begin
|
||||
A := AccumA;
|
||||
R := AccumR;
|
||||
G := AccumG;
|
||||
B := AccumB;
|
||||
end;
|
||||
end;
|
||||
|
||||
DestPtr := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + J, DestX];
|
||||
|
||||
for I := 0 to DestWidth - 1 do
|
||||
begin
|
||||
ClusterX := MapX[I];
|
||||
AccumA := 0;
|
||||
AccumR := 0;
|
||||
AccumG := 0;
|
||||
AccumB := 0;
|
||||
for X := 0 to Length(ClusterX) - 1 do
|
||||
begin
|
||||
Weight := Round(ClusterX[X].Weight * 256);
|
||||
with LineBuffer[ClusterX[X].Pos - XMinimum] do
|
||||
begin
|
||||
AccumB := AccumB + B * Weight;
|
||||
AccumG := AccumG + G * Weight;
|
||||
AccumR := AccumR + R * Weight;
|
||||
AccumA := AccumA + A * Weight;
|
||||
end;
|
||||
end;
|
||||
|
||||
AccumA := ClampInt(AccumA, 0, $00FF0000);
|
||||
AccumR := ClampInt(AccumR, 0, $00FF0000);
|
||||
AccumG := ClampInt(AccumG, 0, $00FF0000);
|
||||
AccumB := ClampInt(AccumB, 0, $00FF0000);
|
||||
SrcColor.Color := (Cardinal(AccumA and $00FF0000) shl 8) or
|
||||
(AccumR and $00FF0000) or ((AccumG and $00FF0000) shr 8) or ((AccumB and $00FF0000) shr 16);
|
||||
|
||||
AlphaBlendPixels(@SrcColor, DestPtr);
|
||||
|
||||
Inc(DestPtr);
|
||||
end;
|
||||
end; }
|
||||
end;
|
||||
|
||||
procedure TFastARGB32Canvas.UpdateCanvasState;
|
||||
var
|
||||
I: LongInt;
|
||||
|
@ -1601,6 +2103,24 @@ begin
|
|||
Result := [ifA8R8G8B8];
|
||||
end;
|
||||
|
||||
procedure TFastARGB32Canvas.InvertColors;
|
||||
var
|
||||
X, Y: Integer;
|
||||
PixPtr: PColor32Rec;
|
||||
begin
|
||||
for Y := FClipRect.Top to FClipRect.Bottom - 1 do
|
||||
begin
|
||||
PixPtr := @FScanlines[Y, FClipRect.Left];
|
||||
for X := FClipRect.Left to FClipRect.Right - 1 do
|
||||
begin
|
||||
PixPtr.R := not PixPtr.R;
|
||||
PixPtr.G := not PixPtr.G;
|
||||
PixPtr.B := not PixPtr.B;
|
||||
Inc(PixPtr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterCanvas(TFastARGB32Canvas);
|
||||
|
||||
|
@ -1616,6 +2136,19 @@ finalization
|
|||
- add blending (*image and object drawing)
|
||||
- more objects (arc, polygon)
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Added some methods to TFastARGB32Canvas (InvertColors, DrawAlpha/StretchDrawAlpha)
|
||||
- Fixed DrawAlpha/StretchDrawAlpha destination alpha calculation.
|
||||
- Added PremultiplyAlpha and UnPremultiplyAlpha methods.
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- Added FillChannel methods.
|
||||
- Added FloodFill method.
|
||||
- Added GetHistogram method.
|
||||
- Fixed "Invalid FP operation" in AdjustColorLevels in FPC compiled exes
|
||||
(thanks to Carlos González).
|
||||
- Added TImagingCanvas.AdjustColorLevels method.
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed error that could cause AV in linear and nonlinear filters.
|
||||
- Added blended rect filling function FillRectBlend.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingClasses.pas 124 2008-04-21 09:47:07Z galfar $
|
||||
$Id: ImagingClasses.pas 173 2009-09-04 17:05:52Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -68,7 +68,7 @@ type
|
|||
constructor CreateFromImage(AImage: TBaseImage);
|
||||
destructor Destroy; override;
|
||||
{ Returns info about current image.}
|
||||
function ToString: string;
|
||||
function ToString: string; {$IF Defined(DCC) and (CompilerVersion >= 20.0)}override;{$IFEND}
|
||||
|
||||
{ Creates a new image data with the given size and format. Old image
|
||||
data is lost. Works only for the current image of TMultiImage.}
|
||||
|
@ -81,8 +81,8 @@ type
|
|||
{ Mirrors current image. Reverses the image along its vertical axis the left
|
||||
side becomes the right and vice versa.}
|
||||
procedure Mirror;
|
||||
{ Rotates image by 90, 180, 270, -90, -180, or -270 degrees counterclockwise.}
|
||||
procedure Rotate(Angle: LongInt);
|
||||
{ Rotates image by Angle degrees counterclockwise.}
|
||||
procedure Rotate(Angle: Single);
|
||||
{ Copies rectangular part of SrcImage to DstImage. No blending is performed -
|
||||
alpha is simply copied to destination image. Operates also with
|
||||
negative X and Y coordinates.
|
||||
|
@ -451,7 +451,7 @@ begin
|
|||
DoPixelsChanged;
|
||||
end;
|
||||
|
||||
procedure TBaseImage.Rotate(Angle: LongInt);
|
||||
procedure TBaseImage.Rotate(Angle: Single);
|
||||
begin
|
||||
if Valid and Imaging.RotateImage(FPData^, Angle) then
|
||||
DoPixelsChanged;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingColors.pas 74 2007-03-12 15:04:04Z galfar $
|
||||
$Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -68,6 +68,12 @@ procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
|
|||
{ Converts CMYK to RGB color.}
|
||||
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
|
||||
|
||||
{ Converts RGB color to YCoCg.}
|
||||
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
|
||||
{ Converts YCoCg to RGB color.}
|
||||
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
|
||||
|
@ -149,11 +155,17 @@ procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
|
|||
begin
|
||||
RGBToCMY(R, G, B, C, M, Y);
|
||||
K := Min(C, Min(M, Y));
|
||||
if K > 0 then
|
||||
if K = 255 then
|
||||
begin
|
||||
C := C - K;
|
||||
M := M - K;
|
||||
Y := Y - K;
|
||||
C := 0;
|
||||
M := 0;
|
||||
Y := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
C := ClampToByte(Round((C - K) / (255 - K) * 255));
|
||||
M := ClampToByte(Round((M - K) / (255 - K) * 255));
|
||||
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -168,11 +180,17 @@ procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
|
|||
begin
|
||||
RGBToCMY16(R, G, B, C, M, Y);
|
||||
K := Min(C, Min(M, Y));
|
||||
if K > 0 then
|
||||
if K = 65535 then
|
||||
begin
|
||||
C := C - K;
|
||||
M := M - K;
|
||||
Y := Y - K;
|
||||
C := 0;
|
||||
M := 0;
|
||||
Y := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
|
||||
M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
|
||||
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -183,12 +201,35 @@ begin
|
|||
B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
|
||||
end;
|
||||
|
||||
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
|
||||
begin
|
||||
// C and Delphi's SHR behaviour differs for negative numbers, use div instead.
|
||||
Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
|
||||
Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128);
|
||||
Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128);
|
||||
end;
|
||||
|
||||
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
|
||||
var
|
||||
CoInt, CgInt: Integer;
|
||||
begin
|
||||
CoInt := Co - 128;
|
||||
CgInt := Cg - 128;
|
||||
R := ClampToByte(Y + CoInt - CgInt);
|
||||
G := ClampToByte(Y + CgInt);
|
||||
B := ClampToByte(Y - CoInt - CgInt);
|
||||
end;
|
||||
|
||||
{
|
||||
File Notes:
|
||||
|
||||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Added RGB<>YCoCg conversion functions.
|
||||
- Fixed RGB>>CMYK conversions.
|
||||
|
||||
-- 0.23 Changes/Bug Fixes -----------------------------------
|
||||
- Added RGB<>CMY(K) converion functions for 16 bit channels
|
||||
(needed by PSD loading code).
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingComponents.pas 132 2008-08-27 20:37:38Z galfar $
|
||||
$Id: ImagingComponents.pas 171 2009-09-02 01:34:19Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -26,7 +26,7 @@
|
|||
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
|
||||
}
|
||||
|
||||
{ This unit contains VCL/CLX/LCL TGraphic descendant which uses Imaging library
|
||||
{ This unit contains VCL/LCL TGraphic descendant which uses Imaging library
|
||||
for saving and loading.}
|
||||
unit ImagingComponents;
|
||||
|
||||
|
@ -34,6 +34,17 @@ unit ImagingComponents;
|
|||
|
||||
interface
|
||||
|
||||
{$IFDEF LCL}
|
||||
{$DEFINE COMPONENT_SET_LCL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
|
||||
// If no component sets should be used just include empty unit.
|
||||
//DOC-IGNORE-BEGIN
|
||||
implementation
|
||||
//DOC-IGNORE-END
|
||||
{$ELSE}
|
||||
|
||||
uses
|
||||
SysUtils, Types, Classes,
|
||||
{$IFDEF MSWINDOWS}
|
||||
|
@ -42,10 +53,6 @@ uses
|
|||
{$IFDEF COMPONENT_SET_VCL}
|
||||
Graphics,
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
Qt,
|
||||
QGraphics,
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
InterfaceBase,
|
||||
GraphType,
|
||||
|
@ -71,6 +78,8 @@ type
|
|||
procedure ReadDataFromStream(Stream: TStream); virtual;
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
public
|
||||
constructor Create; override;
|
||||
|
||||
{ Loads new image from the stream. It can load all image
|
||||
file formats supported by Imaging (and enabled of course)
|
||||
even though it is called by descendant class capable of
|
||||
|
@ -114,8 +123,7 @@ type
|
|||
{ Returns file extensions of this graphic class.}
|
||||
class function GetFileExtensions: string; override;
|
||||
{ Returns default MIME type of this graphic class.}
|
||||
function GetMimeType: string; override; // uncomment for Laz 0.9.25 if you get error here
|
||||
//function GetDefaultMimeType: string; override;
|
||||
function GetMimeType: string; override;
|
||||
{$ENDIF}
|
||||
{ Default (the most common) file extension of this graphic class.}
|
||||
property DefaultFileExt: string read FDefaultFileExt;
|
||||
|
@ -123,7 +131,7 @@ type
|
|||
|
||||
TImagingGraphicForSaveClass = class of TImagingGraphicForSave;
|
||||
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
{ TImagingGraphic descendant for loading/saving Windows bitmaps.
|
||||
VCL/CLX/LCL all have native support for bitmaps so you might
|
||||
want to disable this class (although you can save bitmaps with
|
||||
|
@ -140,7 +148,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
{ TImagingGraphic descendant for loading/saving JPEG images.}
|
||||
TImagingJpeg = class(TImagingGraphicForSave)
|
||||
protected
|
||||
|
@ -151,8 +159,7 @@ type
|
|||
procedure SaveToStream(Stream: TStream); override;
|
||||
class function GetFileFormat: TImageFileFormat; override;
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
//function GetMimeType: string; override; // uncomment for Laz 0.9.25 if you get error here
|
||||
function GetDefaultMimeType: string; override;
|
||||
function GetMimeType: string; override;
|
||||
{$ENDIF}
|
||||
{ See ImagingJpegQuality option for details.}
|
||||
property Quality: LongInt read FQuality write FQuality;
|
||||
|
@ -161,7 +168,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_PNG}
|
||||
{$IFNDEF DONT_LINK_PNG}
|
||||
{ TImagingGraphic descendant for loading/saving PNG images.}
|
||||
TImagingPNG = class(TImagingGraphicForSave)
|
||||
protected
|
||||
|
@ -178,7 +185,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
{ TImagingGraphic descendant for loading/saving GIF images.}
|
||||
TImagingGIF = class(TImagingGraphicForSave)
|
||||
public
|
||||
|
@ -186,7 +193,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
{ TImagingGraphic descendant for loading/saving Targa images.}
|
||||
TImagingTarga = class(TImagingGraphicForSave)
|
||||
protected
|
||||
|
@ -200,7 +207,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
{ Compresssion type used when saving DDS files by TImagingDds.}
|
||||
TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5);
|
||||
|
||||
|
@ -218,7 +225,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_MNG}
|
||||
{$IFNDEF DONT_LINK_MNG}
|
||||
{ TImagingGraphic descendant for loading/saving MNG images.}
|
||||
TImagingMNG = class(TImagingGraphicForSave)
|
||||
protected
|
||||
|
@ -233,8 +240,7 @@ type
|
|||
procedure SaveToStream(Stream: TStream); override;
|
||||
class function GetFileFormat: TImageFileFormat; override;
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
//function GetMimeType: string; override; // uncomment for Laz 0.9.25 if you get error here
|
||||
function GetDefaultMimeType: string; override;
|
||||
function GetMimeType: string; override;
|
||||
{$ENDIF}
|
||||
{ See ImagingMNGLossyCompression option for details.}
|
||||
property LossyCompression: Boolean read FLossyCompression write FLossyCompression;
|
||||
|
@ -251,7 +257,7 @@ type
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_JNG}
|
||||
{$IFNDEF DONT_LINK_JNG}
|
||||
{ TImagingGraphic descendant for loading/saving JNG images.}
|
||||
TImagingJNG = class(TImagingGraphicForSave)
|
||||
protected
|
||||
|
@ -328,29 +334,29 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
|
|||
implementation
|
||||
|
||||
uses
|
||||
{$IF Defined(UNIX) and Defined(COMPONENT_SET_LCL)}
|
||||
{$IFDEF LCLGTK2}
|
||||
{$IF Defined(LCL)}
|
||||
{$IF Defined(LCLGTK2)}
|
||||
GLib2, GDK2, GTK2, GTKDef, GTKProc,
|
||||
{$ELSE}
|
||||
{$ELSEIF Defined(LCLGTK)}
|
||||
GDK, GTK, GTKDef, GTKProc,
|
||||
{$ENDIF}
|
||||
{$IFEND}
|
||||
{$IFEND}
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
ImagingBitmap,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
ImagingJpeg,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
ImagingGif,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
ImagingTarga,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
ImagingDds,
|
||||
{$ENDIF}
|
||||
{$IF Defined(LINK_PNG) or Defined(LINK_MNG) or Defined(LINK_JNG)}
|
||||
{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)}
|
||||
ImagingNetworkGraphics,
|
||||
{$IFEND}
|
||||
ImagingUtility;
|
||||
|
@ -359,9 +365,10 @@ resourcestring
|
|||
SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s';
|
||||
SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p';
|
||||
SBadFormatDisplay = 'Unsupported image format passed';
|
||||
SUnsupportedLCLWidgetSet = 'This function is not implemented for current LCL widget set';
|
||||
SImagingGraphicName = 'Imaging Graphic AllInOne';
|
||||
|
||||
{ Registers types to VCL/CLX/LCL.}
|
||||
{ Registers types to VCL/LCL.}
|
||||
procedure RegisterTypes;
|
||||
var
|
||||
I: LongInt;
|
||||
|
@ -387,87 +394,85 @@ var
|
|||
begin
|
||||
for I := Imaging.GetFileFormatCount - 1 downto 0 do
|
||||
RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I));
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGraphic);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingGraphic);
|
||||
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
RegisterFileFormat(TImagingTarga);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingTarga);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingTarga);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
RegisterFileFormat(TImagingDDS);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingDDS);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingDDS);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_JNG}
|
||||
{$IFNDEF DONT_LINK_JNG}
|
||||
RegisterFileFormat(TImagingJNG);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJNG);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingJNG);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_MNG}
|
||||
{$IFNDEF DONT_LINK_MNG}
|
||||
RegisterFileFormat(TImagingMNG);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingMNG);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingMNG);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
RegisterFileFormat(TImagingGIF);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingGIF);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingGIF);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_PNG}
|
||||
{$IFNDEF DONT_LINK_PNG}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
// Unregister Lazarus´ default PNG loader which crashes on some PNG files
|
||||
TPicture.UnregisterGraphicClass(TPortableNetworkGraphic);
|
||||
{$ENDIF}
|
||||
RegisterFileFormat(TImagingPNG);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingPNG);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingPNG);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
RegisterFileFormat(TImagingJpeg);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingJpeg);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingJpeg);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
RegisterFileFormat(TImagingBitmap);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.RegisterClass(TImagingBitmap);{$ENDIF}
|
||||
Classes.RegisterClass(TImagingBitmap);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{ Unregisters types from VCL/CLX/LCL.}
|
||||
{ Unregisters types from VCL/LCL.}
|
||||
procedure UnRegisterTypes;
|
||||
begin
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
TPicture.UnregisterGraphicClass(TImagingBitmap);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingBitmap);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingBitmap);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
TPicture.UnregisterGraphicClass(TImagingJpeg);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingJpeg);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingJpeg);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_PNG}
|
||||
{$IFNDEF DONT_LINK_PNG}
|
||||
TPicture.UnregisterGraphicClass(TImagingPNG);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingPNG);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingPNG);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
TPicture.UnregisterGraphicClass(TImagingGIF);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGIF);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingGIF);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
TPicture.UnregisterGraphicClass(TImagingTarga);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingTarga);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingTarga);
|
||||
{$ENDIF}
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
TPicture.UnregisterGraphicClass(TImagingDDS);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingDDS);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingDDS);
|
||||
{$ENDIF}
|
||||
TPicture.UnregisterGraphicClass(TImagingGraphic);
|
||||
{$IFNDEF COMPONENT_SET_CLX}Classes.UnRegisterClass(TImagingGraphic);{$ENDIF}
|
||||
Classes.UnRegisterClass(TImagingGraphic);
|
||||
end;
|
||||
|
||||
function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat;
|
||||
begin
|
||||
case Format of
|
||||
{$IFNDEF COMPONENT_SET_LCL}
|
||||
{$IFDEF COMPONENT_SET_VCL}
|
||||
ifIndex8: Result := pf8bit;
|
||||
{$ENDIF}
|
||||
{$IF (not Defined(COMPONENT_SET_CLX)) and (not Defined(COMPONENT_SET_LCL))}
|
||||
ifR5G6B5: Result := pf16bit;
|
||||
ifR8G8B8: Result := pf24bit;
|
||||
{$IFEND}
|
||||
{$ENDIF}
|
||||
ifA8R8G8B8,
|
||||
ifX8R8G8B8: Result := pf32bit;
|
||||
else
|
||||
|
@ -479,11 +484,9 @@ function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat;
|
|||
begin
|
||||
case Format of
|
||||
pf8bit: Result := ifIndex8;
|
||||
{$IFNDEF COMPONENT_SET_CLX}
|
||||
pf15bit: Result := ifA1R5G5B5;
|
||||
pf16bit: Result := ifR5G6B5;
|
||||
pf24bit: Result := ifR8G8B8;
|
||||
{$ENDIF}
|
||||
pf32bit: Result := ifA8R8G8B8;
|
||||
else
|
||||
Result := ifUnknown;
|
||||
|
@ -499,9 +502,6 @@ var
|
|||
{$IFDEF COMPONENT_SET_VCL}
|
||||
LogPalette: TMaxLogPalette;
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
ColorTable: PPalette32;
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
RawImage: TRawImage;
|
||||
ImgHandle, ImgMaskHandle: HBitmap;
|
||||
|
@ -517,19 +517,16 @@ begin
|
|||
if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then
|
||||
Imaging.ConvertImage(WorkData, ifA8R8G8B8)
|
||||
else
|
||||
{$IFNDEF COMPONENT_SET_LCL}
|
||||
{$IFDEF COMPONENT_SET_VCL}
|
||||
if Info.IsIndexed or Info.HasGrayChannel then
|
||||
Imaging.ConvertImage(WorkData, ifIndex8)
|
||||
else if Info.UsePixelFormat then
|
||||
Imaging.ConvertImage(WorkData, ifR5G6B5)
|
||||
else
|
||||
{$ENDIF}
|
||||
{$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);
|
||||
Imaging.ConvertImage(WorkData, ifR8G8B8);
|
||||
{$ELSE}
|
||||
Imaging.ConvertImage(WorkData, ifA8R8G8B8);
|
||||
{$IFEND}
|
||||
{$ENDIF}
|
||||
|
||||
PF := DataFormatToPixelFormat(WorkData.Format);
|
||||
GetImageFormatInfo(WorkData.Format, Info);
|
||||
|
@ -565,27 +562,13 @@ begin
|
|||
// Copy scanlines
|
||||
for I := 0 to WorkData.Height - 1 do
|
||||
Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
Bitmap.Width := WorkData.Width;
|
||||
Bitmap.Height := WorkData.Height;
|
||||
Bitmap.PixelFormat := PF;
|
||||
|
||||
if (PF = pf8bit) and (WorkData.Palette <> nil) then
|
||||
begin
|
||||
// Copy palette
|
||||
ColorTable := Bitmap.ColorTable;
|
||||
for I := 0 to Info.PaletteEntries - 1 do
|
||||
with ColorTable[I] do
|
||||
begin
|
||||
R := WorkData.Palette[I].R;
|
||||
G := WorkData.Palette[I].G;
|
||||
B := WorkData.Palette[I].B;
|
||||
end;
|
||||
end;
|
||||
// Copy scanlines
|
||||
for I := 0 to WorkData.Height - 1 do
|
||||
Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes);
|
||||
// Delphi 2009 and newer support alpha transparency fro TBitmap
|
||||
{$IF Defined(DELPHI) and (CompilerVersion >= 20.0)}
|
||||
if Bitmap.PixelFormat = pf32bit then
|
||||
Bitmap.AlphaFormat := afDefined;
|
||||
{$IFEND}
|
||||
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
// Create 32bit raw image from image data
|
||||
|
@ -594,9 +577,9 @@ begin
|
|||
begin
|
||||
Width := WorkData.Width;
|
||||
Height := WorkData.Height;
|
||||
BitsPerPixel := Info.BytesPerPixel * 8;
|
||||
BitsPerPixel := 32;
|
||||
Format := ricfRGBA;
|
||||
LineEnd := rileByteBoundary;
|
||||
LineEnd := rileDWordBoundary;
|
||||
BitOrder := riboBitsInOrder;
|
||||
ByteOrder := riboLSBFirst;
|
||||
LineOrder := riloTopToBottom;
|
||||
|
@ -608,14 +591,13 @@ begin
|
|||
RedShift := 16;
|
||||
GreenShift := 8;
|
||||
BlueShift := 0;
|
||||
Depth := 24;
|
||||
Depth := 32; // Must be 32 for alpha blending (and for working in MacOSX Carbon)
|
||||
end;
|
||||
RawImage.Data := WorkData.Bits;
|
||||
RawImage.DataSize := WorkData.Size;
|
||||
|
||||
// Create bitmap from raw image
|
||||
{ If you get complitation error here upgrade to Lazarus 0.9.24+ }
|
||||
if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle, False) then
|
||||
if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle) then
|
||||
begin
|
||||
Bitmap.Handle := ImgHandle;
|
||||
Bitmap.MaskHandle := ImgMaskHandle;
|
||||
|
@ -634,9 +616,6 @@ var
|
|||
Colors: Word;
|
||||
LogPalette: TMaxLogPalette;
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
ColorTable: PPalette32;
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
RawImage: TRawImage;
|
||||
LineLazBytes: LongInt;
|
||||
|
@ -650,7 +629,6 @@ begin
|
|||
// trough RawImage api and cannot be changed to mirror some Imaging format
|
||||
// (so formats with no coresponding Imaging format cannot be saved now).
|
||||
|
||||
{ If you get complitation error here upgrade to Lazarus 0.9.24+ }
|
||||
if RawImage_DescriptionFromBitmap(Bitmap.Handle, RawImage.Description) then
|
||||
case RawImage.Description.BitsPerPixel of
|
||||
8: Format := ifIndex8;
|
||||
|
@ -707,28 +685,9 @@ begin
|
|||
for I := 0 to Data.Height - 1 do
|
||||
Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
if Format = ifIndex8 then
|
||||
begin
|
||||
// Copy palette
|
||||
ColorTable := Bitmap.ColorTable;
|
||||
for I := 0 to Info.PaletteEntries - 1 do
|
||||
with ColorTable[I] do
|
||||
begin
|
||||
Data.Palette[I].A := $FF;
|
||||
Data.Palette[I].R := R;
|
||||
Data.Palette[I].G := G;
|
||||
Data.Palette[I].B := B;
|
||||
end;
|
||||
end;
|
||||
// Copy scanlines
|
||||
for I := 0 to Data.Height - 1 do
|
||||
Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes);
|
||||
{$ENDIF}
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
// Get raw image from bitmap (mask handle must be 0 or expect violations)
|
||||
if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then // uncommnet for Laz 0.9.25 if you get error here
|
||||
//if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, Classes.Rect(0, 0, Data.Width, Data.Height)) then
|
||||
if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then
|
||||
begin
|
||||
LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel,
|
||||
RawImage.Description.LineEnd);
|
||||
|
@ -757,6 +716,7 @@ procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: T
|
|||
var
|
||||
OldMode: Integer;
|
||||
BitmapInfo: Windows.TBitmapInfo;
|
||||
Bmp: TBitmap;
|
||||
begin
|
||||
if TestImage(ImageData) then
|
||||
begin
|
||||
|
@ -780,10 +740,22 @@ begin
|
|||
end;
|
||||
|
||||
try
|
||||
with SrcRect, ImageData do
|
||||
Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top,
|
||||
with SrcRect, ImageData do
|
||||
if Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top,
|
||||
DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, Left,
|
||||
Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY);
|
||||
Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY) <> Height then
|
||||
begin
|
||||
// StretchDIBits may fail on some ocassions (error 487, http://support.microsoft.com/kb/269585).
|
||||
// This fallback is slow but works every time. Thanks to Sergey Galezdinov for the fix.
|
||||
Bmp := TBitmap.Create;
|
||||
try
|
||||
ConvertDataToBitmap(ImageData, Bmp);
|
||||
StretchBlt(DC, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top,
|
||||
Bmp.Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
|
||||
finally
|
||||
Bmp.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Windows.SetStretchBltMode(DC, OldMode);
|
||||
end;
|
||||
|
@ -792,50 +764,21 @@ end;
|
|||
{$ENDIF}
|
||||
|
||||
procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect);
|
||||
{$IF Defined(MSWINDOWS) and not Defined(COMPONENT_SET_CLX)}
|
||||
{$IF Defined(DCC) or Defined(LCLWIN32)} // Delphi or LCL Win32
|
||||
begin
|
||||
DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect);
|
||||
end;
|
||||
{$ELSEIF Defined(COMPONENT_SET_CLX)}
|
||||
var
|
||||
Bitmap: TBitmap;
|
||||
//Handle: LongWord;
|
||||
begin
|
||||
(*
|
||||
// It would be nice if this worked:
|
||||
DstCanvas.Start;
|
||||
Handle := QPainter_handle(DstCanvas.Handle);
|
||||
{$IFDEF MSWINDOWS}
|
||||
DisplayImageDataOnDC(Handle, DstRect, ImageData, SrcRect);
|
||||
{$ELSE}
|
||||
DisplayImageDataOnX(Handle, DstRect, ImageData, SrcRect);
|
||||
{$ENDIF}
|
||||
DstCanvas.Stop;
|
||||
*)
|
||||
Bitmap := TBitmap.Create;
|
||||
try
|
||||
ConvertDataToBitmap(ImageData, Bitmap);
|
||||
DstCanvas.CopyRect(DstRect, Bitmap.Canvas, SrcRect);
|
||||
finally
|
||||
Bitmap.Free;
|
||||
end;
|
||||
end;
|
||||
{$ELSEIF Defined(UNIX) and Defined(COMPONENT_SET_LCL)}
|
||||
{$ELSEIF Defined(LCLGTK) or Defined(LCLGTK2)}
|
||||
|
||||
procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY,
|
||||
SrcWidth, SrcHeight: Integer; ImageData: TImageData);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
// If you get compilation errors here with new Lazarus (rev 14368+)
|
||||
// uncomment commented code and comment the active code below:
|
||||
|
||||
P := TGtkDeviceContext(Dest).Offset;
|
||||
//P := GetDCOffset(TDeviceContext(Dest));
|
||||
Inc(DstX, P.X);
|
||||
Inc(DstY, P.Y);
|
||||
gdk_draw_rgb_32_image(TGtkDeviceContext(Dest).Drawable, TGtkDeviceContext(Dest).GC,
|
||||
//gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC,
|
||||
DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE,
|
||||
@PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4);
|
||||
end;
|
||||
|
@ -890,6 +833,10 @@ begin
|
|||
end;
|
||||
end;
|
||||
end;
|
||||
{$ELSE}
|
||||
begin
|
||||
raise Exception.Create(SUnsupportedLCLWidgetSet);
|
||||
end;
|
||||
{$IFEND}
|
||||
|
||||
procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage);
|
||||
|
@ -911,6 +858,12 @@ end;
|
|||
|
||||
{ TImagingGraphic class implementation }
|
||||
|
||||
constructor TImagingGraphic.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
PixelFormat := pf24Bit;
|
||||
end;
|
||||
|
||||
procedure TImagingGraphic.LoadFromStream(Stream: TStream);
|
||||
begin
|
||||
ReadDataFromStream(Stream);
|
||||
|
@ -1020,14 +973,13 @@ begin
|
|||
Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
function TImagingGraphicForSave.GetMimeType: string; // uncomment for Laz 0.9.25 if you get error here
|
||||
//function TImagingGraphicForSave.GetDefaultMimeType: string;
|
||||
function TImagingGraphicForSave.GetMimeType: string;
|
||||
begin
|
||||
Result := 'image/' + FDefaultFileExt;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_BITMAP}
|
||||
{$IFNDEF DONT_LINK_BITMAP}
|
||||
|
||||
{ TImagingBitmap class implementation }
|
||||
|
||||
|
@ -1051,7 +1003,7 @@ begin
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_JPEG}
|
||||
{$IFNDEF DONT_LINK_JPEG}
|
||||
|
||||
{ TImagingJpeg class implementation }
|
||||
|
||||
|
@ -1068,8 +1020,7 @@ begin
|
|||
end;
|
||||
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
//function TImagingJpeg.GetMimeType: string; // uncomment for Laz 0.9.25 if you get error here
|
||||
function TImagingJpeg.GetDefaultMimeType: string;
|
||||
function TImagingJpeg.GetMimeType: string;
|
||||
begin
|
||||
Result := 'image/jpeg';
|
||||
end;
|
||||
|
@ -1086,7 +1037,7 @@ end;
|
|||
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_PNG}
|
||||
{$IFNDEF DONT_LINK_PNG}
|
||||
|
||||
{ TImagingPNG class implementation }
|
||||
|
||||
|
@ -1112,7 +1063,7 @@ begin
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_GIF}
|
||||
{$IFNDEF DONT_LINK_GIF}
|
||||
|
||||
{ TImagingGIF class implementation}
|
||||
|
||||
|
@ -1123,7 +1074,7 @@ end;
|
|||
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_TARGA}
|
||||
{$IFNDEF DONT_LINK_TARGA}
|
||||
|
||||
{ TImagingTarga class implementation }
|
||||
|
||||
|
@ -1147,7 +1098,7 @@ begin
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_DDS}
|
||||
{$IFNDEF DONT_LINK_DDS}
|
||||
|
||||
{ TImagingDDS class implementation }
|
||||
|
||||
|
@ -1180,7 +1131,7 @@ begin
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_MNG}
|
||||
{$IFNDEF DONT_LINK_MNG}
|
||||
|
||||
{ TImagingMNG class implementation }
|
||||
|
||||
|
@ -1201,8 +1152,7 @@ begin
|
|||
end;
|
||||
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
//function TImagingMNG.GetMimeType: string; // uncomment for Laz 0.9.25 if you get error here
|
||||
function TImagingMNG.GetDefaultMimeType: string;
|
||||
function TImagingMNG.GetMimeType: string;
|
||||
begin
|
||||
Result := 'video/mng';
|
||||
end;
|
||||
|
@ -1222,7 +1172,7 @@ begin
|
|||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_JNG}
|
||||
{$IFNDEF DONT_LINK_JNG}
|
||||
|
||||
{ TImagingJNG class implementation }
|
||||
|
||||
|
@ -1259,12 +1209,30 @@ initialization
|
|||
finalization
|
||||
UnRegisterTypes;
|
||||
|
||||
{$IFEND} // {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)}
|
||||
|
||||
{
|
||||
File Notes:
|
||||
|
||||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Setting AlphaFormat property of TBitmap in ConvertDataToBitmap
|
||||
when using Delphi 2009+.
|
||||
- Fixed garbled LCL TBitmaps created by ConvertDataToBitmap
|
||||
in Mac OS X (Carbon).
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- Added some more IFDEFs for Lazarus widget sets.
|
||||
- Removed CLX code.
|
||||
- GTK version of Unix DisplayImageData only used with LCL GTK so the
|
||||
the rest of the unit can be used with Qt or other LCL interfaces.
|
||||
- Fallback mechanism for DisplayImageDataOnDC, it may fail on occasions.
|
||||
- Changed file format conditional compilation to reflect changes
|
||||
in LINK symbols.
|
||||
- Lazarus 0.9.26 compatibility changes.
|
||||
|
||||
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus
|
||||
with GTK2 target.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingExport.pas 71 2007-03-08 00:10:10Z galfar $
|
||||
$Id: ImagingExport.pas 173 2009-09-04 17:05:52Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -52,14 +52,14 @@ function ImTestImage(var Image: TImageData): Boolean; cdecl;
|
|||
function ImFreeImage(var Image: TImageData): Boolean; cdecl;
|
||||
{ Look at DetermineFileFormat for details. Ext should have enough space for
|
||||
result file extension.}
|
||||
function ImDetermineFileFormat(FileName, Ext: PChar): Boolean; cdecl;
|
||||
function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl;
|
||||
{ Look at DetermineMemoryFormat for details. Ext should have enough space for
|
||||
result file extension.}
|
||||
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean; cdecl;
|
||||
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl;
|
||||
{ Look at IsFileFormatSupported for details.}
|
||||
function ImIsFileFormatSupported(FileName: PChar): Boolean; cdecl;
|
||||
function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl;
|
||||
{ Look at EnumFileFormats for details.}
|
||||
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
|
||||
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
|
||||
var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl;
|
||||
|
||||
{ Inits image list.}
|
||||
|
@ -82,24 +82,24 @@ function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl;
|
|||
function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl;
|
||||
|
||||
{ Look at LoadImageFromFile for details.}
|
||||
function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean; cdecl;
|
||||
function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl;
|
||||
{ Look at LoadImageFromMemory for details.}
|
||||
function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl;
|
||||
{ Look at LoadMultiImageFromFile for details.}
|
||||
function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList): Boolean; cdecl;
|
||||
function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl;
|
||||
{ Look at LoadMultiImageFromMemory for details.}
|
||||
function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
|
||||
var ImageList: TImageDataList): Boolean; cdecl;
|
||||
|
||||
{ Look at SaveImageToFile for details.}
|
||||
function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean; cdecl;
|
||||
function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl;
|
||||
{ Look at SaveImageToMemory for details.}
|
||||
function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
|
||||
function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
|
||||
const Image: TImageData): Boolean; cdecl;
|
||||
{ Look at SaveMultiImageToFile for details.}
|
||||
function ImSaveMultiImageToFile(FileName: PChar; ImageList: TImageDataList): Boolean; cdecl;
|
||||
function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl;
|
||||
{ Look at SaveMultiImageToMemory for details.}
|
||||
function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
|
||||
function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
|
||||
ImageList: TImageDataList): Boolean; cdecl;
|
||||
|
||||
{ Look at CloneImage for details.}
|
||||
|
@ -131,7 +131,7 @@ function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
|
|||
function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
|
||||
MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl;
|
||||
{ Look at RotateImage for details.}
|
||||
function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean; cdecl;
|
||||
function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl;
|
||||
|
||||
{ Look at CopyRect for details.}
|
||||
function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
|
||||
|
@ -262,33 +262,33 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImDetermineFileFormat(FileName, Ext: PChar): Boolean;
|
||||
function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean;
|
||||
var
|
||||
S: string;
|
||||
begin
|
||||
try
|
||||
S := Imaging.DetermineFileFormat(FileName);
|
||||
Result := S <> '';
|
||||
StrCopy(Ext, PChar(S));
|
||||
StrCopy(Ext, PAnsiChar(AnsiString(S)));
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PChar): Boolean;
|
||||
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean;
|
||||
var
|
||||
S: string;
|
||||
begin
|
||||
try
|
||||
S := Imaging.DetermineMemoryFormat(Data, Size);
|
||||
Result := S <> '';
|
||||
StrCopy(Ext, PChar(S));
|
||||
StrCopy(Ext, PAnsiChar(AnsiString(S)));
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ImIsFileFormatSupported(FileName: PChar): Boolean;
|
||||
function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean;
|
||||
begin
|
||||
try
|
||||
Result := Imaging.IsFileFormatSupported(FileName);
|
||||
|
@ -297,7 +297,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PChar;
|
||||
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
|
||||
var CanSave, IsMultiImageFormat: Boolean): Boolean;
|
||||
var
|
||||
StrName, StrDefaultExt, StrMasks: string;
|
||||
|
@ -305,9 +305,9 @@ begin
|
|||
try
|
||||
Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave,
|
||||
IsMultiImageFormat);
|
||||
StrCopy(Name, PChar(StrName));
|
||||
StrCopy(DefaultExt, PChar(StrDefaultExt));
|
||||
StrCopy(Masks, PChar(StrMasks));
|
||||
StrCopy(Name, PAnsiChar(AnsiString(StrName)));
|
||||
StrCopy(DefaultExt, PAnsiChar(AnsiString(StrDefaultExt)));
|
||||
StrCopy(Masks, PAnsiChar(AnsiString(StrMasks)));
|
||||
except
|
||||
Result := False;
|
||||
end;
|
||||
|
@ -419,7 +419,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImLoadImageFromFile(FileName: PChar; var Image: TImageData): Boolean;
|
||||
function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean;
|
||||
begin
|
||||
try
|
||||
Result := Imaging.LoadImageFromFile(FileName, Image);
|
||||
|
@ -437,7 +437,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImLoadMultiImageFromFile(FileName: PChar; var ImageList: TImageDataList):
|
||||
function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList):
|
||||
Boolean;
|
||||
begin
|
||||
try
|
||||
|
@ -460,7 +460,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImSaveImageToFile(FileName: PChar; const Image: TImageData): Boolean;
|
||||
function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean;
|
||||
begin
|
||||
try
|
||||
Result := Imaging.SaveImageToFile(FileName, Image);
|
||||
|
@ -469,7 +469,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImSaveImageToMemory(Ext: PChar; Data: Pointer; var Size: LongInt;
|
||||
function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
|
||||
const Image: TImageData): Boolean;
|
||||
begin
|
||||
try
|
||||
|
@ -479,7 +479,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImSaveMultiImageToFile(FileName: PChar;
|
||||
function ImSaveMultiImageToFile(FileName: PAnsiChar;
|
||||
ImageList: TImageDataList): Boolean;
|
||||
begin
|
||||
try
|
||||
|
@ -490,7 +490,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImSaveMultiImageToMemory(Ext: PChar; Data: Pointer; Size: PLongInt;
|
||||
function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
|
||||
ImageList: TImageDataList): Boolean;
|
||||
begin
|
||||
try
|
||||
|
@ -612,7 +612,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ImRotateImage(var Image: TImageData; Angle: LongInt): Boolean;
|
||||
function ImRotateImage(var Image: TImageData; Angle: Single): Boolean;
|
||||
begin
|
||||
try
|
||||
Result := Imaging.RotateImage(Image, Angle);
|
||||
|
@ -864,6 +864,10 @@ end;
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 ---------------------------------------------------
|
||||
- changed PChars to PAnsiChars and some more D2009 friendly
|
||||
casts.
|
||||
|
||||
-- 0.19 -----------------------------------------------------
|
||||
- updated to reflect changes in low level interface (added pixel set/get, ...)
|
||||
- changed ImInitImage to procedure to reflect change in Imaging.pas
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingFormats.pas 129 2008-08-06 20:01:30Z galfar $
|
||||
$Id: ImagingFormats.pas 176 2009-10-12 10:53:17Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -388,6 +388,7 @@ var
|
|||
BytesPerPixel: 1;
|
||||
ChannelCount: 1;
|
||||
PaletteEntries: 256;
|
||||
HasAlphaChannel: True;
|
||||
IsIndexed: True;
|
||||
GetPixelsSize: GetStdPixelsSize;
|
||||
CheckDimensions: CheckStdDimensions;
|
||||
|
@ -1617,8 +1618,7 @@ begin
|
|||
Result[0][0].Pos := (SrcLow + SrcHigh) div 2;
|
||||
Result[0][0].Weight := 1.0;
|
||||
end
|
||||
else
|
||||
if Scale < 1.0 then
|
||||
else if Scale < 1.0 then
|
||||
begin
|
||||
// Sub-sampling - scales from bigger to smaller
|
||||
Radius := Radius / Scale;
|
||||
|
@ -1649,8 +1649,7 @@ begin
|
|||
Result[I][0].Pos := Floor(Center);
|
||||
Result[I][0].Weight := 1.0;
|
||||
end
|
||||
else
|
||||
if Count <> 0.0 then
|
||||
else if Count <> 0.0 then
|
||||
Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count;
|
||||
end;
|
||||
end
|
||||
|
@ -1680,8 +1679,7 @@ begin
|
|||
begin
|
||||
if J < 0 then
|
||||
N := SrcImageWidth + J
|
||||
else
|
||||
if J >= SrcImageWidth then
|
||||
else if J >= SrcImageWidth then
|
||||
N := J - SrcImageWidth
|
||||
else
|
||||
N := ClampInt(J, SrcLow, SrcHigh - 1);
|
||||
|
@ -1723,13 +1721,19 @@ procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
|
|||
DstHeight: LongInt; Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean);
|
||||
const
|
||||
Channel8BitMax: Single = 255.0;
|
||||
type
|
||||
TBufferItem = record
|
||||
A, R, G, B: Integer;
|
||||
end;
|
||||
var
|
||||
MapX, MapY: TMappingTable;
|
||||
I, J, X, Y: LongInt;
|
||||
XMinimum, XMaximum: LongInt;
|
||||
LineBuffer: array of TColorFPRec;
|
||||
LineBufferFP: array of TColorFPRec;
|
||||
LineBufferInt: array of TBufferItem;
|
||||
ClusterX, ClusterY: TCluster;
|
||||
Weight, AccumA, AccumR, AccumG, AccumB: Single;
|
||||
IWeight, IAccumA, IAccumR, IAccumG, IAccumB: Integer;
|
||||
DstLine: PByte;
|
||||
SrcColor: TColor32Rec;
|
||||
SrcFloat: TColorFPRec;
|
||||
|
@ -1759,10 +1763,10 @@ begin
|
|||
try
|
||||
// Find min and max X coords of pixels that will contribute to target image
|
||||
FindExtremes(MapX, XMinimum, XMaximum);
|
||||
SetLength(LineBuffer, XMaximum - XMinimum + 1);
|
||||
|
||||
if not UseOptimizedVersion then
|
||||
begin
|
||||
SetLength(LineBufferFP, XMaximum - XMinimum + 1);
|
||||
// Following code works for the rest of data formats
|
||||
for J := 0 to DstHeight - 1 do
|
||||
begin
|
||||
|
@ -1773,10 +1777,10 @@ begin
|
|||
for X := XMinimum to XMaximum do
|
||||
begin
|
||||
// Clear accumulators
|
||||
AccumA := 0.0;
|
||||
AccumR := 0.0;
|
||||
AccumG := 0.0;
|
||||
AccumB := 0.0;
|
||||
AccumA := 0;
|
||||
AccumR := 0;
|
||||
AccumG := 0;
|
||||
AccumB := 0;
|
||||
// For each pixel in line compute weighted sum of pixels
|
||||
// in source column that will contribute to this pixel
|
||||
for Y := 0 to Length(ClusterY) - 1 do
|
||||
|
@ -1790,7 +1794,7 @@ begin
|
|||
AccumA := AccumA + SrcFloat.A * Weight;
|
||||
end;
|
||||
// Store accumulated value for this pixel in buffer
|
||||
with LineBuffer[X - XMinimum] do
|
||||
with LineBufferFP[X - XMinimum] do
|
||||
begin
|
||||
A := AccumA;
|
||||
R := AccumR;
|
||||
|
@ -1806,17 +1810,17 @@ begin
|
|||
begin
|
||||
ClusterX := MapX[I];
|
||||
// Clear accumulator
|
||||
AccumA := 0.0;
|
||||
AccumR := 0.0;
|
||||
AccumG := 0.0;
|
||||
AccumB := 0.0;
|
||||
AccumA := 0;
|
||||
AccumR := 0;
|
||||
AccumG := 0;
|
||||
AccumB := 0;
|
||||
// Compute weighted sum of values (which are already
|
||||
// computed weighted sums of pixels in source columns stored in LineBuffer)
|
||||
// that will contribute to the current target pixel
|
||||
for X := 0 to Length(ClusterX) - 1 do
|
||||
begin
|
||||
Weight := ClusterX[X].Weight;
|
||||
with LineBuffer[ClusterX[X].Pos - XMinimum] do
|
||||
with LineBufferFP[ClusterX[X].Pos - XMinimum] do
|
||||
begin
|
||||
AccumB := AccumB + B * Weight;
|
||||
AccumG := AccumG + G * Weight;
|
||||
|
@ -1838,37 +1842,35 @@ begin
|
|||
end
|
||||
else
|
||||
begin
|
||||
SetLength(LineBufferInt, XMaximum - XMinimum + 1);
|
||||
// Following code is optimized for images with 8 bit channels
|
||||
for J := 0 to DstHeight - 1 do
|
||||
begin
|
||||
ClusterY := MapY[J];
|
||||
for X := XMinimum to XMaximum do
|
||||
begin
|
||||
AccumA := 0.0;
|
||||
AccumR := 0.0;
|
||||
AccumG := 0.0;
|
||||
AccumB := 0.0;
|
||||
IAccumA := 0;
|
||||
IAccumR := 0;
|
||||
IAccumG := 0;
|
||||
IAccumB := 0;
|
||||
for Y := 0 to Length(ClusterY) - 1 do
|
||||
begin
|
||||
Weight := ClusterY[Y].Weight;
|
||||
IWeight := Round(256 * ClusterY[Y].Weight);
|
||||
CopyPixel(
|
||||
@PByteArray(SrcImage.Bits)[(ClusterY[Y].Pos * SrcImage.Width + X) * Info.BytesPerPixel],
|
||||
@SrcColor, Info.BytesPerPixel);
|
||||
|
||||
AccumB := AccumB + SrcColor.B * Weight;
|
||||
if Info.ChannelCount > 1 then
|
||||
AccumG := AccumG + SrcColor.G * Weight;
|
||||
if Info.ChannelCount > 2 then
|
||||
AccumR := AccumR + SrcColor.R * Weight;
|
||||
if Info.ChannelCount > 3 then
|
||||
AccumA := AccumA + SrcColor.A * Weight;
|
||||
IAccumB := IAccumB + SrcColor.B * IWeight;
|
||||
IAccumG := IAccumG + SrcColor.G * IWeight;
|
||||
IAccumR := IAccumR + SrcColor.R * IWeight;
|
||||
IAccumA := IAccumA + SrcColor.A * IWeight;
|
||||
end;
|
||||
with LineBuffer[X - XMinimum] do
|
||||
with LineBufferInt[X - XMinimum] do
|
||||
begin
|
||||
A := AccumA;
|
||||
R := AccumR;
|
||||
G := AccumG;
|
||||
B := AccumB;
|
||||
A := IAccumA;
|
||||
R := IAccumR;
|
||||
G := IAccumG;
|
||||
B := IAccumB;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -1877,31 +1879,26 @@ begin
|
|||
for I := 0 to DstWidth - 1 do
|
||||
begin
|
||||
ClusterX := MapX[I];
|
||||
AccumA := 0.0;
|
||||
AccumR := 0.0;
|
||||
AccumG := 0.0;
|
||||
AccumB := 0.0;
|
||||
IAccumA := 0;
|
||||
IAccumR := 0;
|
||||
IAccumG := 0;
|
||||
IAccumB := 0;
|
||||
for X := 0 to Length(ClusterX) - 1 do
|
||||
begin
|
||||
Weight := ClusterX[X].Weight;
|
||||
with LineBuffer[ClusterX[X].Pos - XMinimum] do
|
||||
IWeight := Round(256 * ClusterX[X].Weight);
|
||||
with LineBufferInt[ClusterX[X].Pos - XMinimum] do
|
||||
begin
|
||||
AccumB := AccumB + B * Weight;
|
||||
if Info.ChannelCount > 1 then
|
||||
AccumG := AccumG + G * Weight;
|
||||
if Info.ChannelCount > 2 then
|
||||
AccumR := AccumR + R * Weight;
|
||||
if Info.ChannelCount > 3 then
|
||||
AccumA := AccumA + A * Weight;
|
||||
IAccumB := IAccumB + B * IWeight;
|
||||
IAccumG := IAccumG + G * IWeight;
|
||||
IAccumR := IAccumR + R * IWeight;
|
||||
IAccumA := IAccumA + A * IWeight;
|
||||
end;
|
||||
end;
|
||||
SrcColor.B := ClampToByte(Round(AccumB));
|
||||
if Info.ChannelCount > 1 then
|
||||
SrcColor.G := ClampToByte(Round(AccumG));
|
||||
if Info.ChannelCount > 2 then
|
||||
SrcColor.R := ClampToByte(Round(AccumR));
|
||||
if Info.ChannelCount > 3 then
|
||||
SrcColor.A := ClampToByte(Round(AccumA));
|
||||
|
||||
SrcColor.B := ClampInt(IAccumB, 0, $00FF0000) shr 16;
|
||||
SrcColor.G := ClampInt(IAccumG, 0, $00FF0000) shr 16;
|
||||
SrcColor.R := ClampInt(IAccumR, 0, $00FF0000) shr 16;
|
||||
SrcColor.A := ClampInt(IAccumA, 0, $00FF0000) shr 16;
|
||||
|
||||
CopyPixel(@SrcColor, DstLine, Info.BytesPerPixel);
|
||||
Inc(DstLine, Info.BytesPerPixel);
|
||||
|
@ -3234,11 +3231,11 @@ type
|
|||
|
||||
TPixelBlock = array[0..15] of TPixelInfo;
|
||||
|
||||
function DecodeCol(Color : Word): TColor32Rec;
|
||||
function DecodeCol(Color: Word): TColor32Rec;
|
||||
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
||||
begin
|
||||
Result.A := $FF;
|
||||
{Result.R := ((Color and $F800) shr 11) shl 3;
|
||||
{ Result.R := ((Color and $F800) shr 11) shl 3;
|
||||
Result.G := ((Color and $07E0) shr 5) shl 2;
|
||||
Result.B := (Color and $001F) shl 3;}
|
||||
// this color expansion is slower but gives better results
|
||||
|
@ -3663,7 +3660,7 @@ begin
|
|||
GetBlock(Pixels, SrcBits, X, Y, Width, Height);
|
||||
for I := 0 to 7 do
|
||||
PByteArray(@AlphaBlock.Alphas)[I] :=
|
||||
((Pixels[I shl 1].Alpha shr 4) shl 4) or (Pixels[I shl 1 + 1].Alpha shr 4);
|
||||
(Pixels[I shl 1].Alpha shr 4) or ((Pixels[I shl 1 + 1].Alpha shr 4) shl 4);
|
||||
GetEndpoints(Pixels, Block.Color0, Block.Color1);
|
||||
FixEndpoints(Block.Color0, Block.Color1, False);
|
||||
Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels);
|
||||
|
@ -4222,7 +4219,11 @@ initialization
|
|||
|
||||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
- rewrite StretchRect for 8bit channels to use integer math?
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes -----------------------------------
|
||||
- Filtered resampling ~10% faster now.
|
||||
- Fixed DXT3 alpha encoding.
|
||||
- ifIndex8 format now has HasAlphaChannel=True.
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes -----------------------------------
|
||||
- Made some resampling stuff public so that it can be used in canvas class.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingGif.pas 132 2008-08-27 20:37:38Z galfar $
|
||||
$Id: ImagingGif.pas 157 2009-02-15 14:24:58Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -44,9 +44,11 @@ type
|
|||
its own color palette. GIF uses lossless LZW compression
|
||||
(patent expired few years ago).
|
||||
Imaging can load and save all GIFs with all frames and supports
|
||||
transparency.}
|
||||
transparency. Imaging can load just raw ifIndex8 frames or
|
||||
also animate them in ifA8R8G8B8 format. See ImagingGIFLoadAnimated option.}
|
||||
TGIFFileFormat = class(TImageFileFormat)
|
||||
private
|
||||
FLoadAnimated: LongBool;
|
||||
function InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
|
||||
procedure LZWDecompress(Stream: TStream; Handle: TImagingHandle;
|
||||
Width, Height: Integer; Interlaced: Boolean; Data: Pointer);
|
||||
|
@ -62,6 +64,8 @@ type
|
|||
public
|
||||
constructor Create; override;
|
||||
function TestFormat(Handle: TImagingHandle): Boolean; override;
|
||||
published
|
||||
property LoadAnimated: LongBool read FLoadAnimated write FLoadAnimated;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
@ -70,10 +74,11 @@ const
|
|||
SGIFFormatName = 'Graphics Interchange Format';
|
||||
SGIFMasks = '*.gif';
|
||||
GIFSupportedFormats: TImageFormats = [ifIndex8];
|
||||
GIFDefaultLoadAnimated = True;
|
||||
|
||||
type
|
||||
TGIFVersion = (gv87, gv89);
|
||||
TDisposalMethod = (dmUndefined, dmLeave, dmRestoreBackground,
|
||||
TDisposalMethod = (dmNoRemoval, dmLeave, dmRestoreBackground,
|
||||
dmRestorePrevious, dmReserved4, dmReserved5, dmReserved6, dmReserved7);
|
||||
|
||||
const
|
||||
|
@ -144,6 +149,19 @@ type
|
|||
Terminator: Byte;
|
||||
end;
|
||||
|
||||
const
|
||||
// Netscape sub block types
|
||||
GIFAppLoopExtension = 1;
|
||||
GIFAppBufferExtension = 2;
|
||||
|
||||
type
|
||||
TGIFIdentifierCode = array[0..7] of AnsiChar;
|
||||
TGIFAuthenticationCode = array[0..2] of AnsiChar;
|
||||
TGIFApplicationRec = packed record
|
||||
Identifier: TGIFIdentifierCode;
|
||||
Authentication: TGIFAuthenticationCode;
|
||||
end;
|
||||
|
||||
const
|
||||
CodeTableSize = 4096;
|
||||
HashTableSize = 17777;
|
||||
|
@ -206,8 +224,10 @@ begin
|
|||
FCanSave := True;
|
||||
FIsMultiImageFormat := True;
|
||||
FSupportedFormats := GIFSupportedFormats;
|
||||
FLoadAnimated := GIFDefaultLoadAnimated;
|
||||
|
||||
AddMasks(SGIFMasks);
|
||||
RegisterOption(ImagingGIFLoadAnimated, @FLoadAnimated);
|
||||
end;
|
||||
|
||||
function TGIFFileFormat.InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer;
|
||||
|
@ -644,28 +664,56 @@ end;
|
|||
|
||||
function TGIFFileFormat.LoadData(Handle: TImagingHandle;
|
||||
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
|
||||
type
|
||||
TFrameInfo = record
|
||||
Left, Top: Integer;
|
||||
Width, Height: Integer;
|
||||
Disposal: TDisposalMethod;
|
||||
HasTransparency: Boolean;
|
||||
HasLocalPal: Boolean;
|
||||
TransIndex: Integer;
|
||||
BackIndex: Integer;
|
||||
end;
|
||||
var
|
||||
Header: TGIFHeader;
|
||||
HasGlobalPal: Boolean;
|
||||
GlobalPalLength: Integer;
|
||||
GlobalPal: TPalette32Size256;
|
||||
I: Integer;
|
||||
ScreenWidth, ScreenHeight, I, CachedIndex: Integer;
|
||||
BlockID: Byte;
|
||||
HasGraphicExt: Boolean;
|
||||
GraphicExt: TGraphicControlExtension;
|
||||
Disposals: array of TDisposalMethod;
|
||||
FrameInfos: array of TFrameInfo;
|
||||
AppRead: Boolean;
|
||||
CachedFrame: TImageData;
|
||||
AnimFrames: TDynImageDataArray;
|
||||
|
||||
function ReadBlockID: Byte;
|
||||
begin
|
||||
Result := GIFTrailer;
|
||||
GetIO.Read(Handle, @Result, SizeOf(Result));
|
||||
if GetIO.Read(Handle, @Result, SizeOf(Result)) < SizeOf(Result) then
|
||||
Result := GIFTrailer;
|
||||
end;
|
||||
|
||||
procedure ReadExtensions;
|
||||
var
|
||||
BlockSize, ExtType: Byte;
|
||||
BlockSize, BlockType, ExtType: Byte;
|
||||
AppRec: TGIFApplicationRec;
|
||||
LoopCount: SmallInt;
|
||||
|
||||
procedure SkipBytes;
|
||||
begin
|
||||
with GetIO do
|
||||
repeat
|
||||
// Read block sizes and skip them
|
||||
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||
Seek(Handle, BlockSize, smFromCurrent);
|
||||
until BlockSize = 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
HasGraphicExt := False;
|
||||
AppRead := False;
|
||||
|
||||
// Read extensions until image descriptor is found. Only graphic extension
|
||||
// is stored now (for transparency), others are skipped.
|
||||
|
@ -674,47 +722,69 @@ var
|
|||
begin
|
||||
Read(Handle, @ExtType, SizeOf(ExtType));
|
||||
|
||||
if ExtType = GIFGraphicControlExtension then
|
||||
while ExtType in [GIFGraphicControlExtension, GIFCommentExtension, GIFApplicationExtension, GIFPlainText] do
|
||||
begin
|
||||
HasGraphicExt := True;
|
||||
Read(Handle, @GraphicExt, SizeOf(GraphicExt));
|
||||
if ExtType = GIFGraphicControlExtension then
|
||||
begin
|
||||
HasGraphicExt := True;
|
||||
Read(Handle, @GraphicExt, SizeOf(GraphicExt));
|
||||
end
|
||||
else if (ExtType = GIFApplicationExtension) and not AppRead then
|
||||
begin
|
||||
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||
if BlockSize >= SizeOf(AppRec) then
|
||||
begin
|
||||
Read(Handle, @AppRec, SizeOf(AppRec));
|
||||
if (AppRec.Identifier = 'NETSCAPE') and (AppRec.Authentication = '2.0') then
|
||||
begin
|
||||
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||
while BlockSize <> 0 do
|
||||
begin
|
||||
BlockType := ReadBlockID;
|
||||
Dec(BlockSize);
|
||||
|
||||
case BlockType of
|
||||
GIFAppLoopExtension:
|
||||
if (BlockSize >= SizeOf(LoopCount)) then
|
||||
begin
|
||||
// Read loop count
|
||||
Read(Handle, @LoopCount, SizeOf(LoopCount));
|
||||
Dec(BlockSize, SizeOf(LoopCount));
|
||||
end;
|
||||
GIFAppBufferExtension:
|
||||
begin
|
||||
Dec(BlockSize, SizeOf(Word));
|
||||
Seek(Handle, SizeOf(Word), smFromCurrent);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SkipBytes;
|
||||
AppRead := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Revert all bytes reading
|
||||
Seek(Handle, - SizeOf(AppRec) - SizeOf(BlockSize), smFromCurrent);
|
||||
SkipBytes;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Seek(Handle, - BlockSize - SizeOf(BlockSize), smFromCurrent);
|
||||
SkipBytes;
|
||||
end;
|
||||
end
|
||||
else if ExtType in [GIFCommentExtension, GIFApplicationExtension, GIFPlainText] then
|
||||
repeat
|
||||
// Read block sizes and skip them
|
||||
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||
Seek(Handle, BlockSize, smFromCurrent);
|
||||
until BlockSize = 0;
|
||||
|
||||
// Read ID of following block
|
||||
BlockID := ReadBlockID;
|
||||
ExtType := BlockID;
|
||||
end
|
||||
else if ExtType in [GIFCommentExtension, GIFApplicationExtension, GIFPlainText] then
|
||||
repeat
|
||||
// Read block sizes and skip them
|
||||
Read(Handle, @BlockSize, SizeOf(BlockSize));
|
||||
Seek(Handle, BlockSize, smFromCurrent);
|
||||
until BlockSize = 0;
|
||||
|
||||
// Read ID of following block
|
||||
BlockID := ReadBlockID;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CopyFrameTransparent(const Image, Frame: TImageData; Left, Top,
|
||||
TransIndex: Integer; Disposal: TDisposalMethod);
|
||||
var
|
||||
X, Y: Integer;
|
||||
Src, Dst: PByte;
|
||||
begin
|
||||
Src := Frame.Bits;
|
||||
|
||||
// Copy all pixels from frame to log screen but ignore the transparent ones
|
||||
for Y := 0 to Frame.Height - 1 do
|
||||
begin
|
||||
Dst := @PByteArray(Image.Bits)[(Top + Y) * Image.Width + Left];
|
||||
for X := 0 to Frame.Width - 1 do
|
||||
begin
|
||||
// If disposal methos is undefined copy all pixels regardless of
|
||||
// transparency (transparency of whole image will be determined by TranspIndex
|
||||
// in image palette) - same effect as filling the image with trasp color
|
||||
// instead of backround color beforehand.
|
||||
// For other methods don't copy transparent pixels from frame to image.
|
||||
if (Src^ <> TransIndex) or (Disposal = dmUndefined) then
|
||||
Dst^ := Src^;
|
||||
Inc(Src);
|
||||
Inc(Dst);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -743,33 +813,49 @@ var
|
|||
procedure ReadFrame;
|
||||
var
|
||||
ImageDesc: TImageDescriptor;
|
||||
HasLocalPal, Interlaced, HasTransparency: Boolean;
|
||||
I, Idx, LocalPalLength, TransIndex: Integer;
|
||||
Interlaced: Boolean;
|
||||
I, Idx, LocalPalLength: Integer;
|
||||
LocalPal: TPalette32Size256;
|
||||
BlockTerm: Byte;
|
||||
Frame: TImageData;
|
||||
LZWStream: TMemoryStream;
|
||||
|
||||
procedure RemoveBadFrame;
|
||||
begin
|
||||
FreeImage(Images[Idx]);
|
||||
SetLength(Images, Length(Images) - 1);
|
||||
end;
|
||||
|
||||
begin
|
||||
Idx := Length(Images);
|
||||
SetLength(Images, Idx + 1);
|
||||
SetLength(FrameInfos, Idx + 1);
|
||||
FillChar(LocalPal, SizeOf(LocalPal), 0);
|
||||
|
||||
with GetIO do
|
||||
begin
|
||||
// Read and parse image descriptor
|
||||
Read(Handle, @ImageDesc, SizeOf(ImageDesc));
|
||||
HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
|
||||
FrameInfos[Idx].HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
|
||||
Interlaced := (ImageDesc.PackedFields and GIFInterlaced) = GIFInterlaced;
|
||||
LocalPalLength := ImageDesc.PackedFields and GIFColorTableSize;
|
||||
LocalPalLength := 1 shl (LocalPalLength + 1); // Total pal length is 2^(n+1)
|
||||
|
||||
// Create new logical screen
|
||||
NewImage(Header.ScreenWidth, Header.ScreenHeight, ifIndex8, Images[Idx]);
|
||||
// From Mozilla source
|
||||
if (ImageDesc.Width = 0) or (ImageDesc.Width > Header.ScreenWidth) then
|
||||
ImageDesc.Width := Header.ScreenWidth;
|
||||
if (ImageDesc.Height = 0) or (ImageDesc.Height > Header.ScreenHeight) then
|
||||
ImageDesc.Height := Header.ScreenHeight;
|
||||
|
||||
FrameInfos[Idx].Left := ImageDesc.Left;
|
||||
FrameInfos[Idx].Top := ImageDesc.Top;
|
||||
FrameInfos[Idx].Width := ImageDesc.Width;
|
||||
FrameInfos[Idx].Height := ImageDesc.Height;
|
||||
FrameInfos[Idx].BackIndex := Header.BackgroundColorIndex;
|
||||
|
||||
// Create new image for this frame which would be later pasted onto logical screen
|
||||
InitImage(Frame);
|
||||
NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Frame);
|
||||
NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Images[Idx]);
|
||||
|
||||
// Load local palette if there is any
|
||||
if HasLocalPal then
|
||||
if FrameInfos[Idx].HasLocalPal then
|
||||
for I := 0 to LocalPalLength - 1 do
|
||||
begin
|
||||
LocalPal[I].A := 255;
|
||||
|
@ -780,87 +866,174 @@ var
|
|||
|
||||
// Use local pal if present or global pal if present or create
|
||||
// default pal if neither of them is present
|
||||
if HasLocalPal then
|
||||
if FrameInfos[Idx].HasLocalPal then
|
||||
Move(LocalPal, Images[Idx].Palette^, SizeOf(LocalPal))
|
||||
else if HasGlobalPal then
|
||||
Move(GlobalPal, Images[Idx].Palette^, SizeOf(GlobalPal))
|
||||
else
|
||||
FillCustomPalette(Images[Idx].Palette, GlobalPalLength, 3, 3, 2);
|
||||
|
||||
// Add default disposal method for this frame
|
||||
SetLength(Disposals, Length(Disposals) + 1);
|
||||
Disposals[High(Disposals)] := dmUndefined;
|
||||
if (ImageDesc.Left <= Header.ScreenWidth + 1) and (ImageDesc.Top <= Header.ScreenHeight + 1) then
|
||||
begin
|
||||
// Resize the screen if needed to fit the frame
|
||||
ScreenWidth := Max(ScreenWidth, ImageDesc.Width + ImageDesc.Left);
|
||||
ScreenHeight := Max(ScreenHeight, ImageDesc.Height + ImageDesc.Top);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Remove frame outside logical screen
|
||||
RemoveBadFrame;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// If Grahic Control Extension is present make use of it
|
||||
if HasGraphicExt then
|
||||
begin
|
||||
HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
|
||||
Disposals[High(Disposals)] := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
|
||||
if HasTransparency then
|
||||
Images[Idx].Palette[GraphicExt.TransparentColorIndex].A := 0;
|
||||
end
|
||||
else
|
||||
HasTransparency := False;
|
||||
|
||||
if Idx >= 1 then
|
||||
begin
|
||||
// If previous frame had some special disposal method we take it into
|
||||
// account now
|
||||
case Disposals[Idx - 1] of
|
||||
dmUndefined: ; // Do nothing
|
||||
dmLeave:
|
||||
begin
|
||||
// Leave previous frame on log screen
|
||||
CopyRect(Images[Idx - 1], 0, 0, Images[Idx].Width,
|
||||
Images[Idx].Height, Images[Idx], 0, 0);
|
||||
end;
|
||||
dmRestoreBackground:
|
||||
begin
|
||||
// Clear log screen with background color
|
||||
FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
|
||||
@Header.BackgroundColorIndex);
|
||||
end;
|
||||
dmRestorePrevious:
|
||||
if Idx >= 2 then
|
||||
begin
|
||||
// Set log screen to "previous of previous" frame
|
||||
CopyRect(Images[Idx - 2], 0, 0, Images[Idx].Width,
|
||||
Images[Idx].Height, Images[Idx], 0, 0);
|
||||
end;
|
||||
FrameInfos[Idx].HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
|
||||
FrameInfos[Idx].Disposal := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
|
||||
if FrameInfos[Idx].HasTransparency then
|
||||
begin
|
||||
FrameInfos[Idx].TransIndex := GraphicExt.TransparentColorIndex;
|
||||
Images[Idx].Palette[FrameInfos[Idx].TransIndex].A := 0;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// First frame - just fill with background color
|
||||
FillRect(Images[Idx], 0, 0, Images[Idx].Width, Images[Idx].Height,
|
||||
@Header.BackgroundColorIndex);
|
||||
end;
|
||||
FrameInfos[Idx].HasTransparency := False;
|
||||
|
||||
LZWStream := TMemoryStream.Create;
|
||||
try
|
||||
// Copy LZW data to temp stream, needed for correct decompression
|
||||
CopyLZWData(LZWStream);
|
||||
LZWStream.Position := 0;
|
||||
// Data decompression finally
|
||||
LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Frame.Bits);
|
||||
// Now copy frame to logical screen with skipping of transparent pixels (if enabled)
|
||||
TransIndex := Iff(HasTransparency, GraphicExt.TransparentColorIndex, MaxInt);
|
||||
CopyFrameTransparent(Images[Idx], Frame, ImageDesc.Left, ImageDesc.Top,
|
||||
TransIndex, Disposals[Idx]);
|
||||
try
|
||||
// Copy LZW data to temp stream, needed for correct decompression
|
||||
CopyLZWData(LZWStream);
|
||||
LZWStream.Position := 0;
|
||||
// Data decompression finally
|
||||
LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Images[Idx].Bits);
|
||||
except
|
||||
RemoveBadFrame;
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
FreeImage(Frame);
|
||||
LZWStream.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CopyFrameTransparent32(const Image, Frame: TImageData; Left, Top: Integer);
|
||||
var
|
||||
X, Y: Integer;
|
||||
Src: PByte;
|
||||
Dst: PColor32;
|
||||
begin
|
||||
Src := Frame.Bits;
|
||||
|
||||
// Copy all pixels from frame to log screen but ignore the transparent ones
|
||||
for Y := 0 to Frame.Height - 1 do
|
||||
begin
|
||||
Dst := @PColor32RecArray(Image.Bits)[(Top + Y) * Image.Width + Left];
|
||||
for X := 0 to Frame.Width - 1 do
|
||||
begin
|
||||
if (Frame.Palette[Src^].A <> 0) then
|
||||
Dst^ := Frame.Palette[Src^].Color;
|
||||
Inc(Src);
|
||||
Inc(Dst);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AnimateFrame(Index: Integer; var AnimFrame: TImageData);
|
||||
var
|
||||
I, First, Last: Integer;
|
||||
UseCache: Boolean;
|
||||
BGColor: TColor32;
|
||||
begin
|
||||
// We may need to use raw frame 0 to n to correctly animate n-th frame
|
||||
Last := Index;
|
||||
First := Max(0, Last);
|
||||
// See if we can use last animate frame as a basis for this one
|
||||
// (so we don't have to use previous raw frames).
|
||||
UseCache := TestImage(CachedFrame) and (CachedIndex = Index - 1) and (CachedIndex >= 0) and
|
||||
(FrameInfos[CachedIndex].Disposal <> dmRestorePrevious);
|
||||
|
||||
// Reuse or release cache
|
||||
if UseCache then
|
||||
CloneImage(CachedFrame, AnimFrame)
|
||||
else
|
||||
FreeImage(CachedFrame);
|
||||
|
||||
// Default color for clearing of the screen
|
||||
BGColor := Images[Index].Palette[FrameInfos[Index].BackIndex].Color;
|
||||
|
||||
// Now prepare logical screen for drawing of raw frame at Index.
|
||||
// We may need to use all previous raw frames to get the screen
|
||||
// to proper state (according to their disposal methods).
|
||||
|
||||
if not UseCache then
|
||||
begin
|
||||
if FrameInfos[Index].HasTransparency then
|
||||
BGColor := Images[Index].Palette[FrameInfos[Index].TransIndex].Color;
|
||||
// Clear whole screen
|
||||
FillMemoryLongWord(AnimFrame.Bits, AnimFrame.Size, BGColor);
|
||||
|
||||
// Try to maximize First so we don't have to use all 0 to n raw frames
|
||||
while First > 0 do
|
||||
begin
|
||||
if (ScreenWidth = Images[First].Width) and (ScreenHeight = Images[First].Height) then
|
||||
begin
|
||||
if (FrameInfos[First].Disposal = dmRestoreBackground) and (First < Last) then
|
||||
Break;
|
||||
end;
|
||||
Dec(First);
|
||||
end;
|
||||
|
||||
for I := First to Last - 1 do
|
||||
begin
|
||||
case FrameInfos[I].Disposal of
|
||||
dmNoRemoval, dmLeave:
|
||||
begin
|
||||
// Copy previous raw frame onto screen
|
||||
CopyFrameTransparent32(AnimFrame, Images[I], FrameInfos[I].Left, FrameInfos[I].Top);
|
||||
end;
|
||||
dmRestoreBackground:
|
||||
if (I > First) then
|
||||
begin
|
||||
// Restore background color
|
||||
FillRect(AnimFrame, FrameInfos[I].Left, FrameInfos[I].Top,
|
||||
FrameInfos[I].Width, FrameInfos[I].Height, @BGColor);
|
||||
end;
|
||||
dmRestorePrevious: ; // Do nothing - previous state is already on screen
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if FrameInfos[CachedIndex].Disposal = dmRestoreBackground then
|
||||
begin
|
||||
// We have our cached result but also need to restore
|
||||
// background in a place of cached frame
|
||||
if FrameInfos[CachedIndex].HasTransparency then
|
||||
BGColor := Images[CachedIndex].Palette[FrameInfos[CachedIndex].TransIndex].Color;
|
||||
FillRect(AnimFrame, FrameInfos[CachedIndex].Left, FrameInfos[CachedIndex].Top,
|
||||
FrameInfos[CachedIndex].Width, FrameInfos[CachedIndex].Height, @BGColor);
|
||||
end;
|
||||
|
||||
// Copy current raw frame to prepared screen
|
||||
CopyFrameTransparent32(AnimFrame, Images[Index], FrameInfos[Index].Left, FrameInfos[Index].Top);
|
||||
|
||||
// Cache animated result
|
||||
CloneImage(AnimFrame, CachedFrame);
|
||||
CachedIndex := Index;
|
||||
end;
|
||||
|
||||
begin
|
||||
AppRead := False;
|
||||
|
||||
SetLength(Images, 0);
|
||||
FillChar(GlobalPal, SizeOf(GlobalPal), 0);
|
||||
|
||||
with GetIO do
|
||||
begin
|
||||
// Read GIF header
|
||||
Read(Handle, @Header, SizeOf(Header));
|
||||
ScreenWidth := Header.ScreenWidth;
|
||||
ScreenHeight := Header.ScreenHeight;
|
||||
HasGlobalPal := Header.PackedFields and GIFGlobalColorTable = GIFGlobalColorTable; // Bit 7
|
||||
GlobalPalLength := Header.PackedFields and GIFColorTableSize; // Bits 0-2
|
||||
GlobalPalLength := 1 shl (GlobalPalLength + 1); // Total pal length is 2^(n+1)
|
||||
|
@ -883,6 +1056,9 @@ begin
|
|||
// Now read all data blocks in the file until file trailer is reached
|
||||
while BlockID <> GIFTrailer do
|
||||
begin
|
||||
// Read blocks until we find the one of known type
|
||||
while not (BlockID in [GIFTrailer, GIFExtensionIntroducer, GIFImageDescriptor]) do
|
||||
BlockID := ReadBlockID;
|
||||
// Read supported and skip unsupported extensions
|
||||
ReadExtensions;
|
||||
// If image frame is found read it
|
||||
|
@ -895,6 +1071,31 @@ begin
|
|||
BlockID := GIFTrailer;
|
||||
end;
|
||||
|
||||
if FLoadAnimated then
|
||||
begin
|
||||
// Aniated frames will be stored in AnimFrames
|
||||
SetLength(AnimFrames, Length(Images));
|
||||
InitImage(CachedFrame);
|
||||
CachedIndex := -1;
|
||||
|
||||
for I := 0 to High(Images) do
|
||||
begin
|
||||
// Create new logical screen
|
||||
NewImage(ScreenWidth, ScreenHeight, ifA8R8G8B8, AnimFrames[I]);
|
||||
// Animate frames to current log screen
|
||||
AnimateFrame(I, AnimFrames[I]);
|
||||
end;
|
||||
|
||||
// Now release raw 8bit frames and put animated 32bit ones
|
||||
// to output array
|
||||
FreeImage(CachedFrame);
|
||||
for I := 0 to High(AnimFrames) do
|
||||
begin
|
||||
FreeImage(Images[I]);
|
||||
Images[I] := AnimFrames[I];
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
@ -1007,6 +1208,14 @@ initialization
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed bug - loading of GIF with NETSCAPE app extensions
|
||||
failed with Delphi 2009.
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- GIF loading and animation mostly rewritten, based on
|
||||
modification by Sergey Galezdinov (ExtraGIF in Extras/Contrib).
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed loading of some rare GIFs, problems with LZW
|
||||
decompression.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingJpeg.pas 128 2008-07-23 11:57:36Z galfar $
|
||||
$Id: ImagingJpeg.pas 180 2009-10-16 01:07:26Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -43,22 +43,22 @@ unit ImagingJpeg;
|
|||
{$DEFINE IMJPEGLIB}
|
||||
{ $DEFINE PASJPEG}
|
||||
|
||||
{ Automatically use FPC's PasJpeg when compiling with Lazarus.}
|
||||
|
||||
{$IFDEF LCL}
|
||||
{ Automatically use FPC's PasJpeg when compiling with Lazarus. But not when
|
||||
WINDOWS is defined. See http://galfar.vevb.net/imaging/smf/index.php/topic,90.0.html}
|
||||
{$IF Defined(LCL) and not Defined(WINDOWS)}
|
||||
{$UNDEF IMJPEGLIB}
|
||||
{$DEFINE PASJPEG}
|
||||
{$ENDIF}
|
||||
{$IFEND}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, ImagingTypes, Imaging, ImagingColors,
|
||||
{$IF Defined(IMJPEGLIB)}
|
||||
imjpeglib, imjmorecfg, imjcomapi, imjdapimin,
|
||||
imjpeglib, imjmorecfg, imjcomapi, imjdapimin, imjdeferr, imjerror,
|
||||
imjdapistd, imjcapimin, imjcapistd, imjdmarker, imjcparam,
|
||||
{$ELSEIF Defined(PASJPEG)}
|
||||
jpeglib, jmorecfg, jcomapi, jdapimin,
|
||||
jpeglib, jmorecfg, jcomapi, jdapimin, jdeferr, jerror,
|
||||
jdapistd, jcapimin, jcapistd, jdmarker, jcparam,
|
||||
{$IFEND}
|
||||
ImagingUtility;
|
||||
|
@ -70,7 +70,10 @@ uses
|
|||
|
||||
type
|
||||
{ Class for loading/saving Jpeg images. Supports load/save of
|
||||
8 bit grayscale and 24 bit RGB images.}
|
||||
8 bit grayscale and 24 bit RGB images. Jpegs can be saved with optional
|
||||
progressive encoding.
|
||||
Based on IJG's JpegLib so doesn't support alpha channels and lossless
|
||||
coding.}
|
||||
TJpegFileFormat = class(TImageFileFormat)
|
||||
private
|
||||
FGrayScale: Boolean;
|
||||
|
@ -110,10 +113,11 @@ const
|
|||
const
|
||||
{ Jpeg file identifiers.}
|
||||
JpegMagic: TChar2 = #$FF#$D8;
|
||||
JFIFSignature: TChar4 = 'JFIF';
|
||||
EXIFSignature: TChar4 = 'Exif';
|
||||
BufferSize = 16384;
|
||||
|
||||
resourcestring
|
||||
SJpegError = 'JPEG Error';
|
||||
|
||||
type
|
||||
TJpegContext = record
|
||||
case Byte of
|
||||
|
@ -139,40 +143,23 @@ type
|
|||
|
||||
var
|
||||
JIO: TIOFunctions;
|
||||
|
||||
JpegErrorMgr: jpeg_error_mgr;
|
||||
|
||||
{ Intenal unit jpeglib support functions }
|
||||
|
||||
procedure JpegError(CurInfo: j_common_ptr);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure EmitMessage(CurInfo: j_common_ptr; msg_level: Integer);
|
||||
procedure JpegError(CInfo: j_common_ptr);
|
||||
var
|
||||
Buffer: string;
|
||||
begin
|
||||
{ Create the message and raise exception }
|
||||
CInfo^.err^.format_message(CInfo, buffer);
|
||||
raise EImagingError.CreateFmt(SJPEGError + ' %d: ' + Buffer, [CInfo.err^.msg_code]);
|
||||
end;
|
||||
|
||||
procedure OutputMessage(CurInfo: j_common_ptr);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure FormatMessage(CurInfo: j_common_ptr; var buffer: string);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure ResetErrorMgr(CurInfo: j_common_ptr);
|
||||
begin
|
||||
CurInfo^.err^.num_warnings := 0;
|
||||
CurInfo^.err^.msg_code := 0;
|
||||
end;
|
||||
|
||||
var
|
||||
JpegErrorRec: jpeg_error_mgr = (
|
||||
error_exit: JpegError;
|
||||
emit_message: EmitMessage;
|
||||
output_message: OutputMessage;
|
||||
format_message: FormatMessage;
|
||||
reset_error_mgr: ResetErrorMgr);
|
||||
|
||||
procedure ReleaseContext(var jc: TJpegContext);
|
||||
begin
|
||||
if jc.common.err = nil then
|
||||
|
@ -221,7 +208,7 @@ begin
|
|||
FillInputBuffer(cinfo);
|
||||
end;
|
||||
Src.Pub.next_input_byte := @PByteArray(Src.Pub.next_input_byte)[num_bytes];
|
||||
// Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
|
||||
//Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
|
||||
Dec(Src.Pub.bytes_in_buffer, num_bytes);
|
||||
end;
|
||||
end;
|
||||
|
@ -311,7 +298,11 @@ end;
|
|||
procedure InitDecompressor(Handle: TImagingHandle; var jc: TJpegContext);
|
||||
begin
|
||||
FillChar(jc, sizeof(jc), 0);
|
||||
jc.common.err := @JpegErrorRec;
|
||||
// Set standard error handlers and then override some
|
||||
jc.common.err := jpeg_std_error(JpegErrorMgr);
|
||||
jc.common.err.error_exit := JpegError;
|
||||
jc.common.err.output_message := OutputMessage;
|
||||
|
||||
jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, sizeof(jc.d));
|
||||
JpegStdioSrc(jc.d, Handle);
|
||||
jpeg_read_header(@jc.d, True);
|
||||
|
@ -329,15 +320,19 @@ procedure InitCompressor(Handle: TImagingHandle; var jc: TJpegContext;
|
|||
Saver: TJpegFileFormat);
|
||||
begin
|
||||
FillChar(jc, sizeof(jc), 0);
|
||||
jc.common.err := @JpegErrorRec;
|
||||
// Set standard error handlers and then override some
|
||||
jc.common.err := jpeg_std_error(JpegErrorMgr);
|
||||
jc.common.err.error_exit := JpegError;
|
||||
jc.common.err.output_message := OutputMessage;
|
||||
|
||||
jpeg_CreateCompress(@jc.c, JPEG_LIB_VERSION, sizeof(jc.c));
|
||||
JpegStdioDest(jc.c, Handle);
|
||||
if Saver.FGrayScale then
|
||||
jc.c.in_color_space := JCS_GRAYSCALE
|
||||
else
|
||||
jc.c.in_color_space := JCS_RGB;
|
||||
jpeg_set_defaults(@jc.c);
|
||||
jpeg_set_quality(@jc.c, Saver.FQuality, True);
|
||||
if Saver.FGrayScale then
|
||||
jpeg_set_colorspace(@jc.c, JCS_GRAYSCALE)
|
||||
else
|
||||
jpeg_set_colorspace(@jc.c, JCS_YCbCr);
|
||||
if Saver.FProgressive then
|
||||
jpeg_simple_progression(@jc.c);
|
||||
end;
|
||||
|
@ -376,13 +371,14 @@ var
|
|||
jc: TJpegContext;
|
||||
Info: TImageFormatInfo;
|
||||
Col32: PColor32Rec;
|
||||
{$IFDEF RGBSWAPPED}
|
||||
NeedsRedBlueSwap: Boolean;
|
||||
Pix: PColor24Rec;
|
||||
{$ENDIF}
|
||||
begin
|
||||
// Copy IO functions to global var used in JpegLib callbacks
|
||||
Result := False;
|
||||
SetJpegIO(GetIO);
|
||||
SetLength(Images, 1);
|
||||
|
||||
with JIO, Images[0] do
|
||||
try
|
||||
InitDecompressor(Handle, jc);
|
||||
|
@ -390,6 +386,8 @@ begin
|
|||
JCS_GRAYSCALE: Format := ifGray8;
|
||||
JCS_RGB: Format := ifR8G8B8;
|
||||
JCS_CMYK: Format := ifA8R8G8B8;
|
||||
else
|
||||
Exit;
|
||||
end;
|
||||
NewImage(jc.d.image_width, jc.d.image_height, Format, Images[0]);
|
||||
jpeg_start_decompress(@jc.d);
|
||||
|
@ -398,11 +396,18 @@ begin
|
|||
LinesPerCall := 1;
|
||||
Dest := Bits;
|
||||
|
||||
// If Jpeg's colorspace is RGB and not YCbCr we need to swap
|
||||
// R and B to get Imaging's native order
|
||||
NeedsRedBlueSwap := jc.d.jpeg_color_space = JCS_RGB;
|
||||
{$IFDEF RGBSWAPPED}
|
||||
// Force R-B swap for FPC's PasJpeg
|
||||
NeedsRedBlueSwap := True;
|
||||
{$ENDIF}
|
||||
|
||||
while jc.d.output_scanline < jc.d.output_height do
|
||||
begin
|
||||
LinesRead := jpeg_read_scanlines(@jc.d, @Dest, LinesPerCall);
|
||||
{$IFDEF RGBSWAPPED}
|
||||
if Format = ifR8G8B8 then
|
||||
if NeedsRedBlueSwap and (Format = ifR8G8B8) then
|
||||
begin
|
||||
Pix := PColor24Rec(Dest);
|
||||
for I := 0 to Width - 1 do
|
||||
|
@ -411,7 +416,6 @@ begin
|
|||
Inc(Pix);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
Inc(Dest, PtrInc * LinesRead);
|
||||
end;
|
||||
|
||||
|
@ -526,7 +530,7 @@ end;
|
|||
function TJpegFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
|
||||
var
|
||||
ReadCount: LongInt;
|
||||
ID: array[0..9] of Char;
|
||||
ID: array[0..9] of AnsiChar;
|
||||
begin
|
||||
Result := False;
|
||||
if Handle <> nil then
|
||||
|
@ -554,8 +558,20 @@ initialization
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.5 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed swapped Red-Blue order when loading Jpegs with
|
||||
jc.d.jpeg_color_space = JCS_RGB.
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes ---------------------------------
|
||||
- Changed the Jpeg error manager, messages were not properly formated.
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed wrong color space setting in InitCompressor.
|
||||
- Fixed problem with progressive Jpegs in FPC (modified JpegLib,
|
||||
can't use FPC's PasJpeg in Windows).
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes ---------------------------------
|
||||
-- FPC's PasJpeg wasn't really used in last version, fixed.
|
||||
- FPC's PasJpeg wasn't really used in last version, fixed.
|
||||
|
||||
-- 0.24.1 Changes/Bug Fixes ---------------------------------
|
||||
- Fixed loading of CMYK jpeg images. Could cause heap corruption
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingOpenGL.pas 128 2008-07-23 11:57:36Z galfar $
|
||||
$Id: ImagingOpenGL.pas 165 2009-08-14 12:34:40Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -33,32 +33,35 @@ unit ImagingOpenGL;
|
|||
{$I ImagingOptions.inc}
|
||||
|
||||
{ Define this symbol if you want to use dglOpenGL header.}
|
||||
{.$DEFINE USE_DGL_HEADERS}
|
||||
{ $DEFINE USE_DGL_HEADERS}
|
||||
{ $DEFINE USE_GLSCENE_HEADERS}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats,
|
||||
{$IFDEF USE_DGL_HEADERS}
|
||||
{$IF Defined(USE_DGL_HEADERS)}
|
||||
dglOpenGL,
|
||||
{$ELSEIF Defined(USE_GLSCENE_HEADERS)}
|
||||
OpenGL1x,
|
||||
{$ELSE}
|
||||
gl, glext,
|
||||
{$ENDIF}
|
||||
{$IFEND}
|
||||
ImagingUtility;
|
||||
|
||||
type
|
||||
{ Various texture capabilities of installed OpenGL driver.}
|
||||
TGLTextureCaps = record
|
||||
MaxTextureSize: LongInt; // Max size of texture in pixels supported by HW
|
||||
NonPowerOfTwo: Boolean; // HW has full support for NPOT textures
|
||||
DXTCompression: Boolean; // HW supports S3TC/DXTC compressed textures
|
||||
ATI3DcCompression: Boolean; // HW supports ATI 3Dc compressed textures (ATI2N)
|
||||
LATCCompression: Boolean; // HW supports LATC/RGTC compressed textures (ATI1N+ATI2N)
|
||||
FloatTextures: Boolean; // HW supports floating point textures
|
||||
MaxAnisotropy: LongInt; // Max anisotropy for aniso texture filtering
|
||||
MaxTextureSize: LongInt; // Max size of texture in pixels supported by HW
|
||||
NonPowerOfTwo: Boolean; // HW has full support for NPOT textures
|
||||
DXTCompression: Boolean; // HW supports S3TC/DXTC compressed textures
|
||||
ATI3DcCompression: Boolean; // HW supports ATI 3Dc compressed textures (ATI2N)
|
||||
LATCCompression: Boolean; // HW supports LATC/RGTC compressed textures (ATI1N+ATI2N)
|
||||
FloatTextures: Boolean; // HW supports floating point textures
|
||||
MaxAnisotropy: LongInt; // Max anisotropy for aniso texture filtering
|
||||
MaxSimultaneousTextures: LongInt; // Number of texture units
|
||||
ClampToEdge: Boolean; // GL_EXT_texture_edge_clamp
|
||||
TextureLOD: Boolean; // GL_SGIS_texture_lod
|
||||
ClampToEdge: Boolean; // GL_EXT_texture_edge_clamp
|
||||
TextureLOD: Boolean; // GL_SGIS_texture_lod
|
||||
VertexTextureUnits: Integer; // Texture units accessible in vertex programs
|
||||
end;
|
||||
|
||||
|
@ -278,6 +281,10 @@ const
|
|||
GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
|
||||
GL_HALF_FLOAT_ARB = $140B;
|
||||
|
||||
// Other GL constants
|
||||
GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C;
|
||||
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
GLLibName = 'opengl32.dll';
|
||||
{$ENDIF}
|
||||
|
@ -880,6 +887,9 @@ initialization
|
|||
not only A8R8G8B8
|
||||
- support for cube and 3D maps
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes ---------------------------------
|
||||
- Added support for GLScene's OpenGL header.
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes ---------------------------------
|
||||
- Added 3Dc compressed texture formats support.
|
||||
- Added detection of 3Dc formats to texture caps.
|
||||
|
|
|
@ -1,47 +1,53 @@
|
|||
{ $Id: ImagingOptions.inc 132 2008-08-27 20:37:38Z galfar $ }
|
||||
{ $Id: ImagingOptions.inc 174 2009-09-08 09:37:59Z galfar $ }
|
||||
|
||||
{
|
||||
User Options
|
||||
Following defines and options can be changed by user.
|
||||
}
|
||||
|
||||
{ Source options. }
|
||||
{ Source options }
|
||||
|
||||
{$DEFINE USE_INLINE} // use function inlining for some functions
|
||||
// works in Free Pascal and Delphi 9+
|
||||
{$DEFINE USE_ASM} // if defined, assembler versions of some
|
||||
// functions will be used (only for x86)
|
||||
{ $DEFINE DEBUG} // if defined, debug info, range/IO/overflow
|
||||
{$DEFINE USE_INLINE} // Use function inlining for some functions
|
||||
// works in Free Pascal and Delphi 9+.
|
||||
{.$DEFINE USE_ASM} // Ff defined, assembler versions of some
|
||||
// functions will be used (only for x86).
|
||||
|
||||
// Debug options: If none of these two are defined
|
||||
// your project settings are used.
|
||||
{ $DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow
|
||||
// checking, stack frames, assertions, and
|
||||
// other debugging options will be turned on
|
||||
// other debugging options will be turned on.
|
||||
{$DEFINE IMAGING_RELEASE} // If defined, all debug info is off.
|
||||
|
||||
{ File format support linking options. Undefine formats which you don't want
|
||||
to be registred automatically. }
|
||||
|
||||
{.$DEFINE LINK_JPEG} // link support for Jpeg images
|
||||
{.$DEFINE LINK_PNG} // link support for PNG images
|
||||
{$DEFINE LINK_TARGA} // link support for Targa images
|
||||
{$DEFINE LINK_BITMAP} // link support for Windows Bitmap images
|
||||
{.$DEFINE LINK_DDS} // link support for DDS images
|
||||
{.$DEFINE LINK_GIF} // link support for GIF images
|
||||
{.$DEFINE LINK_MNG} // link support for MNG images
|
||||
{.$DEFINE LINK_JNG} // link support for JNG images
|
||||
{.$DEFINE LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
|
||||
|
||||
{.$DEFINE LINK_EXTRAS} // link support for file formats defined in
|
||||
// Extras package. Exactly which formats will be
|
||||
// registered depends on settings in
|
||||
// ImagingExtras.pas unit.
|
||||
(* File format support linking options.
|
||||
Define formats which you don't want to be registred automatically.
|
||||
Default: all formats are registered = no symbols defined.
|
||||
Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
|
||||
*)
|
||||
|
||||
//{$DEFINE DONT_LINK_JPEG} // link support for Jpeg images
|
||||
//{$DEFINE DONT_LINK_PNG} // link support for PNG images
|
||||
//{$DEFINE DONT_LINK_TARGA} // link support for Targa images
|
||||
//{$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images
|
||||
{$DEFINE DONT_LINK_DDS} // link support for DDS images
|
||||
{$DEFINE DONT_LINK_GIF} // link support for GIF images
|
||||
{$DEFINE DONT_LINK_MNG} // link support for MNG images
|
||||
{$DEFINE DONT_LINK_JNG} // link support for JNG images
|
||||
{$DEFINE DONT_LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
|
||||
|
||||
{$DEFINE DONT_LINK_EXTRAS} // link support for file formats defined in
|
||||
// Extras package. Exactly which formats will be
|
||||
// registered depends on settings in
|
||||
// ImagingExtras.pas unit.
|
||||
|
||||
{ Component set used in ImagignComponents.pas unit. You usually don't need
|
||||
to be concerned with this - proper component library is selected automatically
|
||||
according to your compiler (only exception is using CLX in Delphi 6/7). }
|
||||
according to your compiler. }
|
||||
|
||||
{$DEFINE COMPONENT_SET_VCL} // use Borland's VCL
|
||||
{ $DEFINE COMPONENT_SET_CLX} // use Borland's CLX (set automatically when using Kylix,
|
||||
// must be se manually when compiling with Delphi 6/7)
|
||||
{ $DEFINE COMPONENT_SET_LCL} // use Lazarus' LCL (set automatically when
|
||||
// compiling with FPC)
|
||||
{ $DEFINE COMPONENT_SET_VCL} // use Delphi VCL
|
||||
{$DEFINE COMPONENT_SET_LCL} // use Lazarus LCL (set automatically when compiling with FPC)
|
||||
|
||||
{
|
||||
Auto Options
|
||||
|
@ -85,7 +91,7 @@
|
|||
{$ENDIF}
|
||||
{$IFEND}
|
||||
|
||||
{$IFDEF DEBUG}
|
||||
{$IF Defined(IMAGING_DEBUG)}
|
||||
{$ASSERTIONS ON}
|
||||
{$DEBUGINFO ON}
|
||||
{$RANGECHECKS ON}
|
||||
|
@ -95,13 +101,13 @@
|
|||
{$OPTIMIZATION OFF}
|
||||
{$STACKFRAMES ON}
|
||||
{$LOCALSYMBOLS ON}
|
||||
{ $DEFINE MEMCHECK}
|
||||
{$DEFINE MEMCHECK}
|
||||
{$ENDIF}
|
||||
{$IFDEF FPC}
|
||||
{$S+}
|
||||
{$CHECKPOINTER ON}
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
{$ELSEIF Defined(IMAGING_RELEASE)}
|
||||
{$ASSERTIONS OFF}
|
||||
{$DEBUGINFO OFF}
|
||||
{$RANGECHECKS OFF}
|
||||
|
@ -115,7 +121,8 @@
|
|||
{$IFDEF FPC}
|
||||
{$S-}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$IFEND}
|
||||
|
||||
|
||||
{ Compiler capabilities }
|
||||
|
||||
|
@ -151,40 +158,11 @@
|
|||
{$IFDEF FPC}
|
||||
{$DEFINE COMPONENT_SET_LCL}
|
||||
{$UNDEF COMPONENT_SET_VCL}
|
||||
{$UNDEF COMPONENT_SET_CLX}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF KYLIX}
|
||||
{$DEFINE COMPONENT_SET_CLX}
|
||||
{$UNDEF COMPONENT_SET_VCL}
|
||||
{$UNDEF COMPONENT_SET_LCL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DELPHI}
|
||||
{$UNDEF COMPONENT_SET_LCL}
|
||||
{$IF CompilerVersion >= 17}
|
||||
{$UNDEF COMPONENT_SET_CLX} // Delphi 9+ has no CLX
|
||||
{$IFEND}
|
||||
{$IFNDEF COMPONENT_SET_VCL}
|
||||
{$IFNDEF COMPONENT_SET_CLX}
|
||||
{$DEFINE COMPONENT_SET_VCL} // use VCL as default if not set
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF COMPONENT_SET_VCL}
|
||||
{$UNDEF COMPONENT_SET_CLX}
|
||||
{$UNDEF COMPONENT_SET_LCL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF COMPONENT_SET_CLX}
|
||||
{$UNDEF COMPONENT_SET_VCL}
|
||||
{$UNDEF COMPONENT_SET_LCL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF COMPONENT_SET_LCL}
|
||||
{$UNDEF COMPONENT_SET_VCL}
|
||||
{$UNDEF COMPONENT_SET_CLX}
|
||||
{$DEFINE COMPONENT_SET_VCL}
|
||||
{$ENDIF}
|
||||
|
||||
{ Platform options }
|
||||
|
@ -220,16 +198,4 @@
|
|||
{$INLINE ON} // turns inlining on for compilers that support it
|
||||
{$ENDIF}
|
||||
|
||||
{ Extension dependencies check }
|
||||
|
||||
{$IFDEF LINK_MNG} // MNG uses internaly both PNG and JNG
|
||||
{$DEFINE LINK_JNG}
|
||||
{$DEFINE LINK_PNG}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF LINK_JNG} // JNG uses internaly both PNG and JPEG
|
||||
{$DEFINE LINK_PNG}
|
||||
{$DEFINE LINK_JPEG}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingPortableMaps.pas 127 2008-05-31 01:57:13Z galfar $
|
||||
$Id: ImagingPortableMaps.pas 163 2009-07-28 21:44:10Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -46,7 +46,7 @@ type
|
|||
TPortableMapInfo = record
|
||||
Width: LongInt;
|
||||
Height: LongInt;
|
||||
FormatId: Char;
|
||||
FormatId: AnsiChar;
|
||||
MaxVal: LongInt;
|
||||
BitCount: LongInt;
|
||||
Depth: LongInt;
|
||||
|
@ -200,7 +200,7 @@ var
|
|||
MonoData: Pointer;
|
||||
Info: TImageFormatInfo;
|
||||
PixelFP: TColorFPRec;
|
||||
LineBuffer: array[0..LineBufferCapacity - 1] of Char;
|
||||
LineBuffer: array[0..LineBufferCapacity - 1] of AnsiChar;
|
||||
LineEnd, LinePos: LongInt;
|
||||
MapInfo: TPortableMapInfo;
|
||||
LineBreak: string;
|
||||
|
@ -228,7 +228,7 @@ var
|
|||
function ReadString: string;
|
||||
var
|
||||
S: AnsiString;
|
||||
C: Char;
|
||||
C: AnsiChar;
|
||||
begin
|
||||
// First skip all whitespace chars
|
||||
SetLength(S, 1);
|
||||
|
@ -266,7 +266,7 @@ var
|
|||
// Dec pos, current is the begining of the the string
|
||||
Dec(LinePos);
|
||||
|
||||
Result := S;
|
||||
Result := string(S);
|
||||
end;
|
||||
|
||||
function ReadIntValue: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
@ -276,7 +276,7 @@ var
|
|||
|
||||
procedure FindLineBreak;
|
||||
var
|
||||
C: Char;
|
||||
C: AnsiChar;
|
||||
begin
|
||||
LineBreak := #10;
|
||||
repeat
|
||||
|
@ -586,7 +586,11 @@ var
|
|||
begin
|
||||
SetLength(S, Length(S) + 1);
|
||||
S[Length(S)] := Delimiter;
|
||||
{$IF Defined(DCC) and Defined(UNICODE)}
|
||||
GetIO.Write(Handle, @AnsiString(S)[1], Length(S));
|
||||
{$ELSE}
|
||||
GetIO.Write(Handle, @S[1], Length(S));
|
||||
{$IFEND}
|
||||
Inc(LineLength, Length(S));
|
||||
end;
|
||||
|
||||
|
@ -807,7 +811,6 @@ begin
|
|||
FName := SPGMFormatName;
|
||||
FSupportedFormats := PGMSupportedFormats;
|
||||
AddMasks(SPGMMasks);
|
||||
|
||||
RegisterOption(ImagingPGMSaveBinary, @FSaveBinary);
|
||||
FIdNumbers := '25';
|
||||
end;
|
||||
|
@ -818,7 +821,10 @@ var
|
|||
MapInfo: TPortableMapInfo;
|
||||
begin
|
||||
FillChar(MapInfo, SizeOf(MapInfo), 0);
|
||||
MapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
|
||||
if FSaveBinary then
|
||||
MapInfo.FormatId := FIdNumbers[1]
|
||||
else
|
||||
MapInfo.FormatId := FIdNumbers[0];
|
||||
MapInfo.Binary := FSaveBinary;
|
||||
Result := SaveDataInternal(Handle, Images, Index, MapInfo);
|
||||
end;
|
||||
|
@ -853,7 +859,6 @@ begin
|
|||
FName := SPPMFormatName;
|
||||
FSupportedFormats := PPMSupportedFormats;
|
||||
AddMasks(SPPMMasks);
|
||||
|
||||
RegisterOption(ImagingPPMSaveBinary, @FSaveBinary);
|
||||
FIdNumbers := '36';
|
||||
end;
|
||||
|
@ -864,7 +869,10 @@ var
|
|||
MapInfo: TPortableMapInfo;
|
||||
begin
|
||||
FillChar(MapInfo, SizeOf(MapInfo), 0);
|
||||
MapInfo.FormatId := Iff(FSaveBinary, FIdNumbers[1], FIdNumbers[0]);
|
||||
if FSaveBinary then
|
||||
MapInfo.FormatId := FIdNumbers[1]
|
||||
else
|
||||
MapInfo.FormatId := FIdNumbers[0];
|
||||
MapInfo.Binary := FSaveBinary;
|
||||
Result := SaveDataInternal(Handle, Images, Index, MapInfo);
|
||||
end;
|
||||
|
@ -952,11 +960,17 @@ var
|
|||
begin
|
||||
FillChar(MapInfo, SizeOf(MapInfo), 0);
|
||||
Info := GetFormatInfo(Images[Index].Format);
|
||||
|
||||
if (Info.ChannelCount > 1) or Info.IsIndexed then
|
||||
MapInfo.TupleType := ttRGBFP
|
||||
else
|
||||
MapInfo.TupleType := ttGrayScaleFP;
|
||||
MapInfo.FormatId := Iff(MapInfo.TupleType = ttGrayScaleFP, FIdNumbers[1], FIdNumbers[0]);
|
||||
|
||||
if MapInfo.TupleType = ttGrayScaleFP then
|
||||
MapInfo.FormatId := FIdNumbers[1]
|
||||
else
|
||||
MapInfo.FormatId := FIdNumbers[0];
|
||||
|
||||
MapInfo.Binary := True;
|
||||
Result := SaveDataInternal(Handle, Images, Index, MapInfo);
|
||||
end;
|
||||
|
@ -983,6 +997,9 @@ initialization
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.3 Changes/Bug Fixes -----------------------------------
|
||||
- Fixed D2009 Unicode related bug in PNM saving.
|
||||
|
||||
-- 0.24.3 Changes/Bug Fixes -----------------------------------
|
||||
- Improved compatibility of 16bit/component image loading.
|
||||
- Changes for better thread safety.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingTarga.pas 84 2007-05-27 13:54:27Z galfar $
|
||||
$Id: ImagingTarga.pas 139 2008-09-18 02:01:42Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -89,11 +89,11 @@ type
|
|||
|
||||
{ Footer at the end of TGA file.}
|
||||
TTargaFooter = packed record
|
||||
ExtOff: LongWord; // Extension Area Offset
|
||||
DevDirOff: LongWord; // Developer Directory Offset
|
||||
Signature: array[0..15] of Char; // TRUEVISION-XFILE
|
||||
Reserved: Byte; // ASCII period '.'
|
||||
NullChar: Byte; // 0
|
||||
ExtOff: LongWord; // Extension Area Offset
|
||||
DevDirOff: LongWord; // Developer Directory Offset
|
||||
Signature: TChar16; // TRUEVISION-XFILE
|
||||
Reserved: Byte; // ASCII period '.'
|
||||
NullChar: Byte; // 0
|
||||
end;
|
||||
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingTypes.pas 132 2008-08-27 20:37:38Z galfar $
|
||||
$Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -39,7 +39,7 @@ const
|
|||
{ Current Minor version of Imaging.}
|
||||
ImagingVersionMinor = 26;
|
||||
{ Current patch of Imaging.}
|
||||
ImagingVersionPatch = 0;
|
||||
ImagingVersionPatch = 4;
|
||||
|
||||
{ Imaging Option Ids whose values can be set/get by SetOption/
|
||||
GetOption functions.}
|
||||
|
@ -91,6 +91,11 @@ const
|
|||
Allowed values are in range 0 (no compresstion) to 9 (best compression).
|
||||
Default value is 5.}
|
||||
ImagingPNGCompressLevel = 26;
|
||||
{ Boolean option that specifies whether PNG images with more frames (APNG format)
|
||||
are animated by Imaging (according to frame disposal/blend methods) or just
|
||||
raw frames are loaded and sent to user (if you want to animate APNG yourself).
|
||||
Default value is 1.}
|
||||
ImagingPNGLoadAnimated = 27;
|
||||
|
||||
{ Specifies whether MNG animation frames are saved with lossy or lossless
|
||||
compression. Lossless frames are saved as PNG images and lossy frames are
|
||||
|
@ -140,10 +145,11 @@ const
|
|||
{ Boolean option that specifies whether GIF images with more frames
|
||||
are animated by Imaging (according to frame disposal methods) or just
|
||||
raw frames are loaded and sent to user (if you want to animate GIF yourself).
|
||||
Default value is 1.}
|
||||
Default value is 1.
|
||||
Raw frames are 256 color indexed images (ifIndex8), whereas
|
||||
animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
|
||||
ImagingGIFLoadAnimated = 56;
|
||||
|
||||
|
||||
{ This option is used when reducing number of colors used in
|
||||
image (mainly when converting from ARGB image to indexed
|
||||
format). Mask is 'anded' (bitwise AND) with every pixel's
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
$Id: ImagingUtility.pas 128 2008-07-23 11:57:36Z galfar $
|
||||
$Id: ImagingUtility.pas 175 2009-10-06 11:55:15Z galfar $
|
||||
Vampyre Imaging Library
|
||||
by Marek Mauder
|
||||
http://imaginglib.sourceforge.net
|
||||
|
@ -56,6 +56,7 @@ type
|
|||
TBooleanArray = array[0..MaxInt - 1] of Boolean;
|
||||
PBooleanArray = ^TBooleanArray;
|
||||
|
||||
TDynByteArray = array of Byte;
|
||||
TDynIntegerArray = array of Integer;
|
||||
TDynBooleanArray = array of Boolean;
|
||||
|
||||
|
@ -98,10 +99,11 @@ type
|
|||
end;
|
||||
PFloatHelper = ^TFloatHelper;
|
||||
|
||||
TChar2 = array[0..1] of Char;
|
||||
TChar3 = array[0..2] of Char;
|
||||
TChar4 = array[0..3] of Char;
|
||||
TChar8 = array[0..7] of Char;
|
||||
TChar2 = array[0..1] of AnsiChar;
|
||||
TChar3 = array[0..2] of AnsiChar;
|
||||
TChar4 = array[0..3] of AnsiChar;
|
||||
TChar8 = array[0..7] of AnsiChar;
|
||||
TChar16 = array[0..15] of AnsiChar;
|
||||
|
||||
{ Options for BuildFileList function:
|
||||
flFullNames - file names in result will have full path names
|
||||
|
@ -156,10 +158,13 @@ function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFD
|
|||
function StrToken(var S: string; Sep: Char): string;
|
||||
{ Same as StrToken but searches from the end of S string.}
|
||||
function StrTokenEnd(var S: string; Sep: Char): string;
|
||||
{ Fills instance of TStrings with tokens from string S where tokens are separated by
|
||||
one of Seps characters.}
|
||||
procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
|
||||
{ Returns string representation of integer number (with digit grouping).}
|
||||
function IntToStrFmt(const I: Int64): string;
|
||||
function IntToStrFmt(const I: Int64): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
{ Returns string representation of float number (with digit grouping).}
|
||||
function FloatToStrFmt(const F: Double; Precision: Integer = 2): string;
|
||||
function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
||||
{ Clamps integer value to range <Min, Max>}
|
||||
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||||
|
@ -447,7 +452,7 @@ var
|
|||
if CaseSensitive then
|
||||
Result := A = B
|
||||
else
|
||||
Result := UpCase(A) = UpCase(B);
|
||||
Result := AnsiUpperCase (A) = AnsiUpperCase (B);
|
||||
end;
|
||||
|
||||
function MatchAt(MaskPos, KeyPos: LongInt): Boolean;
|
||||
|
@ -609,101 +614,6 @@ begin
|
|||
end;
|
||||
|
||||
function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
|
||||
{$IFDEF USE_ASM}
|
||||
asm
|
||||
// The Original ASM Code is (C) Fastcode project.
|
||||
test eax, eax
|
||||
jz @Nil
|
||||
test edx, edx
|
||||
jz @Nil
|
||||
dec ecx
|
||||
jl @Nil
|
||||
|
||||
push esi
|
||||
push ebx
|
||||
|
||||
mov esi, [edx-4] //Length(Str)
|
||||
mov ebx, [eax-4] //Length(Substr)
|
||||
sub esi, ecx //effective length of Str
|
||||
add edx, ecx //addr of the first char at starting position
|
||||
cmp esi, ebx
|
||||
jl @Past //jump if EffectiveLength(Str)<Length(Substr)
|
||||
test ebx, ebx
|
||||
jle @Past //jump if Length(Substr)<=0
|
||||
|
||||
add esp, -12
|
||||
add ebx, -1 //Length(Substr)-1
|
||||
add esi, edx //addr of the terminator
|
||||
add edx, ebx //addr of the last char at starting position
|
||||
mov [esp+8], esi //save addr of the terminator
|
||||
add eax, ebx //addr of the last char of Substr
|
||||
sub ecx, edx //-@Str[Length(Substr)]
|
||||
neg ebx //-(Length(Substr)-1)
|
||||
mov [esp+4], ecx //save -@Str[Length(Substr)]
|
||||
mov [esp], ebx //save -(Length(Substr)-1)
|
||||
movzx ecx, byte ptr [eax] //the last char of Substr
|
||||
|
||||
@Loop:
|
||||
cmp cl, [edx]
|
||||
jz @Test0
|
||||
@AfterTest0:
|
||||
cmp cl, [edx+1]
|
||||
jz @TestT
|
||||
@AfterTestT:
|
||||
add edx, 4
|
||||
cmp edx, [esp+8]
|
||||
jb @Continue
|
||||
@EndLoop:
|
||||
add edx, -2
|
||||
cmp edx, [esp+8]
|
||||
jb @Loop
|
||||
@Exit:
|
||||
add esp, 12
|
||||
@Past:
|
||||
pop ebx
|
||||
pop esi
|
||||
@Nil:
|
||||
xor eax, eax
|
||||
ret
|
||||
@Continue:
|
||||
cmp cl, [edx-2]
|
||||
jz @Test2
|
||||
cmp cl, [edx-1]
|
||||
jnz @Loop
|
||||
@Test1:
|
||||
add edx, 1
|
||||
@Test2:
|
||||
add edx, -2
|
||||
@Test0:
|
||||
add edx, -1
|
||||
@TestT:
|
||||
mov esi, [esp]
|
||||
test esi, esi
|
||||
jz @Found
|
||||
@String:
|
||||
movzx ebx, word ptr [esi+eax]
|
||||
cmp bx, word ptr [esi+edx+1]
|
||||
jnz @AfterTestT
|
||||
cmp esi, -2
|
||||
jge @Found
|
||||
movzx ebx, word ptr [esi+eax+2]
|
||||
cmp bx, word ptr [esi+edx+3]
|
||||
jnz @AfterTestT
|
||||
add esi, 4
|
||||
jl @String
|
||||
@Found:
|
||||
mov eax, [esp+4]
|
||||
add edx, 2
|
||||
|
||||
cmp edx, [esp+8]
|
||||
ja @Exit
|
||||
|
||||
add esp, 12
|
||||
add eax, edx
|
||||
pop ebx
|
||||
pop esi
|
||||
end;
|
||||
{$ELSE}
|
||||
var
|
||||
I, X: LongInt;
|
||||
Len, LenSubStr: LongInt;
|
||||
|
@ -728,11 +638,10 @@ begin
|
|||
end;
|
||||
Result := 0;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt;
|
||||
begin
|
||||
Result := PosEx(LowerCase(SubStr), LowerCase(S), Offset);
|
||||
Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset);
|
||||
end;
|
||||
|
||||
function StrToken(var S: string; Sep: Char): string;
|
||||
|
@ -775,6 +684,19 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
|
||||
var
|
||||
Token, Str: string;
|
||||
begin
|
||||
Tokens.Clear;
|
||||
Str := S;
|
||||
while Str <> '' do
|
||||
begin
|
||||
Token := StrToken(Str, Sep);
|
||||
Tokens.Add(Token);
|
||||
end;
|
||||
end;
|
||||
|
||||
function IntToStrFmt(const I: Int64): string;
|
||||
begin
|
||||
Result := Format('%.0n', [I * 1.0]);
|
||||
|
@ -790,8 +712,7 @@ begin
|
|||
Result := Number;
|
||||
if Result < Min then
|
||||
Result := Min
|
||||
else
|
||||
if Result > Max then
|
||||
else if Result > Max then
|
||||
Result := Max;
|
||||
end;
|
||||
|
||||
|
@ -800,8 +721,7 @@ begin
|
|||
Result := Number;
|
||||
if Result < Min then
|
||||
Result := Min
|
||||
else
|
||||
if Result > Max then
|
||||
else if Result > Max then
|
||||
Result := Max;
|
||||
end;
|
||||
|
||||
|
@ -831,7 +751,7 @@ end;
|
|||
function NextPow2(Num: LongInt): LongInt;
|
||||
begin
|
||||
Result := Num and -Num;
|
||||
while (Result < Num) do
|
||||
while Result < Num do
|
||||
Result := Result shl 1;
|
||||
end;
|
||||
|
||||
|
@ -1335,11 +1255,11 @@ end;
|
|||
|
||||
function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt;
|
||||
var
|
||||
I: LongInt;
|
||||
I: LongInt;
|
||||
begin
|
||||
Result := Depth;
|
||||
for I := 1 to MipMaps - 1 do
|
||||
Inc(Result, ClampInt(Depth shr I, 1, Depth));
|
||||
Result := Depth;
|
||||
for I := 1 to MipMaps - 1 do
|
||||
Inc(Result, ClampInt(Depth shr I, 1, Depth));
|
||||
end;
|
||||
|
||||
function BoundsToRect(X, Y, Width, Height: LongInt): TRect;
|
||||
|
@ -1552,6 +1472,12 @@ initialization
|
|||
-- TODOS ----------------------------------------------------
|
||||
- nothing now
|
||||
|
||||
-- 0.26.1 Changes/Bug Fixes -----------------------------------
|
||||
- Some formatting changes.
|
||||
- Changed some string functions to work with localized strings.
|
||||
- ASM version of PosEx had bugs, removed it.
|
||||
- Added StrTokensToList function.
|
||||
|
||||
-- 0.25.0 Changes/Bug Fixes -----------------------------------
|
||||
- Fixed error in ClipCopyBounds which was causing ... bad clipping!
|
||||
|
||||
|
|
|
@ -34,7 +34,7 @@ uses
|
|||
{$IFDEF VER70}
|
||||
{$ifndef NO_GETENV}
|
||||
Dos, { DOS unit should declare getenv() }
|
||||
{ function GetEnv(name : string) : string; }
|
||||
{ function GetEnv(name : string) : string; }
|
||||
{$endif}
|
||||
imjmemdos; { import the system-dependent declarations }
|
||||
{$ELSE}
|
||||
|
@ -492,6 +492,7 @@ begin
|
|||
{ Calculate max # of rows allowed in one allocation chunk }
|
||||
ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div
|
||||
(long(blocksperrow) * SIZEOF(JBLOCK));
|
||||
|
||||
if (ltemp <= 0) then
|
||||
ERREXIT(cinfo, JERR_WIDTH_OVERFLOW);
|
||||
if (ltemp < long(numrows)) then
|
||||
|
|
|
@ -27,13 +27,8 @@ uses
|
|||
NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
|
||||
size_t and will be a multiple of sizeof(align_type). }
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
const
|
||||
MAX_ALLOC_CHUNK = long(32752);
|
||||
{$ELSE}
|
||||
const
|
||||
MAX_ALLOC_CHUNK = long(1000000000);
|
||||
{$ENDIF}
|
||||
|
||||
{GLOBAL}
|
||||
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
|
||||
|
|
|
@ -124,7 +124,7 @@ type
|
|||
FStrmPos: Integer;
|
||||
FOnProgress: TNotifyEvent;
|
||||
FZRec: TZStreamRec;
|
||||
FBuffer: array [Word] of Char;
|
||||
FBuffer: array [Word] of Byte;
|
||||
protected
|
||||
procedure Progress(Sender: TObject); dynamic;
|
||||
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
||||
|
@ -228,7 +228,7 @@ type
|
|||
implementation
|
||||
|
||||
const
|
||||
ZErrorMessages: array[0..9] of PChar = (
|
||||
ZErrorMessages: array[0..9] of PAnsiChar = (
|
||||
'need dictionary', // Z_NEED_DICT (2)
|
||||
'stream end', // Z_STREAM_END (1)
|
||||
'', // Z_OK (0)
|
||||
|
@ -491,7 +491,7 @@ end;
|
|||
function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
var
|
||||
I: Integer;
|
||||
Buf: array [0..4095] of Char;
|
||||
Buf: array [0..4095] of Byte;
|
||||
begin
|
||||
if (Offset = 0) and (Origin = soFromBeginning) then
|
||||
begin
|
||||
|
|
|
@ -172,7 +172,7 @@ begin
|
|||
c^.sub.lit := t^.base;
|
||||
{$IFDEF DEBUG}
|
||||
if (t^.base >= $20) and (t^.base < $7f) then
|
||||
Tracevv('inflate: literal '+char(t^.base))
|
||||
Tracevv('inflate: literal '+AnsiChar(t^.base))
|
||||
else
|
||||
Tracevv('inflate: literal '+IntToStr(t^.base));
|
||||
{$ENDIF}
|
||||
|
|
|
@ -99,7 +99,7 @@ begin
|
|||
Dec(k, t^.bits);
|
||||
{$IFDEF DEBUG}
|
||||
if (t^.base >= $20) and (t^.base < $7f) then
|
||||
Tracevv('inflate: * literal '+char(t^.base))
|
||||
Tracevv('inflate: * literal '+AnsiChar(t^.base))
|
||||
else
|
||||
Tracevv('inflate: * literal '+ IntToStr(t^.base));
|
||||
{$ENDIF}
|
||||
|
@ -241,7 +241,7 @@ begin
|
|||
|
||||
{$IFDEF DEBUG}
|
||||
if (t^.base >= $20) and (t^.base < $7f) then
|
||||
Tracevv('inflate: * literal '+char(t^.base))
|
||||
Tracevv('inflate: * literal '+AnsiChar(t^.base))
|
||||
else
|
||||
Tracevv('inflate: * literal '+IntToStr(t^.base));
|
||||
{$ENDIF}
|
||||
|
|
|
@ -376,23 +376,23 @@ const
|
|||
|
||||
|
||||
{$IFDEF DEBUG}
|
||||
procedure Assert(cond : boolean; msg : string);
|
||||
procedure Assert(cond : boolean; msg : AnsiString);
|
||||
{$ENDIF}
|
||||
|
||||
procedure Trace(x : string);
|
||||
procedure Tracev(x : string);
|
||||
procedure Tracevv(x : string);
|
||||
procedure Tracevvv(x : string);
|
||||
procedure Tracec(c : boolean; x : string);
|
||||
procedure Tracecv(c : boolean; x : string);
|
||||
procedure Trace(x : AnsiString);
|
||||
procedure Tracev(x : AnsiString);
|
||||
procedure Tracevv(x : AnsiString);
|
||||
procedure Tracevvv(x : AnsiString);
|
||||
procedure Tracec(c : boolean; x : AnsiString);
|
||||
procedure Tracecv(c : boolean; x : AnsiString);
|
||||
|
||||
function zlibVersion : string;
|
||||
function zlibVersion : AnsiString;
|
||||
{ The application can compare zlibVersion and ZLIB_VERSION for consistency.
|
||||
If the first character differs, the library code actually used is
|
||||
not compatible with the zlib.h header file used by the application.
|
||||
This check is automatically made by deflateInit and inflateInit. }
|
||||
|
||||
function zError(err : int) : string;
|
||||
function zError(err : int) : AnsiString;
|
||||
function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
|
||||
procedure ZFREE (var strm : z_stream; ptr : voidpf);
|
||||
procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
|
||||
|
@ -416,9 +416,9 @@ const
|
|||
const
|
||||
z_verbose : int = 1;
|
||||
|
||||
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
|
||||
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
|
||||
Stream_size: LongInt): LongInt;
|
||||
function inflateInit_(var Stream: z_stream; const Version: string;
|
||||
function inflateInit_(var Stream: z_stream; const Version: AnsiString;
|
||||
Stream_size: Longint): LongInt;
|
||||
|
||||
{$IFDEF DEBUG}
|
||||
|
@ -430,29 +430,29 @@ implementation
|
|||
uses
|
||||
imzdeflate, imzinflate;
|
||||
|
||||
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: string;
|
||||
function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
|
||||
Stream_size: LongInt): LongInt;
|
||||
begin
|
||||
Result := imzdeflate.deflateInit_(@Stream, Level, Version, Stream_size);
|
||||
end;
|
||||
|
||||
function inflateInit_(var Stream: z_stream; const Version: string;
|
||||
function inflateInit_(var Stream: z_stream; const Version: AnsiString;
|
||||
Stream_size: Longint): LongInt;
|
||||
begin
|
||||
Result := imzinflate.inflateInit_(@Stream, Version, Stream_size);
|
||||
end;
|
||||
|
||||
function zError(err : int) : string;
|
||||
function zError(err : int) : AnsiString;
|
||||
begin
|
||||
zError := z_errmsg[Z_NEED_DICT-err];
|
||||
end;
|
||||
|
||||
function zlibVersion : string;
|
||||
function zlibVersion : AnsiString;
|
||||
begin
|
||||
zlibVersion := ZLIB_VERSION;
|
||||
end;
|
||||
|
||||
procedure z_error (m : string);
|
||||
procedure z_error (m : AnsiString);
|
||||
begin
|
||||
WriteLn(output, m);
|
||||
Write('Zlib - Halt...');
|
||||
|
@ -460,42 +460,42 @@ begin
|
|||
Halt(1);
|
||||
end;
|
||||
|
||||
procedure Assert(cond : boolean; msg : string);
|
||||
procedure Assert(cond : boolean; msg : AnsiString);
|
||||
begin
|
||||
if not cond then
|
||||
z_error(msg);
|
||||
end;
|
||||
|
||||
procedure Trace(x : string);
|
||||
procedure Trace(x : AnsiString);
|
||||
begin
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
procedure Tracev(x : string);
|
||||
procedure Tracev(x : AnsiString);
|
||||
begin
|
||||
if (z_verbose>0) then
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
procedure Tracevv(x : string);
|
||||
procedure Tracevv(x : AnsiString);
|
||||
begin
|
||||
if (z_verbose>1) then
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
procedure Tracevvv(x : string);
|
||||
procedure Tracevvv(x : AnsiString);
|
||||
begin
|
||||
if (z_verbose>2) then
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
procedure Tracec(c : boolean; x : string);
|
||||
procedure Tracec(c : boolean; x : AnsiString);
|
||||
begin
|
||||
if (z_verbose>0) and (c) then
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
procedure Tracecv(c : boolean; x : string);
|
||||
procedure Tracecv(c : boolean; x : AnsiString);
|
||||
begin
|
||||
if (z_verbose>1) and c then
|
||||
WriteLn(x);
|
||||
|
|
|
@ -637,7 +637,7 @@ const
|
|||
}
|
||||
|
||||
const
|
||||
Buf_size = (8 * 2*sizeof(char));
|
||||
Buf_size = (8 * 2*sizeof(uch));
|
||||
{ Number of bits used within bi_buf. (bi_buf might be implemented on
|
||||
more than 16 bits on some systems.) }
|
||||
|
||||
|
@ -916,7 +916,7 @@ begin
|
|||
{$ifdef DEBUG}
|
||||
if (n>31) and (n<128) then
|
||||
Tracecv(tree <> tree_ptr(@static_ltree),
|
||||
(^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
|
||||
(^M'n #'+IntToStr(n)+' '+AnsiChar(n)+' l '+IntToStr(len)+' c '+
|
||||
IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
|
||||
else
|
||||
Tracecv(tree <> tree_ptr(@static_ltree),
|
||||
|
@ -1962,7 +1962,7 @@ begin
|
|||
{ send a literal byte }
|
||||
{$ifdef DEBUG}
|
||||
Tracevvv(#13'cd '+IntToStr(lc));
|
||||
Tracecv((lc > 31) and (lc < 128), ' '+char(lc)+' ');
|
||||
Tracecv((lc > 31) and (lc < 128), ' '+AnsiChar(lc)+' ');
|
||||
{$ENDIF}
|
||||
send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len);
|
||||
end
|
||||
|
@ -2106,7 +2106,7 @@ begin
|
|||
{$endif} { STORED_FILE_OK }
|
||||
|
||||
{$ifdef FORCE_STORED}
|
||||
if (buf <> pchar(0)) then
|
||||
if (buf <> pcharf(0)) then
|
||||
begin { force stored block }
|
||||
{$else}
|
||||
if (stored_len+4 <= opt_lenb) and (buf <> pcharf(0)) then
|
||||
|
|
|
@ -61,7 +61,7 @@ uses
|
|||
|
||||
function deflateInit_(strm : z_streamp;
|
||||
level : int;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
|
||||
|
||||
|
@ -499,7 +499,7 @@ function deflateInit2_(var strm : z_stream;
|
|||
windowBits : int;
|
||||
memLevel : int;
|
||||
strategy : int;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
var
|
||||
s : deflate_state_ptr;
|
||||
|
@ -622,7 +622,7 @@ end;
|
|||
|
||||
function deflateInit_(strm : z_streamp;
|
||||
level : int;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
begin
|
||||
if (strm = Z_NULL) then
|
||||
|
@ -1528,7 +1528,7 @@ begin
|
|||
begin
|
||||
WriteLn(' start ',start,', match ',match ,' length ', length);
|
||||
repeat
|
||||
Write(char(s.window^[match]), char(s.window^[start]));
|
||||
Write(AnsiChar(s.window^[match]), AnsiChar(s.window^[start]));
|
||||
Inc(match);
|
||||
Inc(start);
|
||||
Dec(length);
|
||||
|
@ -1539,7 +1539,7 @@ begin
|
|||
begin
|
||||
Write('\\[',start-match,',',length,']');
|
||||
repeat
|
||||
Write(char(s.window^[start]));
|
||||
Write(AnsiChar(s.window^[start]));
|
||||
Inc(start);
|
||||
Dec(length);
|
||||
Until (length = 0);
|
||||
|
@ -1910,7 +1910,7 @@ end;
|
|||
begin
|
||||
{ No match, output a literal byte }
|
||||
{$IFDEF DEBUG}
|
||||
Tracevv(char(s.window^[s.strstart]));
|
||||
Tracevv(AnsiChar(s.window^[s.strstart]));
|
||||
{$ENDIF}
|
||||
{_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);}
|
||||
bflush := _tr_tally (s, 0, s.window^[s.strstart]);
|
||||
|
@ -2071,7 +2071,7 @@ begin
|
|||
single literal. If there was a match but the current match
|
||||
is longer, truncate the previous match to a single literal. }
|
||||
{$IFDEF DEBUG}
|
||||
Tracevv(char(s.window^[s.strstart-1]));
|
||||
Tracevv(AnsiChar(s.window^[s.strstart-1]));
|
||||
{$ENDIF}
|
||||
bflush := _tr_tally (s, 0, s.window^[s.strstart-1]);
|
||||
|
||||
|
@ -2104,7 +2104,7 @@ begin
|
|||
if (s.match_available) then
|
||||
begin
|
||||
{$IFDEF DEBUG}
|
||||
Tracevv(char(s.window^[s.strstart-1]));
|
||||
Tracevv(AnsiChar(s.window^[s.strstart-1]));
|
||||
bflush :=
|
||||
{$ENDIF}
|
||||
_tr_tally (s, 0, s.window^[s.strstart-1]);
|
||||
|
|
|
@ -31,13 +31,13 @@ function inflateInit(var z : z_stream) : int;
|
|||
|
||||
|
||||
function inflateInit_(z : z_streamp;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
|
||||
|
||||
function inflateInit2_(var z: z_stream;
|
||||
w : int;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
|
||||
function inflateInit2(var z: z_stream;
|
||||
|
@ -246,7 +246,7 @@ end;
|
|||
|
||||
function inflateInit2_(var z: z_stream;
|
||||
w : int;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
begin
|
||||
if (version = '') or (version[1] <> ZLIB_VERSION[1]) or
|
||||
|
@ -333,7 +333,7 @@ begin
|
|||
end;
|
||||
|
||||
function inflateInit_(z : z_streamp;
|
||||
const version : string;
|
||||
const version : AnsiString;
|
||||
stream_size : int) : int;
|
||||
begin
|
||||
{ initialize state }
|
||||
|
|
|
@ -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