Продолжение приложения б

procedure ShiftPlan( var data, plan, potential: TData );

function IsOver( x,y: integer ): integer;

procedure AddRemoveLine( i1, i2: integer );

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses size;

procedure TForm1.Button1Click(Sender: TObject);

var

index, s: integer;

begin

if Size_f1.ShowModal () <> mrOk then

exit;

s := StrToInt( Size_f1.Cols_e1.Text );

StringGrid1.ColCount := s + 2;

for index := 1 to s do

StringGrid1.Cells[index+1,0] := IntToStr( index );

s := StrToInt( Size_f1.Rows_e1.Text );

StringGrid1.RowCount := s + 2;

for index := 1 to s do

StringGrid1.Cells[0, index+1] := IntToStr( index );

end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if (StringGrid1.Col = 1) and (StringGrid1.Row = 1) then

begin

Key := #0;

exit;

end;

if (Key < '0') or (Key > '9') then

Key := #0;

end;

Продолжение приложения б

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.Cells[1,0] := 'Магазины';

StringGrid1.Cells[0,1] := 'Склады';

StringGrid1.Cells[1,1] := 'Наличие/Потребность';

FillChar( fData, sizeof(fData), 0 );

fFigures := TList.Create;

fLines := TList.Create;

fMouseState := 0;

end;

procedure TForm1.Button2Click(Sender: TObject);

function GetInt( x, y: integer ): integer;

begin

Result := StrToInt( StringGrid1.Cells[ x, y ] );

end;

var

index, index2, s, old_s: integer;

data, plan, potential: TData;

begin

Memo1.Lines.Clear;

data := TData.Create;

data.Width := StringGrid1.ColCount-2;

data.Height := StringGrid1.RowCount-2;

for index := 0 to data.Height-1 do

for index2 := 0 to data.Width-1 do

data.Arr[index2,index] := GetInt( index2+2, index+2 );

for index := 0 to data.Width-1 do

data.Top[index] := GetInt( index+2, 1 );

for index := 0 to data.Height-1 do

data.Left[index] := GetInt( 1, index+2 );

plan := TData.Create;

potential := TData.Create;

Продолжение приложения б

Memo1.Lines.Add( 'Äàíî:' );

Dump( data, 7 );

Memo1.Lines.Add( 'Ïëàí:' );

CalcNorthWest( data, plan );

Dump( plan, 1 );

Memo1.Lines.Add( 'S = ' + IntToStr( CalcSum(data, plan) ) );

old_s := 0;

while (true) do

begin

CalcPotential( data, plan, potential );

Memo1.Lines.Add( 'Потенциал:' );

Dump( potential, 1 );

if (potential.Min >= 0) then

begin

Memo1.Lines.Add( 'Завершено!' );

break;

end;

ShiftPlan( data, plan, potential );

s := CalcSum(data, plan);

Memo1.Lines.Add( 'Результат:' );

Dump( plan, 1 );

Memo1.Lines.Add( 'S = ' + IntToStr(s) );

if (old_s = s) then

break

else

old_s := s;

end;

end;

{ TData }

procedure TData.Assign(data: TData);

var

index, index2: integer;

begin

AssignLT( data );

for index := 0 to Height-1 do

Продолжение приложения б

for index2 := 0 to Width-1 do

Arr[index2,index] := data.Arr[index2,index];

end;

procedure TData.AssignLT(data: TData);

var

index: integer;

begin

Reset;

Width := data.Width;

Height := data.Height;

for index := 0 to Width-1 do

Top[index] := data.Top[index];

for index := 0 to Height-1 do

Left[index] := data.Left[index];

end;

constructor TData.Create;

begin

Reset;

end;

function TForm1.Check(data: TData): boolean;

var

s, index: integer;

begin

s := 0;

for index := 0 to data.Width-1 do

s := s + data.Top[index];

for index := 0 to data.Height-1 do

s := s - data.Left[index];

Result := s = 0;

end;

procedure TForm1.CalcNorthWest( data: TData; var plan: TData);

var

index, index2, t: integer;

begin

index := 0;

index2 := 0;

plan.AssignLT( data );

while (index < plan.Height) and (index2 < plan.Width) do

begin

t := min( plan.Left[index], plan.Top[index2] );

plan.Arr[index2,index] := t;