145 lines
3.7 KiB
ObjectPascal
145 lines
3.7 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Image Converter }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
{$I frx.inc}
|
|
|
|
unit frxImageConverter;
|
|
|
|
interface
|
|
|
|
uses
|
|
Graphics,
|
|
Classes;
|
|
|
|
type
|
|
TfrxPictureType = (gpPNG, gpBMP, gpJPG , gpGIF, gpEMF, gpWMF );
|
|
|
|
procedure SaveGraphicAs(Graphic: TGraphic; Stream: TStream; PicType: TfrxPictureType; Transparent: Boolean = False; TransparentColor: TColor = clNone); overload;
|
|
procedure SaveGraphicAs(Graphic: TGraphic; Path: string; PicType: TfrxPictureType); overload;
|
|
|
|
function GetPicFileExtension(PicType: TfrxPictureType): string;
|
|
function TypeToGraphicFormat(PicType: TfrxPictureType): String;
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxPictureGraphics, GIF;
|
|
|
|
function TypeToGraphicFormat(PicType: TfrxPictureType): String;
|
|
begin
|
|
case PicType of
|
|
gpEMF: Result := 'FREMF';
|
|
gpWMF: Result := 'WMF';
|
|
gpBMP: Result := 'BMP';
|
|
gpPNG: Result := 'PNG';
|
|
gpJPG: Result := 'JPG';
|
|
gpGIF: Result := 'JPG';
|
|
end;
|
|
end;
|
|
|
|
function GetPicFileExtension(PicType: TfrxPictureType): string;
|
|
begin
|
|
case PicType of
|
|
gpPNG: Result := 'png';
|
|
gpBMP: Result := 'bmp';
|
|
gpJPG: Result := 'jpg';
|
|
gpGIF: Result := 'gif';
|
|
gpEMF: Result := 'emf';
|
|
gpWMF: Result := 'wmf';
|
|
else Result := '';
|
|
end;
|
|
end;
|
|
|
|
procedure SaveGraphicAs(Graphic: TGraphic; Path: string; PicType: TfrxPictureType);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(Path, fmCreate);
|
|
|
|
try
|
|
SaveGraphicAs(Graphic, Stream, PicType)
|
|
finally
|
|
Stream.Free
|
|
end
|
|
end;
|
|
|
|
procedure SaveGraphicAs(Graphic: TGraphic; Stream: TStream; PicType: TfrxPictureType; Transparent: Boolean = False; TransparentColor: TColor = clNone);
|
|
var
|
|
Format: String;
|
|
DestG: TGraphic;
|
|
PixF: TPixelFormat;
|
|
GFormat: TfrxCustomGraphicFormatClass;
|
|
LtColor: TColor;
|
|
{$IFNDEF FPC}
|
|
procedure SaveAsGIF;
|
|
var
|
|
Bitmap: TBitmap;
|
|
begin
|
|
Bitmap := TBitmap.Create;
|
|
|
|
try
|
|
Bitmap.Width := Graphic.Width;
|
|
Bitmap.Height := Graphic.Height;
|
|
Bitmap.Canvas.Lock;
|
|
try
|
|
Bitmap.Canvas.Draw(0, 0, Graphic);
|
|
finally
|
|
Bitmap.Canvas.Unlock;
|
|
end;
|
|
GIFSaveToStream(Stream, Bitmap);
|
|
finally
|
|
Bitmap.Free
|
|
end
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
Format := 'BMP';
|
|
case PicType of
|
|
gpEMF: Format := 'FREMF';
|
|
gpWMF: Format := 'WMF';
|
|
gpBMP: Format := 'BMP';
|
|
gpPNG: Format := 'PNG';
|
|
gpJPG: Format := 'JPG';
|
|
{$IFNDEF FPC}
|
|
gpGIF: SaveAsGIF;
|
|
{$ENDIF}
|
|
end;
|
|
if PicType <> gpGIF then
|
|
begin
|
|
PixF := pf24bit;
|
|
|
|
GFormat := GetGraphicFormats.FindByName(Format, [gcConvert]);
|
|
if Assigned(GFormat) then
|
|
begin
|
|
if (PicType = gpPNG) and (Transparent or GFormat.HasAlphaChanel(Graphic) or Graphic.Transparent or GFormat.HasMaskColor(Graphic)) then
|
|
PixF := pf32bit;
|
|
DestG := GFormat.ConvertFrom(Graphic, PixF, 100);
|
|
//GetGraphicFormats.Convert(Graphic, Format, PixF, 100);
|
|
if Assigned(DestG) then
|
|
try
|
|
LtColor := GFormat.GetTransparentColor(DestG);
|
|
if LtColor <> clNone then
|
|
TransparentColor := LtColor;
|
|
if (TransparentColor = clNone) and GFormat.HasMaskColor(Graphic) then
|
|
TransparentColor := GFormat.GetTransparentColor(Graphic);
|
|
if TransparentColor <> clNone then
|
|
GFormat.SetTransparentColor(DestG, TransparentColor);
|
|
DestG.SaveToStream(Stream);
|
|
finally
|
|
DestG.Free;
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|