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

 

Приложения

 

 

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

 

Главный модуль. Этот модуль выполняет  функции:

• в нем описан основной интерфейс пользователя
• управление проектами (добавление, изменение, открытие)
• ввод данных

 

unit Main;

unit Main;

 

interface

 

uses

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

  Dialogs, Menus, StdCtrls, Grids, ExtCtrls, Buttons, ComCtrls, ToolWin, ImgList;

 

type

  TForm_Main = class(TForm)

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    N_New: TMenuItem;

    P_In_data: TPanel;//панель входных данных

    SG_Tabl_input: TStringGrid;

    ED_S: TLabeledEdit;

    Ed_P: TLabeledEdit;

    N_Save: TMenuItem;

    N_load: TMenuItem;

    N_open_otchet: TMenuItem;

    N3: TMenuItem;

    ImageList1: TImageList;

    OD_file: TOpenDialog;

    N2: TMenuItem;

    Panel1: TPanel;

    BitBtn1: TBitBtn;

    BitBtn2: TBitBtn;

    Panel2: TPanel;

    RE_Help: TRichEdit;

    N_SetColor: TMenuItem;

    ColorDialog1: TColorDialog;

    N_Font: TMenuItem;

    FontDialog1: TFontDialog;

    Label1: TLabel;

    Label2: TLabel;

    BitBtn3: TBitBtn;

    N_exit: TMenuItem;

    N4: TMenuItem;

    BitBtn4: TBitBtn;

    BitBtn5: TBitBtn;

    BitBtn6: TBitBtn;//таблица входных данных

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

    procedure N_SaveClick(Sender: TObject);

    procedure N_loadClick(Sender: TObject);

    function B_ZapolnClick(Sender: TObject):boolean;

    procedure BitBtn1Click(Sender: TObject);

    procedure NewProjectClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure ToolButton3Click(Sender: TObject);

    procedure N_NewClick(Sender: TObject);

    procedure N2Click(Sender: TObject);

    procedure BitBtn2Click(Sender: TObject);

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

    procedure N_SetColorClick(Sender: TObject);

    procedure N_FontClick(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure BitBtn3Click(Sender: TObject);

    procedure N_exitClick(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure BitBtn4Click(Sender: TObject);

    procedure BitBtn5Click(Sender: TObject);

    procedure BitBtn6Click(Sender: TObject);

  private

 

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form_Main: TForm_Main;

  ProgramWay: string;

 

procedure EnterData(FromFile: boolean;

                      n: integer = 0;

                      P: boolean = false;

                      S: boolean = false;

                      sNam: string ='');

 

procedure OpenProject (PFile: string);

procedure ResizeProject (n: integer; P: boolean; S: boolean);

 

implementation

 

{$R *.dfm}

 

uses

  variable, Enter_setting, view_result, UnitOpenProject, functions, Help;

 

var

  Mash : Tcar;

  DirProject, NameProject : string;

 

procedure OpenProject (PFile: string);

begin

  NameProject := PFile;

    if Mash <> nil then

  begin

    //MessageBox(

    //ShowMessage('Вы действительно хотите открыть новый проект');

    //exit;

  end;

  mash := Tcar.create;

 

  if mash.LoadFromFile(NameProject) then

  begin              

    EnterData(true);

  end

  else

  begin

    Mash.Destroy;

    Mash := nil;

  end;

end;

 

procedure SetPanel;

var

  i : integer;

begin

  with Form_Main do

  begin

    P_In_data.Visible := true;

    SG_Tabl_input.ColCount := Mash.n + 2;

    SG_Tabl_input.RowCount := 3;

    Ed_p.Visible := false;

    Ed_s.Visible := false;

    Panel2.Visible := false;

 

    for i := 1 to Mash.n + 1 do

      SG_Tabl_input.Cells[i, 0]:= IntToStr(i - 1);

    SG_Tabl_input.Cells[0, 1]:='Z(t)';

    SG_Tabl_input.Cells[0, 2]:='U(t)';

 

    if Mash.PConst then

      Ed_p.Visible := true

    else

    begin

      SG_Tabl_input.RowCount := SG_Tabl_input.RowCount + 1;

      SG_Tabl_input.Cells[0,SG_Tabl_input.RowCount-1]:='P(t)';

    end;

 

    if Mash.SConst then

      Ed_s.Visible := true

    else

    begin

      SG_Tabl_input.RowCount := SG_Tabl_input.RowCount + 1;

      SG_Tabl_input.Cells[0,SG_Tabl_input.RowCount-1]:='S(t)';

    end;

 

    SG_Tabl_input.Height := SG_Tabl_input.DefaultRowHeight *

        (SG_Tabl_input.RowCount + 1);

  end;

 

end;

 

procedure ResizeProject (n: integer; P: boolean; S: boolean);

begin

    Mash := Tcar.create(n, P, S);

    setPanel;

end;

 

procedure EnterData(FromFile: boolean;

                      n: integer = 0;

                      P: boolean = false;

                      S: boolean = false;

                      sNam: string = '');

var

  i: integer;

begin

  if FromFile then

  begin

    setPanel;

    with Form_Main do

    begin

      for I := 0 to mash.n do

      begin

        SG_Tabl_input.Cells[i+1,1] := FloatToStr(Mash.z[i]);

        SG_Tabl_input.Cells[i+1,2] := FloatToStr(Mash.u[i]);

      end;//for I := 0 to mash.n do

 

      if Mash.PConst then

        Ed_p.Text := FloatToStr(Mash.p[0])

      else

      for I := 0 to mash.n do

        SG_Tabl_input.Cells[i+1,3] := FloatToStr(Mash.p[i]);

 

      if Mash.SConst then

        Ed_S.Text := FloatToStr(Mash.s[0])

      else

        for I := 0 to mash.n do

          if Mash.PConst then

            SG_Tabl_input.Cells[i+1,3] := FloatToStr(Mash.s[i])

          else

            SG_Tabl_input.Cells[i+1,4] := FloatToStr(Mash.s[i]);

    end;//with Form_Main do

 

  end

  else

  begin

    Mash := Tcar.create(n, P, S);

    setPanel;

    NameProject := dirProject + sNam;

  end;

 

end;

 

procedure TForm_Main.BitBtn1Click(Sender: TObject);

begin

  OpenFileProject;

end;

 

procedure TForm_Main.BitBtn2Click(Sender: TObject);

begin

   NewProjectClick(Sender);

end;

 

procedure TForm_Main.BitBtn3Click(Sender: TObject);

begin

  close;

end;

 

procedure TForm_Main.BitBtn4Click(Sender: TObject);

begin

  //изменить настройки проекта

  SetProject(NameFile(NameProject), Mash.n, Mash.PConst, Mash.SConst);

end;

 

procedure TForm_Main.BitBtn5Click(Sender: TObject);

begin

  if mash = nil then

  begin

    ShowMessage('Вы не создали или не открыли проект');

    exit;

  end;

  mash := TCar.create(SG_Tabl_input.ColCount - 2, ed_p.Visible, ed_s.Visible);

  if B_ZapolnClick(sender) then

  begin

    mash.decision;

    mash.SaveToHTML(NameProject);

    OpenOtchet(NameProject);

  end;

 

end;

 

procedure TForm_Main.BitBtn6Click(Sender: TObject);

begin

  close;

end;

 

function TForm_Main.B_ZapolnClick(Sender: TObject):boolean;

var

  i, j: Integer;

begin

  for i := 1 to SG_Tabl_input.RowCount - 1 do

  begin

    for j := 1 to SG_Tabl_input.ColCount - 1 do

      if SG_Tabl_input.Cells[j, i] = '' then

      begin

        result := false;

        showMessage('Не заполнены все поля');

        exit;

      end;

  end;

 

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

  begin

    mash.z[i - 1] := StrToFloat(SG_Tabl_input.Cells[i, 1]);

    Mash.u[i - 1] := StrToFloat(SG_Tabl_input.Cells[i, 2]);

  end;

 

  if mash.PConst then

    mash.p[0] := StrToFloat(Ed_p.Text)

  else

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

  begin

    mash.P[i - 1] := StrToFloat(SG_Tabl_input.Cells[i, 3]);

  end;

 

  if mash.SConst then

    mash.s[0] := StrToFloat(Ed_s.Text)

  else

    if mash.PConst then

      for I := 1 to SG_Tabl_input.ColCount - 1 do

        mash.s[i - 1] := StrToFloat(SG_Tabl_input.Cells[i, 3])

    else

      for I := 1 to SG_Tabl_input.ColCount - 1 do

        mash.s[i - 1] := StrToFloat(SG_Tabl_input.Cells[i, 4]);

 

  if Mash.test_data then

    result := true

    //ShowMessage('данные верны')

  else

  begin

    ShowMessage('данные не верны');

    result := false;

  end;

end;

 

procedure TForm_Main.ED_SKeyPress(Sender: TObject; var Key: Char);

begin

  if ((#46 = key) or ('.' = key)) and (pos(',', ED_S.Text) > 0) then

    key := #0;

  if #46 = key then

    key := ',';

  if not(('0' <= key) and (key <= '9') or (key = #8) or (',' = key)) then

    key := #0;

end;

 

procedure TForm_Main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

var

  varin : variant;

begin

  if mash <> nil then

  begin

    varin := messageBox(Handle,'Сохранить  проект перед выходом?','Выход',

        mb_YesNoCancel or mb_iconquestion);

    if varin = mrYes then

      N_SaveClick(Sender);

    if varin = mrNo then

      CanClose := true;

    if varin = mrCancel then

      CanClose := false;

  end;

 

end;

 

procedure TForm_Main.FormCreate(Sender: TObject);

begin

  NameProject := '';

  ProgramWay := DirInit(ParamStr(0));

  DirProject := ProgramWay + ProjectFolder;

  mash := nil;

  panel2.Top := (Form_Main.Height div 2) - (panel2.Height div 2);

  panel2.Left := (Width div 2) + (panel2.Width div 2) - 150;

  RE_Help.Lines.LoadFromFile('files\help_data.rtf');

end;

 

 

procedure TForm_Main.N_exitClick(Sender: TObject);

begin

  Close;

end;

 

procedure TForm_Main.N_FontClick(Sender: TObject);

begin

  if Fontdialog1.Execute then

    Font := Fontdialog1.Font;

end;

 

procedure TForm_Main.N_loadClick(Sender: TObject);

{загрузка данных из файла}

begin

  if Mash <> nil then

  begin

    //MessageBox(

    //ShowMessage('Вы  действительно хотите открыть новый проект');

    //exit;

  end;

  mash := Tcar.create;

 

  if OD_file.Execute then

  begin

    ShowMessage(DeleteExtension(OD_file.FileName));

    NameProject := DeleteExtension(OD_file.FileName);

    DirProject := DirInit(Od_file.FileName);

  end

  else

    exit;

 

  if mash.LoadFromFile(NameProject) then

  begin

    EnterData(true);

  end

  else

  begin

    freeandnil(Mash);//освобождение

  end;

end;

 

procedure TForm_Main.N_NewClick(Sender: TObject);

{создать проект}

begin

  newElem;

end;

 

procedure TForm_Main.N_SaveClick(Sender: TObject);

{сохранение данных}

begin

  if mash = nil then

    ShowMessage('Не создан проект')

  else

    if B_ZapolnClick(sender) then

      Mash.SaveToFile( NameProject);

end;

 

procedure TForm_Main.N_SetColorClick(Sender: TObject);

begin

  if ColorDialog1.Execute then

    color := ColorDialog1.Color;

end;

 

procedure TForm_Main.SG_Tabl_inputKeyPress(Sender: TObject; var Key: Char);

var

  I, flag: Integer;

  str: string;

begin

  ED_SKeyPress(sender, key);

  if key = '.' then

    key := ',';

  if key = ',' then

  begin

    str := SG_Tabl_input.Cells[SG_Tabl_input.Col,SG_Tabl_input.Row];

    flag := 0;

    for I := 0 to length(str) do

      if str[i] = ',' then

        inc(flag);

    if flag > 0 then

      key := #0;  

  end;            

end;

 

procedure TForm_Main.ToolButton3Click(Sender: TObject);

begin

  OpenFileProject;

end;

 

procedure TForm_Main.N2Click(Sender: TObject);

//окно открытия проекта

begin

  FormOpenProjects.ShowModal;

end;

 

procedure TForm_Main.N4Click(Sender: TObject);

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

begin

  help.Form1.ShowModal;

end;

 

procedure TForm_Main.NewProjectClick(Sender: TObject);

//Создание нового  проекта

begin

  if mash <> nil then

  begin

    Mash := nil;

    P_In_data.Visible := false;

  end;

  newElem;

end;

 

end.

 

 

 

Модуль создания и изменение  параметров проекта. Модуль выполняет функцию, ввод настроек проекта (длину планового периода, имя проекта, изменяется или нет остаточная стоимость и цена новой машины).

 

 

unit Enter_setting;

 

interface

 

uses

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

  Dialogs, StdCtrls, functions, ComCtrls;

 

type

  TForm_enter = class(TForm)

    Ed_n: TEdit;

    But_set: TButton;

    CheckSconst: TCheckBox;

    CheckPconst: TCheckBox;

    Ed_patch: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    UpDown1: TUpDown;

    B_resize: TButton;

    procedure But_setClick(Sender: TObject);

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

    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

    procedure FormActivate(Sender: TObject);

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

    procedure B_resizeClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form_enter: TForm_enter;

 

procedure SetProject(s:string; n:integer; pCon,sCon:boolean);

procedure newElem;

 

implementation

{$R *.dfm}

 

uses

  Main;

 

procedure newElem;

begin

  Form_enter.Ed_Patch.Enabled := true;

  Form_enter.ShowModal;

end;

 

procedure SetProject(s:string; n:integer; pCon,sCon:boolean);

begin                 

  Form_enter.Ed_Patch.Enabled := false;

  Form_enter.Ed_Patch.Text := s;

  Form_enter.But_set.Visible := false;

  Form_enter.B_resize.Visible := true;

  Form_enter.Ed_n.Text := IntToStr(n);

  Form_enter.UpDown1.Position := n;

  Form_enter.CheckPconst.Checked := pCon;

  Form_enter.CheckSconst.Checked := sCon;

  Form_enter.ShowModal;

end;

 

procedure TForm_enter.B_resizeClick(Sender: TObject);

var

  n: integer;

begin

  Form_enter.But_set.Visible := true;

  Form_enter.B_resize.Visible := false;

  n := StrToInt(Ed_n.Text);

   if n > 0 then

  begin

    ResizeProject (n, CheckPconst.Checked, CheckSconst.Checked);

    Form_enter.Ed_Patch.Enabled := true;

    close;

  end

  else

    ShowMessage('вы  не правильно ввели' +

     'длину  плановуого периода');

end;

 

procedure TForm_enter.But_setClick(Sender: TObject);

var

  n, i: integer;

begin

  if Trim(Ed_patch.Text) = '' then

  begin

    ShowMessage('Вы  не ввели имя проекта'+ #10 + #13 +

    ' Пожалуйста  введите имя');

    Ed_patch.SetFocus;

    exit;

  end;

  n := StrToInt(Ed_n.Text);

  if n > 0 then

  begin

    for i:=0 to main.Form_Main.SG_Tabl_input.RowCount do

      main.Form_Main.SG_Tabl_input.Rows[i].Clear;

    EnterData(false, n, CheckPconst.Checked, CheckSconst.Checked,

        Ed_Patch.Text);

  end

  else

    ShowMessage('вы не правильно ввели' +

     'длину плановуого периода');

  close;

end;

 

procedure TForm_enter.Ed_nKeyPress(Sender: TObject; var Key: Char);

begin

  if not(('0' <= key) and (key <= '9') or (key = #8)) then

    key := #0;

end;

 

procedure TForm_enter.Ed_patchKeyPress(Sender: TObject; var Key: Char);

begin

  if key = '.' then

    key := #0;

end;

 

procedure TForm_enter.FormActivate(Sender: TObject);

begin

  UpDown1.Position := StrToInt(ED_n.Text);

end;

 

procedure TForm_enter.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

  ED_n.Text := IntToStr(UpDown1.Position);

end;

 

end.

 

 

Модуль открытия нового проекта. Этот модуль выводит пользователю все  существующие проекты франящиеся в  папке с программой для выбора пользователя проекта для открытия

 

unit UnitOpenProject;

 

interface

 

uses

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

  Dialogs, StdCtrls, Buttons;

 

type

  TFormOpenProjects = class(TForm)

    LB_File: TListBox;

    B_open: TButton;

    BitBtn1: TBitBtn;

    B_new: TButton;

    procedure FormActivate(Sender: TObject);

    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;

      var Resize: Boolean);

    procedure LB_FileDblClick(Sender: TObject);

    procedure B_openClick(Sender: TObject);

    procedure B_newClick(Sender: TObject);

    procedure BitBtn1Click(Sender: TObject);

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

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  FormOpenProjects: TFormOpenProjects;

 

procedure OpenFileProject ();

 

implementation

 

{$R *.dfm}

 

uses

  Functions, variable, main;

 

var

  dir : string;

 

 

procedure OpenFileProject ();

begin

  FormOpenProjects.ShowModal;

  FormOpenProjects.B_new.Visible := false;

  FormOpenProjects.LB_File.Visible := true;

  FormOpenProjects.B_open.Visible := false;

  //FormOpenProjects.Visible := true;

end;

 

procedure ListFileDir(Path: string; FileList: TStrings);

var

   SR: TSearchRec;

begin

   if FindFirst(Path + '*.bin', faAnyFile, SR) = 0 then

   begin

     repeat

       if (SR.Attr <> faDirectory) then

       begin

         FileList.Add(copy(SR.Name,0,pos('.',SR.Name) - 1));

       end;

     until FindNext(SR) <> 0;

     FindClose(SR);

   end;

end;

 

 

procedure TFormOpenProjects.BitBtn1Click(Sender: TObject);

begin

  //main.Form_Main.Destroy;

  close;

end;

 

procedure TFormOpenProjects.B_newClick(Sender: TObject);

begin

  Form_Main.N_NewClick(sender);

  close;

end;

 

procedure TFormOpenProjects.B_openClick(Sender: TObject);

begin

  LB_file.Visible := true;

  B_new.Visible := false

end;

 

procedure TFormOpenProjects.FormActivate(Sender: TObject);

begin

  LB_File.Clear;

  dir := DirInit(ParamStr(0))+ProjectFolder;

  ListFileDir(Dir, LB_File.Items);

end;

 

procedure TFormOpenProjects.FormCanResize(Sender: TObject; var NewWidth,

  NewHeight: Integer; var Resize: Boolean);

begin

  resize := false;

end;

 

procedure TFormOpenProjects.LB_FileDblClick(Sender: TObject);

begin

  if LB_File.ItemIndex = -1 then