Задача о замени оборудования

    ShowMessage('Выберите проект')

  else

  begin

    OpenProject(dir + LB_File.Items[LB_File.ItemIndex]);

    close;

  end;

end;

 

procedure TFormOpenProjects.LB_FileKeyPress(Sender: TObject; var Key: Char);

begin

  if key = #13 then

    LB_FileDblClick(self);

end;

 

end.

 

 

 

Модуль математической обработки  данных. В этом модуле выполняются  функции:

• решение задачи
• формирование отчета
• сохранение в файл
• извлечение из файла
• проверка коректности данных

 

unit variable;

 

interface

 

type

  Tcar = class

 

    private

 

      file_bin : file;//бинарный файл

      bool_f : array of array of boolean;//замена/сохранение машины

      //истина - замена оборудования

      f : array of array of real;//значение результата  решения

 

      type

        arr = array of real;

 

    public

    //подготовка

        z, u, p, s : arr;

        n : integer;

        PConst : boolean;

        SConst : boolean;

 

 

      constructor create(count:integer; PConst, SConst:boolean);overload;

    //проверка корректности введеных данных

      function test_data():boolean;

      procedure SaveToFile(path:string);

      function LoadFromFile (Path:string):boolean;

      procedure decision();

      procedure SaveToHTML(Path:string);

 

      {

        z - стоимость продукции

        u - эксплуатационные затраты

        s - остаточная стомость

        p - цена новой машины

        n - длина планового периода

    }

 

  end;

const

  ProjectFolder = 'Projects\';

  HtmlFile = '_otchet.HTML';

 

 

implementation

 

uses

  SysUtils, Dialogs;

 

constructor Tcar.create(Count:integer; PConst, SConst:boolean);

begin

  self.Pconst := Pconst;

  self.SConst := SConst;

  if count < 0 then

  begin

    ShowMessage('error length year');

  end

  else

  begin

    n := Count;

    Setlength(z, n + 1);

    Setlength(u, n + 1);

 

    if Pconst then

      setlength(p, 1)

    else

      setlength(p, n + 1);

 

    if Sconst then

      setlength(s, 1)

    else

      setlength(s, n + 1);

  end;

end;

 

function Tcar.test_data;

var

  i, len :integer;

begin

  len := length(z);

  if (len > 0) then

    result := true

  else

    result := false;

  for I := 0 to len do

  begin

    if (z[i] < 0) and (u[i] < 0) then

    begin

      result := false;

      break;

    end;

  end;

 

  for i := 0 to len - 2 do

  begin

    if (z[i] < z[i+1]) or (u[i] > u[i+1]) then

    begin

      result := false;

      break;

    end;

  end;

end;

 

procedure Tcar.decision;

var

  i: Integer;

  t: Integer;

  save, zam : real;

begin

  setlength(f, n, n+1);

  setLength(bool_f, n, n+1);

  for I := 0 to n+1 do

    f[0,i] := z[i] - u[i];

 

  for i := 0 to n - 2 do

    for t := 0 to n do

    begin

      if t <> n then

        Save := f[0, t] + f[i, t+1]//Save

      else

        save := -1000;

      if SConst then

        zam := s[0]

      else

        zam := s[t];

      if PConst then

        zam := zam - p[0]

      else

        zam := zam - p[t];

      zam := zam + f[0, 0] + f[i, 1];

      if Save >= Zam then

      begin

        f[i+1,t] := Save;

        bool_f[i+1,t] := false;

      end

      else

      begin

        f[i+1,t] := Zam;

        bool_f[i+1,t] := true;

      end;

    end;

end;

 

function Tcar.LoadFromFile(Path: string): boolean;

{ Чтение из  файла в объект}

var

  i, sizeData, SizeInt, count : integer;

  temp : real;

begin

  Assignfile(file_bin, Path + '.bin');

  {$I-}

  reset(file_bin, 1);

  if ioresult = 0 then

    //ShowMessage('file open ok')

  else

  begin

    ShowMessage('Ошибка открытия файла');

    result := false;

    exit;

  end;

  {$I+}

  SizeData := SizeOf(temp);

  SizeInt := SizeOf(integer);

  BlockRead(file_bin, n, SizeInt);

  setlength(z, n);

  setlength(u, n);

  n := n - 1;

  //чтение данных U и Z

  for I := 0 to n do

  begin

    BlockRead(file_bin, temp, SizeData);

    z[i] := temp;

    BlockRead(file_bin, temp, SizeData);

    u[i] := temp;

  end;

//Чтение S

  BlockRead(file_bin, count, SizeInt);

  SetLength (s, count);

  if count = 1 then

  begin

    SConst := true;

    BlockRead(file_bin, temp, SizeData);

    s[0] := temp;

  end

  else

  begin

    SConst := false;

    for I := 0 to count - 1 do

    begin

      BlockRead(file_bin, temp, SizeData);

      s[i] := temp;

    end;

  end;

  //Чтение p

  BlockRead(file_bin, count, SizeInt);

  SetLength (p, count);

  if count = 1 then

  begin

    PConst := true;

    BlockRead(file_bin, temp, SizeData);

    p[0] := temp;

  end

  else

  begin

    PConst := false;

    for I := 0 to count - 1 do

    begin

      BlockRead(file_bin, temp, SizeData);

      p[i] := temp;

    end;

  end;

 

  CloseFile(file_bin);

  result := true;

end;

 

procedure Tcar.SaveToFile(path: string);

var

  i, sizeData, SizeInt, count : integer;

  temp : real;

begin

  sizeData := sizeof(temp);

  SizeInt := sizeof(integer);

 

  AssignFile(file_bin, path + '.bin');

  rewrite(file_bin, 1);

 

  count := length(z);

  BlockWrite(file_bin, count, SizeInt);

 

  for i := 0 to length(z) - 1 do

  begin

    BlockWrite(file_bin, z[i], SizeData);

    blockWrite(file_bin, u[i], SizeData);

  end;

 

  Count := length(s);

  BlockWrite(file_bin, count, SizeInt);

  for I := 0 to Count - 1 do

    BlockWrite(file_bin, s[i], SizeData);

 

  Count := length(p);

  BlockWrite(file_bin, Count, SizeInt);

  for I := 0 to Count - 1 do

    BlockWrite(file_bin, p[i], SizeData);

 

  closeFile(file_bin);

end;

procedure Tcar.SaveToHTML(Path: string);

var

  str : string;

  FText : TextFile;

  I: Integer;

  j: Integer;

const

  ColorSave = '"#F00010"';

  ColorZam = '"#00FF1"';

begin

  AssignFile(Ftext, Path + HtmlFile);

  rewrite(Ftext);

  str := '<html><head>'+

    '<meta http-equiv="Content-Type" content="text/html;'

    + 'charset=windows-1251" /> <title>Документ без названия</title>' +

    '<link type="text/css" href="css/css.css" rel="stylesheet" />' +

    '</head><body><H2 align="center">Динамическое программирование</H2>' +

    '<table width="80%" align="center" bgcolor="#00FFFF">';

  Writeln(FText, str);

  str := '<tr><td></td>';

  for i := 0 to n do

    str := str + '<td>' + IntToStr(i) + '</td>';

  str := str + '</tr>';

  Writeln(FText, str);

  for I := 0 to n-1 do

  begin

  str := '<tr> <td>F' + IntToStr(i+1) + '(t)</td>';

    for j := 0 to n do

    begin

      if bool_f[i,j]=true then

        str := Str + '<td bgcolor=' + ColorSave + '>' + FloatToStr(f[i,j])

          + '</td>'

      else

        str := Str + '<td bgcolor='+ColorZam+'>' + FloatToStr(f[i,j]) + '</td>';

    end;

  str := str + '</tr>';

  writeln(Ftext, str);

  end;

  str := '</table>';

  Writeln(FText, str);

 

  str := '<br><br>';

  str := str + '<table> <tr><td widht="20px" bgcolor=' + ColorZam +

      ' >&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>';

  str := str + '<td> -  Сохранение оборудования</td>';

  str := str + '</tr></table>';

 

  writeln(Ftext, str);

    str := '<br>';

  str := str + '<table> <tr><td widht="20px" bgcolor=' + ColorSave +

      ' >&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>';

  str := str + '<td> -  Замена оборудования</td>';

  str := str + '</tr></table> <br>';

  str := str + 'Курсовой проект студента группы Пр - 356: ' +

    'Старостина  А';

  str := str + '<br>Руководитель  Курсвового проекта: Т.Д. Оболенцева';

  writeln(Ftext, str);

 

  str := '</body></html>';

  Writeln(FText, str);

  closeFile(ftext);

end;

end.

 

 

 

Модуль отображения результатов

 

(*********************************************

* модуль просмотра  результата

* цель: вывод  пользователю отчета по резултатам  работы программы

* входные данные имя проекта

* procedure OpenOtchet (Str: string);

* дата 9.04.2011

*)

unit view_result;

 

interface

 

uses

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

  Dialogs, OleCtrls, SHDocVw, StdCtrls;

 

type

  TWebbrow = class(TForm)

    WebBrowser1: TWebBrowser;

    procedure FormCreate(Sender: TObject);

    procedure WebBrowser1Visible(ASender: TObject; Visible: WordBool);

    procedure FormShow(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

procedure OpenOtchet (Str: string);

 

var

  Webbrow: TWebbrow;

 

 

 

implementation

 

{$R *.dfm}

 

procedure OpenOtchet (Str: string);

begin

  WebBrow.WebBrowser1.Navigate(Str + '_otchet.HTML');

  Webbrow.ShowModal;

end;

procedure TWebbrow.FormCreate(Sender: TObject);

begin

  //webBrowser1.Refresh;

// WebBrowser1.Navigate('D:\документы\коледж\3 курс\курсовик'

//  + '\программа  в 0.1\qw\qw_otchet.HTML');

end;

 

procedure TWebbrow.FormShow(Sender: TObject);

begin

//  WebBrowser1.Refresh;

end;

 

procedure TWebbrow.WebBrowser1Visible(ASender: TObject; Visible: WordBool);

begin

    WebBrowser1.Refresh;

end;

 

end.

 

Пример 1

 

 

 

Результат

 

 

Пример 2