unit umz;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ComCtrls, Buttons, StdCtrls, ExtCtrls, ufile;

type

  { TFMZ }

  TFMZ = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit9: TEdit;
    Label1: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label13: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Memo1: TMemo;
    PageControl1: TPageControl;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    SaveDialog1: TSaveDialog;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  FMZ: TFMZ;
  r0, h, h0, hx, r, rx, mashtab: real;
  r02, h2, h02, hx2, rx2, hc, hc2, rc, rc2, rcx, l, lc, lmax, lc2, lmax2: real;
  kateg: integer;

implementation

{ TFMZ }

procedure rascet(h:real; var h0,r0,lmax,lc:real; var res:boolean);
 begin
  res:=false;
  if kateg=1 then begin // 1 уровень мз
    kateg:=1;
    if h<30 then begin // высота от 0 до 30м
      h0:=0.7*h;
      r0:=0.6*h;
      lmax:=4.25*h;
      lc:=2.25*h;
    end else
    if h<100 then begin // высота от 30 до 100м
      h0:=(0.7-7.14/1000*(h-30))*h;
      r0:=(0.6-1.43/1000*(h-30))*h;
      lmax:=(4.25-3.57/1000*(h-30))*h;
      lc:=(2.25-0.0107/1000*(h-30))*h;
    end else
    if h<=150 then begin // высота от 100 до 150м
      h0:=(0.65-0.001*(h-100))*h;
      r0:=(0.5-0.002*(h-100))*h;
      lmax:=4*h;
      lc:=1.5*h;
    end else begin // высота свыше 150м
      ShowMessage('Для высот свыше 150м следует пользоваться специальной методикой расчета (см. СО р.3.3.2.1(3))');
      exit;
    end;
  end;
  if kateg=2 then begin // 2 уровень мз
    kateg:=2;
    if h<30 then begin // высота от 0 до 30м
      h0:=0.8*h;
      r0:=0.8*h;
      lmax:=4.75*h;
      lc:=2.5*h;
    end else
    if h<100 then begin // высота от 30 до 100м
      h0:=0.8*h;
      r0:=(0.8-1.43/1000*(h-30))*h;
      lmax:=(4.75-3.57/1000*(h-30))*h;
      lc:=(2.25-0.0107/1000*(h-30))*h;
    end else
    if h<=150 then begin // высота от 100 до 150м
      h0:=(0.8-(h-100)/1000)*h;
      r0:=0.7*h;
      lmax:=4.5*h;
      lc:=1.5*h;
    end else begin // высота свыше 150м
      ShowMessage('Для высот свыше 150м следует пользоваться специальной методикой расчета (см. СО р.3.3.2.1(3))');
      exit;
    end;
  end;
  if kateg=3 then begin // 3 уровень мз
    if h<30 then begin // высота от 0 до 30м
      h0:=0.85*h;
      r0:=1.2*h;
      lmax:=5.75*h;
      lc:=2.5*h;
    end else
    if h<100 then begin // высота от 30 до 100м
      h0:=0.85*h;
      r0:=1.2*h;
      lmax:=(5.75-3.57/1000*(h-30))*h;
      lc:=2.5*h;
    end else
    if h<=150 then begin // высота от 100 до 150м
      h0:=0.85*h;
      r0:=(1.2-(h-100)/1000)*h;
      lmax:=5.5*h;
      lc:=2.5*h;
    end else begin // высота свыше 150м
      ShowMessage('Для высот свыше 150м следует пользоваться специальной методикой расчета (см. СО р.3.3.2.1(3))');
      exit;
    end;
  end;
  res:=true;
end;

// расчет мз одиночного стержневого молниеотвода
procedure TFMZ.BitBtn1Click(Sender: TObject);
 var res:boolean;
begin
  Button1.Enabled:=false;
  h:=strtofloat(Edit1.Text);
  hx:=strtofloat(Edit2.Text);
  if RadioButton1.Checked then kateg:=1;
  if RadioButton2.Checked then kateg:=2;
  if RadioButton3.Checked then kateg:=3;
  rascet(h,h0,r0,lmax,lc,res);
  if not res then exit;

  rx:=r0*(h0-hx)/h0;
  Label5.Caption:='Rx='+floattostrf(rx,ffFixed,10,2);
  if rx<0 then begin
      ShowMessage('Молниезащита не обеспечивается:  Rx='+floattostrf(rx,ffFixed,10,2)+'м. < 0');
      exit;
    end;
  Button1.Enabled:=true;
  mashtab:=1/h*30;
end;

// расчет мз двух стержневых молниеотводов
procedure TFMZ.BitBtn2Click(Sender: TObject);
 var res:boolean;
begin
  Button2.Enabled:=false;
  if RadioButton4.Checked then kateg:=1;
  if RadioButton5.Checked then kateg:=2;
  if RadioButton6.Checked then kateg:=3;

  h:=strtofloat(Edit5.Text);
  rascet(h,h0,r0,lmax,lc,res);
  if not res then exit;
  h2:=strtofloat(Edit6.Text);
  rascet(h2,h02,r02,lmax2,lc2,res);
  if not res then exit;

  l:=strtofloat(Edit7.Text);
  hx:=strtofloat(Edit9.Text);
  if l>lmax then begin
      ShowMessage('Расстояние между молниеприемниками превышает допустимое значение (Lmax='+floattostrf(lmax,ffFixed,10,2)+'м.).'+#13+
      'Такие молниеприемники долны рассматриваться как одиночные (см. СО р.3.3.2.3)');
      exit;
    end;
  rx:=r0*(h0-hx)/h0;
  rx2:=r02*(h02-hx)/h02;
  hc:=h0*(lmax-l)/(lmax-lc);
  hc2:=h02*(lmax2-l)/(lmax2-lc2);
  lc:=(lc+lc2)/2;
  if l<=lc then hc:=(h0+h02)/2 else hc:=(hc+hc2)/2;
  rc:=(r0+r02)/2;
  rcx:=(r0+r02)/2*(hc-hx)/hc;

  Label11.Caption:='Rcx='+floattostrf(rcx,ffFixed,10,2);
  if rcx<0 then begin
      ShowMessage('Молниезащита не обеспечивается:  Rcx='+floattostrf(rcx,ffFixed,10,2)+'м. < 0');
      exit;
    end;
  Button2.Enabled:=true;
  if h>h2 then mashtab:=1/h*30 else mashtab:=1/h2*30;
end;

// рисование мз одиночного стержневого молниеотвода
procedure TFMZ.Button1Click(Sender: TObject);
var
     sFILE_NAME: string;
     Txt:TextFile;
     x, y: real;
begin
   // * выбор файла для записи
    if not(SaveDialog1.Execute) then exit;
    sFILE_NAME:=Utf8ToAnsi(SaveDialog1.FileName);
    if FileExists(sFILE_NAME) then
       if MessageDlg('Выбранный файл существует! Заменить?'+#13+'Данные в существующем файле будут потеряны',
          mtConfirmation, mbYesNo, 0)=7 then exit;
    if not(ToDXF_begin(Txt,sFILE_NAME)) then begin
       ShowMessage('Ошибка создания файла!'+#13+
           'Запись в выбранный файл не удается.'+#13+
           'Возможно данный файл занят другой программой (например, AutoCAD`ом)');
       exit;
    end;
    x:=0; y:=0;

    Phy_Text_Color(Txt,x-5,y-3,2.5,0,'0,000',0);

    Phy_Line(Txt,x,y,x+r0*mashtab*1.1,y);
    Phy_Line(Txt,x,y+h*mashtab,x,y);
    Phy_Line(Txt,x,y+h0*mashtab,x+r0*mashtab,y);
    Phy_Line(Txt,x,y+hx*mashtab,x+rx*mashtab,y+hx*mashtab);
    Phy_Line(Txt,x+rx*mashtab,y+hx*mashtab,x+rx*mashtab,y);

    Phy_Text_Color(Txt,x-5,y+h*mashtab,2.5,0,'h',0);
    Phy_Text_Color(Txt,x-5,y+h0*mashtab,2.5,0,'h0',0);
    Phy_Text_Color(Txt,x-5,y+hx*mashtab,2.5,0,'hx',0);
    Phy_Text_Color(Txt,x+r0*mashtab,y-3,2.5,0,'r0',0);
    Phy_Text_Color(Txt,x+rx*mashtab,y-3,2.5,0,'rx',0);

    Phy_Text_Color(Txt,x,y-30,2.5,0,'h= '+floattostrf(h,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x,y-33,2.5,0,'h0='+floattostrf(h0,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x,y-36,2.5,0,'r0='+floattostrf(r0,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x,y-39,2.5,0,'hx='+floattostrf(hx,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x,y-42,2.5,0,'rx='+floattostrf(rx,ffFixed,10,2)+' м.',0);

    ToDXF_end(Txt); // закрытие DXF
end;

// рисование мз двойного стержневого молниеотвода
procedure TFMZ.Button2Click(Sender: TObject);
var
     sFILE_NAME: string;
     Txt:TextFile;
     x, y, p: real;
begin
   // * выбор файла для записи
    if not(SaveDialog1.Execute) then exit;
    sFILE_NAME:=Utf8ToAnsi(SaveDialog1.FileName);
    if FileExists(sFILE_NAME) then
       if MessageDlg('Выбранный файл существует! Заменить?'+#13+'Данные в существующем файле будут потеряны',
          mtConfirmation, mbYesNo, 0)=7 then exit;
    if not(ToDXF_begin(Txt,sFILE_NAME)) then begin
       ShowMessage('Ошибка создания файла!'+#13+
           'Запись в выбранный файл не удается.'+#13+
           'Возможно данный файл занят другой программой (например, AutoCAD`ом)');
       exit;
    end;
    x:=0; y:=0;

    Phy_Text_Color(Txt,x-5,y-3,2.5,0,'0,000',0);

    Phy_Line(Txt,x-r0*mashtab*1.1,y,x+(r02+l)*mashtab*1.1,y);

    Phy_Line(Txt,x,y+h*mashtab,x,y);
    Phy_Line(Txt,x+l*mashtab,y+h2*mashtab,x+l*mashtab,y);

    Phy_Line(Txt,x,y+h0*mashtab,x-r0*mashtab,y);
    Phy_Line(Txt,x+l*mashtab,y+h02*mashtab,x+(l+r02)*mashtab,y);

    Phy_Line(Txt,x,y+h0*mashtab,x+l/2*mashtab,y+hc*mashtab);
    Phy_Line(Txt,x+l*mashtab,y+h02*mashtab,x+l/2*mashtab,y+hc*mashtab);

    Phy_Line(Txt,x+l/2*mashtab,y,x+l/2*mashtab,y+hc*mashtab);
    Phy_Line(Txt,x-rx*mashtab,y+hx*mashtab,x+(l+rx2)*mashtab,y+hx*mashtab);

    Phy_Text_Color(Txt,x-rx*mashtab,y-3+hx*mashtab,2.5,0,'rx',0);
    Phy_Text_Color(Txt,x-5+(l+rx2)*mashtab,y-3+hx*mashtab,2.5,0,'rx2',0);
    Phy_Text_Color(Txt,x-5+r0*mashtab,y-3,2.5,0,'r0',0);
    Phy_Text_Color(Txt,x-5+(l+r02)*mashtab,y-3,2.5,0,'r02',0);
    Phy_Text_Color(Txt,x-5,y+h*mashtab,2.5,0,'h',0);
    Phy_Text_Color(Txt,x-5,y+h0*mashtab,2.5,0,'h0',0);
    Phy_Text_Color(Txt,x+5+l*mashtab,y+h2*mashtab,2.5,0,'h2',0);
    Phy_Text_Color(Txt,x+5+l*mashtab,y+h02*mashtab,2.5,0,'h02',0);

    Phy_Text_Color(Txt,x+l/2*mashtab,y+hc*mashtab+3,2.5,0,'hc',0);
    Phy_Text_Color(Txt,x+l/2*mashtab,y-3,2.5,0,'L/2',0);
    Phy_Text_Color(Txt,x-r0*mashtab-5,y+hx*mashtab+3,2.5,0,'hx',0);

    if h>h2 then p:=r0*1.2*mashtab else p:=r02*1.2*mashtab;
    Phy_Line(Txt,x-r0*mashtab,y-p,x+(l+r02)*mashtab,y-p); // осевая линия
    Phy_Circ(Txt,x,y-p,0.5);
    Phy_Circ(Txt,x+l*mashtab,y-p,0.5);
    Phy_Arc(Txt,x,y-p,r0*mashtab,90,-90);
    Phy_Arc(Txt,x+l*mashtab,y-p,r02*mashtab,-90,90);
    Phy_Arc(Txt,x,y-p,rx*mashtab,90,-90);
    Phy_Arc(Txt,x+l*mashtab,y-p,rx2*mashtab,-90,90);

    Phy_Line(Txt,x,y-p+rx*mashtab,x+l/2*mashtab,y-p+rcx*mashtab); // 6 линий центральной части
    Phy_Line(Txt,x,y-p-rx*mashtab,x+l/2*mashtab,y-p-rcx*mashtab);
    Phy_Line(Txt,x+l*mashtab,y-p+rx2*mashtab,x+l/2*mashtab,y-p+rcx*mashtab);
    Phy_Line(Txt,x+l*mashtab,y-p-rx2*mashtab,x+l/2*mashtab,y-p-rcx*mashtab);
    Phy_Line(Txt,x,y-p+r0*mashtab,x+l*mashtab,y-p+r02*mashtab);
    Phy_Line(Txt,x,y-p-r0*mashtab,x+l*mashtab,y-p-r02*mashtab);

    Phy_Line(Txt,x+l/2*mashtab,y-p-rcx*mashtab,x+l/2*mashtab,y-p+rcx*mashtab); // линия rcx
    Phy_Text_Color(Txt,x-2+l/2*mashtab,y-p-4-rcx*mashtab,2.5,0,'2Rcx',0);

    Phy_Line(Txt,x-rx*mashtab,y-p,x-rx*mashtab,y+hx*mashtab);
    Phy_Line(Txt,x+(l+rx2)*mashtab,y-p,x+(l+rx2)*mashtab,y+hx*mashtab);

    Phy_Text_Color(Txt,x+l*mashtab*2,y-27,2.5,0,'L=  '+floattostrf(l,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-30,2.5,0,'h=  '+floattostrf(h,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-33,2.5,0,'h0= '+floattostrf(h0,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-36,2.5,0,'r0= '+floattostrf(r0,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-39,2.5,0,'rx= '+floattostrf(rx,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-42,2.5,0,'h2= '+floattostrf(h2,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-45,2.5,0,'h02='+floattostrf(h02,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-48,2.5,0,'r02='+floattostrf(r02,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-51,2.5,0,'rx2='+floattostrf(rx2,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-54,2.5,0,'hc= '+floattostrf(hc,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-57,2.5,0,'Rcx='+floattostrf(rcx,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-60,2.5,0,'Lmax='+floattostrf(lmax,ffFixed,10,2)+' м.',0);
    Phy_Text_Color(Txt,x+l*mashtab*2,y-63,2.5,0,'Lc= '+floattostrf(lc,ffFixed,10,2)+' м.',0);

    ToDXF_end(Txt); // закрытие DXF
end;

procedure TFMZ.FormCreate(Sender: TObject);
begin
  fs:= DefaultFormatSettings;
  fs.DecimalSeparator:='.';
end;


initialization
  {$I umz.lrs}

end.

