unit ufile;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

function Phy_Text_Color(var TxtFile:TextFile; x1,y1,h,r:real; s: string; Color:byte):boolean;
function Phy_Circ(var Txt:TextFile; x1,y1,r:real):boolean;
function Phy_Line(var Txt:TextFile; x1,y1,x2,y2:real):boolean;
function Phy_Arc(var Txt:TextFile; x1,y1,r,u1,u2:real):boolean;
function Phy_Text2(var Txt:TextFile; x1,y1:real; s: string):boolean;
function ToDXF_begin(var Txt:TextFile; sFILE_NAME:string):boolean;
function ToDXF_end(var Txt:TextFile):boolean;
function KabelLine_ToDXF(var Txt:TextFile; x,y: real; s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string):boolean;
procedure Kruez_ToDXF(var Txt:TextFile; x,y: real);

  var
//  TxtFile: TextFile;
  fs: TFormatSettings;
//  sFILE_NAME: string;
  metka: integer;

implementation

function Phy_Line(var Txt:TextFile; x1,y1,x2,y2:real):boolean;
begin
  Writeln(Txt, '0',#10,#13,'LINE',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20'); Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '11'); Writeln(Txt, FloatToStr(x2,fs));
  Writeln(Txt, '21'); Writeln(Txt, FloatToStr(y2,fs));
  result:=true;
end;

function Phy_Circ(var Txt:TextFile; x1,y1,r:real):boolean;
begin
  Writeln(Txt, '0',#10,#13,'CIRCLE',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '40');  Writeln(Txt, FloatToStr(r,fs));
  result:=true;
end;

function Phy_Arc(var Txt:TextFile; x1,y1,r,u1,u2:real):boolean;
begin
  Writeln(Txt, '0',#10,#13,'ARC',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '40');  Writeln(Txt, FloatToStr(r,fs));
  Writeln(Txt, '50');  Writeln(Txt, FloatToStr(u1,fs));
  Writeln(Txt, '51');  Writeln(Txt, FloatToStr(u2,fs));
  result:=true;
end;

function Phy_Poly(var Txt:TextFile; x1,y1,x2,y2:real):boolean;
begin
  Writeln(Txt, '0',#10,#13,'POLYLINE',#10,#13,'8',#10,#13,'0',#10,#13,'66',#10,#13,'1');
  Writeln(Txt, '10',#10,#13,'0',#10,#13,'20',#10,#13,'0',#10,#13,'70',#10,#13,'1');
  Writeln(Txt, '0',#10,#13,'VERTEX',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20'); Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '0',#10,#13,'VERTEX',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y2,fs));
  Writeln(Txt, '0',#10,#13,'VERTEX',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x2,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y2,fs));
  Writeln(Txt, '0',#10,#13,'VERTEX',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x2,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '0',#10,#13,'SEQEND',#10,#13,'8',#10,#13,'0');
  result:=true;
end;

function Phy_Text(var Txt:TextFile; x1,y1,h,r:real; s: string):boolean;
begin
  Writeln(Txt, '0',#10,#13,'TEXT',#10,#13,'8',#10,#13,'0',#10,#13,'10');
  Writeln(Txt, FloatToStr(x1,fs));
  Writeln(Txt, '20');  Writeln(Txt, FloatToStr(y1,fs));
  Writeln(Txt, '30');  Writeln(Txt, '0');
  Writeln(Txt, '40');  Writeln(Txt, FloatToStr(h,fs));
  Writeln(Txt, '1');   Writeln(Txt, Utf8ToAnsi(s));
//  Writeln(Txt, '1');   Writeln(Txt, s));
  Writeln(Txt, '50');  Writeln(Txt, FloatToStr(r,fs));
  result:=true;
end;

function Phy_Text_Color(var TxtFile:TextFile; x1,y1,h,r:real; s: string; Color:byte):boolean;
// color: 1-красный, 2-желтый, 3-зеленый (см. список цветов в акаде)
begin
  if s='' then exit;
  Writeln(TxtFile, '0',#10,#13,'TEXT',#10,#13,'5',#10,#13,IntToStr(metka),#10,#13,'8',#10,#13,'0');
  Writeln(TxtFile, '62',#10,#13, IntToStr(Color));
  Writeln(TxtFile,'10');
  Writeln(TxtFile, FloatToStr(x1,fs));
  Writeln(TxtFile, '20');  Writeln(TxtFile, FloatToStr(y1,fs));
  Writeln(TxtFile, '30');  Writeln(TxtFile, '0');
  Writeln(TxtFile, '40');  Writeln(TxtFile, FloatToStr(h,fs));
  Writeln(TxtFile, '1');   Writeln(TxtFile, Utf8ToAnsi(s));
  Writeln(TxtFile, '50');  Writeln(TxtFile, FloatToStr(r,fs));
  inc(metka); result:=true;
end;

function Phy_Text2(var Txt:TextFile; x1,y1:real; s: string):boolean;
begin
  Phy_Text(Txt,x1,y1,2,0,s);
  result:=true;
end;

function ToDXF_begin(var Txt:TextFile; sFILE_NAME:string):boolean;// шапка dxf-FILE
begin
  Assign(Txt, sFILE_NAME);
  try
    Rewrite(Txt);
    Writeln(Txt, Utf8ToAnsi('0'));
    Writeln(Txt, Utf8ToAnsi('SECTION'));
    Writeln(Txt, Utf8ToAnsi('2'));
    Writeln(Txt, Utf8ToAnsi('ENTITIES'));
    result:=true;
  except
    result:=false;
  end;
end;

function ToDXF_end(var Txt:TextFile):boolean; // end dxf-FILE
begin
  Writeln(Txt, Utf8ToAnsi('0'));
  Writeln(Txt, Utf8ToAnsi('ENDSEC'));
  Writeln(Txt, Utf8ToAnsi('0'));
  Writeln(Txt, Utf8ToAnsi('EOF'));
  Close(Txt);
  result:=true;
  end;

function KabelLine_ToDXF(var Txt:TextFile; x,y: real; s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string):boolean;
begin
    if s1<>'' then Phy_Text2(Txt, x,y,s1);
    if s2<>'' then Phy_Text2(Txt, x+15,y,s2);
    if s3<>'' then Phy_Text2(Txt, x+30,y,s3);
    if s4<>'' then Phy_Text2(Txt, x+45,y,s4);
    if s5<>'' then Phy_Text2(Txt, x+60,y,s5);
    if s6<>'' then Phy_Text2(Txt, x+75,y,s6);
    if s7<>'' then Phy_Text2(Txt, x+90,y,s7);
    if s8<>'' then Phy_Text2(Txt, x+125,y,s8);
    if s9<>'' then Phy_Text2(Txt, x+135,y,s9);
    if s10<>'' then Phy_Text2(Txt, x+145,y,s10);
    if s11<>'' then Phy_Text2(Txt, x+155,y,s11);
    if s12<>'' then Phy_Text2(Txt, x+170,y,s12);
    result:=true;
end;

procedure Kruez_ToDXF(var Txt:TextFile; x,y: real);
begin Phy_Line(Txt, x,y,x-20,y+20); end;

end.


