1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:

procedure TIfiplot.Plot(const EmfFile: String);
var
  fs: TFileStream;
  mf: TMetafile;
  mfc: TMetafileCanvas;
  xsize, ysize, cx, cy,
    xmin, xmax, ymin, ymax,
    hres, vres, hsize, vsize: Integer;
  rc: TRect;
  pt: TPoint;
  rgn: HRGN;
begin
  if not FInitOk then exit;
  try
    fs:=TFileStream.Create(EmfFile, fmCreate or fmShareDenyWrite);
  except
    FErrorCode:=cErrSaveEmfFile;
    exit;
  end;

  try
    mf:=TMetafile.Create;
    mf.MMWidth:=21000;
    mf.MMHeight:=29700;
  except
    FErrorCode:=cErrInternal;
    exit;
  end;

  // [...]

  mfc:=TMetafileCanvas.CreateWithComment(mf, 0, 'Ifiplot 2.0', '');
  try
    // Größe der Zeichenfläche ermitteln (Gerätekoordinaten)
    hres:=GetDeviceCaps(mfc.Handle, HORZRES);
    vres:=GetDeviceCaps(mfc.Handle, VERTRES);
    hsize:=GetDeviceCaps(mfc.Handle, HORZSIZE);
    vsize:=GetDeviceCaps(mfc.Handle, VERTSIZE);

    xsize:=MulDiv(mf.MMWidth, hres, hsize*100);
    ysize:=MulDiv(mf.MMHeight, vres, vsize*100);

    with mfc do
    begin
      // [...]

      // Rahmen
      SetMapMode(Handle, MM_ANISOTROPIC);
      SetWindowExtEx(Handle, 2100, 2970, nil);
      SetViewportExtEx(Handle, xsize, -ysize, nil);
      SetViewportOrgEx(Handle, 0, ysize, nil);
      
      // Zeichenoperationen 
      // [...] 

      if FShape.Count > 2 then  // min. 3 Punkte vorhanden?
      begin
        // Zeichenfläche initialisieren
        rc:=Rect(250,2820,1950,500);

        // [...]

        xmin:=FParamsData.MinX*FParamsData.ScaleX;
        xmax:=FParamsData.MaxX*FParamsData.ScaleX;
        ymin:=FParamsData.MinY*FParamsData.ScaleY;
        ymax:=FParamsData.MaxY*FParamsData.ScaleY;

        if FParamsData.Scale<>2 then
          SetMapMode(Handle, MM_ISOTROPIC);
        SetWindowExtEx(Handle, xmax-xmin+10, ymax-ymin+10, nil);
        SetViewportExtEx(Handle, xsize, -ysize, nil);
        SetViewportOrgEx(Handle, rc.Left + xsize div 2,
                                 rc.Top + ysize div 2, nil);

        // zusätzliche Verschiebung des Ursprungs zum Mittelpunkt des Objektes
        pt.x:=xmin + (xmax-xmin) div 2;
        pt.y:=ymin + (ymax-ymin) div 2;
        LPtoDP(Handle,pt,1);
        cx:=pt.x; cy:=pt.y;
        GetViewportOrgEx(Handle, pt);
        OffsetViewportOrgEx(Handle, pt.x-cx, pt.y-cy, nil);

        // Clipping-Bereich festlegen
        rgn:=CreateRectRgnIndirect(rc);
        SelectClipRgn(Handle,rgn);
        DeleteObject(rgn);

        // Zeichenoperationen
        // [...]
      end;
    end;  // with mfc
  finally
    mfc.Free;
  end;
  try
    mf.SaveToStream(fs);
  except
    FErrorCode:=cErrSaveEmfFile;
  end;
  mf.Free;
  fs.Free;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

procedure TForm1.Button1Click(Sender: TObject);
Var Meta: TMetafile;
v,w: TSize;
begin
 Meta := TMetafile.Create;
 Meta.mmWidth := 10000;
 Meta.mmHeight := 10000;
 With TMetafileCanvas.Create(Meta, 0) do
  try
   SetMapMode(Handle, MM_hiMetric);
   GetWindowExtEx(Handle, w);
   GetViewPortExtEx(Handle, v);
   SetMapMode(Handle, MM_Anisotropic);
   SetWindowExtEx(Handle, w.cx, w.cy, nil);
   SetViewPortExtEx(Handle, v.cx, -v.cy, nil);
   Rectangle(0, 0, 10000,10000);
   Rectangle(0, 0, 5000,5000);
  Finally Free;
 end;
 Meta.SaveToFile('Test.emf');
 Meta.Free;
end;