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