Моделирование транспортной задачи

Автор: Пользователь скрыл имя, 25 Февраля 2013 в 20:55, курсовая работа

Краткое описание

В настоящее время нельзя назвать область человеческой деятельности, в которой в той или иной степени не использовались бы методы моделирования. Особенно это относится к сфере управления различными производствами и системами, где основными являются процессы принятия решений на основе получаемой информации.
Определим через слово "объект" все то, на что направлена человеческая деятельность (лат.Objectum-предмет). Выработка методологии направлена на упорядочение получения и обработки информации об объектах, которые существуют вне нашего сознания и взаимодействуют между собой и внешней средой.

Файлы: 1 файл

Копия ОТЧЕТ Курсова2я.doc

— 7.27 Мб (Скачать)

  Dump( a, 1 );

  // Строим путь (назад)

  x1 := x_m;

  y1 := y_m;

  f2 := f;

  while (f >= 0) do

    begin

      path[f].x := x1;

      path[f].y := y1;

      Find( x1, y1, (f+1) and 1, f );

      dec(f);

    end;

  v_m := MaxInt;

  x_m := -1;

  index := 1;

  while (index < f2) do

    begin

      f := plan.Arr[ path[index].x, path[index].y ];

      if (f < v_m) then

        begin

          v_m := f;

          x_m := index;

        end;

      inc(index,2);

    end;

  // add/sub vals

  for index := 0 to f2-1 do

    begin

      f := plan.Arr[ path[index].x, path[index].y ];

      if ( (index and 1) = 0 ) then   f := f + v_m

      else                            f := f - v_m;

      plan.Arr[ path[index].x, path[index].y ] := f;

    end;

end;

procedure TForm1.Button5Click(Sender: TObject);

procedure c( x, y: integer; s: string );

begin

  StringGrid1.Cells[ x, y ] := s;

end;

begin

    StringGrid1.ColCount := 7;

  StringGrid1.RowCount := 5;

  // top

  c( 2, 1, '20' );

  c( 3, 1, '80' );

  c( 4, 1, '90' );

  c( 5, 1, '60' );

  c( 6, 1, '40' );

 

  // left

  c( 1, 2, '40' );

  c( 1, 3, '150' );

  c( 1, 4, '100' );

  // mid

  c( 2, 2, '7' );

  c( 3, 2, '3' );

  c( 4, 2, '5' );

  c( 5, 2, '4' );

  c( 6, 2, '2' );

 

  c( 2, 3, '6' );

  c( 3, 3, '2' );

  c( 4, 3, '3' );

  c( 5, 3, '1' );

  c( 6, 3, '7' );

 

  c( 2, 4, '3' );

  c( 3, 4, '5' );

  c( 4, 4, '2' );

  c( 5, 4, '6' );

  c( 6, 4, '4' );

end;

procedure TForm1.Button6Click(Sender: TObject);

var

  fig: TFigure;

  s: string;

begin

  fig := TFigure.Create;

  fig.x := PaintBox1.Width div 2;

  fig.y := PaintBox1.Height div 2;

  if (MessageBox( 0, 'Это поставщик?', 'Вопрос', MB_YESNO ) = ID_YES) then

    fig.flag := 0

  else

    fig.flag := 1;

  s := InputBox( 'Введите количество товара', '', '1' );

  fig.val := StrToInt( s );

 

  fFigures.Add( fig );

  Redraw;

end;

procedure TForm1.Redraw;

var

  index: integer;

  canv: TCanvas;

  fig, fig2: TFigure;

  l: TLine;

begin

  canv := PaintBox1.Canvas;

  canv.Brush.Color := clWhite;

  canv.FillRect( Rect(0,0, PaintBox1.Width, PaintBox1.Height) );

  canv.Font.Color := clBlack;

  for index := 0 to fLines.Count-1 do

    begin

      l := fLines.Items[index];

      fig := fFigures.Items[ l.i1 ];

      canv.MoveTo( fig.x, fig.y );

      fig2 := fFigures.Items[ l.i2 ];

      canv.LineTo( fig2.x, fig2.y );

      canv.TextOut( (fig.x + fig2.x) div 2 - 10, (fig.y + fig2.y) div 2 - 10,

        ' ' + IntToStr( l.val ) + ' ' );

    end;

  canv.Font.Color := clYellow;

  for index := 0 to fFigures.Count-1 do

    begin

      fig := fFigures.Items[index];

      if (fig.flag = 0) then

        canv.Brush.Color := clBlue

      else

        canv.Brush.Color := clRed;

      canv.Rectangle( fig.x-fFigSize, fig.y-fFigSize,

        fig.x+fFigSize, fig.y+fFigSize );

      canv.TextOut( fig.x - 10, fig.y - 10,

        ' ' + IntToStr( fig.val ) + ' ' );

    end;

end;

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

var

  index: integer;

  fig: TFigure;

begin

  for index := 0 to fFigures.Count-1 do

    begin

      fig := fFigures.Items[index];

      if (  (abs( fig.x - x ) <= fFigSize) and

            (abs( fig.y - y ) <= fFigSize) ) then

        begin

          Result := index;

          exit;

        end;

    end; //for

  Result := -1;

end;

procedure TForm1.AddRemoveLine(i1, i2: integer);

var

  index, f: integer;

  l: TLine;

  s: string;

begin

  if ((i1 < 0) or (i2 < 0) or (i1 = i2)) then

    exit;

  f := 0;

  for index := 0 to fLines.Count-1 do

    begin

      l := fLines.Items[index];

      if (((l.i1 = i1) and (l.i2 = i2)) or

          ((l.i2 = i1) and (l.i1 = i2)) ) then

        begin // remove

          f := 1;

          break;

        end

    end;

  if (f = 1) then

    begin

      fLines.Delete( index );

      l.Destroy;

    end

  else

    begin

      l := TLine.Create;

      s := InputBox( 'Введите цену', '', '1' );

      l.i1 := i1;

      l.i2 := i2;

      l.val := StrToInt( s );

      fLines.Add( l );

    end;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

  fLines.Clear;

  fFigures.Clear;

  Redraw;

end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  i: integer;

begin

  i := IsOver( X,Y );

  if (i < 0) then

    exit;

  if (Button = mbLeft) then

    fMouseState := 1 // drag figure

  else if (Button = mbRight) then

    fMouseState := 2;

  fMouseInd := i;

end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

var

  fig: TFigure;

begin

  if (fMouseState = 1) then

    begin

      fig := fFigures.Items[fMouseInd];

      fig.x := X;

      fig.y := Y;

      Redraw;

    end

  else if (fMouseState = 2) then

    begin

      fig := fFigures.Items[fMouseInd];

      Redraw;

      PaintBox1.Canvas.MoveTo( fig.x, fig.y );

      PaintBox1.Canvas.LineTo( x, y );

    end;

end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  i: integer;

begin

  i := fMouseState;

  fMouseState := 0;

  if (i = 2) then

    begin // drag&check line

      i := IsOver( x,y );

      Redraw;

 

      if (i < 0) then

        exit;

      AddRemoveLine( fMouseInd, i );

    end;

  Redraw;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

  Redraw;

end;

procedure TForm1.Button7Click(Sender: TObject);

var

  index, c1, c2: integer;

  fig, fig2: TFigure;

  l: TLine;

begin

  c1 := 0;

  c2 := 0;

  for index := 0 to fFigures.Count-1 do

    begin

      fig := fFigures.Items[index];

      if (fig.flag = 0) then

        inc(c1)

      else

        inc(c2);

    end;

  StringGrid1.ColCount := c2 + 2;

  StringGrid1.RowCount := c1 + 2;

  c1 := 0;

  c2 := 0;

  for index := 0 to fFigures.Count-1 do

    begin

      fig := fFigures.Items[index];

      if (fig.flag = 0) then

        begin

          StringGrid1.Cells[1,c1+2] := IntToStr( fig.val );

          fig.p := c1;

          inc( c1 );

        end

      else

        begin

          StringGrid1.Cells[c2+2,1] := IntToStr( fig.val );

          fig.p := c2;

          inc( c2 );

        end;

    end;

  for index := 0 to fLines.Count-1 do

    begin

      l := fLines.Items[index];

      fig := fFigures.Items[ l.i1 ];

      fig2 := fFigures.Items[ l.i2 ];

      if (fig.flag = fig2.flag) then

        continue;

      if (fig.flag = 0) then

        StringGrid1.Cells[ fig2.p+2, fig.p+2 ] := IntToStr( l.val )

      else

        StringGrid1.Cells[ fig.p+2, fig2.p+2 ] := IntToStr( l.val );

    end;

  Button2Click( nil );

end;

end.

 

 


Информация о работе Моделирование транспортной задачи