Разработка программы "Организация перевозок"

         CopyMemory(XValues[I], X[I], SizeOf(Double) * Length(XValues[I]));

       end;

     end;

     procedure TTransportTask.SetInputData;

     ПРОДОЛЖЕНИЕ ПРИЛОЖЕНИЯ В

     var

       I: Longword;

     begin

       FStockSumm := VectorSumm(AStock);

       FNeedSumm := VectorSumm(ANeed);

       for I := 0 to Length(APrices) - 1 do

         CopyMemory(C[I], APrices[I], SizeOf(Double) * Length(APrices[I]));

       CopyMemory(Stock, AStock, SizeOf(Double) * Length(AStock));

       CopyMemory(Need, ANeed, SizeOf(Double) * Length(ANeed));

       if FStockSumm = FNeedSumm then

         FTaskType := tttClosed

       else

         if FStockSumm > FNeedSumm then

         begin

           FTaskType := tttSurplus;

           Inc(CC);

           SetLength(Need, CC);

           Need[CC - 1] := FStockSumm - FNeedSumm;

           SetLength(C, CC);

           SetLength(C[CC - 1], SC);

           for I := 0 to SC - 1 do

             C[CC - 1, I] := 0;

         end else

         begin

           FTaskType := tttShortage;

           Inc(SC);

           SetLength(Stock, SC);

           Stock[SC - 1] := FNeedSumm - FStockSumm;

           for I := 0 to CC - 1 do

           begin

             SetLength(C[I], SC);

             C[I, SC - 1] := 0;

           end;

         end;

       FCalculated := False;

     end; 

     function TTransportTask.VectorSumm(V: TVector): Double;

     var

       I: Longword;

     begin

       Result := 0;

       for I := 0 to Length(V) - 1 do

         Result := Result + V[I];

     end; 

     { TTRPoint } 

     constructor TTRCoord.Create(I, J: Longword);

     begin

       Self.I := I;

       Self.J := J;

     end; 

     end. 
 

     TR_MainForm.pas

     ПРОДОЛЖЕНИЕ ПРИЛОЖЕНИЯ В

     unit TR_MainForm; 

     interface 

     uses

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

       Dialogs, StdCtrls, ComCtrls, ExtCtrls, TR_AlignEdit, Grids, Math, Buttons; 

     type

       TfMain = class(TForm)

         gbInputParams: TGroupBox;

         udSuppliersCount: TUpDown;

         udConsumersCount: TUpDown;

         eSuppliersCount: TAlignEdit;

         lSuppliersCount: TLabel;

         lConsumersCount: TLabel;

         eConsumersCount: TAlignEdit;

         gbAddititionalInfo: TGroupBox;

         pAddititionalInfo: TPanel;

         memAddititionalInfo: TMemo;

         gbManagement: TGroupBox;

         gbTable: TGroupBox;

         pTable: TPanel;

         sgTable: TStringGrid;

         bCalcAutomatic: TButton;

         bNewCalculation: TButton;

         bHelp: TButton;

         bAbout: TButton;

         bExit: TButton;

         procedure bExitClick(Sender: TObject);

         procedure bNewCalculationClick(Sender: TObject);

         procedure eSuppliersCountExit(Sender: TObject);

         procedure eConsumersCountExit(Sender: TObject);

         procedure WriteInfo(Text: string);

         procedure ClearInfo;

         function InputValues: Boolean;

         procedure sgTableDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;

           State: TGridDrawState);

         procedure sgTableSelectCell(Sender: TObject; ACol, ARow: Integer;

           var CanSelect: Boolean);

         procedure bCalcAutomaticClick(Sender: TObject);

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

           Shift: TShiftState);

         procedure FormCreate(Sender: TObject);

         procedure FormConstrainedResize(Sender: TObject; var MinWidth, MinHeight,

           MaxWidth, MaxHeight: Integer);

         procedure FormActivate(Sender: TObject);

         procedure FormKeyPress(Sender: TObject; var Key: Char);

         procedure sgTableSetEditText(Sender: TObject; ACol, ARow: Integer;

           const Value: string);

         procedure bAboutClick(Sender: TObject);

         procedure sgTableExit(Sender: TObject);

         procedure bHelpClick(Sender: TObject);

       private

         { Private declarations }

         ПРОДОЛЖЕНИЕ ПРИЛОЖЕНИЯ В

       public

         { Public declarations }

       end;

     var

       fMain: TfMain; 

     implementation 

     uses TR_Decision, TR_AboutForm, TR_HelpForm; 

     {$R *.dfm} 

     var

       Prices, Answer: TMatrix;

       Need, Stock: TVector;

       DataChanged: Boolean = False;

       CCol: Longword = 1;

       CRow: Longword = 2;

       TT: TTransportTask = nil;

       CC, SC: Longword;

       Mode: Boolean = False; 

     procedure TfMain.WriteInfo(Text: string);

     begin

       memAddititionalInfo.Lines.Add(Text);

     end; 

     procedure tfMain.ClearInfo;

     begin

       memAddititionalInfo.Clear;

     end; 

     function TfMain.InputValues;

     label

       ResCheck;

     var

       I, J: Longword;

     begin

       Result := True;

       SC := udSuppliersCount.Position;

       CC := udConsumersCount.Position;

       with sgTable do

       begin

         for I := 1 to ColCount - 2 do

           for J := 2 to RowCount - 2 do

             if not TryStrToFloat(Cells[I, J], Prices[I - 1, J - 2]) then

             begin

               Col := I;

               Row := J;

               ActiveControl := sgTable;

               goto ResCheck;

             end;

         for I := 2 to RowCount - 2 do

           if not TryStrToFloat(Cells[ColCount - 1, I], Stock[I - 2]) or

             (Stock[I - 2] = 0) then

           begin

             Col := ColCount - 1;

             Row := I;

             goto ResCheck;

          ПРОДОЛЖЕНИЕ ПРИЛОЖЕНИЯ В

        (Need[I - 1] = 0) then

           begin

             Col := I;

             Row := RowCount - 1;

             goto ResCheck;

           end;

         Exit;

       end;

       ResCheck: begin

         Result := False;

         MessageBox(Application.Handle, 'В таблице имеются  некорректные ' +

           'значения. Исправьте их и попробуйте снова.', 'Ошибка', MB_ICONERROR

           or MB_OK);

         ActiveControl := sgTable;

       end;

     end; 

     procedure TfMain.bAboutClick(Sender: TObject);

     begin

       fAbout.ShowModal;

     end; 

     procedure TfMain.bCalcAutomaticClick(Sender: TObject);

     var

       I, J: Longword;

     begin

       if not InputValues then

         Exit;

       sgTable.Options := sgTable.Options - [goEditing];

       TT.SetInputData(Prices, Need, Stock);

       ClearInfo;

       case TT.TaskType of

         tttClosed: WriteInfo('Задача закрытая.');

         tttSurplus: begin

           WriteInfo('Задача открытая, с избытком запасов, введён ' +

           'фиктивный потребитель B' + IntToStr(TT.ConsumersCount) + '.');

           Inc(CC);

         end;

         tttShortage: begin

           WriteInfo('Задача открытая, с дефицитом  запасов, введён ' +

           'фиктивный поставщик A' + IntToStr(TT.SuppliersCount) + '.');

           Inc(SC);

         end;

       end;

       TT.Calculate;

       with sgTable do

       begin

         ColCount := CC + 1;

         RowCount := SC + 1;

         FixedRows := 1;

         for I := 1 to ColCount - 1 do

           Cells[I, 0] := 'B' + IntToStr(I);

         for I := 1 to RowCount - 1 do

           Cells[0, I] := 'A' + IntToStr(I);

         bCalcAutomatic.Enabled := False;

         SetLength(Answer, CC);

         for I := 0 to CC - 1 do

           SetLength(Answer[I], SC);

         TT.GetOutputData(Answer);

        ПРОДОЛЖЕНИЕ ПРИЛОЖЕНИЯ В

       for I := 0 to CC - 1 do

           for J := 0 to SC - 1 do

             if Answer[I, J] <> 0 then

               Cells[I + 1, J + 1] := FloatToStr(Answer[I, J])