Листинг программы

 

unit Unit1; 

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Grids, StdCtrls, TransportProblem; 

type

  TForm1 = class(TForm)

    GroupBox1: TGroupBox;

    Label1: TLabel;

    Label2: TLabel;

    Edit1: TEdit;

    Edit2: TEdit;

    StringGrid1: TStringGrid;

    Button3: TButton;

    Button4: TButton;

    Button5: TButton;

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    Button2: TButton;

    Button6: TButton;

    Button1: TButton;

    Button7: TButton;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Button8: TButton;

    procedure EditChange(Sender: TObject);

    procedure EditExit(Sender: TObject);

    procedure KeyPressed(Sender: TObject; var Key: Word;

      Shift: TShiftState);

    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure Button3Click(Sender: TObject);

    procedure Button5Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Button2Click(Sender: TObject);

    procedure Button6Click(Sender: TObject);

    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;

      Shift: TShiftState);

    procedure Button1Click(Sender: TObject);

    procedure Button7Click(Sender: TObject);

    procedure Load;

    procedure SetProblem;

   

  end; 

var

  Form1: TForm1;

  TempC, TempP: TArray; 

implementation 

uses Unit2; 

{$R *.dfm} 

procedure TForm1.Load;

var

  F: TextFile;

  i, j: Integer;

  S: String;

begin

  AssignFile(F, OpenDialog1.FileName);

    {$I-}

    Reset(F);

    {$I+}

    if IOResult <> 0 then begin

      MessageDlg('Ошибка чтения файла', mtError, [mbOk], 0);

      Exit;

    end;

    Readln(F, S);

    Edit1.Text:= S;

    Edit1.OnExit(Edit1);

    Readln(F, S);

    Edit2.Text:= S;

    Edit2.OnExit(Edit2);

    for i:= 0 to StringGrid1.RowCount - 1 do begin

      for j:= 0 to StringGrid1.ColCount - 1 do begin

        Readln(F, S);

        StringGrid1.Cells[j, i]:= S;

      end;

    end;

end; 

procedure TForm1.EditChange(Sender: TObject);

begin

  if (Sender as TEdit).Text = '' then

    Exit;

  try

    case StrToInt((Sender as TEdit).Text[Length((Sender as TEdit).Text)]) of

      0..9: Exit;

    end;

  except

    (Sender as TEdit).Text:= Copy((Sender as TEdit).Text, 1, Length((Sender as TEdit).Text) - 1);

    MessageDlg('Разрешается вводить только цифры', mtError, [mbOk], 0);

    Exit;

  end;

end; 

procedure TForm1.EditExit(Sender: TObject);

begin

  if (Sender as TEdit).Text = '' then

    Exit;

  if (Sender as TEdit).Tag = 0 then

    StringGrid1.RowCount:= StrToInt((Sender as TEdit).Text) + 1

  else

    StringGrid1.ColCount:= StrToInt((Sender as TEdit).Text) + 1;

end; 

procedure TForm1.KeyPressed(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key = 13 then

    EditExit(Sender);

end; 

procedure TForm1.StringGrid1MouseDown(Sender: TObject;

  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

  Col, Row: Integer;

begin

  StringGrid1.MouseToCell(X, Y, Col, Row);

  if (Col = 0) and (Row = 0) then

    Exit;

  if Col = 0 then begin

    StringGrid1.Cells[0, Row]:= InputBox('Мощность', 'Введите мощность', '');

    Exit

  end;

  if Row = 0 then

    StringGrid1.Cells[Col, 0]:= InputBox('Мощность', 'Введите мощность', '');

end; 

procedure TForm1.SetProblem;

var

  i, j: Integer;

begin

  SetLength(Customers, StringGrid1.ColCount - 1);

  for i:= 1 to StringGrid1.ColCount - 1 do

    Customers[i - 1]:= StrToInt(StringGrid1.Cells[i, 0]);

  SetLength(Postavshiki, StringGrid1.RowCount - 1);

  for j:= 1 to StringGrid1.RowCount - 1 do

    Postavshiki[j - 1]:= StrToInt(StringGrid1.Cells[0, j]);

  SetLength(Matr, Length(Postavshiki), Length(Customers));

  for i:= 1 to StringGrid1.RowCount - 1 do begin

    for j:= 1 to StringGrid1.ColCount - 1 do begin

      Matr[i - 1, j - 1]:= StrToInt(StringGrid1.Cells[j, i]);

    end;

  end;

end; 

procedure TForm1.Button5Click(Sender: TObject);

var

  F: TextFile;

  i, j: Integer;

begin

  if SaveDialog1.Execute then begin

    AssignFile(F, SaveDialog1.FileName);

    Rewrite(F);

    Writeln(F, Edit1.Text);

    Writeln(F, Edit2.Text);

    for i:= 0 to StringGrid1.RowCount - 1 do begin

      for j:= 0 to StringGrid1.ColCount - 1 do begin

        Writeln(F, StringGrid1.Cells[j, i]);

      end;

    end;

    CloseFile(F);

  end;

end; 

procedure TForm1.Button4Click(Sender: TObject);

begin

  if OpenDialog1.Execute then begin

    Load;

  end;

end; 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  Application.Terminate;

end; 

procedure TForm1.Button2Click(Sender: TObject);

var

  i: Integer;

begin

  for i:=0 to StringGrid1.ColCount - 1 do

    StringGrid1.Cols[i].Clear;

end; 

procedure TForm1.Button6Click(Sender: TObject);

begin

  Form1.Close;

end; 

procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key <> 13 then

    Exit;

  if StringGrid1.Col < StringGrid1.ColCount - 1 then

    StringGrid1.Col:= StringGrid1.Col + 1

  else

    if StringGrid1.Row < StringGrid1.RowCount - 1 then begin

      StringGrid1.Row:= StringGrid1.Row + 1;

      StringGrid1.Col:= 1;

    end;

end; 

procedure TForm1.Button3Click(Sender: TObject);

var

  i: Integer;

  //TempC, TempP: TArray;

begin

  SetProblem;

  SetLength(TempC, Length(Customers));

  SetLength(TempP, Length(Postavshiki));

  for i:= 0 to Length(TempC) do

    TempC[i]:= Customers[i];

  for i:= 0 to Length(TempP) do

    TempP[i]:= Postavshiki[i];

  Solve(NorthWestCorner);

  //Solve(MinCost);

  //Solve(Fogel);

end; 

procedure TForm1.Button1Click(Sender: TObject);

var

  i: Integer;

  //TempC, TempP: TArray;

begin

  SetProblem;

  SetLength(TempC, Length(Customers));

  SetLength(TempP, Length(Postavshiki));

  for i:= 0 to Length(TempC) do

    TempC[i]:= Customers[i];

  for i:= 0 to Length(TempP) do

    TempP[i]:= Postavshiki[i];

  //Solve(NorthWestCorner);

  Solve(MinCost);

  //Solve(Fogel);

end; 
 

procedure TForm1.Button7Click(Sender: TObject);

var

  i: Integer;

  //TempC, TempP: TArray;

begin

  SetProblem;

  SetLength(TempC, Length(Customers));

  SetLength(TempP, Length(Postavshiki));

  for i:= 0 to Length(TempC) do

    TempC[i]:= Customers[i];

  for i:= 0 to Length(TempP) do

    TempP[i]:= Postavshiki[i];

  //Solve(NorthWestCorner);

  //Solve(MinCost);

  Solve(Fogel);

end; 

end

 
 

unit TransportProblem;

 

interface

 

uses

  Math, Dialogs, Windows, SysUtils, ComCtrls;

 

type

  TArray = array of Integer;

  TMatr = array of array of Integer;