diff --git a/components/fpvectorial/fpvectorial.pas b/components/fpvectorial/fpvectorial.pas index e58338ca0a..7d7dd88791 100644 --- a/components/fpvectorial/fpvectorial.pas +++ b/components/fpvectorial/fpvectorial.pas @@ -1486,11 +1486,14 @@ type BackgroundColor: TFPColor; AdjustPenColorToBackground: Boolean; RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page + public { Base methods } constructor Create(AOwner: TvVectorialDocument); virtual; destructor Destroy; override; procedure Assign(ASource: TvPage); virtual; procedure SetPageFormat(AFormat: TvPageFormat); + function RealWidth: Double; + function RealHeight: Double; { Data reading methods } procedure CalculateDocumentSize; virtual; function GetEntity(ANum: Cardinal): TvEntity; virtual; abstract; @@ -1520,6 +1523,7 @@ type { Debug methods } procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract; + property Owner: TvVectorialDocument read FOwner; property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates; end; @@ -1536,7 +1540,6 @@ type procedure AppendSegmentToTmpPath(ASegment: TPathSegment); procedure CallbackDeleteEntity(data,arg:pointer); public - Owner: TvVectorialDocument; { Base methods } constructor Create(AOwner: TvVectorialDocument); override; destructor Destroy; override; @@ -5937,8 +5940,8 @@ procedure TvCircle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; begin ALeft := X - Radius; ARight := X + Radius; - ATop := Y + Radius; - ABottom := Y - Radius; + ATop := Y - Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment; + ABottom := Y + Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment; end; function TvCircle.CreatePath: TPath; @@ -6322,7 +6325,7 @@ begin ALeft := Min(ALeft, pts[j].x); ARight := Max(ARight, pts[j].x); mx := Max(mx, pts[j].y); - mn := Min(mx, pts[j].y); + mn := Min(mn, pts[j].y); end; if ARenderInfo.Page.UseTopLeftCoordinates then begin @@ -6336,8 +6339,8 @@ begin end else begin ALeft := X; - ATop := Y; ARight := X + CX; + ATop := Y; ABottom := Y + CY * ARenderInfo.Page.GetTopLeftCoords_Adjustment; end; end; @@ -8949,6 +8952,7 @@ begin begin lCurEntity := GetEntity(i); lRenderInfo.Canvas := lBmp.Canvas; + lRenderInfo.Page := self; lCurEntity.CalculateBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom); MinX := Min(MinX, lLeft); MaxX := Max(MaxX, lRight); @@ -8963,8 +8967,18 @@ begin end; end; lBmp.Free; - Width := abs(MaxX - MinX); - Height := abs(MaxY - MinY); + //Width := abs(MaxX - MinX); + //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; procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer; @@ -9137,7 +9151,7 @@ begin FEntities := TFPList.Create; FTmpPath := TPath.Create(Self); - Owner := AOwner; + FOwner := AOwner; Clear(); BackgroundColor := colWhite; RenderInfo.BackgroundColor := colWhite; diff --git a/components/fpvectorial/tests/vtmain.lfm b/components/fpvectorial/tests/vtmain.lfm index 5b6b39442b..905911bdd5 100644 --- a/components/fpvectorial/tests/vtmain.lfm +++ b/components/fpvectorial/tests/vtmain.lfm @@ -1,36 +1,35 @@ object MainForm: TMainForm Left = 324 - Height = 690 + Height = 717 Top = 125 - Width = 900 + Width = 905 Caption = 'Visual fpvectorial test' - ClientHeight = 690 - ClientWidth = 900 + ClientHeight = 717 + ClientWidth = 905 OnCreate = FormCreate OnDestroy = FormDestroy ShowHint = True LCLVersion = '2.3.0.0' object GbTree: TGroupBox - Left = 4 - Height = 682 - Top = 4 - Width = 344 + Left = 8 + Height = 701 + Top = 8 + Width = 336 Align = alClient - BorderSpacing.Around = 4 + BorderSpacing.Around = 8 Caption = 'Test shapes and objects' - ClientHeight = 662 - ClientWidth = 340 + ClientHeight = 681 + ClientWidth = 332 Font.Style = [fsBold] ParentFont = False TabOrder = 0 object Tree: TTreeView - Left = 4 - Height = 650 - Top = 4 - Width = 332 + Left = 6 + Height = 669 + Top = 6 + Width = 320 Align = alClient - BorderSpacing.Bottom = 4 - BorderSpacing.Around = 4 + BorderSpacing.Around = 6 HideSelection = False Images = ImageList ParentFont = False @@ -46,48 +45,49 @@ object MainForm: TMainForm end object ScrollBox1: TScrollBox Left = 352 - Height = 690 + Height = 717 Top = 0 - Width = 548 - HorzScrollBar.Increment = 54 - HorzScrollBar.Page = 543 + Width = 553 + HorzScrollBar.Increment = 55 + HorzScrollBar.Page = 553 HorzScrollBar.Smooth = True HorzScrollBar.Tracking = True VertScrollBar.Increment = 69 - VertScrollBar.Page = 690 + VertScrollBar.Page = 695 VertScrollBar.Smooth = True VertScrollBar.Tracking = True Align = alRight BorderStyle = bsNone - ClientHeight = 690 - ClientWidth = 548 + ClientHeight = 717 + ClientWidth = 553 TabOrder = 1 object AllTestsPanel: TPanel Left = 4 - Height = 682 - Top = 4 - Width = 536 + Height = 683 + Top = 8 + Width = 537 Align = alTop AutoSize = True - BorderSpacing.Right = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 BorderSpacing.Around = 4 BevelOuter = bvNone - ClientHeight = 682 - ClientWidth = 536 + ClientHeight = 683 + ClientWidth = 537 TabOrder = 0 object gbRenderTest: TGroupBox AnchorSideLeft.Control = AllTestsPanel AnchorSideBottom.Side = asrBottom Left = 0 - Height = 282 + Height = 284 Top = 0 - Width = 255 + Width = 256 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Right = 31 Caption = 'Render test' - ClientHeight = 262 - ClientWidth = 251 + ClientHeight = 264 + ClientWidth = 252 Font.Style = [fsBold] ParentFont = False TabOrder = 0 @@ -95,7 +95,7 @@ object MainForm: TMainForm Left = 8 Height = 30 Top = 2 - Width = 239 + Width = 240 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 2 @@ -109,7 +109,7 @@ object MainForm: TMainForm Left = 16 Height = 15 Top = 36 - Width = 231 + Width = 232 Align = alTop BorderSpacing.Left = 16 BorderSpacing.Top = 4 @@ -123,7 +123,7 @@ object MainForm: TMainForm Left = 16 Height = 15 Top = 55 - Width = 231 + Width = 232 Align = alTop BorderSpacing.Left = 16 BorderSpacing.Top = 4 @@ -137,7 +137,7 @@ object MainForm: TMainForm Left = 8 Height = 15 Top = 74 - Width = 239 + Width = 240 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 4 @@ -153,15 +153,15 @@ object MainForm: TMainForm AnchorSideTop.Control = BtnSaveAsRef AnchorSideTop.Side = asrBottom AnchorSideBottom.Side = asrBottom - Left = 4 + Left = 6 Height = 128 Top = 130 Width = 116 AutoSize = True - BorderSpacing.Left = 4 + BorderSpacing.Left = 6 BorderSpacing.Top = 6 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 6 Caption = 'Origin at BOTTOM' ClientHeight = 108 ClientWidth = 112 @@ -176,7 +176,7 @@ object MainForm: TMainForm Width = 100 BorderSpacing.Left = 6 BorderSpacing.Top = 2 - BorderSpacing.Right = 4 + BorderSpacing.Right = 6 BorderSpacing.Bottom = 6 OnPaint = PaintBoxPaint end @@ -187,18 +187,18 @@ object MainForm: TMainForm AnchorSideTop.Control = gbBottomLeft AnchorSideBottom.Control = gbRenderTest AnchorSideBottom.Side = asrBottom - Left = 128 + Left = 130 Height = 128 Top = 130 - Width = 114 + Width = 116 Anchors = [akTop, akLeft, akBottom] AutoSize = True BorderSpacing.Left = 8 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 6 Caption = 'Origin at TOP' ClientHeight = 108 - ClientWidth = 110 + ClientWidth = 112 ParentFont = False TabOrder = 1 object TopLeftPaintbox: TPaintBox @@ -210,7 +210,7 @@ object MainForm: TMainForm Width = 100 BorderSpacing.Left = 6 BorderSpacing.Top = 2 - BorderSpacing.Right = 4 + BorderSpacing.Right = 6 BorderSpacing.Bottom = 6 OnPaint = PaintBoxPaint end @@ -240,13 +240,13 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = gbRenderTest AnchorSideBottom.Side = asrBottom - Left = 286 - Height = 282 + Left = 287 + Height = 284 Top = 0 Width = 250 Anchors = [akTop, akLeft, akRight, akBottom] Caption = 'Reference image test' - ClientHeight = 262 + ClientHeight = 264 ClientWidth = 246 Font.Style = [fsBold] ParentFont = False @@ -299,15 +299,15 @@ object MainForm: TMainForm AnchorSideTop.Side = asrBottom AnchorSideBottom.Control = gbReferenceImageTest AnchorSideBottom.Side = asrBottom - Left = 4 + Left = 6 Height = 128 Top = 130 Width = 116 Anchors = [akLeft, akBottom] AutoSize = True - BorderSpacing.Left = 4 + BorderSpacing.Left = 6 BorderSpacing.Top = 8 - BorderSpacing.Bottom = 4 + BorderSpacing.Bottom = 6 Caption = 'Reference image' ClientHeight = 108 ClientWidth = 112 @@ -333,15 +333,15 @@ object MainForm: TMainForm AnchorSideRight.Control = AllTestsPanel AnchorSideRight.Side = asrBottom Left = 0 - Height = 313 - Top = 298 - Width = 536 + Height = 312 + Top = 300 + Width = 537 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 16 Caption = 'Read/write test' - ClientHeight = 293 - ClientWidth = 532 + ClientHeight = 292 + ClientWidth = 533 Font.Style = [fsBold] ParentFont = False TabOrder = 2 @@ -349,7 +349,7 @@ object MainForm: TMainForm Left = 8 Height = 15 Top = 2 - Width = 516 + Width = 517 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 2 @@ -363,7 +363,7 @@ object MainForm: TMainForm Left = 8 Height = 45 Top = 72 - Width = 516 + Width = 517 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 4 @@ -377,17 +377,17 @@ object MainForm: TMainForm AnchorSideLeft.Control = gbReadWriteTest AnchorSideTop.Control = CbFileFormat AnchorSideTop.Side = asrBottom - Left = 4 - Height = 129 + Left = 6 + Height = 128 Top = 156 Width = 210 AutoSize = True - BorderSpacing.Left = 4 + BorderSpacing.Left = 6 BorderSpacing.Top = 8 - BorderSpacing.Right = 4 + BorderSpacing.Right = 6 BorderSpacing.Bottom = 8 Caption = 'Written with origin at BOTTOM' - ClientHeight = 109 + ClientHeight = 108 ClientWidth = 206 ParentFont = False TabOrder = 0 @@ -413,10 +413,10 @@ object MainForm: TMainForm AnchorSideTop.Control = gbWRBottomLeft Left = 6 Height = 100 - Top = 3 + Top = 2 Width = 100 BorderSpacing.Left = 6 - BorderSpacing.Top = 3 + BorderSpacing.Top = 2 BorderSpacing.Bottom = 6 OnPaint = PaintBoxPaint end @@ -425,7 +425,7 @@ object MainForm: TMainForm Left = 8 Height = 30 Top = 19 - Width = 516 + Width = 517 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 2 @@ -439,7 +439,7 @@ object MainForm: TMainForm Left = 8 Height = 15 Top = 53 - Width = 520 + Width = 521 Align = alTop BorderSpacing.Left = 8 BorderSpacing.Top = 4 @@ -492,7 +492,7 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter AnchorSideRight.Control = gbReadWriteTest AnchorSideRight.Side = asrBottom - Left = 435 + Left = 436 Height = 25 Top = 124 Width = 89 @@ -511,8 +511,8 @@ object MainForm: TMainForm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = CbFileFormat AnchorSideTop.Side = asrBottom - Left = 222 - Height = 129 + Left = 224 + Height = 128 Top = 156 Width = 213 AutoSize = True @@ -520,7 +520,7 @@ object MainForm: TMainForm BorderSpacing.Top = 8 BorderSpacing.Bottom = 8 Caption = 'Written with origin at TOP' - ClientHeight = 109 + ClientHeight = 108 ClientWidth = 209 ParentFont = False TabOrder = 3 @@ -531,7 +531,7 @@ object MainForm: TMainForm AnchorSideTop.Side = asrCenter Left = 114 Height = 25 - Top = 41 + Top = 40 Width = 91 AutoSize = True BorderSpacing.Left = 8 @@ -546,10 +546,10 @@ object MainForm: TMainForm AnchorSideTop.Control = gbWRTopLeft Left = 6 Height = 100 - Top = 3 + Top = 2 Width = 100 BorderSpacing.Left = 6 - BorderSpacing.Top = 3 + BorderSpacing.Top = 2 BorderSpacing.Bottom = 6 OnPaint = PaintBoxPaint end @@ -563,14 +563,14 @@ object MainForm: TMainForm AnchorSideRight.Side = asrBottom Left = 0 Height = 55 - Top = 627 - Width = 536 + Top = 628 + Width = 537 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Top = 16 Caption = 'Test results' ClientHeight = 35 - ClientWidth = 532 + ClientWidth = 533 Font.Style = [fsBold] ParentFont = False TabOrder = 3 diff --git a/components/fpvectorial/tests/vtmain.pas b/components/fpvectorial/tests/vtmain.pas index 8c7e5f186c..a162a680f3 100644 --- a/components/fpvectorial/tests/vtmain.pas +++ b/components/fpvectorial/tests/vtmain.pas @@ -1190,7 +1190,12 @@ procedure TMainForm.TreeSelectionChanged(Sender: TObject); begin ShowRenderTestImages; ShowRefImageTest; - ShowWriteReadTestImages; + try + ShowWriteReadTestImages; + except + on E:Exception do + MessageDlg(E.Message, mtError, [mbOK], 0); + end; UpdateTestResults; UpdateCmdStates; end; diff --git a/components/fpvectorial/wmfvectorialreader.pas b/components/fpvectorial/wmfvectorialreader.pas index eb437d31c5..c449e5532b 100644 --- a/components/fpvectorial/wmfvectorialreader.pas +++ b/components/fpvectorial/wmfvectorialreader.pas @@ -636,7 +636,10 @@ begin FHasPlaceableMetaHeader := false; n := AStream.Read(buf{%H-}, SizeOf(TPlaceableMetaHeader)); 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! FHasPlaceableMetaHeader := true; diff --git a/components/fpvectorial/wmfvectorialwriter.pas b/components/fpvectorial/wmfvectorialwriter.pas index b64d439c92..569ea58524 100644 --- a/components/fpvectorial/wmfvectorialwriter.pas +++ b/components/fpvectorial/wmfvectorialwriter.pas @@ -26,7 +26,7 @@ unit wmfvectorialwriter; interface -uses +uses lazlogger, Classes, SysUtils, FPImage, FPCanvas, fpvectorial, fpvWMF; @@ -55,6 +55,8 @@ type 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 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 FScalingFactor: Double; // Conversion fpvectorial units to logical units FMaxRecordSize: Int64; @@ -338,24 +340,37 @@ end; procedure TvWMFVectorialWriter.PrepareScaling(APage: TvVectorialPage); const - MAXINT16 = 32767; + MAXINT16 = 30000; // should be 32767, but avoid overflows... var maxx, maxy: Double; + w, h: Double; 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 - maxx := APage.Width * FScalingFactor; - maxy := APage.Height * FScalingFactor; + maxx := w * FScalingFactor; + maxy := h * FScalingFactor; // wmf is 16 bit only! --> reduce magnification if numbers get too big if Max(maxx, maxy) > MAXINT16 then begin - FScalingFactor := trunc(MAXINT16 / Max(APage.Width, APage.Height)); - FLogicalMaxX := word(trunc(APage.Width * FScalingFactor)); - FLogicalMaxY := word(trunc(APage.Height * FScalingFactor)); - end else - begin - FLogicalMaxX := trunc(maxx); - FLogicalMaxY := trunc(maxy); + FScalingFactor := trunc(MAXINT16 / Max(w, h)); + maxx := APage.Width * FScalingFactor; + maxy := APage.Height * FScalingFactor; end; + FLogicalMaxX := trunc(maxx); + FLogicalMaxY := trunc(maxy); + (* + 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; function TvWMFVectorialWriter.ScaleSizeX(x: Double): Integer; @@ -376,7 +391,8 @@ end; function TvWMFVectorialWriter.ScaleY(y: Double): Integer; begin if FUseTopLeftCoordinates then - Result := ScaleSizeY(y) else + Result := ScaleSizeY(y) + else Result := FLogicalMaxY - ScaleSizeY(y); end; @@ -476,11 +492,13 @@ begin end else begin rec.Top := c.y + r.y; - reC.Bottom := c.y - r.y; + rec.Bottom := c.y - r.y; end; UpdateBounds(rec.Left, rec.Top); 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 WriteWMFRecord(AStream, META_ELLIPSE, rec, SizeOf(TWMFRectRecord)); end;