535 lines
16 KiB
ObjectPascal
535 lines
16 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v6.0 }
|
|
{ Graphic routines }
|
|
{ }
|
|
{ Copyright (c) 1998-2018 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxPNGGraphicsLaz;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
SysUtils, {$IFNDEF FPC}Windows, Messages,{$ENDIF}
|
|
Classes, Graphics, frxPictureGraphics, frxBaseGraphicsTypes;
|
|
|
|
const
|
|
frxPNGFileFormat = 5;
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxUtils
|
|
{$IFNDEF FPC}
|
|
{$IFDEF Delphi12}
|
|
, pngimage
|
|
{$ELSE}
|
|
, frxpngimage
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
;
|
|
|
|
type
|
|
{$IFDEF Delphi12}
|
|
TPNGObject = class(TPngImage);
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
TPNGObject = class(TPortableNetworkGraphic);
|
|
{$ENDIF}
|
|
THackGraphic = class(TGraphic);
|
|
TfrxPNGGraphicFormat = class(TfrxFullAbilitiesGraphicFormat)
|
|
protected
|
|
class function GetCanvasHelperClass: TfrxGraphicCanvasHelperClass; override;
|
|
{$IFNDEF FPC}
|
|
class procedure AssignBitmapToAPNG(PNG: TPngObject; ABitmap: TBitmap);
|
|
{$ENDIF}
|
|
public
|
|
class function ConvertToBitmap(Graphic: TGraphic; DestPixelFormat: TPixelFormat): TGraphic; override;
|
|
class function ConvertFrom(Graphic: TGraphic; DestPixelFormat: TPixelFormat; DestQuality: Integer = 100): TGraphic; override;
|
|
class function CreateNew(Width: Integer; Height: Integer; PixelFormat: TPixelFormat; Transparent: Boolean; Quality: Integer = 100): TGraphic; override;
|
|
class function CreateFromStream(const Stream: TStream): TGraphic; override;
|
|
class procedure DrawTransparent(Canvas: TCanvas; AGraphic: TGraphic; Area: TRect; MaskColor: TColor; Quality: TfrxGraphicQuality); override;
|
|
class procedure Draw(Canvas: TCanvas; AGraphic: TGraphic; Area: TRect; Quality: TfrxGraphicQuality); override;
|
|
class function GetGraphicClass: TGraphicClass; override;
|
|
class function GetGraphicMime: String; override;
|
|
class function GetGraphicName: String; override;
|
|
class function GetGraphicExt: String; override;
|
|
class function GetGraphicConst: Integer; override;
|
|
class function GetAlphaBitmap(Graphic: TGraphic): TBitmap; override;
|
|
class function GetGraphicProps(Graphic: TGraphic): TfrxGraphicProps; override;
|
|
class function HasAlphaChanel(Graphic: TGraphic): Boolean; override;
|
|
class function IsSupportedFormat(const Stream: TStream): Boolean; override;
|
|
class function LoadFromStream(const aPictire: TPicture; Stream: TStream): Boolean; override;
|
|
class procedure SetTransparent(Graphic: TGraphic; Transparent: Boolean); override;
|
|
class procedure SetTransparentColor(Graphic: TGraphic; Color: TColor); override;
|
|
class function GetTransparentColor(Graphic: TGraphic): TColor; override;
|
|
end;
|
|
|
|
TfrxPNGCanvasHelper = class(TfrxGraphicCanvasHelper)
|
|
private
|
|
FBitmap: TBitmap;
|
|
protected
|
|
function GetCanvas: TCanvas; override;
|
|
function GetCanvasGraphic: TGraphic; override;
|
|
public
|
|
procedure ReleaseCanvas; override;
|
|
end;
|
|
|
|
{$IFNDEF FPC}
|
|
|
|
function PNGToPNGA(PNG: TPngObject): TPngObject;
|
|
var
|
|
PNGA: TPngObject;
|
|
tRNS: TChunktRNS;
|
|
PLTE: TChunkPLTE;
|
|
dst: pRGBLine;
|
|
src, alpha: {$IFDEF Delphi12}pngimage.{$ELSE}frxpngimage.{$ENDIF}pByteArray;
|
|
X, Y: Integer;
|
|
i: byte;
|
|
begin
|
|
PNGA := TPngObject.CreateBlank(COLOR_RGBALPHA, 8, PNG.Width, PNG.Height);
|
|
case PNG.Header.ColorType of
|
|
COLOR_PALETTE:
|
|
begin
|
|
tRNS := PNG.Chunks.ItemFromClass(TChunktRNS) as TChunktRNS;
|
|
PLTE := PNG.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
|
|
for Y := 0 to PNG.Height - 1 do
|
|
begin
|
|
dst := PNGA.Scanline[Y];
|
|
src := PNG.Scanline[Y];
|
|
alpha := PNGA.AlphaScanline[Y];
|
|
for X := 0 to PNG.Width - 1 do
|
|
begin
|
|
case PNG.Header.BitDepth of
|
|
8:
|
|
i := src[X];
|
|
2, 4:
|
|
i := src[X div 2] shr ((1 - (X mod 2)) * 4) and $0F;
|
|
1:
|
|
i := src[X div 8] shr (7 - (X mod 8)) and 1;
|
|
else
|
|
raise Exception.Create('Unknown PNG BitDepth');
|
|
end;
|
|
dst[X].rgbtBlue := PLTE.Item[i].rgbBlue;
|
|
dst[X].rgbtGreen := PLTE.Item[i].rgbGreen;
|
|
dst[X].rgbtRed := PLTE.Item[i].rgbRed;
|
|
if tRNS <> nil then
|
|
alpha[X] := tRNS.PaletteValues[i]
|
|
else
|
|
alpha[X] := 255;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
COLOR_RGB, COLOR_GRAYSCALE:
|
|
begin
|
|
PNGA.Canvas.Lock;
|
|
try
|
|
BitBlt(PNGA.Canvas.Handle, 0, 0, PNGA.Width, PNGA.Height,
|
|
PNG.Canvas.Handle, 0, 0, SRCCOPY);
|
|
finally
|
|
PNGA.Canvas.Unlock;
|
|
end;
|
|
for Y := 0 to PNG.Height - 1 do
|
|
FillChar(PNGA.AlphaScanline[Y]^, PNG.Width, 255);
|
|
end;
|
|
|
|
COLOR_GRAYSCALEALPHA:
|
|
begin
|
|
PNGA.Canvas.Lock;
|
|
try
|
|
BitBlt(PNGA.Canvas.Handle, 0, 0, PNGA.Width, PNGA.Height,
|
|
PNG.Canvas.Handle, 0, 0, SRCCOPY);
|
|
finally
|
|
PNGA.Canvas.Unlock;
|
|
end;
|
|
for Y := 0 to PNG.Height - 1 do
|
|
begin
|
|
src := PNG.AlphaScanline[Y];
|
|
alpha := PNGA.AlphaScanline[Y];
|
|
Move(src^, alpha^, PNG.Width);
|
|
end;
|
|
end;
|
|
|
|
else
|
|
PNGA.Assign(PNG);
|
|
end;
|
|
Result := PNGA;
|
|
end;
|
|
|
|
procedure Png32ToTransparentBitmap32(PNG: TPngObject; out Bitmap: TBitmap);
|
|
var
|
|
AlphaScanline: {$IFDEF Delphi12}pngimage.{$ELSE}frxpngimage.{$ENDIF}pByteArray;
|
|
Alpha: Byte;
|
|
Dest: PByte;
|
|
Source: PByte;
|
|
y, x: Integer;
|
|
begin
|
|
Bitmap := TBitmap.Create;
|
|
Bitmap.PixelFormat := pf32bit;
|
|
Bitmap.Width := PNG.Width;
|
|
Bitmap.Height := PNG.Height;
|
|
// Bitmap.Canvas.Lock;
|
|
Bitmap.Canvas.Draw(0, 0, PNG);
|
|
|
|
for y := 0 to PNG.Height - 1 do
|
|
begin
|
|
AlphaScanline := PNG.AlphaScanline[y];
|
|
Dest := Bitmap.ScanLine[y];
|
|
Source := PNG.Scanline[y];
|
|
for x := 0 to PNG.Width - 1 do
|
|
begin
|
|
Alpha := AlphaScanline^[x];
|
|
Dest^ := MulDiv(Source^, Alpha, 255); Inc(Dest); Inc(Source);
|
|
Dest^ := MulDiv(Source^, Alpha, 255); Inc(Dest); Inc(Source);
|
|
Dest^ := MulDiv(Source^, Alpha, 255); Inc(Dest); Inc(Source);
|
|
Dest^ := Alpha; Inc(Dest);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function IsCanPngToTransparentBitmap32(PNG: TPngObject; out Bitmap: TBitmap): boolean;
|
|
var
|
|
PNGA: TPngObject;
|
|
begin
|
|
Result := PNG.TransparencyMode in [ptmBit, ptmPartial];
|
|
if Result then
|
|
if PNG.Header.ColorType = COLOR_RGBALPHA then
|
|
Png32ToTransparentBitmap32(PNG, Bitmap)
|
|
else
|
|
begin
|
|
PNGA := PNGToPNGA(PNG);
|
|
Png32ToTransparentBitmap32(PNGA, Bitmap);
|
|
PNGA.Free;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
Bitmap32BF: TBlendFunction = ( BlendOp: AC_SRC_OVER; BlendFlags: 0;
|
|
SourceConstantAlpha: 255; AlphaFormat: AC_SRC_ALPHA );
|
|
{$ENDIF}
|
|
|
|
{ TfrxPNGGraphicFormat }
|
|
{$IFNDEF FPC}
|
|
class procedure TfrxPNGGraphicFormat.AssignBitmapToAPNG(PNG: TPngObject; ABitmap: TBitmap);
|
|
var
|
|
SourceBM, DestPNG, AlphaPNG: PByte;
|
|
y, x: Integer;
|
|
S1, S2, S3, Alpha: Byte;
|
|
Factor: Double;
|
|
begin
|
|
for Y := 0 to ABitmap.Height - 1 do
|
|
begin
|
|
SourceBM := ABitmap.Scanline[Y];
|
|
DestPNG := PNG.Scanline[Y];
|
|
AlphaPNG := Pointer(PNG.AlphaScanline[Y]);
|
|
for X := 0 to ABitmap.Width - 1 do
|
|
begin
|
|
S1 := SourceBM^; Inc(SourceBM);
|
|
S2 := SourceBM^; Inc(SourceBM);
|
|
S3 := SourceBM^; Inc(SourceBM);
|
|
alpha := SourceBM^; Inc(SourceBM);
|
|
|
|
if alpha > 0 then
|
|
Factor := 255 / alpha
|
|
else
|
|
Factor := 0;
|
|
|
|
DestPNG^ := Round(S1 * Factor); Inc(DestPNG);
|
|
DestPNG^ := Round(S2 * Factor); Inc(DestPNG);
|
|
DestPNG^ := Round(S3 * Factor); Inc(DestPNG);
|
|
if AlphaPNG <> nil then
|
|
begin
|
|
AlphaPNG^ := alpha;
|
|
Inc(AlphaPNG);
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
{$ENDIF}
|
|
|
|
class function TfrxPNGGraphicFormat.ConvertFrom(Graphic: TGraphic; DestPixelFormat: TPixelFormat; DestQuality: Integer): TGraphic;
|
|
var
|
|
Bitmap: TBitmap absolute Graphic;
|
|
HasAlpha, NeedBitmap: Boolean;
|
|
begin
|
|
if Graphic is GetGraphicClass then
|
|
begin
|
|
Result := CreateNew(Graphic.Width, Graphic.Height, DestPixelFormat, DestPixelFormat = pf32bit, DestQuality);
|
|
TPngObject(Result).Canvas.Brush.Color := clWhite;
|
|
TPngObject(Result).Canvas.FillRect(0, 0, Graphic.Width, Graphic.Height);
|
|
Result.Assign(Graphic);
|
|
Exit;
|
|
end;
|
|
NeedBitmap := not (Graphic is TBitmap);
|
|
if NeedBitmap then
|
|
Graphic := GetGraphicFormats.ConvertToBitmap(Graphic, DestPixelFormat);
|
|
try
|
|
HasAlpha := (DestPixelFormat = pf32bit) and (Bitmap.PixelFormat = pf32bit);
|
|
Result := CreateNew(Bitmap.Width, Bitmap.Height, DestPixelFormat, HasAlpha, DestQuality);
|
|
// TODO: Alpha
|
|
if HasAlpha then
|
|
Result.Assign(Graphic)
|
|
else Result.Assign(Graphic);
|
|
//if not HasAlpha then
|
|
// TPngObject(Result).TransparentColor := $FFFFFF;
|
|
finally
|
|
if NeedBitmap then Graphic.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.ConvertToBitmap(Graphic: TGraphic;
|
|
DestPixelFormat: TPixelFormat): TGraphic;
|
|
var
|
|
ABitmap: TBitmap;
|
|
// PNGA: TPngObject absolute Graphic;
|
|
// ResBitmap: TBitmap absolute Result;
|
|
begin
|
|
Result := nil;
|
|
// if (PNGA.TransparencyMode in [ptmBit, ptmPartial]) and (PNGA.Header.ColorType = COLOR_RGBALPHA) then
|
|
// Png32ToTransparentBitmap32(PNGA, ResBitmap);
|
|
|
|
if Result = nil then
|
|
Result := inherited ConvertToBitmap(Graphic, DestPixelFormat);
|
|
{ invert black transparent color of PNG image with alpha to white fill color }
|
|
{ used when convert PNG with alpha to non transcarent image like JPEG }
|
|
if (TPngObject(Graphic).Transparent) and (DestPixelFormat <> pf32bit) then
|
|
begin
|
|
ABitmap := TBitmap(GetAlphaBitmap(Graphic));
|
|
try
|
|
Result := inherited ConvertToBitmap(Graphic, DestPixelFormat);
|
|
TBitmap(Result).Canvas.Lock;
|
|
TBitmap(Result).Canvas.CopyMode := cmMergePaint;
|
|
TBitmap(Result).Canvas.Draw(0, 0, ABitmap);
|
|
TBitmap(Result).Canvas.Unlock;
|
|
finally
|
|
ABitmap.Free;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.CreateFromStream(
|
|
const Stream: TStream): TGraphic;
|
|
begin
|
|
Result := inherited CreateFromStream(Stream);
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.CreateNew(Width, Height: Integer;
|
|
PixelFormat: TPixelFormat; Transparent: Boolean; Quality: Integer): TGraphic;
|
|
begin
|
|
Result := TPortableNetworkGraphic.Create;
|
|
TPortableNetworkGraphic(Result).PixelFormat := PixelFormat;
|
|
TPortableNetworkGraphic(Result).SetSize(Width, Height);
|
|
end;
|
|
|
|
class procedure TfrxPNGGraphicFormat.Draw(Canvas: TCanvas; AGraphic: TGraphic;
|
|
Area: TRect; Quality: TfrxGraphicQuality);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if (Quality in [gqPrint, gqHiQuality]) and HasAlphaChanel(AGraphic) or (Canvas.ClassType = frxDefaultMetaCanvasClass) then
|
|
DrawTransparent(Canvas, AGraphic, Area, clNone, Quality)
|
|
else
|
|
{$ENDIF}
|
|
inherited Draw(Canvas, AGraphic, Area, Quality);
|
|
end;
|
|
|
|
class procedure TfrxPNGGraphicFormat.DrawTransparent(Canvas: TCanvas;
|
|
AGraphic: TGraphic; Area: TRect; MaskColor: TColor;
|
|
Quality: TfrxGraphicQuality);
|
|
var
|
|
Bitmap: TBitmap;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if (Quality = gqFast) and (Canvas.ClassType <> frxDefaultMetaCanvasClass) and (MaskColor = clNone) then
|
|
Draw(Canvas, AGraphic, Area, Quality)// faster and bad smooth
|
|
else if (MaskColor = clNone) and ((AGraphic is TPngObject){$IFDEF Delphi12} or (AGraphic is TPngImage){$ENDIF}) and
|
|
IsCanPngToTransparentBitmap32(TPngObject(AGraphic), Bitmap) then
|
|
begin
|
|
{ print, metafile and HQ pnly}
|
|
SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
|
|
AlphaBlend(Canvas.Handle,
|
|
Area.Left, Area.Top,
|
|
Area.Right - Area.Left, Area.Bottom - Area.Top,
|
|
Bitmap.Canvas.Handle,
|
|
0, 0,
|
|
AGraphic.Width, AGraphic.Height,
|
|
Bitmap32BF);
|
|
Bitmap.Free;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
inherited DrawTransparent(Canvas, AGraphic, Area, MaskColor, Quality);
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetAlphaBitmap(Graphic: TGraphic): TBitmap;
|
|
var
|
|
PNGA: TPNGObject absolute Graphic;
|
|
i: Integer;
|
|
AlphaBitmap: TBitmap absolute Result;
|
|
begin
|
|
Result := nil;
|
|
if not (Graphic is TPngObject)
|
|
{$IFDEF Delphi12}
|
|
and not (Graphic is TPngImage)
|
|
{$ENDIF}
|
|
then Exit;
|
|
Result := TBitmap.Create;
|
|
AlphaBitmap.PixelFormat := pf8bit;
|
|
AlphaBitmap.Width := PNGA.Width;
|
|
AlphaBitmap.Height := PNGA.Height;
|
|
//TODO: Alpha
|
|
//for i := 0 to AlphaBitmap.Height - 1 do
|
|
// CopyMemory(AlphaBitmap.ScanLine[i], PNGA.AlphaScanline[i], AlphaBitmap.Width);
|
|
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetCanvasHelperClass: TfrxGraphicCanvasHelperClass;
|
|
begin
|
|
Result := TfrxPNGCanvasHelper;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicClass: TGraphicClass;
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
Result := TPngImage;
|
|
{$ELSE}
|
|
Result := TPortableNetworkGraphic;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicConst: Integer;
|
|
begin
|
|
Result := frxPNGFileFormat;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicExt: String;
|
|
begin
|
|
Result := '.png';
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicMime: String;
|
|
begin
|
|
Result := 'image/png';
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicName: String;
|
|
begin
|
|
Result := 'PNG';
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetGraphicProps(
|
|
Graphic: TGraphic): TfrxGraphicProps;
|
|
var
|
|
PNG: TPNGObject absolute Graphic;
|
|
begin
|
|
Result.HasAlpha := PNG.Transparent;
|
|
Result.Transparent := PNG.Transparent;
|
|
Result.TransparentColor := PNG.TransparentColor;
|
|
Result.Quality := 100;
|
|
Result.PixelFormat := PNG.PixelFormat;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.GetTransparentColor(
|
|
Graphic: TGraphic): TColor;
|
|
begin
|
|
Result := clNone;
|
|
if (TPngObject(Graphic).Transparent)then
|
|
Result := TPngObject(Graphic).TransparentColor;
|
|
end;
|
|
class function TfrxPNGGraphicFormat.HasAlphaChanel(Graphic: TGraphic): Boolean;
|
|
begin
|
|
Result := False; // TODO;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.IsSupportedFormat(
|
|
const Stream: TStream): Boolean;
|
|
const
|
|
OriginalPngHeader: array[0..7] of AnsiChar = (#137, #80, #78, #71, #13, #10, #26, #10);
|
|
var
|
|
PNGHeader: array[0..7] of AnsiChar;
|
|
pos: Integer;
|
|
begin
|
|
Result := False;
|
|
if (Stream.Size - Stream.Position) >= SizeOf(PNGHeader) then
|
|
begin
|
|
pos := Stream.Position;
|
|
Stream.ReadBuffer(PNGHeader, SizeOf(PNGHeader));
|
|
Stream.Position := pos;
|
|
if PNGHeader = OriginalPngHeader then
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
class function TfrxPNGGraphicFormat.LoadFromStream(const aPictire: TPicture;
|
|
Stream: TStream): Boolean;
|
|
begin
|
|
Result := False;
|
|
Result := inherited LoadFromStream(aPictire, Stream);
|
|
//THackGraphic(aPictire.Graphic).Changed(nil);
|
|
Result := True;
|
|
end;
|
|
|
|
class procedure TfrxPNGGraphicFormat.SetTransparent(Graphic: TGraphic;
|
|
Transparent: Boolean);
|
|
begin
|
|
TPngObject(Graphic).Transparent := Transparent;
|
|
end;
|
|
|
|
class procedure TfrxPNGGraphicFormat.SetTransparentColor(Graphic: TGraphic;
|
|
Color: TColor);
|
|
begin
|
|
TPngObject(Graphic).TransparentColor := Color;
|
|
end;
|
|
|
|
{ TfrxPNGCanvasHelper }
|
|
|
|
function TfrxPNGCanvasHelper.GetCanvas: TCanvas;
|
|
begin
|
|
if not TPngObject(FGraphic).Transparent then
|
|
Result := TPngObject(FGraphic).Canvas
|
|
else
|
|
begin
|
|
Result := TPngObject(FGraphic).Canvas
|
|
//FBitmap := TBitmap(TfrxPNGGraphicFormat.ConvertToBitmap(FGraphic, pf32bit));
|
|
//Result := FBitmap.Canvas;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPNGCanvasHelper.GetCanvasGraphic: TGraphic;
|
|
begin
|
|
Result := FBitmap;
|
|
end;
|
|
|
|
procedure TfrxPNGCanvasHelper.ReleaseCanvas;
|
|
begin
|
|
if Assigned(FBitmap) then
|
|
begin
|
|
//TfrxPNGGraphicFormat.AssignBitmapToAPNG(TPngObject(FGraphic), FBitmap);
|
|
FreeAndNil(FBitmap);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF Delphi12}
|
|
TPicture.RegisterFileFormat('PNG_OLD', 'Portable Network Graphics', TPNGObject);
|
|
{$ENDIF}
|
|
GetGraphicFormats.RegisterFormat(TfrxPNGGraphicFormat);
|
|
|
|
finalization
|
|
GetGraphicFormats.UnregisterFormat(TfrxPNGGraphicFormat);
|
|
{$IFDEF Delphi12}
|
|
TPicture.UnregisterGraphicClass(TPNGObject);
|
|
{$ENDIF}
|
|
|
|
end.
|