1 { A fpvectorial reader for wmf files.
2
3 Documentation used:
4 - http://msdn.microsoft.com/en-us/library/cc250370.aspx
5 - http://wvware.sourceforge.net/caolan/ora-wmf.html
6 - http://www.symantec.com/avcenter/reference/inside.the.windows.meta.file.format.pdf
7
8 These functions are not supported:
9 - see the empty case items in "TWMFVectorialReader.ReadRecords"
10
11 Issues:
12 - Text often truncated, last character missing
13
14 Author: Werner Pamler
15 }
16
17 {.$DEFINE WMF_DEBUG}
18
19 unit wmfvectorialreader;
20
21 {$mode objfpc}{$H+}
22
23 interface
24
25 uses
26 Classes, SysUtils,
27 FPImage, FPCanvas,
28 fpvectorial;
29
30 type
31 TParamArray = array of word;
32
33 TWMFObjList = class(TFPList)
34 public
Addnull35 function Add(AData: Pointer): Integer;
36 end;
37
38 { TvWMFVectorialReader }
39
40 TvWMFVectorialReader = class(TvCustomVectorialReader)
41 private
42 // list for WMF Objects
43 FObjList: TWMFObjList;
44 // info from header
45 FBBox: TRect; // in metafile units as specified by UnitsPerInch. NOTE: "logical" units can be different!
46 FUnitsPerInch: Integer;
47 FHasPlaceableMetaHeader: Boolean;
48 // state
49 FCurrPen: TvPen;
50 FCurrBrush: TvBrush;
51 FCurrFont: TvFont;
52 FCurrPalette: TFPPalette;
53 FCurrTextColor: TFPColor;
54 FCurrTextAlign: Word;
55 FCurrBkMode: Word;
56 FCurrPolyFillMode: Word;
57 FCurrRawFontHeight: Integer;
58 FMapMode: Word;
59 FWindowOrigin: TPoint;
60 FWindowExtent: TPoint;
61 FRecordStartPos: Int64;
62 FScalingFactorX: Double;
63 FScalingFactorY: Double;
64 FPageWidth: Double;
65 FPageHeight: Double;
66 FErrMsg: TStrings;
67
68 procedure ClearObjList;
69
CreateBrushnull70 function CreateBrush(const AParams: TParamArray): Integer;
CreateFontnull71 function CreateFont(const AParams: TParamArray): Integer;
CreatePalettenull72 function CreatePalette(const AParams: TParamArray): Integer;
CreatePatternBrushnull73 function CreatePatternBrush(const AParams: TParamArray): Integer;
CreatePennull74 function CreatePen(const AParams: TParamArray): Integer;
CreateRegionnull75 function CreateRegion(const AParams: TParamArray): Integer;
76 procedure DeleteObj(const AParams: TParamArray);
DIBCreatePatternBrushnull77 function DIBCreatePatternBrush(const AParams: TParamArray): Integer;
78 procedure ReadArc(APage: TvVectorialpage; const AParams: TParamArray);
79 procedure ReadBkColor(APage: TvVectorialPage; const AParams: TParamArray);
80 procedure ReadBkMode(APage: TvVectorialPage; const AValue: Word);
81 procedure ReadChord(APage: TvVectorialpage; const AParams: TParamArray);
ReadColornull82 function ReadColor(const AParams: TParamArray; AIndex: Integer): TFPColor;
83 procedure ReadExtTextOut(APage: TvVectorialPage; const AParams: TParamArray);
84 procedure ReadEllipse(APage: TvVectorialPage; const AParams: TParamArray);
ReadImagenull85 function ReadImage(const AParams: TParamArray; AIndex: Integer;
86 AImage: TFPCustomImage): Boolean;
87 procedure ReadLine(APage: TvVectorialPage; P1X, P1Y, P2X, P2Y: SmallInt);
88 procedure ReadMapMode(const AParams: TParamArray);
89 procedure ReadOffsetWindowOrg(const AParams: TParamArray);
90 procedure ReadPie(APage: TvVectorialPage; const AParams: TParamArray);
91 procedure ReadPolyFillMode(const AValue: Word);
92 procedure ReadPolygon(APage: TvVectorialPage; const AParams: TParamArray;
93 AFilled: boolean);
94 procedure ReadPolyPolygon(APage: TvVectorialPage; const AParams: TParamArray);
95 procedure ReadRectangle(APage: TvVectorialPage; const AParams: TParamArray;
96 IsRounded: Boolean);
97 procedure ReadStretchDIB(AStream: TStream; APage: TvVectorialPage;
98 const AParams: TParamArray);
ReadStringnull99 function ReadString(const AParams: TParamArray;
100 AStartIndex, ALength: Integer): String;
101 procedure ReadTextAlign(const AParams: TParamArray);
102 procedure ReadTextColor(const AParams: TParamArray);
103 procedure ReadTextOut(APage: TvVectorialPage; const AParams: TParamArray);
104 procedure ReadWindowExt(const AParams: TParamArray);
105 procedure ReadWindowOrg(const AParams: TParamArray);
106 procedure SelectObj(const AIndex: Integer);
107 procedure SelectPalette(const AIndex: Integer);
108
109 protected
110 procedure ReadHeader(AStream: TStream);
111 procedure ReadRecords(AStream: TStream; AData: TvVectorialDocument);
112
113 procedure LogError(AMsg: String);
114
115 procedure CalcScalingFactors(out fx, fy: Double);
ScaleXnull116 function ScaleX(x: Integer): Double;
ScaleYnull117 function ScaleY(y: Integer): Double;
ScaleSizeXnull118 function ScaleSizeX(x: Integer): Double;
ScaleSizeYnull119 function ScaleSizeY(y: Integer): Double;
120
121 public
122 constructor Create; override;
123 destructor Destroy; override;
124 procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
125 end;
126
127
128 implementation
129
130 uses
131 FPReadBMP, BMPcomn,
132 LConvEncoding, Math,
133 fpvUtils, fpvWMF;
134
135 const
136 INCH2MM = 25.4; // 1 inch = 25.4 mm
137 MM2INCH = 1.0/INCH2MM;
138 DEFAULT_SIZE = 100; // size of image (in mm) if scaling info is not available
139 SIZE_OF_WORD = 2;
140 FPV_UNIT: (fuPX, fuMM) = fuPX;
141
142 type
143 TWMFFont = class
144 Font: TvFont;
145 RawHeight: Integer;
146 end;
147
148 TWMFBrush = class
149 Brush: TvBrush;
150 end;
151
152 TWMFPen = class
153 Pen: TvPen;
154 RawPenWidth: Integer;
155 end;
156
157 TWMFPalette = class
158 // not used, just needed as a filler in the ObjList
159 end;
160
161 TWMFRegion = class
162 // not used, just needed as a filler in the ObjList
163 end;
164
165
166 { TWMFObjList }
167
Addnull168 function TWMFObjList.Add(AData: Pointer): Integer;
169 var
170 i: Integer;
171 begin
172 // Fill empty items first
173 for i := 0 to Count-1 do
174 if Items[i] = nil then begin
175 Items[i] := AData;
176 Result := i;
177 exit;
178 end;
179 Result := inherited Add(AData);
180 end;
181
182
183 { TvWMFVectorialReader }
184
185 constructor TvWMFVectorialReader.Create;
186 begin
187 inherited;
188 FErrMsg := TStringList.Create;
189 FObjList := TWMFObjList.Create;
190 with FCurrPen do begin
191 Style := psSolid;
192 Color := colBlack;
193 Width := 1;
194 end;
195 with FCurrBrush do begin
196 Style := bsSolid;
197 Color := colBlack;
198 end;
199 with FCurrFont do begin
200 Color := colBlack;
201 Size := 10;
202 Name := 'Arial';
203 Orientation := 0;
204 Bold := false;
205 Italic := False;
206 Underline := false;
207 StrikeThrough := false;
208 end;
209 FCurrTextColor := colBlack;
210 FCurrTextAlign := 0; // Left + Top
211 FCurrPolyFillMode := ALTERNATE;
212 FMapMode := MM_ANISOTROPIC;
213 FUnitsPerInch := 96;
214 end;
215
216 destructor TvWMFVectorialReader.Destroy;
217 begin
218 ClearObjList;
219 FObjList.Free;
220 FErrMsg.Free;
221 inherited;
222 end;
223
224 procedure TvWMFVectorialReader.ClearObjList;
225 var
226 i: Integer;
227 begin
228 for i:=0 to FObjList.Count-1 do
229 TObject(FObjList[i]).Free;
230 FObjList.Clear;
231 end;
232
CreateBrushnull233 function TvWMFVectorialReader.CreateBrush(const AParams: TParamArray): Integer;
234 var
235 brushRec: PWMFBrushRecord;
236 wmfBrush: TWMFBrush;
237 begin
238 wmfBrush := TWMFBrush.Create;
239 brushRec := PWMFBrushRecord(@AParams[0]);
240
241 // brush style
242 case brushRec^.Style of
243 BS_SOLID:
244 wmfBrush.Brush.Style := bsSolid;
245 BS_NULL:
246 wmfBrush.brush.Style := bsClear;
247 BS_HATCHED:
248 case brushRec^.Hatch of
249 HS_HORIZONTAL : wmfBrush.brush.Style := bsHorizontal;
250 HS_VERTICAL : wmfBrush.brush.Style := bsVertical;
251 HS_FDIAGONAL : wmfBrush.brush.Style := bsFDiagonal;
252 HS_BDIAGONAL : wmfBrush.brush.Style := bsBDiagonal;
253 HS_CROSS : wmfBrush.brush.Style := bsCross;
254 HS_DIAGCROSS : wmfBrush.brush.Style := bsDiagCross;
255 end;
256 { --- not supported at the moment ...
257 BS_PATTERN = $0003;
258 BS_INDEXED = $0004;
259 BS_DIBPATTERN = $0005;
260 BS_DIBPATTERNPT = $0006;
261 BS_PATTERN8X8 = $0007;
262 BS_DIBPATTERN8X8 = $0008;
263 BS_MONOPATTERN = $0009; }
264 else
265 wmfBrush.brush.Style := bsSolid;
266 end;
267
268 // brush color
269 wmfBrush.brush.Color.Red := brushRec^.ColorRED shl 8;
270 wmfBrush.brush.Color.Green := brushRec^.ColorGREEN shl 8;
271 wmfBrush.brush.Color.Blue := brushRec^.ColorBLUE shl 8;
272
273 // add to WMF object list
274 Result := FObjList.Add(wmfBrush);
275 end;
276
TvWMFVectorialReader.DIBCreatePatternBrushnull277 function TvWMFVectorialReader.DIBCreatePatternBrush(const AParams: TParamArray): Integer;
278 var
279 wmfBrush: TWMFBrush;
280 rasterImg: TvRasterImage = nil;
281 memImg: TFPMemoryImage = nil;
282 style: Word;
283 colorUsage: Word;
284 begin
285 wmfBrush := TWMFBrush.Create;
286
287 style := AParams[0];
288 colorUsage := AParams[1];
289
290 memImg := TFPMemoryImage.Create(0, 0);
291 try
292 if ReadImage(AParams, 2, memImg) then begin
293 wmfBrush.Brush.Image := memImg;
294 wmfBrush.Brush.Style := bsImage;
295 end;
296 except
297 on E:Exception do begin
298 FreeAndNil(memImg);
299 LogError('Image reading error: ' + E.Message);
300 end;
301 end;
302
303 // Add to WMF object list
304 Result := FObjList.Add(wmfBrush);
305 end;
306
CreateFontnull307 function TvWMFVectorialReader.CreateFont(const AParams: TParamArray): Integer;
308 var
309 wmfFont: TWMFFont;
310 fontRec: PWMFFontRecord;
311 fntName: String;
312 idx: Integer;
313 begin
314 idx := Length(Aparams);
315 wmfFont := TWMFFont.Create;
316 fontRec := PWMFFontRecord(@AParams[0]);
317
318 // Get font name
319 SetLength(fntName, 32);
320 idx := SizeOf(TWMFFontRecord) div SIZE_OF_WORD;
321 fntname := StrPas(PChar(@AParams[idx]));
322
323 wmfFont.Font.Name := ISO_8859_1ToUTF8(fntName);
324 wmfFont.Font.Size := round(ScaleSizeY(fontRec^.Height));
325 wmfFont.Font.Color := colBlack; // to be replaced by FCurrTextColor
326 wmfFont.Font.Bold := fontRec^.Weight >= 700;
327 wmfFont.Font.Italic := fontRec^.Italic <> 0;
328 wmfFont.Font.Underline := fontRec^.UnderLine <> 0;
329 wmfFont.Font.StrikeThrough := fontRec^.Strikeout <> 0;
330 wmfFont.Font.Orientation := fontRec^.Escapement div 10;
331 wmfFont.RawHeight := fontRec^.Height; //* 6 div 5; // Rough correction for y position
332
333 // add to WMF object list
334 Result := FObjList.Add(wmfFont);
335 end;
336
337 // to do: implement read palette
TvWMFVectorialReader.CreatePalettenull338 function TvWMFVectorialReader.CreatePalette(const AParams: TParamArray): Integer;
339 var
340 pal: TFPPalette;
341 col: TFPColor;
342 colRec: PWMFPaletteColorRecord;
343 i, n: Integer;
344 begin
345 // start := AParams[0];
346 n := AParams[1];
347 pal := TFPPalette.Create(n);
348 for i:=0 to n-1 do begin
349 colRec := PWMFPaletteColorRecord(@AParams[2 + i*4]);
350 col.Red := colRec^.ColorRED shl 8;
351 col.Green := colRec^.ColorGREEN shl 8;
352 col.Blue := colRec^.ColorBLUE shl 8;
353 pal.Add(col);
354 end;
355 Result := FObjList.Add(pal);
356 end;
357
CreatePatternBrushnull358 function TvWMFVectorialReader.CreatePatternBrush(const AParams: TParamArray): Integer;
359 var
360 wmfBrush: TWMFBrush;
361 begin
362 wmfBrush := TWMFBrush.Create;
363
364 // Add to WMF object list;
365 Result := FObjList.Add(wmfBrush);
366 end;
367
CreatePennull368 function TvWMFVectorialReader.CreatePen(const AParams: TParamArray): Integer;
369 var
370 penRec: PWMFPenRecord;
371 wmfPen: TWMFPen;
372 begin
373 wmfPen := TWMFPen.Create;
374 penRec := PWMFPenRecord(@AParams[0]);
375
376 // pen style
377 case penRec^.Style and $000F of
378 PS_DASH : wmfPen.pen.Style := psDash;
379 PS_DOT : wmfPen.pen.Style := psDot;
380 PS_DASHDOT : wmfPen.pen.Style := psDashDot;
381 PS_DASHDOTDOT : wmfPen.pen.Style := psDashDotDot;
382 PS_NULL : wmfPen.pen.Style := psClear;
383 PS_INSIDEFRAME: wmfPen.pen.Style := psInsideFrame;
384 else wmfPen.pen.Style := psSolid;
385 end;
386 { -- this is not yet supported by fpvectorial
387 case penRec^.Style and $0F00 of
388 PS_ENDCAP_SQUARE: wmfPen.pen.Endcap := pseSquare;
389 PS_ENDCAP_FLAT : wmfPen.pen.EndCap := pseFlat;
390 else wmfPen.pen.EndCap := pseRound;
391 end;
392 case penRec^.Style and $1000 of
393 PS_JOIN_BEVEL : wmfPen.pen.JoinStyle := pjsBevel;
394 PS_JOIN_MITER : wmfPen.pen.JoinStyle := pjsMiter;
395 else wmfPen.pen.JoinStyle := pjsRound;
396 end; }
397
398 // pen width
399 wmfPen.pen.Width := round(ScaleSizeX(penRec^.Width));
400 if penRec^.Width = 0 then
401 wmfPen.pen.Width := 1;
402
403 if wmfPen.pen.Style = psClear
404 then wmfPen.RawPenWidth := 0
405 else wmfPen.RawPenWidth := penRec^.Width;
406
407 // pen color
408 wmfPen.pen.Color.Red := penRec^.ColorRED shl 8;
409 wmfPen.pen.Color.Green := penRec^.ColorGREEN shl 8;
410 wmfPen.pen.Color.Blue := penRec^.ColorBLUE shl 8;
411
412 // Add to WMF object list
413 Result := FObjList.Add(wmfPen);
414 end;
415
416 // todo: implement region
CreateRegionnull417 function TvWMFVectorialReader.CreateRegion(const AParams: TParamArray): Integer;
418 var
419 wmfReg: TWMFRegion;
420 begin
421 wmfReg := TWMFRegion.Create;
422 Result := FObjList.Add(wmfReg);
423 end;
424
425 procedure TvWMFVectorialReader.DeleteObj(const AParams: TParamArray);
426 var
427 obj: TObject;
428 idx: Integer;
429 begin
430 idx := AParams[0];
431 if idx < FObjList.Count then begin
432 obj := TObject(FObjList[idx]);
433 TObject(obj).Free;
434 FObjList[idx] := nil;
435 // Do not delete from list because this will confuse the obj indexes.
436 end;
437 end;
438
439 procedure TvWMFVectorialReader.LogError(AMsg: String);
440 begin
441 FErrMsg.Add(AMsg);
442 end;
443
444 procedure TvWMFVectorialReader.ReadArc(APage: TvVectorialPage;
445 const AParams: TParamArray);
446 var
447 path: TPath;
448 arcRec: PWMFArcRecord;
449 begin
450 arcRec := PWMFArcRecord(@AParams[0]);
451
452 APage.StartPath(ScaleX(arcRec^.XStartArc), ScaleY(arcRec^.YStartArc));
453 APage.AddEllipticalArcWithCenterToPath(
454 ScaleX(arcRec^.Right - arcRec^.Left) / 2,
455 ScaleY(abs(arcRec^.Bottom - arcRec^.Top)) / 2,
456 0.0,
457 ScaleX(arcRec^.XEndArc),
458 ScaleY(arcrec^.YEndArc),
459 ScaleX(arcRec^.Left + arcRec^.Right) / 2,
460 ScaleY(abs(arcRec^.Top + arcRec^.Bottom)) / 2,
461 false
462 );
463 path := APage.EndPath;
464 path.Pen := FCurrPen;
465 end;
466
467 procedure TvWMFVectorialReader.ReadBkColor(APage: TvVectorialPage;
468 const AParams: TParamArray);
469 begin
470 APage.BackgroundColor := ReadColor(AParams, 0);
471 end;
472
473 procedure TvWMFVectorialReader.ReadBkMode(APage: TvVectorialPage;
474 const AValue: Word);
475 begin
476 FCurrBkMode := AValue;
477 end;
478
479 procedure TvWMFVectorialReader.ReadChord(APage: TvVectorialPage;
480 const AParams: TParamArray);
481 var
482 path: TPath;
483 arcRec: PWMFArcRecord;
484 p1, p2: T3dPoint;
485 begin
486 arcRec := PWMFArcRecord(@AParams[0]);
487
488 p1 := Make3DPoint(ScaleX(arcRec^.XStartArc), ScaleY(arcRec^.YStartArc));
489 p2 := Make3DPoint(ScaleX(arcRec^.XEndArc), ScaleY(arcRec^.YEndArc));
490
491 APage.StartPath(p1.x, p1.y);
492 APage.AddEllipticalArcWithCenterToPath(
493 ScaleX(arcRec^.Right - arcRec^.Left) / 2,
494 ScaleY(abs(arcRec^.Bottom - arcRec^.Top)) / 2,
495 0.0,
496 p2.x,
497 p2.y,
498 ScaleX(arcRec^.Left + arcRec^.Right) / 2,
499 ScaleY(abs(arcRec^.Top + arcRec^.Bottom)) / 2,
500 false
501 );
502 APage.AddLineToPath(p1.x, p1.y);
503 path := APage.EndPath;
504 path.Pen := FCurrPen;
505 path.Brush := FCurrBrush;
506 end;
507
TvWMFVectorialReader.ReadColornull508 function TvWMFVectorialReader.ReadColor(const AParams: TParamArray;
509 AIndex: Integer): TFPColor;
510 var
511 colorRec: PWMFColorRecord;
512 begin
513 colorRec := PWMFColorRecord(@AParams[AIndex]);
514 Result.Red := colorRec^.ColorRED shl 8;
515 Result.Green := colorRec^.ColorGREEN shl 8;
516 Result.Blue := colorRec^.ColorBLUE shl 8;
517 Result.Alpha := alphaOpaque;
518 end;
519
520 procedure TvWMFVectorialReader.ReadExtTextOut(APage: TvVectorialPage;
521 const AParams: TParamArray);
522 var
523 x, y, len, opts: Integer;
524 offs: TPoint;
525 R: TRect;
526 s: String;
527 txt: TvText;
528 angle: Double;
529 begin
530 y := SmallInt(AParams[0]); // signed int
531 x := SmallInt(AParams[1]);
532 len := SmallInt(AParams[2]);
533 opts := AParams[3]; // unsigned int
534 if opts <> 0 then begin
535 R.Bottom := SmallInt(AParams[4]);
536 R.Right := SmallInt(AParams[5]);
537 R.Top := SmallInt(AParams[6]);
538 R.Left := SmallInt(AParams[7]);
539 s := ReadString(AParams, 8, len);
540 end else
541 s := ReadString(AParams, 4, len);
542 // We ignore the Dx fields
543
544 // Correct text position which is at baseline in case of fpvectorial, but
545 // may be different depending on bits in the CurrTextAlign value.
546
547 // TO DO: More testing of text positioning
548 angle := DegToRad(FCurrFont.Orientation);
549 case FCurrTextAlign and $0018 of
550 0:
551 offs := Point(0, 0); //Rotate2DPoint(Point(0, +FCurrRawFontHeight), Point(0, 0), angle);
552 TA_BASELINE:
553 // offs := Rotate2DPoint(Point(0, -FCurrRawFontHeight*6 div 5), Point(0, 0), angle);
554 offs := Rotate2DPoint(Point(0, +FCurrRawFontHeight), Point(0, 0), angle);
555 TA_BOTTOM:
556 offs := Rotate2DPoint(Point(0, -FCurrRawFontHeight*7 div 5), Point(0, 0), angle);
557 end;
558
559 // Pass text to fpvectorial
560 txt := APage.AddText(ScaleX(x + offs.X), ScaleY(y + offs.Y), s);
561 // Select the font
562 txt.Font := FCurrFont;
563 // Set horizontal text alignment.
564 case FCurrTextAlign and (TA_RIGHT or TA_CENTER) of
565 TA_RIGHT : txt.TextAnchor := vtaEnd;
566 TA_CENTER : txt.TextAnchor := vtaMiddle;
567 else txt.TextAnchor := vtaStart;
568 end;
569
570 case FCurrBkMode of
571 BM_TRANSPARENT : txt.Brush.Style := bsClear;
572 BM_OPAQUE : txt.Brush.Style := bsSolid;
573 end;
574
575 // to do: draw text background (if opts and ETO_OPAQUE <> 0 )
576 // to do: take care of clipping (if opts and ETO_CLIPPED <> 0)
577 end;
578
579 procedure TvWMFVectorialReader.ReadEllipse(APage: TvVectorialPage;
580 const AParams: TParamArray);
581 var
582 rectRec: PWMFRectRecord; // coordinates are SmallInt.
583 ellipse: TvEllipse;
584 begin
585 rectRec := PWMFRectRecord(@AParams[0]);
586
587 ellipse := TvEllipse.Create(APage);
588 ellipse.X := (ScaleX(rectRec^.Left) + ScaleX(rectRec^.Right)) / 2;
589 ellipse.Y := (ScaleY(rectRec^.Top) + ScaleY(rectRec^.Bottom)) / 2;
590 ellipse.HorzHalfAxis := abs(ScaleX(rectRec^.Right - rectRec^.Left) / 2);
591 ellipse.VertHalfAxis := abs(ScaleSizeY(rectRec^.Bottom - rectRec^.Top) / 2);
592
593 ellipse.Pen := FCurrPen;
594 ellipse.Brush := FCurrBrush;
595
596 APage.AddEntity(ellipse);
597 end;
598
599 procedure TvWMFVectorialReader.ReadFromStream(AStream: TStream;
600 AData: TvVectorialDocument);
601 begin
602 ClearObjList;
603 FErrMsg.Clear;
604
605 ReadHeader(AStream);
606 ReadRecords(AStream, AData);
607
608 if FErrMsg.Count > 0 then
609 raise Exception.Create(FErrMsg.Text);
610 end;
611
612 procedure TvWMFVectorialReader.ReadHeader(AStream: TStream);
613 var
614 buf: array[0..80] of byte;
615 placeableMetaHdr: TPlaceableMetaHeader absolute buf;
616 wmfHdr: TWMFHeader absolute buf;
617 begin
618 AStream.Position := 0;
619
620 // Test if file begins with a placeable meta file header
621 FHasPlaceableMetaHeader := false;
622 AStream.ReadBuffer(buf, SizeOf(TPlaceableMetaHeader));
623 if placeableMetaHdr.Key = WMF_MAGIC_NUMBER then begin // yes!
624 FHasPlaceableMetaHeader := true;
625 FBBox.Left := placeableMetaHdr.Left;
626 FBBox.Top := placeableMetaHdr.Top;
627 FBBox.Right := placeableMetaHdr.Right;
628 FBBox.Bottom := placeableMetaHdr.Bottom;
629 FUnitsPerInch := placeableMetaHdr.Inch;
630 end else
631 begin
632 // Is it the wmf header?
633 if not ((wmfHdr.FileType in [0, 1]) and (wmfHdr.HeaderSize = 9)) then begin
634 // No - then it is not a wmf format.
635 LogError('This is not a WMF file.');
636 exit;
637 end;
638 // Rewind stream
639 AStream.Position := 0;
640 end;
641
642 // Read the wmf header
643 AStream.ReadBuffer(buf, SizeOf(TWMFHeader));
644 // FNumObj := wmfHdr.NumOfObjects;
645 // FMaxRecordSize := wmfHdr.MaxRecordSize; // words
646 end;
647
648 procedure TvWMFVectorialReader.ReadLine(APage: TvVectorialPage;
649 P1X, P1Y, P2X, P2Y: SmallInt);
650 var
651 path: TPath;
652 begin
653 APage.StartPath(ScaleX(P1X), ScaleY(P1Y));
654 APage.AddLineToPath(ScaleX(P2X), ScaleY(P2Y));
655 path := APage.EndPath;
656 path.Pen := FCurrPen;
657 end;
658
659 procedure TvWMFVectorialReader.ReadMapMode(const AParams: TParamArray);
660 begin
661 FMapMode := AParams[0];
662 CalcScalingFactors(FScalingFactorX, FScalingFactorY);
663 end;
664
665 procedure TvWMFVectorialReader.ReadOffsetWindowOrg(const AParams: TParamArray);
666 begin
667 FWindowOrigin.Y := FWindowOrigin.Y + SmallInt(AParams[0]);
668 FWindowOrigin.X := FWindowOrigin.X + SmallInt(AParams[1]);
669 end;
670
671 procedure TvWMFVectorialReader.ReadPie(APage: TvVectorialpage;
672 const AParams: TParamArray);
673 var
674 path: TPath;
675 arcRec: PWMFArcRecord;
676 p1, p2, ctr: T3dPoint;
677 begin
678 arcRec := PWMFArcRecord(@AParams[0]);
679
680 p1 := Make3DPoint(ScaleX(arcRec^.XStartArc), ScaleY(arcRec^.YStartArc));
681 p2 := Make3DPoint(ScaleX(arcRec^.XEndArc), ScaleY(arcRec^.YEndArc));
682 ctr := Make3DPoint(ScaleX(arcRec^.Left + arcRec^.Right)/2, ScaleY(arcRec^.Top + arcRec^.Bottom)/2);
683
684 APage.StartPath(p1.x, p1.y);
685 APage.AddEllipticalArcWithCenterToPath(
686 ScaleX(arcRec^.Right - arcRec^.Left) / 2,
687 ScaleY(abs(arcRec^.Bottom - arcRec^.Top)) / 2,
688 0.0,
689 p2.x, p2.y,
690 ctr.x, ctr.y,
691 false
692 );
693 APage.AddLineToPath(ctr.x, ctr.y);
694 APage.AddLineToPath(p1.x, p1.y);
695 path := APage.EndPath;
696 path.Pen := FCurrPen;
697 path.Brush := FCurrBrush;
698 end;
699
700 procedure TvWMFVectorialReader.ReadPolyFillMode(const AValue: Word);
701 begin
702 FCurrPolyFillMode := AValue;
703 end;
704
705 { AParams[0] ... number of points
706 AParams[1] ... x value of 1st point
707 AParams[2] ... y value of 1st point
708 etc }
709 procedure TvWMFVectorialReader.ReadPolygon(APage: TvVectorialPage;
710 const AParams: TParamArray; AFilled: boolean);
711 const
712 EPS = 1E-6;
713 var
714 n: Integer;
715 i, j: Integer;
716 pts: Array of T3DPoint;
717 path: TPath;
718 begin
719 n := AParams[0];
720 SetLength(pts, n);
721 j := 1;
722 for i:= 0 to n-1 do begin
723 pts[i] := Make3DPoint(ScaleX(SmallInt(AParams[j])), ScaleY(SmallInt(AParams[j+1])));
724 inc(j, 2);
725 end;
726 // Automatically close polygon (but not polyline)
727 if AFilled and not SamePoint(pts[0], pts[n-1], EPS) then begin
728 SetLength(pts, n+1);
729 pts[n] := pts[0];
730 end;
731
732 APage.StartPath(pts[0].X, pts[0].Y);
733 for i:=1 to n-1 do
734 APage.AddLineToPath(pts[i].x, pts[i].y);
735 path := APage.EndPath;
736 path.Pen := FCurrPen;
737 if AFilled then
738 path.Brush := FCurrBrush
739 else begin
740 path.Brush.Style := bsClear;
741 path.Brush.Kind := bkSimpleBrush;
742 end;
743 case FCurrPolyFillMode of
744 ALTERNATE : path.WindingRule := vcmEvenOddRule;
745 WINDING : path.WindingRule := vcmNonZeroWindingRule;
746 end;
747 end;
748
749 procedure TvWMFVectorialReader.ReadPolyPolygon(APage: TvVectorialPage;
750 const AParams: TParamArray);
751 const
752 EPS = 1E-6;
753 var
754 nPoly: Integer;
755 nPts: array of Integer;
756 pts: array of T3DPoint;
757 i, j, k: Integer;
758 path: TPath;
759 P: T3DPoint;
760 Pstart: T3DPoint;
761 begin
762 k := 0;
763 nPoly := AParams[k];
764 inc(k);
765 SetLength(nPts, nPoly);
766 for i:=0 to nPoly-1 do begin
767 nPts[i] := AParams[k];
768 inc(k);
769 end;
770
771 APage.StartPath;
772 for j := 0 to nPoly-1 do begin
773 PStart := Make3DPoint(ScaleX(SmallInt(AParams[k])), ScaleY(SmallInt(AParams[k+1])));
774 inc(k, 2);
775 APage.AddMoveToPath(PStart.X, PStart.Y);
776 for i := 1 to nPts[j]-1 do begin
777 P := Make3DPoint(ScaleX(SmallInt(AParams[k])), ScaleY(SmallInt(AParams[k+1])));
778 inc(k, 2);
779 APage.AddLineToPath(P.X, P.Y);
780 end;
781 // Close polygon
782 if not SamePoint(P, PStart, EPS) then
783 APage.AddLineToPath(PStart.X, PStart.Y);
784 end;
785 path := APage.EndPath;
786 path.Pen := FCurrPen;
787 path.Brush := FCurrBrush;
788 case FCurrPolyFillMode of
789 ALTERNATE : path.WindingRule := vcmEvenOddRule;
790 WINDING : path.WindingRule := vcmNonZeroWindingRule;
791 end;
792
793 // No need to add path to page explicity
794 end;
795
796 procedure TvWMFVectorialReader.ReadRecords(AStream: TStream; AData: TvVectorialDocument);
797 var
798 wmfRec: TWMFRecord;
799 params: TParamArray;
800 page: TvVectorialPage;
801 prevX, prevY: Word;
802 begin
803 page := AData.AddPage(not (vrfWMF_UseBottomLeftCoords in Settings.VecReaderFlags));
804
805 while AStream.Position < AStream.Size do begin
806 // Store the stream position where the current record begins
807 FRecordStartPos := AStream.Position;
808
codenull809 // Read record size and function code
810 AStream.ReadBuffer(wmfRec, SizeOf(TWMFRecord));
811
812 {$IFDEF WMF_DEBUG}
813 writeLn(Format('Record position: %0:d / Record size: %1:d words / Record type: %2:d ($%2:x): %3:s',
814 [FRecordStartPos, wmfRec.Size, wmfRec.Func, WMF_GetRecordTypeName(wmfRec.Func)]));
815 {$ENDIF}
816
817 // End of file?
818 if wmfRec.Func = META_EOF then
819 break;
820
821 // Obviously invalid record?
822 if wmfRec.Size < 3 then begin
823 LogError(Format('Record size error at position %d', [FRecordStartPos]));
824 exit;
825 end;
826
827 // Read parameters
828 SetLength(params, wmfRec.Size - 3);
829 AStream.ReadBuffer(params[0], (wmfRec.Size - 3)*SIZE_OF_WORD);
830
codenull831 // Process record, depending on function code
832 case wmfRec.Func of
833 { *** Bitmap record types *** }
834 META_BITBLT:
835 ;
836 META_DIBBITBLT:
837 ;
838 META_DIBSTRETCHBLT:
839 ;
840 META_SETDIBTODEV:
841 ;
842 META_STRETCHBLT:
843 ;
844 META_STRETCHDIB:
845 ReadStretchDIB(AStream, page, params);
846
847 { *** Drawing records *** }
848 META_ARC:
849 ReadArc(page, params);
850 META_CHORD:
851 ReadChord(page, params);
852 META_ELLIPSE:
853 ReadEllipse(page, params);
854 META_EXTFLOODFILL:
855 ;
856 META_EXTTEXTOUT:
857 ReadExtTextOut(page, params);
858 META_FILLREGION:
859 ;
860 META_FLOODFILL:
861 ;
862 META_FRAMEREGION:
863 ;
864 META_INVERTREGION:
865 ;
866 META_MOVETO:
867 begin
868 prevX := params[1];
869 prevY := params[0];
870 end;
871 META_LINETO:
872 begin
873 ReadLine(page, prevX, prevY, params[1], params[0]);
874 prevX := params[1];
875 prevY := params[0];
876 end;
877 META_PAINTREGION:
878 ;
879 META_PATBLT:
880 ;
881 META_PIE:
882 ReadPie(page, params);
883 META_POLYGON:
884 ReadPolygon(page, params, true);
885 META_POLYLINE:
886 ReadPolygon(page, params, false);
887 META_POLYPOLYGON:
888 ReadPolyPolygon(page, params);
889 META_RECTANGLE:
890 ReadRectangle(page, params, false);
891 META_ROUNDRECT:
892 ReadRectangle(page, params, true);
893 META_SETPIXEL:
894 ;
895 META_TEXTOUT:
896 ReadTextOut(page, params);
897
898 { *** WMF Object records *** }
899 META_CREATEBRUSHINDIRECT:
900 CreateBrush(params);
901 META_CREATEFONTINDIRECT:
902 CreateFont(params);
903 META_CREATEPALETTE:
904 CreatePalette(params);
905 META_CREATEPATTERNBRUSH:
906 CreatePatternBrush(params);
907 META_CREATEPENINDIRECT:
908 CreatePen(params);
909 META_CREATEREGION:
910 CreateRegion(params);
911 META_DIBCREATEPATTERNBRUSH:
912 DIBCreatePatternBrush(params);
913 META_DELETEOBJECT:
914 DeleteObj(params);
915 META_SELECTCLIPREGION:
916 ;
917 META_SELECTOBJECT:
918 SelectObj(params[0]);
919 META_SELECTPALETTE:
920 SelectPalette(params[0]);
921
922 { *** State records *** }
923 META_ANIMATEPALETTE:
924 ;
925 META_EXCLUDECLIPRECT:
926 ;
927 META_INTERSECTCLIPRECT:
928 ;
929 META_OFFSETCLIPRGN:
930 ;
931 META_OFFSETVIEWPORTORG:
932 ;
933 META_OFFSETWiNDOWORG:
934 ReadOffsetWindowOrg(params);
935 META_REALIZEPALETTE:
936 ;
937 META_RESIZEPALETTE:
938 ;
939 META_RESTOREDC:
940 ;
941 META_SAVEDC:
942 ;
943 META_SCALEVIEWPORTEXT:
944 ;
945 META_SCALEWINDOWEXT:
946 ;
947 META_SETBKCOLOR:
948 ReadBkColor(page, params);
949 META_SETBKMODE:
950 ;
951 META_SETLAYOUT:
952 ;
953 META_SETMAPMODE:
954 ReadMapMode(params);
955 META_SETMAPPERFLAGS:
956 ;
957 META_SETPALENTRIES:
958 ;
959 META_SETPOLYFILLMODE:
960 ReadPolyFillMode(params[0]);
961 META_SETRELABS:
962 ;
963 META_SETROP2:
964 ;
965 META_SETSTRETCHBLTMODE:
966 ;
967 META_SETTEXTALIGN:
968 ReadTextAlign(params);
969 META_SETTEXTCHAREXTRA:
970 ;
971 META_SETTEXTCOLOR:
972 ReadTextColor(params);
973 META_SETVIEWPORTEXT:
974 ;
975 META_SETVIEWPORTORG:
976 ;
977 META_SETWINDOWEXT:
978 ReadWindowExt(params);
979 META_SETWINDOWORG:
980 ReadWindowOrg(params);
981
982 { *** ESCAPE records *** }
983 // None of them implemented
984 end;
985
986 AStream.Position := FRecordStartPos + wmfRec.Size * SIZE_OF_WORD;
987 end;
988
989 if FHasPlaceableMetaHeader then begin
990 page.Width := FPageWidth;
991 page.Height := FPageHeight;
992 end else begin
993 page.Width := ScaleSizeX(FWindowExtent.X);
994 page.Height := ScaleSizeY(FWindowExtent.Y);
995 end;
996 AData.Width := page.Width;
997 AData.Height := page.Height;
998
999 SetLength(params, 0);
1000 end;
1001
1002 procedure TvWMFVectorialReader.ReadRectangle(APage: TvVectorialPage;
1003 const AParams: TParamArray; IsRounded: Boolean);
1004 var
1005 rectRec: PWMFRectRecord; // coordinates are SmallInt
1006 rx, ry: SmallInt;
1007 rect: TvRectangle;
1008 begin
1009 if IsRounded then begin
1010 ry := AParams[0];
1011 rx := AParams[1];
1012 rectRec := PWMFRectRecord(@AParams[2]);
1013 end else begin
1014 rectRec := PWMFRectRecord(@AParams[0]);
1015 rx := 0;
1016 ry := 0;
1017 end;
1018
1019 rect := TvRectangle.Create(APage);
1020 rect.X := ScaleX(rectRec^.Left);
1021 rect.Y := ScaleY(rectRec^.Top);
1022 rect.CX := ScaleSizeX(abs(rectRec^.Right - rectRec^.Left));
1023 rect.CY := ScaleSizeY(abs(rectRec^.Bottom - rectRec^.Top));
1024 rect.RX := ScaleSizeX(rx);
1025 rect.RY := ScaleSizeY(ry);
1026 rect.Pen := FCurrPen;
1027 rect.Brush := FCurrBrush;
1028
1029 APage.AddEntity(rect);
1030 end;
1031
TvWMFVectorialReader.ReadImagenull1032 function TvWMFVectorialReader.ReadImage(const AParams: TParamArray;
1033 AIndex: Integer; AImage: TFPCustomImage): Boolean;
1034 var
1035 bmpCoreHdr: PWMFBitmapCoreHeader;
1036 bmpInfoHdr: PWMFBitmapInfoHeader;
1037 hasCoreHdr: Boolean;
1038 bmpFileHdr: TBitmapFileHeader;
1039 w, h: Integer;
1040 memstream: TMemoryStream;
1041 imgSize: Int64;
1042 dataSize: Int64;
1043 reader: TFPCustomImageReader;
1044 begin
1045 Result := false;
1046
1047 bmpCoreHdr := PWMFBitmapCoreHeader(@AParams[AIndex]);
1048 bmpInfoHdr := PWMFBitmapInfoHeader(@AParams[AIndex]);
1049 hasCoreHdr := bmpInfoHdr^.HeaderSize = SizeOf(TWMFBitmapCoreHeader);
1050 if hasCoreHdr then
1051 exit;
1052
1053 w := bmpInfoHdr^.Width;
1054 h := bmpInfoHdr^.Height;
1055 if (w = 0) or (h = 0) then
1056 exit;
1057
1058 memStream := TMemoryStream.Create;
1059 try
1060 datasize := (Length(AParams) - AIndex) * SIZE_OF_WORD;
1061
1062 // Put a bitmap file header in front of the bitmap info header and the data
1063 bmpFileHdr.bfType := BMmagic;
1064 bmpFileHdr.bfSize := SizeOf(bmpFileHdr) + datasize;
1065 if bmpInfoHdr^.Compression in [BI_RGB, BI_BITFIELDS, BI_CMYK] then
1066 imgSize := (w + bmpInfoHdr^.Planes * bmpInfoHdr^.BitCount + 31) div 32 * abs(h)
1067 else
1068 imgSize := bmpInfoHdr^.ImageSize;
1069 bmpFileHdr.bfOffset := bmpFileHdr.bfSize - imgSize;
1070 bmpFileHdr.bfReserved := 0;
1071 memstream.WriteBuffer(bmpFileHdr, SizeOf(bmpFileHdr));
1072 memstream.WriteBuffer(AParams[AIndex], (Length(AParams) - AIndex) * SIZE_OF_WORD);
1073
1074 // Read bitmap to image using the standard bitmap reader.
1075 reader := TFPReaderBMP.Create;
1076 try
1077 memstream.Position := 0;
1078 AImage.LoadfromStream(memStream, reader);
1079 Result := true;
1080 finally
1081 reader.Free;
1082 end;
1083 finally
1084 memstream.Free;
1085 end;
1086 end;
1087
1088
1089 { Tested: embedded bmp, png and jpeg in Inkscape, saved as wmf.
1090 Other tests are missing due to lack of well-defined test files. }
1091 procedure TvWMFVectorialReader.ReadStretchDIB(AStream: TStream;
1092 APage: TvVectorialPage; const AParams: TParamArray);
1093 var
1094 rasterImg: TvRasterImage = nil;
1095 memImg: TFPMemoryImage = nil;
1096 dibRec: PWMFStretchDIBRecord;
1097 hasCoreHdr: Boolean;
1098 begin
1099 dibRec := PWMFStretchDIBRecord(@AParams[0]);
1100 memImg := TFPMemoryImage.Create(0, 0); //w, h);
1101 try
1102 if not ReadImage(AParams, SizeOf(TWMFStretchDIBRecord) div SIZE_OF_WORD, memImg) then
1103 exit;
1104
1105 // Pass bitmap to fpvectorial
1106 rasterImg := TvRasterImage.Create(APage);
1107 rasterImg.RasterImage := memImg;
1108 rasterImg.x := ScaleX(dibRec^.DestX);
1109 rasterImg.y := ScaleY(dibRec^.DestY);
1110 rasterImg.Width := ScaleSizeX(dibRec^.DestWidth);
1111 rasterImg.Height := ScaleSizeY(dibRec^.DestHeight);
1112 APage.AddEntity(rasterImg);
1113 except
1114 on E:Exception do begin
1115 FreeAndNil(rasterImg);
1116 FreeAndNil(memImg);
1117 LogError('Image reading error: ' + E.Message);
1118 exit;
1119 end;
1120 end;
1121 end;
1122
1123 (*
1124 w := bmpInfoHdr^.Width;
1125 h := bmpInfoHdr^.Height;
1126 if (w = 0) or (h = 0) then
1127 exit;
1128 memStream := TMemoryStream.Create;
1129 try
1130 datasize := Length(AParams) * SizeOf(word) - SizeOf(TWMFStretchDIBRecord);
1131 // Put a bitmap file header before the bitmap info header and the data
1132 bmpFileHdr.bfType := BMmagic;
1133 bmpFileHdr.bfSize:= SizeOf(bmpFileHdr) + datasize;
1134 if bmpInfoHdr^.Compression in [BI_RGB, BI_BITFIELDS, BI_CMYK] then
1135 imgSize := (w + bmpInfoHdr^.Planes * bmpInfoHdr^.BitCount + 31) div 32 * abs(h)
1136 else
1137 imgSize := bmpInfoHdr^.ImageSize;
1138 bmpFileHdr.bfOffset := bmpFileHdr.bfSize - imgSize;
1139 bmpFileHdr.bfReserved := 0;
1140 memstream.WriteBuffer(bmpFileHdr, SizeOf(bmpFileHdr));
1141 AStream.Position := FRecordStartPos + 3*SizeOf(Word) + SizeOf(TWMFStretchDIBRecord);
1142 memstream.CopyFrom(AStream, Length(AParams) * SizeOf(Word) - SizeOf(TWMFStretchDIBRecord));
1143 memstream.Position := 0;
1144 try
1145 // Read bitmap
1146 memImg := TFPMemoryImage.Create(w, h);
1147 reader := TFPReaderBMP.Create;
1148 try
1149 memImg.LoadfromStream(memStream, reader);
1150 finally
1151 reader.Free;
1152 end;
1153 // Pass bitmap to fpvectorial
1154 rasterImg := TvRasterImage.Create(APage);
1155 rasterImg.RasterImage := memImg;
1156 rasterImg.x := ScaleX(dibRec^.DestX);
1157 rasterImg.y := ScaleY(dibRec^.DestY);
1158 rasterImg.Width := ScaleSizeX(dibRec^.DestWidth);
1159 rasterImg.Height := ScaleSizeY(dibRec^.DestHeight);
1160 APage.AddEntity(rasterImg);
1161 except
1162 on E:Exception do begin
1163 memImg.Free;
1164 rasterImg.Free;
1165 LogError('Image reading error: ' + E.Message);
1166 exit;
1167 end;
1168 end;
1169 finally
1170 memstream.Free;
1171 end;
1172 end;
1173
1174 // Restore original stream position
1175 AStream.Position := savedPos;
1176 end;
1177 *)
ReadStringnull1178 function TvWMFVectorialReader.ReadString(const AParams: TParamArray;
1179 AStartIndex, ALength: Integer): String;
1180 var
1181 s: ansistring;
1182 i, j: Integer;
1183 begin
1184 SetLength(s, ALength);
1185 i := AStartIndex;
1186 j := 1;
1187 while j < ALength do begin
1188 Move(AParams[i], s[j], SIZE_OF_WORD);
1189 inc(i);
1190 inc(j, 2);
1191 end;
1192 if odd(ALength) then SetLength(s, ALength-1);
1193 Result := ISO_8859_1ToUTF8(s);
1194 end;
1195
1196 procedure TvWMFVectorialReader.ReadTextAlign(const AParams: TParamArray);
1197 begin
1198 FCurrTextAlign := AParams[0];
1199 end;
1200
1201 procedure TvWMFVectorialReader.ReadTextColor(const AParams: TParamArray);
1202 begin
1203 FCurrTextColor := ReadColor(AParams, 0);
1204 end;
1205
1206 procedure TvWMFVectorialReader.ReadTextOut(APage: TvVectorialPage;
1207 const AParams: TParamArray);
1208 var
1209 x, y, len, i: Integer;
1210 s: String;
1211 txt: TvText;
1212 offs: TPoint;
1213 txtHeight: Integer;
1214 begin
1215 { Record layout:
1216 word - String length
1217 even number of bytes - String, no trailing zero
1218 smallInt - yStart
1219 smallInt - xStart }
1220
1221 len := AParams[0];
1222 i := 1;
1223 s := ReadString(AParams, i, len);
1224 if odd(len) then inc(len);
1225 inc(i, len div 2);
1226 y := SmallInt(AParams[i]); // signed int!
1227 x := SmallInt(AParams[i + 1]);
1228
1229 // Correct text position which is at baseline in case of fpvectorial, but
1230 // may be different depending on bits in the CurrTextAlign value.
1231
1232 // TO DO: More testing of text positioning.
1233 case FCurrTextAlign and $0018 of
1234 0:
1235 offs := Point(0, 0);
1236 TA_BASELINE:
1237 offs := Rotate2DPoint(Point(0, FCurrRawFontHeight), Point(0, 0), DegToRad(FCurrFont.Orientation));
1238 TA_BOTTOM:
1239 offs := Rotate2DPoint(Point(0, -FCurrRawFontHeight*7 div 5), Point(0, 0), DegToRad(FCurrFont.Orientation));
1240 end;
1241
1242 // Pass the text to fpvectorial
1243 txt := APage.AddText(ScaleX(x + offs.x), ScaleY(y + offs.y), s);
1244 // Select the font
1245 txt.Font := FCurrFont;
1246 // Font color
1247 txt.Font.Color := FCurrTextColor;
1248 // Set horizontal text alignment.
1249 case FCurrTextAlign and (TA_RIGHT or TA_CENTER) of
1250 TA_RIGHT : txt.TextAnchor := vtaEnd;
1251 TA_CENTER : txt.TextAnchor := vtaMiddle;
1252 else txt.TextAnchor := vtaStart;
1253 end;
1254 // Set background style
1255 case FCurrBkMode of
1256 BM_TRANSPARENT : txt.Brush.Style := bsClear;
1257 BM_OPAQUE : txt.Brush.Style := bsSolid;
1258 end;
1259 end;
1260
1261 procedure TvWMFVectorialReader.ReadWindowExt(const AParams: TParamArray);
1262 begin
1263 FWindowExtent.Y := SmallInt(AParams[0]); // signed int
1264 FWindowExtent.X := SmallInt(AParams[1]);
1265 CalcScalingFactors(FScalingFactorX, FScalingFactorY);
1266 end;
1267
1268 procedure TvWMFVectorialReader.ReadWindowOrg(const AParams: TParamArray);
1269 begin
1270 FWindowOrigin.Y := SmallInt(AParams[0]); // signed int, probably not relevant here.
1271 FWindowOrigin.X := SmallInt(AParams[1]);
1272 end;
1273
1274 procedure TvWMFVectorialReader.CalcScalingFactors(out fx, fy: Double);
1275 begin
1276 // Convert to pixels
1277 case FMapMode of
1278 MM_TEXT: // 1 log unit = 1 pixel
1279 begin
1280 fx := 1.0;
1281 fy := 1.0;
1282 end;
1283 MM_LOMETRIC: // 1 log unit = 1/10 mm
1284 begin
1285 fx := 0.1 * MM2INCH * ScreenDpiX;
1286 fy := 0.1 * MM2INCH * ScreenDpiY;
1287 end;
1288 MM_HIMETRIC: // 1 log unit = 1/100 mm
1289 begin
1290 fx := 0.01 * MM2INCH * ScreenDpiX;
1291 fy := 0.01 * MM2INCH * ScreenDpiY;
1292 end;
1293 MM_LOENGLISH: // 1 log unit = 1/100"
1294 begin
1295 fx := 0.01 * ScreenDpiX;
1296 fy := 0.01 * ScreenDpiY;
1297 end;
1298 MM_HIENGLISH: // 1 log unit = 1/1000"
1299 begin
1300 fx := 0.001 * ScreenDpiX;
1301 fy := 0.001 * ScreenDpiY;
1302 end;
1303 MM_TWIPS: // 1 log unit = 1 twip = 1/1440 inch
1304 begin
1305 fx := 1.0 / 1440 * INCH2MM;
1306 fy := fx;
1307 end;
1308 else
1309 if (FWindowExtent.X = 0) or (FWindowExtent.Y = 0) then
1310 exit;
1311 if FHasPlaceableMetaHeader then begin
1312 FPageWidth := (FBBox.Right - FBBox.Left) / FUnitsPerInch * ScreenDpiX;
1313 FPageHeight := (FBBox.Bottom - FBBox.Top) / FUnitsPerInch * ScreenDpiY;
1314 end else
1315 if FWindowExtent.X > FWindowExtent.Y then begin
1316 FPageWidth := DEFAULT_SIZE * MM2INCH * ScreenDpiX;
1317 FPageHeight := FPageWidth * FWindowExtent.Y / FWindowExtent.X;
1318 end else begin
1319 FPageHeight := DEFAULT_SIZE * MM2INCH * ScreenDpiY;
1320 FPageWidth := FPageHeight * FWindowExtent.X / FWindowExtent.Y;
1321 end;
1322 fx := FPageWidth / FWindowExtent.X;
1323 fy := FPageHeight / FWindowExtent.Y;
1324 end;
1325
1326 // If required convert to mm
1327 // The nominal fpv units are mm, but the svg reader converts to pixels.
1328 if FPV_UNIT = fuMM then begin
1329 fx := fx / ScreenDpiX * INCH2MM;
1330 fy := fy / ScreenDpiY * INCH2MM;
1331 if FMapMode in [MM_ISOTROPIC, MM_ANISOTROPIC] then begin
1332 FPageWidth := FPageWidth / ScreenDpiX * INCH2MM;
1333 FPageHeight := FPageHeight / ScreenDpiY * INCH2MM;
1334 end;
1335 end;
1336 end;
1337
1338 { Scale horizontal logical units (x) to millimeters }
TvWMFVectorialReader.ScaleXnull1339 function TvWMFVectorialReader.ScaleX(x: Integer): Double;
1340 begin
1341 Result := ScaleSizeX(x - FWindowOrigin.X);
1342 end;
1343
1344 { Scale vertical logical units (y) to millimeters.
1345 Coordinates will be increasing downwards, like in SVG }
TvWMFVectorialReader.ScaleYnull1346 function TvWMFVectorialReader.ScaleY(y: Integer): Double;
1347 begin
1348 // Result := ScaleSizeY(y - FWindowOrigin.Y); // there is probably an issue with y direction
1349
1350 if (vrfWMF_UseBottomLeftCoords in Settings.VecReaderFlags) then
1351 Result := FPageHeight - ScaleSizeY(y) else
1352 Result := ScaleSizeY(y - FWindowOrigin.Y);
1353
1354 // Result := FPageHeight - ScaleSizeY(y);
1355 end;
1356
ScaleSizeXnull1357 function TvWMFVectorialReader.ScaleSizeX(x: Integer): Double;
1358 begin
1359 Result := FScalingFactorX * x;
1360 end;
1361
ScaleSizeYnull1362 function TvWMFVectorialReader.ScaleSizeY(y: Integer): Double;
1363 begin
1364 Result := FScalingFactorY * y;
1365 end;
1366
1367 procedure TvWMFVectorialReader.SelectObj(const AIndex: Integer);
1368 var
1369 obj: TObject;
1370 begin
1371 obj := TObject(FObjList[AIndex]);
1372 if obj = nil then
1373 exit;
1374 if obj is TWMFPen then begin
1375 FCurrPen := TWMFPen(obj).Pen;
1376 end else
1377 if obj is TWMFBrush then
1378 FCurrBrush := TWMFBrush(obj).Brush
1379 else
1380 if obj is TWMFFont then begin
1381 FCurrFont := TWMFFont(obj).Font;
1382 FCurrRawFontHeight := TWMFFont(obj).RawHeight;
1383 end else
1384 if obj is TFPPalette then
1385 FCurrPalette := TFPPalette(obj);
1386 end;
1387
1388 procedure TvWMFVectorialReader.SelectPalette(const AIndex: Integer);
1389 begin
1390 SelectObj(AIndex);
1391 end;
1392
1393
1394 initialization
1395 RegisterVectorialReader(TvWMFVectorialReader, vfWindowsMetafileWMF);
1396
1397 end.
1398
1399