paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 17:59:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Fix some bugs in wmf writer. TvPage.CalculateDocumentSize does not change TvPage.Width and .Height any more.

Browse Source
This commit is contained in:
wp_xyz 2023-01-22 17:31:27 +01:00
parent 9cc1d1622d
commit 6fcd0a3784
5 changed files with 144 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/fpvectorial/fpvectorial.pas
View File

@ -1486,11 +1486,14 @@ type
BackgroundColor: TFPColor; BackgroundColor: TFPColor;
AdjustPenColorToBackground: Boolean; AdjustPenColorToBackground: Boolean;
RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page
public
{ Base methods } { Base methods }
constructor Create(AOwner: TvVectorialDocument); virtual; constructor Create(AOwner: TvVectorialDocument); virtual;
destructor Destroy; override; destructor Destroy; override;
procedure Assign(ASource: TvPage); virtual; procedure Assign(ASource: TvPage); virtual;
procedure SetPageFormat(AFormat: TvPageFormat); procedure SetPageFormat(AFormat: TvPageFormat);
function RealWidth: Double;
function RealHeight: Double;
{ Data reading methods } { Data reading methods }
procedure CalculateDocumentSize; virtual; procedure CalculateDocumentSize; virtual;
function GetEntity(ANum: Cardinal): TvEntity; virtual; abstract; function GetEntity(ANum: Cardinal): TvEntity; virtual; abstract;
@ -1520,6 +1523,7 @@ type
{ Debug methods } { Debug methods }
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract; procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract;
property Owner: TvVectorialDocument read FOwner;
property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates; property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates;
end; end;
@ -1536,7 +1540,6 @@ type
procedure AppendSegmentToTmpPath(ASegment: TPathSegment); procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
procedure CallbackDeleteEntity(data,arg:pointer); procedure CallbackDeleteEntity(data,arg:pointer);
public public
Owner: TvVectorialDocument;
{ Base methods } { Base methods }
constructor Create(AOwner: TvVectorialDocument); override; constructor Create(AOwner: TvVectorialDocument); override;
destructor Destroy; override; destructor Destroy; override;
@ -5937,8 +5940,8 @@ procedure TvCircle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
begin begin
ALeft := X - Radius; ALeft := X - Radius;
ARight := X + Radius; ARight := X + Radius;
ATop := Y + Radius; ATop := Y - Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
ABottom := Y - Radius; ABottom := Y + Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
end; end;
function TvCircle.CreatePath: TPath; function TvCircle.CreatePath: TPath;
@ -6322,7 +6325,7 @@ begin
ALeft := Min(ALeft, pts[j].x); ALeft := Min(ALeft, pts[j].x);
ARight := Max(ARight, pts[j].x); ARight := Max(ARight, pts[j].x);
mx := Max(mx, pts[j].y); mx := Max(mx, pts[j].y);
mn := Min(mx, pts[j].y); mn := Min(mn, pts[j].y);
end; end;
if ARenderInfo.Page.UseTopLeftCoordinates then if ARenderInfo.Page.UseTopLeftCoordinates then
begin begin
@ -6336,8 +6339,8 @@ begin
end else end else
begin begin
ALeft := X; ALeft := X;
ATop := Y;
ARight := X + CX; ARight := X + CX;
ATop := Y;
ABottom := Y + CY * ARenderInfo.Page.GetTopLeftCoords_Adjustment; ABottom := Y + CY * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
end; end;
end; end;
@ -8949,6 +8952,7 @@ begin
begin begin
lCurEntity := GetEntity(i); lCurEntity := GetEntity(i);
lRenderInfo.Canvas := lBmp.Canvas; lRenderInfo.Canvas := lBmp.Canvas;
lRenderInfo.Page := self;
lCurEntity.CalculateBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom); lCurEntity.CalculateBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom);
MinX := Min(MinX, lLeft); MinX := Min(MinX, lLeft);
MaxX := Max(MaxX, lRight); MaxX := Max(MaxX, lRight);
@ -8963,8 +8967,18 @@ begin
end; end;
end; end;
lBmp.Free; lBmp.Free;
Width := abs(MaxX - MinX); //Width := abs(MaxX - MinX);
Height := abs(MaxY - MinY); //Height := abs(MaxY - MinY);
end;
function TvPage.RealWidth: Double;
begin
Result := abs(MaxX - MinX);
end;
function TvPage.RealHeight: Double;
begin
Result := abs(MaxY - MinY);
end; end;
procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer; procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer;
@ -9137,7 +9151,7 @@ begin
FEntities := TFPList.Create; FEntities := TFPList.Create;
FTmpPath := TPath.Create(Self); FTmpPath := TPath.Create(Self);
Owner := AOwner; FOwner := AOwner;
Clear(); Clear();
BackgroundColor := colWhite; BackgroundColor := colWhite;
RenderInfo.BackgroundColor := colWhite; RenderInfo.BackgroundColor := colWhite;

162
components/fpvectorial/tests/vtmain.lfm
View File

@ -1,36 +1,35 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 324 Left = 324
Height = 690 Height = 717
Top = 125 Top = 125
Width = 900 Width = 905
Caption = 'Visual fpvectorial test' Caption = 'Visual fpvectorial test'
ClientHeight = 690 ClientHeight = 717
ClientWidth = 900 ClientWidth = 905
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
ShowHint = True ShowHint = True
LCLVersion = '2.3.0.0' LCLVersion = '2.3.0.0'
object GbTree: TGroupBox object GbTree: TGroupBox
Left = 4 Left = 8
Height = 682 Height = 701
Top = 4 Top = 8
Width = 344 Width = 336
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 8
Caption = 'Test shapes and objects' Caption = 'Test shapes and objects'
ClientHeight = 662 ClientHeight = 681
ClientWidth = 340 ClientWidth = 332
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
object Tree: TTreeView object Tree: TTreeView
Left = 4 Left = 6
Height = 650 Height = 669
Top = 4 Top = 6
Width = 332 Width = 320
Align = alClient Align = alClient
BorderSpacing.Bottom = 4 BorderSpacing.Around = 6
BorderSpacing.Around = 4
HideSelection = False HideSelection = False
Images = ImageList Images = ImageList
ParentFont = False ParentFont = False
@ -46,48 +45,49 @@ object MainForm: TMainForm
end end
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 352 Left = 352
Height = 690 Height = 717
Top = 0 Top = 0
Width = 548 Width = 553
HorzScrollBar.Increment = 54 HorzScrollBar.Increment = 55
HorzScrollBar.Page = 543 HorzScrollBar.Page = 553
HorzScrollBar.Smooth = True HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True HorzScrollBar.Tracking = True
VertScrollBar.Increment = 69 VertScrollBar.Increment = 69
VertScrollBar.Page = 690 VertScrollBar.Page = 695
VertScrollBar.Smooth = True VertScrollBar.Smooth = True
VertScrollBar.Tracking = True VertScrollBar.Tracking = True
Align = alRight Align = alRight
BorderStyle = bsNone BorderStyle = bsNone
ClientHeight = 690 ClientHeight = 717
ClientWidth = 548 ClientWidth = 553
TabOrder = 1 TabOrder = 1
object AllTestsPanel: TPanel object AllTestsPanel: TPanel
Left = 4 Left = 4
Height = 682 Height = 683
Top = 4 Top = 8
Width = 536 Width = 537
Align = alTop Align = alTop
AutoSize = True AutoSize = True
BorderSpacing.Right = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 682 ClientHeight = 683
ClientWidth = 536 ClientWidth = 537
TabOrder = 0 TabOrder = 0
object gbRenderTest: TGroupBox object gbRenderTest: TGroupBox
AnchorSideLeft.Control = AllTestsPanel AnchorSideLeft.Control = AllTestsPanel
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 282 Height = 284
Top = 0 Top = 0
Width = 255 Width = 256
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Right = 31 BorderSpacing.Right = 31
Caption = 'Render test' Caption = 'Render test'
ClientHeight = 262 ClientHeight = 264
ClientWidth = 251 ClientWidth = 252
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
@ -95,7 +95,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 30 Height = 30
Top = 2 Top = 2
Width = 239 Width = 240
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -109,7 +109,7 @@ object MainForm: TMainForm
Left = 16 Left = 16
Height = 15 Height = 15
Top = 36 Top = 36
Width = 231 Width = 232
Align = alTop Align = alTop
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -123,7 +123,7 @@ object MainForm: TMainForm
Left = 16 Left = 16
Height = 15 Height = 15
Top = 55 Top = 55
Width = 231 Width = 232
Align = alTop Align = alTop
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -137,7 +137,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 74 Top = 74
Width = 239 Width = 240
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -153,15 +153,15 @@ object MainForm: TMainForm
AnchorSideTop.Control = BtnSaveAsRef AnchorSideTop.Control = BtnSaveAsRef
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 6
Height = 128 Height = 128
Top = 130 Top = 130
Width = 116 Width = 116
AutoSize = True AutoSize = True
BorderSpacing.Left = 4 BorderSpacing.Left = 6
BorderSpacing.Top = 6 BorderSpacing.Top = 6
BorderSpacing.Right = 4 BorderSpacing.Right = 6
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 6
Caption = 'Origin at BOTTOM' Caption = 'Origin at BOTTOM'
ClientHeight = 108 ClientHeight = 108
ClientWidth = 112 ClientWidth = 112
@ -176,7 +176,7 @@ object MainForm: TMainForm
Width = 100 Width = 100
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 4 BorderSpacing.Right = 6
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
OnPaint = PaintBoxPaint OnPaint = PaintBoxPaint
end end
@ -187,18 +187,18 @@ object MainForm: TMainForm
AnchorSideTop.Control = gbBottomLeft AnchorSideTop.Control = gbBottomLeft
AnchorSideBottom.Control = gbRenderTest AnchorSideBottom.Control = gbRenderTest
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 128 Left = 130
Height = 128 Height = 128
Top = 130 Top = 130
Width = 114 Width = 116
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 4 BorderSpacing.Right = 6
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 6
Caption = 'Origin at TOP' Caption = 'Origin at TOP'
ClientHeight = 108 ClientHeight = 108
ClientWidth = 110 ClientWidth = 112
ParentFont = False ParentFont = False
TabOrder = 1 TabOrder = 1
object TopLeftPaintbox: TPaintBox object TopLeftPaintbox: TPaintBox
@ -210,7 +210,7 @@ object MainForm: TMainForm
Width = 100 Width = 100
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 4 BorderSpacing.Right = 6
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
OnPaint = PaintBoxPaint OnPaint = PaintBoxPaint
end end
@ -240,13 +240,13 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbRenderTest AnchorSideBottom.Control = gbRenderTest
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 286 Left = 287
Height = 282 Height = 284
Top = 0 Top = 0
Width = 250 Width = 250
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Reference image test' Caption = 'Reference image test'
ClientHeight = 262 ClientHeight = 264
ClientWidth = 246 ClientWidth = 246
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
@ -299,15 +299,15 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = gbReferenceImageTest AnchorSideBottom.Control = gbReferenceImageTest
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 6
Height = 128 Height = 128
Top = 130 Top = 130
Width = 116 Width = 116
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 4 BorderSpacing.Left = 6
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 6
Caption = 'Reference image' Caption = 'Reference image'
ClientHeight = 108 ClientHeight = 108
ClientWidth = 112 ClientWidth = 112
@ -333,15 +333,15 @@ object MainForm: TMainForm
AnchorSideRight.Control = AllTestsPanel AnchorSideRight.Control = AllTestsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 0 Left = 0
Height = 313 Height = 312
Top = 298 Top = 300
Width = 536 Width = 537
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Read/write test' Caption = 'Read/write test'
ClientHeight = 293 ClientHeight = 292
ClientWidth = 532 ClientWidth = 533
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 2 TabOrder = 2
@ -349,7 +349,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 2 Top = 2
Width = 516 Width = 517
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -363,7 +363,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 45 Height = 45
Top = 72 Top = 72
Width = 516 Width = 517
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -377,17 +377,17 @@ object MainForm: TMainForm
AnchorSideLeft.Control = gbReadWriteTest AnchorSideLeft.Control = gbReadWriteTest
AnchorSideTop.Control = CbFileFormat AnchorSideTop.Control = CbFileFormat
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 4 Left = 6
Height = 129 Height = 128
Top = 156 Top = 156
Width = 210 Width = 210
AutoSize = True AutoSize = True
BorderSpacing.Left = 4 BorderSpacing.Left = 6
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 4 BorderSpacing.Right = 6
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Written with origin at BOTTOM' Caption = 'Written with origin at BOTTOM'
ClientHeight = 109 ClientHeight = 108
ClientWidth = 206 ClientWidth = 206
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
@ -413,10 +413,10 @@ object MainForm: TMainForm
AnchorSideTop.Control = gbWRBottomLeft AnchorSideTop.Control = gbWRBottomLeft
Left = 6 Left = 6
Height = 100 Height = 100
Top = 3 Top = 2
Width = 100 Width = 100
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 2
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
OnPaint = PaintBoxPaint OnPaint = PaintBoxPaint
end end
@ -425,7 +425,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 30 Height = 30
Top = 19 Top = 19
Width = 516 Width = 517
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -439,7 +439,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 53 Top = 53
Width = 520 Width = 521
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -492,7 +492,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = gbReadWriteTest AnchorSideRight.Control = gbReadWriteTest
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 435 Left = 436
Height = 25 Height = 25
Top = 124 Top = 124
Width = 89 Width = 89
@ -511,8 +511,8 @@ object MainForm: TMainForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbFileFormat AnchorSideTop.Control = CbFileFormat
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 222 Left = 224
Height = 129 Height = 128
Top = 156 Top = 156
Width = 213 Width = 213
AutoSize = True AutoSize = True
@ -520,7 +520,7 @@ object MainForm: TMainForm
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Written with origin at TOP' Caption = 'Written with origin at TOP'
ClientHeight = 109 ClientHeight = 108
ClientWidth = 209 ClientWidth = 209
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3
@ -531,7 +531,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 114 Left = 114
Height = 25 Height = 25
Top = 41 Top = 40
Width = 91 Width = 91
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -546,10 +546,10 @@ object MainForm: TMainForm
AnchorSideTop.Control = gbWRTopLeft AnchorSideTop.Control = gbWRTopLeft
Left = 6 Left = 6
Height = 100 Height = 100
Top = 3 Top = 2
Width = 100 Width = 100
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 2
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
OnPaint = PaintBoxPaint OnPaint = PaintBoxPaint
end end
@ -563,14 +563,14 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 0 Left = 0
Height = 55 Height = 55
Top = 627 Top = 628
Width = 536 Width = 537
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Test results' Caption = 'Test results'
ClientHeight = 35 ClientHeight = 35
ClientWidth = 532 ClientWidth = 533
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3

5
components/fpvectorial/tests/vtmain.pas
View File

@ -1190,7 +1190,12 @@ procedure TMainForm.TreeSelectionChanged(Sender: TObject);
begin begin
ShowRenderTestImages; ShowRenderTestImages;
ShowRefImageTest; ShowRefImageTest;
try
ShowWriteReadTestImages; ShowWriteReadTestImages;
except
on E:Exception do
MessageDlg(E.Message, mtError, [mbOK], 0);
end;
UpdateTestResults; UpdateTestResults;
UpdateCmdStates; UpdateCmdStates;
end; end;

5
components/fpvectorial/wmfvectorialreader.pas
View File

@ -636,7 +636,10 @@ begin
FHasPlaceableMetaHeader := false; FHasPlaceableMetaHeader := false;
n := AStream.Read(buf{%H-}, SizeOf(TPlaceableMetaHeader)); n := AStream.Read(buf{%H-}, SizeOf(TPlaceableMetaHeader));
if n <> SizeOf(TPlaceableMetaHeader) then if n <> SizeOf(TPlaceableMetaHeader) then
raise Exception.Create('Error reading the wmf file header.'); begin
LogError('Error reading the wmf file header.');
exit;
end;
if placeableMetaHdr.Key = WMF_MAGIC_NUMBER then begin // yes! if placeableMetaHdr.Key = WMF_MAGIC_NUMBER then begin // yes!
FHasPlaceableMetaHeader := true; FHasPlaceableMetaHeader := true;

42
components/fpvectorial/wmfvectorialwriter.pas
View File

@ -26,7 +26,7 @@ unit wmfvectorialwriter;
interface interface
uses uses lazlogger,
Classes, SysUtils, Classes, SysUtils,
FPImage, FPCanvas, FPImage, FPCanvas,
fpvectorial, fpvWMF; fpvectorial, fpvWMF;
@ -55,6 +55,8 @@ type
FBBox: TRect; // in metafile units as specified by UnitsPerInch. NOTE: "logical" units can be different! FBBox: TRect; // in metafile units as specified by UnitsPerInch. NOTE: "logical" units can be different!
FLogicalMaxX: Word; // Max x coordinate used for scaling, in logical units FLogicalMaxX: Word; // Max x coordinate used for scaling, in logical units
FLogicalMaxY: Word; // Max y coordinate used for scaling, in logical units FLogicalMaxY: Word; // Max y coordinate used for scaling, in logical units
// FLogicalOffsetX: Word; // Position of zero in the range [0..LogicalMaxX]
// FLogicalOffsetY: Word;
FLogicalBounds: TRect; // Enclosing boundary rectangle in logical units FLogicalBounds: TRect; // Enclosing boundary rectangle in logical units
FScalingFactor: Double; // Conversion fpvectorial units to logical units FScalingFactor: Double; // Conversion fpvectorial units to logical units
FMaxRecordSize: Int64; FMaxRecordSize: Int64;
@ -338,24 +340,37 @@ end;
procedure TvWMFVectorialWriter.PrepareScaling(APage: TvVectorialPage); procedure TvWMFVectorialWriter.PrepareScaling(APage: TvVectorialPage);
const const
MAXINT16 = 32767; MAXINT16 = 30000; // should be 32767, but avoid overflows...
var var
maxx, maxy: Double; maxx, maxy: Double;
w, h: Double;
begin begin
APage.CalculateDocumentSize;
w := Max(APage.Width, APage.RealWidth);
h := Max(APage.Height, APage.RealHeight);
FScalingFactor := round(ONE_INCH * 100); // 1 logical unit is 1/100 mm = 10 µm FScalingFactor := round(ONE_INCH * 100); // 1 logical unit is 1/100 mm = 10 µm
maxx := APage.Width * FScalingFactor; maxx := w * FScalingFactor;
maxy := APage.Height * FScalingFactor; maxy := h * FScalingFactor;
// wmf is 16 bit only! --> reduce magnification if numbers get too big // wmf is 16 bit only! --> reduce magnification if numbers get too big
if Max(maxx, maxy) > MAXINT16 then if Max(maxx, maxy) > MAXINT16 then
begin begin
FScalingFactor := trunc(MAXINT16 / Max(APage.Width, APage.Height)); FScalingFactor := trunc(MAXINT16 / Max(w, h));
FLogicalMaxX := word(trunc(APage.Width * FScalingFactor)); maxx := APage.Width * FScalingFactor;
FLogicalMaxY := word(trunc(APage.Height * FScalingFactor)); maxy := APage.Height * FScalingFactor;
end else end;
begin
FLogicalMaxX := trunc(maxx); FLogicalMaxX := trunc(maxx);
FLogicalMaxY := trunc(maxy); FLogicalMaxY := trunc(maxy);
end; (*
FLogicalOffsetX := 0;
FLogicalOffsetY := 0;
// Since the wmf coordinates are stored as word we must offset them in case
// of negative values.
if APage.MinX < 0 then
FLogicalOffsetX := word((trunc(-APage.MinX * FScalingFactor)));
if (APage.MinY < 0) then
FlogicalOffsetY := word((trunc(-APage.MinY * FScalingFactor)));
*)
end; end;
function TvWMFVectorialWriter.ScaleSizeX(x: Double): Integer; function TvWMFVectorialWriter.ScaleSizeX(x: Double): Integer;
@ -376,7 +391,8 @@ end;
function TvWMFVectorialWriter.ScaleY(y: Double): Integer; function TvWMFVectorialWriter.ScaleY(y: Double): Integer;
begin begin
if FUseTopLeftCoordinates then if FUseTopLeftCoordinates then
Result := ScaleSizeY(y) else Result := ScaleSizeY(y)
else
Result := FLogicalMaxY - ScaleSizeY(y); Result := FLogicalMaxY - ScaleSizeY(y);
end; end;
@ -476,11 +492,13 @@ begin
end else end else
begin begin
rec.Top := c.y + r.y; rec.Top := c.y + r.y;
reC.Bottom := c.y - r.y; rec.Bottom := c.y - r.y;
end; end;
UpdateBounds(rec.Left, rec.Top); UpdateBounds(rec.Left, rec.Top);
UpdateBounds(rec.Right, rec.Bottom); UpdateBounds(rec.Right, rec.Bottom);
DebugLn(['c.x=', c.x, ' cy=', c.y, ' r.x=', r.x, ' r.y=', r.y, ' rec.Left=', rec.Left, 'rec.Top=', rec.Top, ' c.x-r.x=', c.x-r.x, ' cy-r.y=', c.y - r.y]);
// WMF record header + parameters // WMF record header + parameters
WriteWMFRecord(AStream, META_ELLIPSE, rec, SizeOf(TWMFRectRecord)); WriteWMFRecord(AStream, META_ELLIPSE, rec, SizeOf(TWMFRectRecord));
end; end;