paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 23:01:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Inoussa to implement DBImageType

Browse Source 
git-svn-id: trunk@46722 -
This commit is contained in:
michael 2020-08-28 16:14:42 +00:00
parent 47d6699a2e
commit db1872c980
1 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/fcl-report/src/fpreport.pp
View File

@ -247,6 +247,8 @@ const
bmOncePerDataloop,bmOncePerPage,bmOncePerPage,bmOncePerPage, bmOncePerDataloop,bmOncePerPage,bmOncePerPage,bmOncePerPage,
bmUnrestricted); bmUnrestricted);
DefaultImageType = 'png';
const const
cMMperInch = 25.4; cMMperInch = 25.4;
cCMperInch = 2.54; cCMperInch = 2.54;
@ -2090,10 +2092,12 @@ type
FImage: TFPCustomImage; FImage: TFPCustomImage;
FStretched: boolean; FStretched: boolean;
FFieldName: TFPReportString; FFieldName: TFPReportString;
FDBImageType : TFPReportString;
FImageID: integer; FImageID: integer;
procedure SetImage(AValue: TFPCustomImage); procedure SetImage(AValue: TFPCustomImage);
procedure SetStretched(AValue: boolean); procedure SetStretched(AValue: boolean);
procedure SetFieldName(AValue: TFPReportString); procedure SetFieldName(AValue: TFPReportString);
procedure SetDBImageType(AValue: TFPReportString);
procedure LoadDBData(AData: TFPReportData); procedure LoadDBData(AData: TFPReportData);
procedure SetImageID(AValue: integer); procedure SetImageID(AValue: integer);
function GetImage: TFPCustomImage; function GetImage: TFPCustomImage;
@ -2105,6 +2109,7 @@ type
property ImageID: integer read FImageID write SetImageID; property ImageID: integer read FImageID write SetImageID;
property Stretched: boolean read FStretched write SetStretched; property Stretched: boolean read FStretched write SetStretched;
property FieldName: TFPReportString read FFieldName write SetFieldName; property FieldName: TFPReportString read FFieldName write SetFieldName;
property DBImageType : TFPReportString read FDBImageType write SetDBImageType;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -2126,6 +2131,7 @@ type
property ImageID; property ImageID;
property Stretched; property Stretched;
property FieldName; property FieldName;
property DBImageType;
property OnBeforePrint; property OnBeforePrint;
end; end;
@ -5331,6 +5337,14 @@ begin
Changed; Changed;
end; end;
procedure TFPReportCustomImage.SetDBImageType(AValue: TFPReportString);
begin
if FDBImageType = AValue then
exit;
FDBImageType := AValue;
Changed;
end;
function TryVarByteArrayToStream(var AValue : Variant; Stream : TMemoryStream) : boolean; function TryVarByteArrayToStream(var AValue : Variant; Stream : TMemoryStream) : boolean;
var var
p : Pointer; p : Pointer;
@ -5357,6 +5371,7 @@ var
v : Variant; v : Variant;
s: string; s: string;
lStream: TMemoryStream; lStream: TMemoryStream;
irc : TFPCustomImageReaderClass;
begin begin
v := AData.FieldValues[FFieldName]; v := AData.FieldValues[FFieldName];
lStream := TMemoryStream.Create; lStream := TMemoryStream.Create;
@ -5366,7 +5381,11 @@ begin
s := v; s := v;
FPReportMIMEEncodeStringToStream(s, lStream); FPReportMIMEEncodeStringToStream(s, lStream);
end; end;
LoadPNGFromStream(lStream) s := Trim(DBImageType);
if (s = '') then
s := DefaultImageType;
irc := TFPCustomImage.FindReaderFromExtension(s);
LoadFromStream(lStream,irc);
finally finally
lStream.Free; lStream.Free;
end; end;
@ -5415,7 +5434,8 @@ begin
idx := TFPReportCustomBand(Parent).Page.Report.Images.GetIndexFromID(ImageID); idx := TFPReportCustomBand(Parent).Page.Report.Images.GetIndexFromID(ImageID);
AWriter.WriteInteger('ImageIndex', idx); AWriter.WriteInteger('ImageIndex', idx);
AWriter.WriteBoolean('Stretched', Stretched); AWriter.WriteBoolean('Stretched', Stretched);
AWriter.WriteString('FieldName', FieldName); AWriter.WriteString('FieldName', FieldName);
AWriter.WriteString('DBImageType', DBImageType);
end; end;
procedure TFPReportCustomImage.RecalcLayout; procedure TFPReportCustomImage.RecalcLayout;
@ -5455,6 +5475,7 @@ begin
FImage := nil; FImage := nil;
FStretched := False; FStretched := False;
FImageID := -1; FImageID := -1;
FDBImageType := DefaultImageType;
end; end;
destructor TFPReportCustomImage.Destroy; destructor TFPReportCustomImage.Destroy;
@ -5494,6 +5515,7 @@ begin
end; end;
FStretched := i.Stretched; FStretched := i.Stretched;
FFieldName := i.FieldName; FFieldName := i.FieldName;
FDBImageType := i.DBImageType;
FImageID := i.ImageID; FImageID := i.ImageID;
end; end;
end; end;
@ -5504,7 +5526,8 @@ begin
{ See code comments in DoWriteLocalProperties() } { See code comments in DoWriteLocalProperties() }
ImageID := AReader.ReadInteger('ImageIndex', -1); ImageID := AReader.ReadInteger('ImageIndex', -1);
Stretched := AReader.ReadBoolean('Stretched', Stretched); Stretched := AReader.ReadBoolean('Stretched', Stretched);
FieldName := AReader.ReadString('FieldName', FieldName); FieldName := AReader.ReadString('FieldName', FieldName);
DBImageType := AReader.ReadString('DBImageType', DBImageType);
end; end;
procedure TFPReportCustomImage.LoadFromFile(const AFileName: string); procedure TFPReportCustomImage.LoadFromFile(const AFileName: string);