Разработка ЭИС планирования закупок для предприятия химической отрасли

 begin

   MT.Post ;

   MT.CLOSE ;

   MT.Open;

 end;

 

end;

 

Procedure  TMAT.Filter_Gr ;

var

        str: string   ;

        SORTFIELD : STRING ;

        Current_Pos : string ;

begin

        if MT.Active = false then MT.Open;

 

        Filter(Grid ,str , SORTFIELD);

        Current_Pos := MTID_MAT.asstring ;

        if Current_Pos ='' then  Current_Pos := '0' ;

 

        Grid.DataSource := nil ;

        MT.Close ;

        DD.SelectSQL.Clear;

        DD.SelectSQL.Add('Select * from MAT where 7=7  ' + Str + SORTFIELD ) ;

        MT.Open ;

 

        Grid.DataSource := DS ;

        MT.Locate('ID_MAT' ,Current_Pos, [loCaseInsensitive] ) ;

end ;

 

 

end.

unit U_MAT_ADD;

 

interface

 

uses

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

  Dialogs, Buttons, ExtCtrls, StdCtrls, Mask, DBCtrls;

 

type

  TMAT_ADD = class(TForm)

    Panel1: TPanel;

    SpeedButton3: TSpeedButton;

    SpeedButton4: TSpeedButton;

    Label1: TLabel;

    DBEdit1: TDBEdit;

    Label2: TLabel;

    DBEdit2: TDBEdit;

    Label3: TLabel;

    DBEdit3: TDBEdit;

    Label4: TLabel;

    DBEdit4: TDBEdit;

    procedure SpeedButton3Click(Sender: TObject);

    procedure SpeedButton4Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  MAT_ADD: TMAT_ADD;

 

implementation

 

uses U_MAT;

 

{$R *.dfm}

 

procedure TMAT_ADD.SpeedButton3Click(Sender: TObject);

begin

  ModalResult := mrOk ;

end;

 

procedure TMAT_ADD.SpeedButton4Click(Sender: TObject);

begin

   ModalResult := mrCancel ;

end;

 

end.

unit U_CLIENT;

 

interface

 

uses

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

  Dialogs, MemTableDataEh, Db, ADODB, MemTableEh, DataDriverEh, ADODataDriverEh,

  Buttons, GridsEh, DBGridEh, ExtCtrls, StdCtrls;

 

type

  TCLIENT = class(TForm)

    GroupBox1: TGroupBox;

    Panel1: TPanel;

    Grid: TDBGridEh;

    BTN_INS: TSpeedButton;

    BTN_ED: TSpeedButton;

    BTN_DEL: TSpeedButton;

    BTN_CLOSE: TSpeedButton;

    DD: TADODataDriverEh;

    MT: TMemTableEh;

    DS: TDataSource;

    MTID_CL: TAutoIncField;

    MTINN: TStringField;

    MTKPP: TStringField;

    MTNAIM: TStringField;

    MTADR: TStringField;

    MTBANK_R: TStringField;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Filter_Gr ;

    procedure GridApplyFilter(Sender: TObject);

    procedure BTN_CLOSEClick(Sender: TObject);

    procedure BTN_INSClick(Sender: TObject);

    procedure BTN_EDClick(Sender: TObject);

    procedure BTN_DELClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  CLIENT: TCLIENT;

 

implementation

 

uses U_DM, Automate, U_CLIENT_ADD;

 

{$R *.dfm}

 

procedure TCLIENT.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  action := cafree;

  CLIENT := nil ;

end;

procedure TCLIENT.FormShow(Sender: TObject);

begin

DataSourceIni(client_ADD, DS) ;

end;

 

procedure TCLIENT.GridApplyFilter(Sender: TObject);

begin

  Filter_Gr;

end;

 

procedure TCLIENT.BTN_CLOSEClick(Sender: TObject);

begin

CLOSE ;

end;

 

procedure TCLIENT.BTN_DELClick(Sender: TObject);

begin

 if MT.State in [dsInsert, dsEdit] then MT.Post ;

 

 If  MessageDlg('Удалить запись',MTCONFIRMATION , [MBYES, MBNO], 0)= mrYes then

   MT.Delete ;

 

   MT.CLOSE ;

   MT.Open;

 

end;

 

procedure TCLIENT.BTN_EDClick(Sender: TObject);

begin

 if MT.State in [dsInsert, dsEdit] then MT.Post ;

 MT.EDIT ;

 if CLIENT_ADD.ShowModal = mrOk then

 begin

   MT.Post ;

   MT.CLOSE ;

   MT.Open;

 end;

 

end;

 

procedure TCLIENT.BTN_INSClick(Sender: TObject);

begin

 if MT.State in [dsInsert, dsEdit] then MT.Post ;

 MT.Insert ;

 if CLIENT_ADD.ShowModal = mrOk then

 begin

   MT.Post ;

   MT.CLOSE ;

   MT.Open;

 end;

 

end;

 

Procedure  TCLIENT.Filter_Gr ;

var

        str: string   ;

        SORTFIELD : STRING ;

        Current_Pos : string ;

begin

        if MT.Active = false then MT.Open;

 

        Filter(Grid ,str , SORTFIELD);

        Current_Pos := MTID_CL.asstring ;

        if Current_Pos ='' then  Current_Pos := '0' ;

 

        Grid.DataSource := nil ;

        MT.Close ;

        DD.SelectSQL.Clear;

        DD.SelectSQL.Add('Select * from CLIENT where 7=7  ' + Str + SORTFIELD ) ;

        MT.Open ;

 

        Grid.DataSource := DS ;

        MT.Locate('ID_CL' ,Current_Pos, [loCaseInsensitive] ) ;

end ;

 

 

end.

unit U_CLIENT_ADD;

 

interface

 

uses

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

  Dialogs, Buttons, ExtCtrls, StdCtrls, Mask, DBCtrls;

 

type

  TCLIENT_ADD = class(TForm)

    Panel1: TPanel;

    SpeedButton3: TSpeedButton;

    SpeedButton4: TSpeedButton;

    Label1: TLabel;

    DBEdit1: TDBEdit;

    Label2: TLabel;

    DBEdit2: TDBEdit;

    Label3: TLabel;

    DBEdit3: TDBEdit;

    Label4: TLabel;

    DBEdit4: TDBEdit;

    Label5: TLabel;

    DBEdit5: TDBEdit;

    procedure SpeedButton3Click(Sender: TObject);

    procedure SpeedButton4Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  CLIENT_ADD: TCLIENT_ADD;

 

implementation

 

uses U_CLIENT;

 

{$R *.dfm}

 

procedure TCLIENT_ADD.SpeedButton3Click(Sender: TObject);

begin

  ModalResult := mrOk ;

end;

 

procedure TCLIENT_ADD.SpeedButton4Click(Sender: TObject);

begin

   ModalResult := mrCancel ;

end;

 

end.

unit Automate;

 

 

interface

uses db,Sysutils, dbgrideh, Dialogs,controls, forms, DBCtrls, DBCtrlsEh, DBLookupEh, ComObj, Variants;

 

type

  TWordReplaceFlags = set of (wrfReplaceAll, wrfMatchCase, wrfMatchWildcards);

   TArrayString = array of string;

 

 

 

function   Pars_Str(Str: string; D_T:  TFieldType): string ; // разбор строки из фильтра для поиска знаков сравнения

Function Error_text(Error_in: string ): String; // Обработчик ошибок. Возвращает нормальный комментарий

Procedure  Filter(Grid: TDBGridEh ; Var Str,  SORTFIELD : string  ) ;  // фильтр + сортировка //

procedure  Error_f(Sender: TObject) ;  // обработка ошибок

function DATE_ADD(DATE: TDatetime; Part: string; AddValue: integer) : TDateTime ; // Добавляет значение к дате

Procedure DataSourceIni(FORM : TFORM; DS: TDataSource ); // выполняется инициализация DataSource на форме (если DataSource принадлежить другой форме)

function Word_StringReplace(ADocument: TFileName; SearchString, ReplaceString: TArrayString; Flags: TWordReplaceFlags): Boolean;// Заменяет в WORD одно слово на другое

 

 

 

implementation

 

 

function Word_StringReplace(ADocument: TFileName; SearchString, ReplaceString: TArrayString; Flags: TWordReplaceFlags): Boolean;

const

  wdFindContinue = 1;

  wdReplaceOne = 1;

  wdReplaceAll = 2;

  wdDoNotSaveChanges = 0;

var

  WordApp: OLEVariant;

  I: INTEGER;

begin

  Result := False;

 

  ADocument := ExtractFilePath(application.ExeName) + '\' +ADocument ; // добавляет путь к  файлу

 

  { Check if file exists }

  if not FileExists(ADocument) then

  begin

    ShowMessage('Specified Document not found.');

    Exit;

  end;

 

  { Create the OLE Object }

  try

    WordApp := CreateOLEObject('Word.Application');

  except

    on E: Exception do

    begin

      E.Message := 'Word is not available.';

      raise;

    end;

  end;

 

  try

    { Hide Word }

    WordApp.Visible := TRUE;

    { Open the document }

    WordApp.Documents.Add(Template := ADocument);

   //  WordApp.Documents.Open(ADocument);

 

    FOR I := 0 TO LENGTH(SearchString)-1 DO

    BEGIN

    WordApp.Selection.Find.ClearFormatting;

 

    WordApp.Selection.Find.Text := SearchString[I];

    WordApp.Selection.Find.Replacement.Text := ReplaceString[I];

 

    WordApp.Selection.Find.Forward := True;

    WordApp.Selection.Find.Wrap := wdFindContinue;

    WordApp.Selection.Find.Format := False;

    WordApp.Selection.Find.MatchCase := wrfMatchCase in Flags;

    WordApp.Selection.Find.MatchWholeWord := False;

    WordApp.Selection.Find.MatchWildcards := wrfMatchWildcards in Flags;

    WordApp.Selection.Find.MatchSoundsLike := False;

    WordApp.Selection.Find.MatchAllWordForms := False;

    { Perform the search}

    if wrfReplaceAll in Flags then

      WordApp.Selection.Find.Execute(Replace := wdReplaceAll)

    else

      WordApp.Selection.Find.Execute(Replace := wdReplaceOne);

 

    END;

    { Save word }

    // WordApp.ActiveDocument.SaveAs(ADocument);

    { Assume that successful }

    Result := True;

    { Close the document }

    // WordApp.ActiveDocument.Close(wdDoNotSaveChanges);

  finally

    { Quit Word }

    // WordApp.Quit;

    WordApp := Unassigned;

  end;

end;

 

 

 

procedure Error_f(Sender: TObject) ;  // обработка ошибок

Begin

         ShowMessage('Правильно введите реквизиты документа !!! ') ;

        (sender as TWinControl).SetFocus ;

         Abort ;

end ;

 

Function Error_text(Error_in: string ): String;

var Error_Array: Array[1..3, 1..2] of string ;

    i: integer;

Begin

{ Функция сравнивает системный  текст ошибки и заменяет на  понятный юзеру :)

  Надо бы поискать, как вернуть  код ошибки ... }

  Error_Array[1, 1] := 'Violation of PRIMARY KEY constraint' ;

  Error_Array[1, 2] := 'Ключевое поле не уникально.' ;

 

  Error_Array[2, 1] := 'Cannot insert the value NULL into column' ;

  Error_Array[2, 2] := 'Поле не может содержать пустое значение.' ;

 

  Error_Array[3, 1] := 'DELETE statement conflicted with COLUMN REFERENCE constraint' ;

  Error_Array[3, 2] := 'Удаление не возможно пока существуют зависимые данные в других таблицах.' ;

 

 

 

 

 

  Result := '' ;

  For i := 1  to 3 do

  Begin

    if  Pos( Error_Array[i, 1] ,Error_in) >0 then // если в тексте ошибки найдена подстрока

    Begin

      Result :=  Error_Array[i, 2];

      Break ;

    End;

  End;

end;

 

function Pars_Str(Str: string; D_T:  TFieldType): string ; // разбор строки из фильтра для поиска знаков сравнения

var

        A: array[1..5] of string ;

        i : integer;

        Zn, Str_c : string ;

Begin

        A[1] := '>' ; A[2] := '<' ; A[3] := '>=' ; A[4] := '<=' ; A[5] := '<>' ;

        Zn := '' ;

        for i := 1 to 5 do

        Begin

                if pos(A[i],Str) <> 0 then

                Begin

                        Zn := A[i] ;

                        if i >2 then // обрезает знак

                                Str_c := copy(Str ,pos(A[i],Str)+2  , length(Str) )

                        else

                                Str_c := copy(Str ,pos(A[i],Str)+1  , length(Str) )

                end ;

        end;

 

        if Zn = '' then

        Begin // если нет знака

            if  (D_T = ftString) or (D_T = ftwideString) then result := ' like ' + QuotedStr('%'+Str+'%')

            else

            if  D_T = ftDateTime then result := ' = ' + QuotedStr(Str)

            else

                result := ' = ' + (Str) ;

        end

        else

        Begin // если есть знак

            if  D_T = ftDateTime then result := Zn + QuotedStr(Str_c)

            else

            if  (D_T = ftString) or (D_T = ftwideString) then result := Zn + QuotedStr(Str_c)

            else

                result := Zn + (Str_c) ;

        end ;

end ;

 

 

Procedure  Filter(Grid: TDBGridEh ; Var Str , SORTFIELD : string  ) ;  // фильтр + сортировка //

var

        i : integer ;

begin

        // Фильтр

        str := '' ;

        for i := 0 to Grid.Columns.Count-1 do

        Begin

              if Grid.Columns[i].STFilter.ExpressionStr <> '' then

                Begin

 

                        if Grid.Columns[i].STFilter.ExpressionStr = '<>Null' then

                                Str := Str + ' and '+ Grid.Columns[i].FieldName+ '<>Null'

                        else

                        if Grid.Columns[i].STFilter.ExpressionStr = '=Null' then

                                Str := Str + ' and '+ Grid.Columns[i].FieldName+ '=Null'

                        else

                                Str := Str + ' and '+Grid.Columns[i].FieldName + Pars_Str(Grid.Columns[i].STFilter.ExpressionStr,Grid.Columns[i].Field.DataType );

                end ;

        end ;

 

       // сортировка

       SORTFIELD := '';

       for i := 0 to Grid.SortMarkedColumns.Count-1 do

       Begin

                  if Grid.SortMarkedColumns[i].Title.SortMarker = smDownEh then

                                SORTFIELD := SORTFIELD + Grid.SortMarkedColumns[i].FieldName + ' DESC , '

                  else

                                SORTFIELD := SORTFIELD + Grid.SortMarkedColumns[i].FieldName + ', ';

       end;

       if SORTFIELD <> '' then SORTFIELD := ' ORDER BY ' + Copy(SORTFIELD,1,Length(SORTFIELD)-2);

end ;

 

 

function DATE_ADD(DATE: TDatetime; Part: string; AddValue: integer) : TDateTime ;

var

  YEAR, MONTH, DAY : word ;

Begin

  DecodeDate(DATE,YEAR,MONTH,DAY);

  if Part = 'YEAR' then YEAR := YEAR + AddValue ;

  // Сюда добавить остальные

  Result := EncodeDate(Year,MONTH,DAY);

End;

 

 

Procedure DataSourceIni(FORM : TFORM; DS: TDataSource );

var i : integer ;

begin

//

  for I := 0 to FORM.ComponentCount - 1 do

  begin

     if FORM.Components[i] is Tdbedit then

       (FORM.Components[i] as  Tdbedit).DataSource := DS ;

     if FORM.Components[i] is TDBDateTimeEditEh then

       (FORM.Components[i] as  TDBDateTimeEditEh).DataSource := DS ;

     if FORM.Components[i] is TDBNumberEditEh then

       (FORM.Components[i] as  TDBNumberEditEh).DataSource := DS ;

     if FORM.Components[i] is TDBLookupComboboxEh then

       (FORM.Components[i] as  TDBLookupComboboxEh).DataSource := DS ;

     if FORM.Components[i] is TDBComboBoxEh then

       (FORM.Components[i] as  TDBComboBoxEh).DataSource := DS ;

 

 

  end;

 

 

 

End;

 

 

end.

unit U_GP;

 

interface

 

uses

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

  Dialogs, MemTableDataEh, Db, ADODB, MemTableEh, DataDriverEh, ADODataDriverEh,

  Buttons, GridsEh, DBGridEh, ExtCtrls, StdCtrls;

 

type

  TGP = class(TForm)

    GroupBox1: TGroupBox;

    Panel1: TPanel;

    Grid: TDBGridEh;

    BTN_INS: TSpeedButton;

    BTN_ED: TSpeedButton;

    BTN_DEL: TSpeedButton;

    BTN_CLOSE: TSpeedButton;

    DD: TADODataDriverEh;

    MT: TMemTableEh;

    DS: TDataSource;

    MTID_PROD: TAutoIncField;

    MTNAIM: TStringField;

    MTEI: TStringField;

    MTHAR: TStringField;

    GroupBox2: TGroupBox;

    Panel2: TPanel;

    SpeedButton1: TSpeedButton;

    SpeedButton2: TSpeedButton;

    SpeedButton3: TSpeedButton;

    GRID1: TDBGridEh;

    DD1: TADODataDriverEh;

    MT1: TMemTableEh;

    DS1: TDataSource;

    MT1ID_SOST: TAutoIncField;

    MT1ID_PROD: TIntegerField;

    MT1ID_MAT: TIntegerField;

    MT1KOL: TFloatField;

    MT1NAIM: TStringField;

    MT1EI: TStringField;

    MemTableEh1: TMemTableEh;

    ADODataDriverEh1: TADODataDriverEh;

    DataSource1: TDataSource;

    MemTableEh1ID_MAT: TAutoIncField;

    MemTableEh1EI: TStringField;

    MemTableEh1NAIM: TStringField;

    MemTableEh1HAR: TStringField;

    MT1NAIM_MAT: TStringField;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure Filter_Gr ;

    procedure GridApplyFilter(Sender: TObject);

    procedure BTN_CLOSEClick(Sender: TObject);

    procedure BTN_INSClick(Sender: TObject);

    procedure BTN_EDClick(Sender: TObject);

    procedure BTN_DELClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure SpeedButton3Click(Sender: TObject);

    procedure SpeedButton1Click(Sender: TObject);

    procedure SpeedButton2Click(Sender: TObject);

    procedure MT1AfterInsert(DataSet: TDataSet);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  GP: TGP;

 

implementation

 

uses U_DM, Automate, U_GP_ADD;

 

{$R *.dfm}

 

procedure TGP.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  action := cafree;

  GP := nil ;

end;

procedure TGP.FormShow(Sender: TObject);

begin

DataSourceIni(GP_ADD, DS) ;

end;

 

procedure TGP.GridApplyFilter(Sender: TObject);

begin

  Filter_Gr;

end;

 

procedure TGP.MT1AfterInsert(DataSet: TDataSet);

begin

MT1ID_PROD.AsInteger := MTID_PROD.AsInteger;

end;

 

procedure TGP.SpeedButton1Click(Sender: TObject);

begin

 if MT1.State in [dsInsert, dsEdit] then MT1.Post ;

 MT1.Insert ;

end;

 

procedure TGP.SpeedButton2Click(Sender: TObject);

begin

 if MT1.State in [dsInsert, dsEdit] then MT1.Post ;

 MT1.edit ;

 

end;

 

procedure TGP.SpeedButton3Click(Sender: TObject);

begin

 if MT1.State in [dsInsert, dsEdit] then MT1.Post ;

 

 If  MessageDlg('Удалить запись',MTCONFIRMATION , [MBYES, MBNO], 0)= mrYes then

   MT1.Delete ;

 

   MT1.CLOSE ;

   MT1.Open;

end;

 

procedure TGP.BTN_CLOSEClick(Sender: TObject);

begin

CLOSE ;

end;

 

procedure TGP.BTN_DELClick(Sender: TObject);

begin

 if MT.State in [dsInsert, dsEdit] then MT.Post ;

 

 If  MessageDlg('Удалить запись',MTCONFIRMATION , [MBYES, MBNO], 0)= mrYes then

   MT.Delete ;

 

   MT.CLOSE ;

   MT.Open;

 

end;

 

procedure TGP.BTN_EDClick(Sender: TObject);

begin

 if MT.State in [dsInsert, dsEdit] then MT.Post ;

 MT.EDIT ;

 if GP_ADD.ShowModal = mrOk then

 begin

   MT.Post ;

   MT.CLOSE ;

   MT.Open;