paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 14:47:21 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Added compact image support by Mattias Gaertner

Browse Source 
git-svn-id: trunk@21653 -
This commit is contained in:
michael 2012-06-19 18:25:27 +00:00
parent 3ffa6bf2f3
commit 616b2d9b20
3 changed files with 216 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
packages/fcl-image/examples/drawing.pp
View File

@ -2,7 +2,7 @@
program Drawing;
uses classes, sysutils,
FPImage, FPCanvas, FPImgCanv,
FPImage, FPCanvas, FPImgCanv, ftFont,
FPWritePNG, FPReadPNG;
const
@ -13,6 +13,7 @@ var canvas : TFPcustomCAnvas;
ci, image : TFPCustomImage;
writer : TFPCustomImageWriter;
reader : TFPCustomImageReader;
f : TFreeTypeFont;
begin
image := TFPMemoryImage.Create (100,100);
ci := TFPMemoryImage.Create (20,20);
@ -27,7 +28,7 @@ begin
GrayScale := false;
end;
try
ci.LoadFromFile ('test.png', reader);
// ci.LoadFromFile ('test.png', reader);
with Canvas as TFPImageCanvas do
begin
pen.mode := pmCopy;
@ -51,11 +52,13 @@ begin
end;
pen.style := psSolid;
RelativeBrushImage := true;
{
brush.image := ci;
brush.style := bsimage;
with brush.FPColor do
green := green div 2;
Ellipse (11,11, 89,89);
}
brush.style := bsSolid;
brush.FPColor := MyColor;
@ -68,8 +71,19 @@ begin
pen.FPColor := colCyan;
ellipseC (50,50, 1,1);
writeln ('Saving to inspect !');
InitEngine;
F:=TFreeTypeFont.Create;
F.Angle:=0.15;
Font:=F;
// Font.Name:='/usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf';
Font.Name:='/home/michael/Documents/arial.ttf';
Font.Size:=10;
Font.FPColor:=colWhite;
// Font.Orientation:=900;
Canvas.TextOut(10,90,'o');
end;
writeln ('Saving to inspect !');
image.SaveToFile ('DrawTest.png', writer);
finally
Canvas.Free;
@ -81,7 +95,7 @@ begin
end;
begin
// DefaultFontPath := 'c:\winnt\fonts\';
// DefaultFontPath := '/usr/share/fonts/truetype/ttf-dejavu/';
DoDraw;
end.

1
packages/fcl-image/fpmake.pp
View File

@ -87,6 +87,7 @@ begin
AddInclude('fphandler.inc');
AddInclude('fppalette.inc');
AddInclude('fpcolcnv.inc');
AddInclude('fpcompactimg.inc');
end;
T:=P.Targets.AddUnit('fpimgcanv.pp');
with T.Dependencies do

197
packages/fcl-image/src/fpimage.pp
View File

@ -343,6 +343,202 @@ function CreateWebSafePalette : TFPPalette;
function CreateGrayScalePalette : TFPPalette;
function CreateVGAPalette : TFPPalette;
Type
TFPCompactImgDesc = record
Gray: boolean; // true = red=green=blue, false: a RGB image
Depth: word; // 8 or 16 bit
HasAlpha: boolean; // has alpha channel
end;
{ TFPCompactImgBase }
TFPCompactImgBase = class(TFPCustomImage)
private
FDesc: TFPCompactImgDesc;
public
property Desc: TFPCompactImgDesc read FDesc;
end;
TFPCompactImgBaseClass = class of TFPCompactImgBase;
{ TFPCompactImgGray16Bit }
TFPCompactImgGray16Bit = class(TFPCompactImgBase)
protected
FData: PWord;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
TFPCompactImgGrayAlpha16BitValue = packed record
g,a: word;
end;
PFPCompactImgGrayAlpha16BitValue = ^TFPCompactImgGrayAlpha16BitValue;
{ TFPCompactImgGrayAlpha16Bit }
TFPCompactImgGrayAlpha16Bit = class(TFPCompactImgBase)
protected
FData: PFPCompactImgGrayAlpha16BitValue;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
{ TFPCompactImgGray8Bit }
TFPCompactImgGray8Bit = class(TFPCompactImgBase)
protected
FData: PByte;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
TFPCompactImgGrayAlpha8BitValue = packed record
g,a: byte;
end;
PFPCompactImgGrayAlpha8BitValue = ^TFPCompactImgGrayAlpha8BitValue;
{ TFPCompactImgGrayAlpha8Bit }
TFPCompactImgGrayAlpha8Bit = class(TFPCompactImgBase)
protected
FData: PFPCompactImgGrayAlpha8BitValue;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
TFPCompactImgRGBA8BitValue = packed record
r,g,b,a: byte;
end;
PFPCompactImgRGBA8BitValue = ^TFPCompactImgRGBA8BitValue;
{ TFPCompactImgRGBA8Bit }
TFPCompactImgRGBA8Bit = class(TFPCompactImgBase)
protected
FData: PFPCompactImgRGBA8BitValue;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
TFPCompactImgRGB8BitValue = packed record
r,g,b: byte;
end;
PFPCompactImgRGB8BitValue = ^TFPCompactImgRGB8BitValue;
{ TFPCompactImgRGB8Bit }
TFPCompactImgRGB8Bit = class(TFPCompactImgBase)
protected
FData: PFPCompactImgRGB8BitValue;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
TFPCompactImgRGB16BitValue = packed record
r,g,b: word;
end;
PFPCompactImgRGB16BitValue = ^TFPCompactImgRGB16BitValue;
{ TFPCompactImgRGB16Bit }
TFPCompactImgRGB16Bit = class(TFPCompactImgBase)
protected
FData: PFPCompactImgRGB16BitValue;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
{ TFPCompactImgRGBA16Bit }
TFPCompactImgRGBA16Bit = class(TFPCompactImgBase)
protected
FData: PFPColor;
function GetInternalColor(x, y: integer): TFPColor; override;
function GetInternalPixel({%H-}x, {%H-}y: integer): integer; override;
procedure SetInternalColor (x, y: integer; const Value: TFPColor); override;
procedure SetInternalPixel({%H-}x, {%H-}y: integer; {%H-}Value: integer); override;
public
constructor Create(AWidth, AHeight: integer); override;
destructor Destroy; override;
procedure SetSize(AWidth, AHeight: integer); override;
end;
{ Create a descriptor to select a CompactImg class }
function GetFPCompactImgDesc(Gray: boolean; Depth: word; HasAlpha: boolean): TFPCompactImgDesc;
{ Returns a CompactImg class that fits the descriptor }
function GetFPCompactImgClass(const Desc: TFPCompactImgDesc): TFPCompactImgBaseClass;
{ Create a CompactImg with the descriptor }
function CreateFPCompactImg(const Desc: TFPCompactImgDesc; Width, Height: integer): TFPCustomImage;
{ Create a CompactImg with the same features as Img.
If Img is a TFPCompactImgBaseClass it will create that.
Otherwise it returns a CompactImg that fits the Img using GetMinimumPTDesc. }
function CreateCompatibleFPCompactImg(Img: TFPCustomImage; Width, Height: integer
): TFPCustomImage;
{ As CreateCompatibleFPCompactImg, but the image has always an alpha channel. }
function CreateCompatibleFPCompactImgWithAlpha(Img: TFPCustomImage;
Width, Height: integer): TFPCustomImage;
{ Returns the smallest descriptor that allows to store the Img.
It returns HasAlpha=false if all pixel are opaque.
It returns Gray=true if all red=green=blue.
It returns Depth=8 if all lo byte equals the hi byte or all lo bytes are 0.
To ignore rounding errors you can pass a FuzzyDepth. For example a FuzzyDepth
of 3 ignores the lower 3 bits when comparing. }
function GetMinimumPTDesc(Img: TFPCustomImage; FuzzyDepth: word = 4): TFPCompactImgDesc;
{ Create a smaller CompactImg with the same information as Img.
Pass FreeImg=true to call Img.Free }
function GetMinimumFPCompactImg(Img: TFPCustomImage; FreeImg: boolean;
FuzzyDepth: word = 4): TFPCustomImage;
implementation
procedure FPImgError (Fmt:TErrorTextIndices; data : array of const);
@ -359,6 +555,7 @@ end;
{$i FPHandler.inc}
{$i FPPalette.inc}
{$i FPColCnv.inc}
{$i fpcompactimg.inc}
function FPColor (r,g,b:word) : TFPColor;
begin