unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ColorGrd;
type
  TMetaDatIniTyp=(mditEllipse,mditPolygon,mditPolyline);
  TMetaDatIni=packed record
    typ:TMetaDatIniTyp;
    brush_color:tcolor;
    pen_color:Tcolor;
    pen_width:double;
  end;
  TMataDatPoint=packed record
    x,y:Double;
  end;
  TMataDatPoints=packed array of TMataDatPoint;
  TMetaDat=packed record
    ini:TMetaDatIni;
    points:TMataDatPoints;
  end;
  TMetaDaten=packed array of TMetaDat;

  EMetaFileError=class(exception);
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    zeiger: TRadioButton;
    ellipse: TRadioButton;
    polygon: TRadioButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    polyline: TRadioButton;
    vg: TCheckBox;
    hg: TCheckBox;
    vgc: TShape;
    hgc: TShape;
    ColorDialog1: TColorDialog;
    Label1: TLabel;
    Edit1: TEdit;
    PaintBox2: TPaintBox;
    xp: TEdit;
    Label2: TLabel;
    yp: TEdit;
    Label3: TLabel;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure polylineClick(Sender: TObject);
    procedure vgcMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure vgClick(Sender: TObject);
    procedure hgClick(Sender: TObject);
    procedure hgcMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  Form1: TForm1;
  metafile:TMetaDaten;
  aktobjekt,aktpoint:integer;
  zb:boolean;//Zeiger checked?
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(metafile,1);
metafile[0].ini.typ:=mditEllipse;
metafile[0].ini.brush_color:=clred;
metafile[0].ini.pen_color:=clYellow;
metafile[0].ini.pen_width:=45;
setlength(metafile[0].points,3);
metafile[0].points[0].x:=3;
metafile[0].points[0].y:=3;
metafile[0].points[1].x:=2;
metafile[0].points[1].y:=2;
metafile[0].points[2].x:=4.5;
metafile[0].points[2].y:=1;  

end;
function XPosToXPos(const x:double):integer;overload;
begin
  result:=trunc(form1.paintbox1.width / x);
end;
function YPosToYPos(const y:double):integer;overload;
begin
  result:=trunc(form1.paintbox1.height / y);
end;
function XPosToXPos(const x:integer):double;overload;
begin
  result:=form1.paintbox1.width / x;
end;
function YPosToYPos(const y:integer):double;overload;
begin
  result:=form1.paintbox1.height / y;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var i,j:integer;
    pwidth,pheight:integer;
    points:array of TPoint;
    function XPosToXPos(x:double):integer;
    begin
      result:=trunc(pwidth/x);
    end;
    function YPosToYPos(y:double):integer;
    begin
      result:=trunc(pheight/y);
    end;
begin
pwidth:=PaintBox1.Width;
pheight:=PaintBox1.Height;
for i:=0 to high(metafile) do begin
  PaintBox1.Canvas.brush.Color:=metafile[i].ini.brush_color;
  if metafile[i].ini.brush_color = clNone then
    PaintBox1.Canvas.brush.Style:=bsClear
   else
    PaintBox1.Canvas.brush.Style:=bsSolid;
  PaintBox1.Canvas.pen.Color:=metafile[i].ini.pen_color;
  if (metafile[i].ini.pen_color = clnone)or(metafile[i].ini.pen_width=0) then
    PaintBox1.Canvas.pen.Style:=psClear
   else
    PaintBox1.Canvas.pen.Style:=psSolid;
  PaintBox1.Canvas.pen.Width:=trunc(sqrt(paintBox1.Width*paintbox1.height) / metafile[i].ini.pen_width);
  case metafile[i].ini.typ of
    mditEllipse: begin
                   PaintBox1.Canvas.Ellipse(XPosToXPos( metafile[i].points[0].x),YPosToYPos(metafile[i].points[0].y),XPosToXPos(metafile[i].points[1].x),YPosToYPos(metafile[i].points[1].y));
                 end;
    mditPolygon: begin
                   setlength(points,length(metafile[i].points));
                   for j:=0 to high(metafile[i].points) do begin
                     points[j].x:=XPosToXPos(metafile[i].points[j].x);
                     points[j].y:=YPosToYPos(metafile[i].points[j].y);
                   end;
                   PaintBox1.Canvas.Polygon(points);
                 end;
    mditPolyline: begin
                   setlength(points,length(metafile[i].points));
                   for j:=0 to high(metafile[i].points) do begin
                     points[j].x:=XPosToXPos(metafile[i].points[j].x);
                     points[j].y:=YPosToYPos(metafile[i].points[j].y);
                   end;
                   PaintBox1.Canvas.Polyline(points);
                 end;
  end;
  for j:=0 to high(metafile[i].points) do begin
    PaintBox1.Canvas.pen.Style:=psClear;
    PaintBox1.Canvas.brush.Style:=bsSolid;
    if (i=aktobjekt)and(j=aktpoint) then
      PaintBox1.Canvas.brush.Color:=clBlue
     else
      PaintBox1.Canvas.brush.Color:=clAqua;
    PaintBox1.Canvas.Ellipse(XPosToXPos(metafile[i].points[j].x)-2,YPosToYPos(metafile[i].points[j].y)-2,XPosToXPos(metafile[i].points[j].x)+2,YPosToYPos(metafile[i].points[j].y)+2);
  end;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var datei:file;
    temp,i,j:integer;
begin
if OpenDialog1.Execute then begin
  SaveDialog1.FileName:=OpenDialog1.FileName;
  AssignFile(datei,SaveDialog1.FileName);
  Reset(datei,1);
  try
    BlockRead(datei,temp,sizeof(temp));
    if temp<>7 then
      raise EMetaFileError.create('Ungültiger Dateicode: '+IntToStr(temp));
    BlockRead(datei,temp,sizeof(temp));
    setlength(metafile,temp);
    for i:=0 to temp-1 do begin
      blockread(datei,metafile[i].ini,sizeof(metafile[i].ini));
      BlockRead(datei,temp,sizeof(temp));
      SetLength(metafile[i].points,temp);
      for j:=0 to temp-1 do begin
        blockread(datei,metafile[i].points[j],sizeof(metafile[i].points[j]));
      end;
    end;
  finally
    CloseFile(datei);
  end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var datei:file;
    temp,i,j:integer;
begin
if SaveDialog1.Execute then begin
  OpenDialog1.FileName:=SaveDialog1.FileName;
  AssignFile(datei,SaveDialog1.FileName);
  Rewrite(datei,1);
  try
    temp:=7;
    BlockWrite(datei,temp,sizeof(temp));
    temp:=length(metafile);
    BlockWrite(datei,temp,sizeof(temp));
    for i:=0 to temp-1 do begin
      blockwrite(datei,metafile[i].ini,sizeof(metafile[i].ini));
      temp:=length(metafile[i].points);
      BlockWrite(datei,temp,sizeof(temp));
      for j:=0 to temp-1 do begin
        blockwrite(datei,metafile[i].points[j],sizeof(metafile[i].points[j]));
      end;
    end;
  finally
    CloseFile(datei);
  end;
end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i,j,oobjekt,opoint:integer;
begin
opoint:=aktpoint;
oobjekt:=aktobjekt;
//if zeiger.Checked then begin
  aktobjekt:=-1;
  for i:=0 to high(metafile) do begin
    for j:=0 to high(metafile[i].points) do begin
      if (abs(x-XPosToXPos(metafile[i].points[j].x))<5) and
            (abs(y-YPosToYPos(metafile[i].points[j].y))<5) then begin
        aktobjekt:=i;
        aktpoint:=j;
        edit1.text:=FloatToStr(metafile[i].ini.pen_width);
        xp.text:=FloatToStr(metafile[i].points[j].x);
        yp.text:=FloatToStr(metafile[i].points[j].y);
        vg.Checked:=metafile[i].ini.pen_color<>clNone;
        hg.Checked:=metafile[i].ini.brush_color<>clNone;
        vgc.brush.color:=metafile[i].ini.pen_color;
        hgc.brush.color:=metafile[i].ini.brush_color;
        if (aktobjekt<>oobjekt)or((aktobjekt<>-1)and(aktpoint<>opoint)) then
          PaintBox1.Repaint;
        exit;
      end;
    end;
  end;
{end else }if (oobjekt=-1)and(not zeiger.Checked) then begin
  aktobjekt:=oobjekt;
  setlength(metafile,length(metafile)+1);
  if ellipse.Checked then
    metafile[high(metafile)].ini.typ:=mditEllipse
   else if polygon.Checked then
    metafile[high(metafile)].ini.typ:=mditPolygon
   else if polyline.Checked then
    metafile[high(metafile)].ini.typ:=mditPolyline;
  if hg.Checked then
    metafile[high(metafile)].ini.brush_color:=hgc.brush.color
   else
    metafile[high(metafile)].ini.brush_color:=clNone;
  if vg.Checked then
    metafile[high(metafile)].ini.pen_color:=vgc.brush.color
   else
    metafile[high(metafile)].ini.pen_color:=clNone;
  metafile[high(metafile)].ini.pen_width:=StrToFloat(Edit1.text);

  aktpoint:=0;
  setlength(metafile[high(metafile)].points,1);
  metafile[high(metafile)].points[0].x:=XPosToXPos(x);
  metafile[high(metafile)].points[0].y:=yPosToyPos(y);
  aktobjekt:=high(metafile);

end else if not zeiger.Checked then begin
  aktobjekt:=oobjekt;
  aktpoint:=length(metafile[aktobjekt].points);
  setlength(metafile[aktobjekt].points,aktpoint+1);
  metafile[aktobjekt].points[aktpoint].x:=XPosToXPos(x);
  metafile[aktobjekt].points[aktpoint].y:=YPosToYPos(y);
end;
        if (aktobjekt<>oobjekt)or((aktobjekt<>-1)and(aktpoint<>opoint)) then
          PaintBox1.Repaint;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if (aktobjekt<>-1)and(ssLeft in shift) then begin
  metafile[aktobjekt].points[aktpoint].x:=xpostoxpos(x);
  metafile[aktobjekt].points[aktpoint].y:=ypostoypos(y);
  xp.text:=FloatToStr(metafile[aktobjekt].points[aktpoint].x);
  yp.text:=FloatToStr(metafile[aktobjekt].points[aktpoint].y);
  paintbox1.repaint;
end;
end;

procedure TForm1.polylineClick(Sender: TObject);
var sendrb:TRadioButton;
begin
  sendrb:=(sender as TRadioButton);
  if sendrb.tag=-1 then begin
    aktobjekt:=-1;

  end else
    if aktobjekt<>-1 then
      metafile[aktobjekt].ini.typ:=tmetadatinityp(sendrb.tag);
  PaintBox1.Repaint;
end;

procedure TForm1.vgcMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color:=vgc.Brush.Color;
if (aktobjekt <> -1)and(ColorDialog1.execute) then begin
  vgc.Brush.Color:=ColorDialog1.Color;
  vg.Checked:=true;
  vgClick(hg as TObject);
  PaintBox1.Repaint;
end;
end;

procedure TForm1.vgClick(Sender: TObject);
begin
if aktobjekt=-1 then exit;
if vg.Checked then
  metafile[aktobjekt].ini.pen_color:=vgc.Brush.Color
 else
  metafile[aktobjekt].ini.pen_color:=clNone;
PaintBox1.Repaint;
end;

procedure TForm1.hgClick(Sender: TObject);
begin
if aktobjekt=-1 then exit;
if hg.Checked then
  metafile[aktobjekt].ini.brush_color:=hgc.Brush.Color
 else
  metafile[aktobjekt].ini.brush_color:=clNone;
PaintBox1.Repaint;

end;

procedure TForm1.hgcMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color:=hgc.Brush.Color;
if (aktobjekt <> -1)and(ColorDialog1.execute) then begin
  hgc.Brush.Color:=ColorDialog1.Color;
  hg.Checked:=true;
  hgClick(hg as TObject);
  PaintBox1.Repaint;
end;

end;

procedure TForm1.FormResize(Sender: TObject);
begin
Label1.Caption:=IntToStr(PaintBox1.Width)+'x'+IntToStr(PaintBox1.Height);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (key=vk_delete) and (aktobjekt<>-1) and (xp.Focused or yp.Focused=false) then begin
  if ssShift in shift then begin
    metafile[aktobjekt]:=metafile [high(metafile)];
    setlength(metafile,high(metafile));
    aktobjekt:=-1;
    PaintBox1.Refresh;
    exit;
  end;
  metafile[aktobjekt].points[aktpoint]:=metafile[aktobjekt].points[high(metafile[aktobjekt].points)];
  setlength(metafile[aktobjekt].points,high(metafile[aktobjekt].points));
  if length(metafile[aktobjekt].points)<=0 then begin
    metafile[aktobjekt]:=metafile [high(metafile)];
    setlength(metafile,high(metafile));
    aktobjekt:=-1;
  end;
  PaintBox1.Refresh;
end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if aktobjekt<>-1 then begin
  metafile[aktobjekt].ini.pen_width:=StrToFloat(edit1.text);
  PaintBox1.Canvas.Rectangle(-1000,-1000,1000,1000);
  PaintBox1.Canvas.pen.Width:=trunc(PaintBox1.Width /metafile[aktobjekt].ini.pen_width);
  PaintBox1.Canvas.MoveTo(0,11);
  PaintBox1.Canvas.LineTo(55,11);
  PaintBox1.Repaint;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  metafile[aktobjekt].points[aktpoint].x:=StrToFloat(xp.text);
  metafile[aktobjekt].points[aktpoint].y:=StrToFloat(yp.text);
  PaintBox1.Refresh;
end;

end.
