unit frm_Main;
// (с) 2004 Rinas Alexandr

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Math, Grids, Spin, TeeProcs,
  TeEngine, Chart, Series, BubbleCh, ArrowCha, Nets, ExtDlgs, ShellAPI;

type
  TfrmMain = class(TForm)
    ScrollBox: TScrollBox;
    Panel1: TPanel;
    Panel2: TPanel;
    edN: TLabeledEdit;
    edW1: TLabeledEdit;
    edW2: TLabeledEdit;
    edW3: TLabeledEdit;
    edW4: TLabeledEdit;
    ProgressBar: TProgressBar;
    Label2: TLabel;
    btnCalcR: TButton;
    Panel3: TPanel;
    Label3: TLabel;
    rbAuto: TRadioButton;
    rbCustom: TRadioButton;
    edR1: TEdit;
    edR2: TEdit;
    lbR: TListBox;
    Label4: TLabel;
    btnSendR: TButton;
    edRsr: TLabeledEdit;
    edNo: TLabeledEdit;
    edNap: TLabeledEdit;
    Panel: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    btnApplyWidth: TButton;
    sgCoord: TStringGrid;
    Label1: TLabel;
    Label5: TLabel;
    btnDeleteJoint: TButton;
    Label6: TLabel;
    seFirst: TSpinEdit;
    seSecond: TSpinEdit;
    Label7: TLabel;
    btnAddJoint: TButton;
    btnAutoConnect: TButton;
    sgJoint: TStringGrid;
    btnShow: TButton;
    btnSavePicture: TButton;
    Chart: TChart;
    Series1: TBubbleSeries;
    Series2: TArrowSeries;
    SavePictureDialog: TSavePictureDialog;
    Panel6: TPanel;
    Label8: TLabel;
    edWidth: TLabeledEdit;
    edHeight: TLabeledEdit;
    edS: TLabeledEdit;
    Label11: TLabel;
    Panel7: TPanel;
    sgSm: TStringGrid;
    btnBuildMatrix: TButton;
    Label10: TLabel;
    Label9: TLabel;
    Label12: TLabel;
    sgR: TStringGrid;
    lbQ: TListBox;
    Label13: TLabel;
    Label14: TLabel;
    lblResult: TLabel;
    lblMail: TLabel;
    edM: TLabeledEdit;
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure EditExit(Sender: TObject);
    procedure btnCalcRClick(Sender: TObject);
    procedure btnSendRClick(Sender: TObject);
    procedure edR2Change(Sender: TObject);
    procedure btnApplyWidthClick(Sender: TObject);
    procedure btnShowClick(Sender: TObject);
    procedure btnAddJointClick(Sender: TObject);
    procedure btnDeleteJointClick(Sender: TObject);
    procedure btnAutoConnectClick(Sender: TObject);
    procedure btnSavePictureClick(Sender: TObject);
    procedure btnBuildMatrixClick(Sender: TObject);
    procedure lblMailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowWarning;
    function GetR: double;
    procedure CalcRsr;
    procedure UpdateJointList;
    procedure UpdateVCCoords;
  end;

const
// количество проверяемых точек при решении уравнения
    Steps=1000;
// количество выводимых в список решений
    GCount=100;


var
    frmMain: TfrmMain;

// глобальные для всего расчета переменные    
var
    S,N,W1,W2,W3,W4: double;
    Rsr,m: double;
    No,Nap: integer;
    wr,hr: double;

type

// 1 значение решения уравнения
    TStep=record
        R,V: double;
    end;

var
// решения уравнения, сортитруются по правильности
// решения (минимуму)
    values: array [1..Steps] of TStep;

implementation

{$R *.dfm}

procedure TfrmMain.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
    ScrollBox.VertScrollBar.Position:=
    ScrollBox.VertScrollBar.Position-WheelDelta div 4;
    Handled:=true;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    ScrollBox.VertScrollBar.Position:=0;
end;

// проверяем, правильное ли занчение
// ввел пользователь в поле
procedure TfrmMain.EditExit(Sender: TObject);
begin
    try
        StrToFloat(TEdit(Sender).Text);
    except
        (Sender as TWinControl).SetFocus;
        MessageBeep(0);
    end;
end;

// получаем значение оптимизационной функции
function GetEps(const R: double): double;
var r1: double;
begin
    r1:=R/(2*Sqrt(2));
    Result:=W1*S/(R*R)+S/(r1*r1)*(W2+0.35*W3*R)+
    W3*(2.82*S/R+0.82*R-1.82*(wr+hr))+0.35*W4*N*r1;
end; 

// сортируем решения уравнения
procedure SortValues;
var i,j: integer;
    t: TStep;
    min: double;
    mini: integer;
begin
    for i:=1 to Steps do
    begin
        t:=values[i];
        min:=t.V;
        mini:=i;
        for j:=i+1 to Steps do
        if values[j].V<min then
        begin
            min:=values[j].V;
            mini:=j;
        end;
        values[i]:=values[mini];
        values[mini]:=t;
    end;
end;

// первоначальный расчет
procedure TfrmMain.btnCalcRClick(Sender: TObject);
var 
    RC,RE: double;
    step: double;
    stepnum,i: integer;
begin
    try
        wr:=StrToFloat(edWidth.Text);
        hr:=StrToFloat(edHeight.Text);
        S:=wr*hr;
        edS.Text:=Trim(Format('%8.3f',[S]));

        N:=StrToFloat(edN.Text);
        W1:=StrToFloat(edW1.Text);
        W2:=StrToFloat(edW2.Text);
        W3:=StrToFloat(edW3.Text);
        W4:=StrToFloat(edW4.Text);
        m:=StrToFloat(edM.Text);
    except
        ShowWarning;
    end;
    RE:=S;
    step:=RE/Steps;
    RC:=0;
    stepnum:=0;
    ProgressBar.Max:=Steps;
    ProgressBar.Position:=0;

    while stepnum<=Steps do
    begin
        RC:=RC+step;
        Inc(stepnum);
        values[stepnum].R:=RC;
        values[stepnum].V:=GetEps(RC);
        ProgressBar.Position:=stepnum;
    end;
    ProgressBar.Position:=Steps;

    SortValues;
    lbR.Items.BeginUpdate;
    lbR.Items.Clear;
    for i:=1 to GCount do
    begin
        lbR.Items.Add(Trim(
        Format('%8.3f',[values[i].R,values[i].V])));
    end;
    lbR.Items.EndUpdate;
    edR1.Text:=lbR.Items[0];
    edR2.Text:=lbR.Items[0];
end;

procedure TfrmMain.btnSendRClick(Sender: TObject);
var i: integer;
begin
    i:=lbR.ItemIndex;
    if i<0 then exit;
    edR1.Text:=lbR.Items[i];
    edR2.Text:=lbR.Items[i];
end;

// Получает значение решения в зависимости
// от выбора пользователя
function TfrmMain.GetR: double;
begin
    try
    if rbAuto.Checked then
        Result:=StrToFloat(edR1.Text)
    else
        Result:=StrToFloat(edR2.Text)
    except
        Result:=0;
    end;
end;

procedure TfrmMain.ShowWarning;
begin
    ShowMessage('Ошибка в исходных данных !'#13#10+
    'Вызможно, не тот десятичный разделитель.');
end;

// Расчет и вывод Rср
procedure TfrmMain.CalcRsr;
begin
    try
        rsr:=GetR/(2*Sqrt(2));
        edRsr.Text:=Trim(Format('%8.3f',[rsr]));
        no:=Ceil(S/(4*rsr*rsr));
        edNo.Text:=Trim(Format('%d',[no]));
        nap:=Ceil(N/(m*No));
        edNap.Text:=Trim(Format('%d',[nap]));
    except
        ShowWarning;
    end;
end;

procedure TfrmMain.edR2Change(Sender: TObject);
begin
    CalcRsr;
end;

procedure TfrmMain.btnApplyWidthClick(Sender: TObject);
var i: integer;
begin
    Randomize;
    with sgCoord do
    begin
        if No<>0 then
            RowCount:=No+1
        else RowCount:=2;
        FixedRows:=1;
        Cells[0,0]:='Номер ВЦ';
        Cells[1,0]:='X, км';
        Cells[2,0]:='Y, км';
        for i:=1 to No do
        begin
            Cells[0,i]:=IntToStr(i);
            Cells[1,i]:=IntToStr(Random(Round(wr)));
            Cells[2,i]:=IntToStr(Random(Round(hr)));
        end;
    end;
    with sgJoint do
    begin
        RowCount:=2;
        Cells[0,0]:='Узел 1';
        Cells[1,0]:='Узел 2';
        Cells[0,1]:='';
        Cells[1,1]:='';
    end;
    seFirst.MaxValue:=No;
    seSecond.MaxValue:=No;
    DestroyNet;
    CreateNet(No);
    UpdateVCCoords;
    UpdateJointList;
end;

// показывает рисунок соединений на экране
procedure TfrmMain.btnShowClick(Sender: TObject);
var i,v1,v2: integer;
begin
    UpdateVCCoords;
    with Chart do
    begin
        BottomAxis.Minimum:=0;
        BottomAxis.Maximum:=wr;
        LeftAxis.Minimum:=0;
        LeftAxis.Maximum:=hr;
        Series[1].Clear;
        for i:=0 to No-1 do
        begin
            TBubbleSeries(Series[1]).AddBubble(
            Net.Vc[i].x,Net.Vc[i].y,0.3,IntToStr(i+1),clBlue);
        end;
        Series[0].Clear;
        for i:=0 to Net.JCount-1 do
        begin
            v1:=Net.Joint[i].vc1.index-1;
            v2:=Net.Joint[i].vc2.index-1;
            TArrowSeries(Series[0]).AddArrow(
            Net.Vc[v1].x,Net.Vc[v1].y,Net.Vc[v2].x,Net.Vc[v2].y);
        end;
    end;
end;

procedure TfrmMain.btnAddJointClick(Sender: TObject);
var i,j: integer;
begin
    i:=seFirst.Value-1;
    j:=seSecond.Value-1;
    Net.AddJoint(Net.Vc[i],Net.Vc[j]);
    UpdateJointList;
end;

// вывести список соединений
procedure TfrmMain.UpdateJointList;
var i: integer;
begin
    with sgJoint do
    begin
        if Net.JCount=0 then
        begin
            RowCount:=2;
            Cells[0,0]:='Узел 1';
            Cells[1,0]:='Узел 2';
            Cells[0,1]:='';
            Cells[1,1]:='';
        end
        else
        begin
            RowCount:=Net.JCount+1;
            Cells[0,0]:='Узел 1';
            Cells[1,0]:='Узел 2';
            for i:=0 to Net.JCount-1 do
            begin
                Cells[0,i+1]:=IntToStr(Net.Joint[i].vc1.index);
                Cells[1,i+1]:=IntToStr(Net.Joint[i].vc2.index);
            end;
        end
    end;
    btnShowClick(nil);
end;

procedure TfrmMain.btnDeleteJointClick(Sender: TObject);
var i,j: integer;
    v1,v2: integer;
begin
    try
    i:=sgJoint.Selection.Top;
    if i<0 then exit;
    v1:=StrToInt(sgJoint.Cells[0,i])-1;
    v2:=StrToInt(sgJoint.Cells[1,i])-1;
    j:=Net.JIndex(Net.Vc[v1],Net.Vc[v2]);
    Net.DeleteJoint(j);
    UpdateJointList;
    except
    end;
end;

procedure TfrmMain.btnAutoConnectClick(Sender: TObject);
var i,j: integer;
begin
    UpdateVCCoords;
    Net.ClearJoints;
    for i:=0 to No-1 do
    for j:=0 to No-1 do
    begin
        if Net.Vc[i].PathTo(Net.Vc[j])<=Rsr*2 then
            Net.AddJoint(Net.Vc[i],Net.Vc[j]);
    end;
    UpdateJointList;
end;

// получение координат ВЦ из gridа
procedure TfrmMain.UpdateVCCoords;
var i: integer;
begin
    try
        for i:=1 to No do
        begin
            Net.Vc[i-1].x:=StrToFloat(sgCoord.Cells[1,i]);
            Net.Vc[i-1].y:=StrToFloat(sgCoord.Cells[2,i]);
        end;
    except
        ShowMessage('Ошибка ввода в координатах ВЦ!');
    end;
end;

procedure TfrmMain.btnSavePictureClick(Sender: TObject);
begin
    if SavePictureDialog.Execute then
    begin
        Chart.SaveToBitmapFile(SavePictureDialog.FileName);
    end;
end;

procedure TfrmMain.btnBuildMatrixClick(Sender: TObject);
var i,j: integer;
    s: string;
    f,f1: double;
    Q: array [0..1000] of integer;
begin
    try
    // строим матрицу смежности
    with sgSm do
    begin
        RowCount:=No+1;
        ColCount:=No+1;
        FixedRows:=1;
        FixedCols:=1;
        for i:=1 to No do
        begin
            Cells[i,0]:=IntToStr(i);
            Cells[0,i]:=IntToStr(i);
        end;
        for i:=0 to No-1 do
        for j:=0 to No-1 do
        begin
            if i=j then s:='-'
            else
            if Net.Vc[i].ConnectedTo(Net.Vc[j]) then s:='1'
            else s:='0';
            Cells[i+1,j+1]:=s;
        end;
    end;
    // строим матрицу R
    with sgR do
    begin
        RowCount:=No+1;
        ColCount:=No+1;
        FixedRows:=1;
        FixedCols:=1;
        for i:=1 to No do
        begin
            Cells[i,0]:=IntToStr(i);
            Cells[0,i]:=IntToStr(i);
        end;
        for i:=0 to No-1 do
        for j:=0 to No-1 do
        begin
            if i=j then s:='-'
            else
            if Net.Vc[i].ConnectedTo(Net.Vc[j]) then
                s:=Trim(Format('%8.2f',[Net.Vc[i].PathTo(Net.Vc[j])/GetR]))
            else s:='0';
            Cells[i+1,j+1]:=s;
        end;
    end;
    // Заполняем значениями Q
    lbQ.Items.Clear;
    for i:=0 to No-1 do
    begin
        f:=0;
        for j:=0 to No-1 do
        begin
            if i=j then f1:=0
            else
                if Net.Vc[i].ConnectedTo(Net.Vc[j]) then f1:=1
                else f1:=0;
            f:=f+f1*m;
        end;
        Q[i]:=Round(f);
        lbQ.Items.Add(Trim(Format('Q[%d]=%d',[i+1,Q[i]])));
    end;
    // рассчитываем стоимость сети
    // 1. капитальные вложения 
    f:=(W1+Nap*W2)*No;
    f1:=0;
    // 2. затраты на проводку сетевых каналов
    // суммируем длины всех соединений между ВЦ
    for i:=0 to Net.JCount-1 do
        f1:=f1+Net.Joint[i].Length*W3;
    // суммируем длины всех соединений между АП и ВЦ
    for i:=0 to No-1 do
        f1:=f1+Nap*Rsr*W4;
    lblResult.Caption:=Trim(Format(
    'W=Wкап+Wкан=%.3f + %.3f=%.3f тыс.грн.',[f,f1,f+f1]
    ));
    except
        ShowWarning;
    end;
end;

procedure TfrmMain.lblMailClick(Sender: TObject);
begin
    ShellExecute(0,'open','mailto:alegzanderr@quart-soft.com','','',SW_SHOW)
end;

end.

