Разработка автоматизированной системы заполнения первичной документации предприятия

If Exec = False Then

begin

Exec := True;

Del_Q := mrYes;

If CL_Click = False Then

begin

If (B_Many.Checked = True) And (TAMode <> am_None) And (CH_F2 = False) Then

If Application.MessageBox('Перед вводом/редактированием списка товаров и услуг на накладную, необходимо сохранить ее. Продолжить?',

'D-Art: Aurora',mb_IconQuestion + mb_YesNo) = mrYes Then

Repeat

CH_F := False; //Можно убрать флажок

If Del_Q = mrYes Then No_Adding := True; //Пока не добавляли записи

SV_Click := True;

DB_Data.Many.Value := 'Да';

Try

DB_Data.N_Gen.Post;

DB_Data.N_Gen.UpdateBatch;

With DB_Data Do Sub_Program.Write_Stat(N_Gen,Primtabs,GEneral.Gen_Stat);

Except

Screen.Cursor := crDefault;

Application.MessageBox('Не удается сохранить изменения в таблице. Возможно введен неуникальный номер накладной, исправьте его и попробуйте ещё раз.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

DB_Data.N_Gen.Edit;

DB_Data.Many.Value := 'Нет';

Exec := False;

CH_F := True;

DB_Data.Num.Value := Right_Num;

SV_Click := False;

//Выбираем оъект для предачи фокуса ввода

Case View_Mode of

vm_TR,vm_RO : Nucll.FocusControl(Nucll.E_Num); //Предаем фокус ввода первому полю редактора

vm_TO : Nucll.FocusControl(Nucll.Grid); //Предаем фокус ввода сетке

End; //Case

Abort;

End;

SV_Click := False;

DB_Data.N_Gen.Edit;

SM_Res := Many_List.ShowModal; //Показвываем окно

If SM_Res = mrCancel Then

begin

//Закрыли нажатием кнопки Cancel

if No_Adding = False Then

Del_Q := Application.MessageBox(PChar('Прекратить ввод списка товаров и услуг для накладной №'+ DB_Data.Num.AsString +' и удалить все записи?'),

'D-Art: Aurora',mb_YesNo+mb_IconExclamation+mb_DefButton2)

Else Del_Q := idYes;

Cancel_Input;

end;

If (No_Adding = True) And (SM_Res = mrOk) Then

begin

//Не добавили ни одной записи

Del_Q := Application.MessageBox(PChar('Не было добавлено ни одной записи. Прекратить редактирование списка товаров и услуг для накладной №'+DB_Data.Num.Asstring+'?'),

'D-Art: Aurora',mb_YesNo+mb_IconExclamation+mb_DefButton2);

Cancel_Input;

if Del_Q = idNo Then SM_Res := mrCancel;

end;

If (No_Adding = False) And (SM_Res = mrOk) Then

begin

if M_Mode <> mrNone Then

begin

DB_Data.N_MIO.Post;

M_Mode := mr_None;

end;

DB_Data.Sum.Value := StrToFloat(Many_List.Edit1.Text);

end;

DB_Data.N_MIO.UpdateBatch;

Until ((SM_Res = mrOk) and (No_Adding = False)) or (Del_Q = idYes)

Else

begin

CH_F := True;

DB_Data.Many.Value := 'Нет';

CH_F2 := False;

end;

end

Else

begin

CH_F := False; //Можно убрать флажок

CL_Click := False;

end;

//При снятии флажка

If (B_Many.Checked = False) And (TAMode <> am_None) And (CH_F = False) And (SMM = False) Then

begin

If CL_Click = False Then

begin

Del_Q := Application.MessageBox(PChar('Удалить список товаров и услуг для накладной №' + DB_Data.Num.AsString + '?'),

'D-Art: Aurora',mb_YesNo+mb_IconExclamation+mb_DefButton2);

If Del_Q = idYes Then

begin

CH_F2 := False;

DB_Data.N_MIO.First;

While not DB_Data.N_MIO.Eof do DB_Data.N_MIO.Delete;

end

Else

begin

CH_F2 := True;

DB_Data.Many.Value := 'Да';

CH_F := False;

end;

end

Else

begin

CH_F2 := False;

DB_Data.N_MIO.First;

While not DB_Data.N_MIO.Eof do DB_Data.N_MIO.Delete;

CL_Click := False;

end;

end;

Exec := False;

end;

end;

{procedure ReFresh_Tab(NewVal: string);

begin

if View_Mode = vm_TR Then Nucll.Ap_Button.Focused;

//Обновляем номера накладных в таблице С.М.Т.

DB_Data.Fresh_ML.Parameters[0].Value := StrToInt(NewVal); //Новое значение

DB_Data.Fresh_ML.Parameters[1].Value := Num_Ins; //Старое значение

DB_Data.Fresh_ML.ExecSQL; //Выполняем запрос

DB_Data.N_MiO.Requery; //Обновляем таблицу

end;}

procedure TNucll.Lst_ManyClick(Sender: TObject);

var Old_Left : integer;

begin

{ If Application.MessageBox('Перед вводом/редактированием списка товаров и услуг на накладную, необходимо сохранить ее. Продолжить?',

'D-Art: Aurora',mb_IconQuestion + mb_YesNo) = mrYes Then

begin

{DB_Data.N_MIO.Active := False;

DB_Data.N_MIO.MasterFields := '';

DB_Data.N_MIO.Active := True;

SV_Click := True;

Try_SV; //Процедура

{DB_Data.N_MIO.Active := False;

DB_Data.N_MIO.MasterFields := 'Num';

DB_Data.N_MIO.Active := True;

DB_Data.N_Gen.Edit;}

Old_Left := Many_List.Ok_b.Left; //Запоминаем положение кнопки Ok

Many_List.Ok_b.Left := Many_List.Cancel_b.Left; //Меняем положение кнопки Ok}

Many_List.Cancel_b.Visible := False; //Прячем кнопку Отмена

//Показываем окно

Many_List.ShowModal;

If M_Mode <> mrNone Then

DB_Data.N_MIO.Post; //Сохраняем изменениня в таблице, если этого не сделал пользователь

//DB_Data.N_MIO.UpdateBatch;

DB_Data.Sum.Value := StrToFloat(Many_List.Edit1.Text);

If DB_Data.N_MIO.RecordCount = 0 Then

begin

SMM := True;

CL_Click := False;

DB_Data.Many.Value := 'Нет';

SMM := False;

Try

SV_Click := True;

DB_Data.N_Gen.Post;

DB_Data.N_Gen.UpdateBatch;

SV_Click := False;

Except

End;

DB_Data.N_Gen.Edit;

end;

M_Mode := mr_None; //Фиксируем сохранение

Many_List.Ok_b.Left := Old_Left; //Восстанавливаем положение кнопки Ok

Many_List.Cancel_b.Visible := True; //Показываем кнопку Отмена}

DB_Data.Sum.Value := StrToFloat(Many_List.Edit1.Text);

//end;

end;

procedure TNucll.Work_AClick(Sender: TObject);

begin

If NoATL = False Then

With DB_Data do

If Sub_Program.A_LST(T_Work,W_List,L_Work.Text,L_Work,1) <> False Then

Many_List.Wk_Many.Items.Add(L_Work.Text);

end;

procedure TNucll.Client_BClick(Sender: TObject);

begin

Sub_Program.Show_ListRed(0,True); //Показываем окно редактора списков с нужным списком

end;

procedure TNucll.Client_AClick(Sender: TObject);

begin

With DB_Data do Sub_Program.A_LST(T_Client,C_List,L_Client.Text,L_Client,2);

end;

procedure TNucll.FioO_BClick(Sender: TObject);

begin

Sub_Program.Show_ListRed(2,True); //Показываем окно редактора списков с нужным списком

end;

procedure TNucll.FioO_AClick(Sender: TObject);

begin

With DB_Data do Sub_Program.A_LST(T_FioO,FO_List,L_FioO.Text,L_FioO,4); //Добавляем запись в список

end;

procedure TNucll.StatO_AClick(Sender: TObject);

begin

With DB_Data do Sub_Program.A_LST(T_StatO,SO_List,L_StatO.Text,L_StatO,5);

end;

procedure TNucll.StatO_BClick(Sender: TObject);

begin

Sub_Program.Show_ListRed(1,True); //Показываем окно редактора списков с нужным списком

end;

procedure TNucll.StatP_BClick(Sender: TObject);

begin

Sub_Program.Show_ListRed(3,True); //Показываем окно редактора списков с нужным списком

end;

procedure TNucll.StatP_AClick(Sender: TObject);

begin

With DB_Data do Sub_Program.A_LST(T_StatP,SP_List,L_StatP.Text,L_StatP,3);

end;

procedure TNucll.Red_LSTClick(Sender: TObject);

begin

With DB_Data do

//Определяем номер ячейки с фокусом и заполняем списки

Case Grid.Columns.Grid.SelectedIndex of

3 : Sub_Program.Show_ListRed(4,True); //Показываем окно редактора списков с нужным списком

4 : Sub_Program.Show_ListRed(0,True);

5 : Sub_Program.Show_ListRed(2,True);

6 : Sub_Program.Show_ListRed(1,True);

8 : Sub_Program.Show_ListRed(3,True);

Else Sub_Program.Show_ListRed(0,True);

End;

end;

procedure TNucll.MoveBy_PClick(Sender: TObject);

begin

Sub_Program.MBR(1);

end;

procedure TNucll.MoveBy_NClick(Sender: TObject);

begin

Sub_Program.MBR(2);

end;

procedure TNucll.E_NumEnter(Sender: TObject);

begin

NoATL := True;

{If error_save = False Then Field_val := E_Num.Text

Else error_save := False;

Nucll.Caption := Field_Val

//Num_Ins := StrToInt(E_Num.Text);}

end;

procedure TNucll.E_NumExit(Sender: TObject);

begin

NoATL := False;

//ReFresh_Tab(E_Num.Text);

end;

procedure TNucll.GridExit(Sender: TObject);

begin

Sub_Program.Colum_Adress; //Проверяем расположение столбцов

InGRD := False;

end;

procedure TNucll.GridEnter(Sender: TObject);

begin

{ If Grid.Columns.Grid.SelectedIndex = 0 Then

Num_Ins := Grid.Columns.Grid.SelectedField.Value;

Sub_Program.Colum_Adress;

Then Grid.Columns.Grid.SelectedIndex of

CN[6] CN[7],CN[8],CN[9],CN[10],CN[11]: Field_val := Grid.Columns.Grid.SelectedField.Value;}

InGRD := True;

Field_val := Grid.Columns.Grid.SelectedField.Value;

end;

procedure TNucll.MB_LSTMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Nucll.FocusControl(Ap_Button);

end;

procedure TNucll.GridDblClick(Sender: TObject);

begin

Try

//Переводим таблицу в режим редактирования

DB_Data.N_Gen.Edit;

Right_num := DB_Data.Num.Value;

Nucll.FocusControl(Grid.Columns.Grid);

Except

Application.MessageBox('Не удается превести запись в режим редактирования.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

Abort;

End;

end;

procedure TNucll.HelpClick(Sender: TObject);

begin

//Отменяем сделанные изменения

If TAMode = am_Add Then SV_Click := True

Else SV_Click := False;

CL_Click := True;

DB_DAta.N_Gen.CancelBatch;

DB_Data.N_MIO.CancelBatch;

DB_Data.N_MIO.Requery;

If TAMode <> am_None Then DB_Data.N_Gen.Edit;

end;

procedure TNucll.E_SumEnter(Sender: TObject);

begin

NoATL := True;

Field_Val := E_Sum.Text;

end;

procedure TNucll.E_DateEnter(Sender: TObject);

begin

NoATL := True;

Field_Val := E_Date.Text;

end;

procedure TNucll.E_DateExit(Sender: TObject);

begin

//DB_Data.FDateSetText(DB_Data.FDate,E_Date.Text);

NoATL := False; end; end.

//ПРОЕКТ "AURORA"

//Модуль данных - объекты для работы с БД

unit Av_DBData;

interface

uses

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

Dialogs, ComCtrls, ToolWin, ExtCtrls, DB, ADODB, DBGrids;

type

TStr_UP = Function(S: PChar): PChar; stdcall;

//TInsstr = Function(SubS, S: PChar; Index: integer): PChar; stdcall;

TSS = Set of Char;

TDB_Data = class(TDataModule)

Nuclls: TADOConnection;

N_Gen: TADOTable;

N_MIO: TADOTable;

DS_Gen: TDataSource;

Num: TIntegerField;

Client: TWideStringField;

Fio_P: TWideStringField;

Stat_P: TWideStringField;

Fio_O: TWideStringField;

Stat_O: TWideStringField;

NDS_Sum: TCurrencyField;

Lists: TADOConnection;

DS_Work: TDataSource;

T_Client: TADOTable;

DS_Client: TDataSource;

Without_NDS: TCurrencyField;

End_Sum: TCurrencyField;

T_FioO: TADOTable;

DS_FioO: TDataSource;

T_StatO: TADOTable;

DS_StatO: TDataSource;

T_StatP: TADOTable;

DS_StatP: TDataSource;

T_Work: TADOTable;

W_List: TWideStringField;

FO_List: TWideStringField;

SO_List: TWideStringField;

SP_List: TWideStringField;

NSP: TWideStringField;

Sile: TWideStringField;

Many: TWideStringField;

Max_Num: TADOQuery;

MN: TIntegerField;

DS_MIO: TDataSource;

M_Values: TWideStringField;

M_SW: TBCDField;

C_List: TWideStringField;

AllSum: TFloatField;

Sectabs: TADOQuery;

Primtabs: TADOQuery;

Id: TAutoIncField;

N_MIOMInc: TAutoIncField;

M_id: TIntegerField;

Querys: TADOConnection;

Q_Teach: TADOTable;

DS_Teach: TDataSource;

Q_Teachinc: TAutoIncField;

Fields: TWideStringField;

Teach_F: TWideStringField;

Id_tab: TWideStringField;

Del_Query: TADOQuery;

QOU: TADOQuery;

DS_QOU: TDataSource;

Teach_V: TStringField;

DT: TWordField;

Selnull: TBooleanField;

NewData: TWideStringField;

Lng: TIntegerField;

QTValues: TWideStringField;

Ed_Query: TADOQuery;

Sum: TBCDField;

Work: TWideStringField;

FDate: TDateTimeField;

Teach_USL: TMemoField;

Mnds: TCurrencyField;

MWnds: TCurrencyField;

Lk_use: TBooleanField;

str_date: TStringField;

Q_Rep: TADOQuery;

QRep_DS: TDataSource;

M_count: TIntegerField;

Q_RepExpr1000: TBCDField;

Q_RepTWork: TWideStringField;

Q_RepNumpp: TIntegerField;

Q_RepExpr1002: TBCDField;

Q_Rep2: TADOQuery;

DS_QR2: TDataSource;

Q_Rep2Expr1000: TBCDField;

Q_Rep2TWork: TWideStringField;

Q_Rep2Expr1002: TIntegerField;

Q_Rep2Numpp: TIntegerField;

Del_ALLT: TADOQuery;

procedure N_GenCalcFields(DataSet: TDataSet);

procedure NumValidate(Sender: TField);

procedure N_GenBeforeScroll(DataSet: TDataSet);

procedure N_GenAfterPost(DataSet: TDataSet);

procedure N_GenAfterEdit(DataSet: TDataSet);

procedure FDateValidate(Sender: TField);

procedure N_GenPostError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

procedure N_GenNewRecord(DataSet: TDataSet);

procedure N_GenAfterInsert(DataSet: TDataSet);

procedure NSPValidate(Sender: TField);

procedure SileValidate(Sender: TField);

procedure ManyValidate(Sender: TField);

procedure SumValidate(Sender: TField);

procedure N_MIONewRecord(DataSet: TDataSet);

procedure N_GenBeforePost(DataSet: TDataSet);

procedure N_GenBeforeEdit(DataSet: TDataSet);

procedure N_GenAfterDelete(DataSet: TDataSet);

procedure N_GenBeforeDelete(DataSet: TDataSet);

procedure N_GenDeleteError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

procedure N_GenEditError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

procedure T_WorkBeforePost(DataSet: TDataSet);

procedure N_GenAfterScroll(DataSet: TDataSet);

procedure N_MIOAfterInsert(DataSet: TDataSet);

procedure N_MIOPostError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

procedure N_MIOAfterPost(DataSet: TDataSet);

procedure N_MIOAfterScroll(DataSet: TDataSet);

procedure N_MIOCalcFields(DataSet: TDataSet);

procedure N_MIOBeforePost(DataSet: TDataSet);

procedure Q_TeachCalcFields(DataSet: TDataSet);

procedure Q_TeachAfterScroll(DataSet: TDataSet);

procedure QTValuesChange(Sender: TField);

procedure Q_TeachBeforePost(DataSet: TDataSet);

procedure FDateSetText(Sender: TField; const Text: String);

Function Ins_Str(SubS, S: string; Index: integer): string;

procedure Q_RepCalcFields(DataSet: TDataSet);

procedure Q_Rep2CalcFields(DataSet: TDataSet);

procedure QOUAfterOpen(DataSet: TDataSet);

private

{ Private declarations }

public

{ Public declarations }

end;

var

DB_Data: TDB_Data;

Nds_v, Nsp_v: real;

RD : TDateTime;

SV_Qes : integer;

//Old_Val : Array[1..12] of Variant;

Str_UP : TStr_UP;

Txt_UP : String;

No_SV, DoPR, error_save, DOQAS, UB_MIO : boolean;

implementation

uses Av_Nuclls, Av_General, Sub_Program, Calend, Av_Data, Av_ListRed,

Av_ManyW, Av_Querys, Av_QLibrary;

{$R *.dfm}

procedure TDB_Data.N_GenCalcFields(DataSet: TDataSet);

begin

NDS_Sum.Value := Sum.Value - (Sum.Value*100)/(100 + 100 * Nds_v); //Сумма НДС

Without_NDS.Value := Sum.Value - NDS_Sum.Value; //Сумма без НДС

If NSP.Value = 'Да' Then

End_Sum.Value := Sum.Value + (Sum.Value * Nsp_v) //Итоговая сумма

Else

End_Sum.Value := Sum.Value;

//Формируем текстовое представление даты

If FDate.AsString <> '' Then str_date.Value := Sub_Program.D_STR(FDate.AsString);

end;

procedure TDB_Data.NumValidate(Sender: TField);

begin

//Определяем правильность номера накладной

If Num.Value <= 0 Then

begin

Nucll.E_Num.Text := Right_num;

Nucll.Grid.Columns.Grid.SelectedField.Value := Right_num;

Application.MessageBox('Неверное значение! Номер накладной введен неправильно.','D-Art: Aurora',mb_Ok + mb_IconHand);

Abort;

end;

end;

procedure NoAccess;

begin

TAMode := am_None;//Фиксируем сохранение

Nucll.Grid.Options := [dgTitles,dgIndicator,dgColumnResize,dgColLines,

dgRowLines,dgTabs,dgRowSelect,dgAlwaysShowSelection,

dgCancelOnExit];

end;

procedure TDB_Data.N_GenBeforeScroll(DataSet: TDataSet);

begin

//Записываем технические данные

If TAMode <> am_None Then N_GenBeforePost(N_Gen);

{begin

N_Gen.Edit; //Перводим таблицу в режим редактирования

RD := StrToDate(FDate.Value); //Преобразуем дату в правильный формат

FDate.Value := DateToStr(RD);

Sub_Program.Date_Val; //Вычисляем значения дня, месяца и года

Real_Sum.Value := End_Sum.Value;

N_Gen.Post; //Сохраняем изменения в таблице}

NoAccess;

Deactive_Ed; //Показываем сохранение

//end;}

CH_F := False; //Можно снимать флажок мно-ва работ

CH_F2 := False; //Можно устанавливать флажок

Screen.Cursor := crDefault;

end;

procedure TDB_Data.N_GenAfterPost(DataSet: TDataSet);

begin

//Показываем сохраненение

NoAccess;

Deactive_Ed;

CH_F := False; //Можно снимать флажок мно-ва работ

CH_F2 := False; //Можно устанавливать флажок}

Screen.Cursor := crDefault;

If SV_Click = False Then

begin

Try

N_Gen.UpdateBatch;

Sub_Program.Write_Stat(N_Gen,Primtabs,GEneral.Gen_Stat);

Except

error_save := true;

Screen.Cursor := crDefault;

Application.MessageBox('Не удается сохранить изменения в таблице. Возможно введен неуникальный номер накладной, исправьте его и попробуйте ещё раз.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

DB_Data.N_Gen.Edit;

Num.Value := Right_num;

SV_Click := False;

//Выбираем оъект для предачи фокуса ввода

Case View_Mode of

vm_TR,vm_RO : Nucll.FocusControl(Nucll.E_Num); //Предаем фокус ввода первому полю редактора

vm_TO : Nucll.FocusControl(Nucll.Grid); //Предаем фокус ввода сетке

End; //Case

Abort;

End;

end;

CL_Click := False;

SV_Click := False;

Cancel_Cls := False; //Можно закрыть окно

end;

procedure TDB_Data.N_GenAfterEdit(DataSet: TDataSet);

begin

TAMode := am_Edit; //Фиксируем режим редактирования

SV_Click := False;

Nucll.Grid.Options := [dgEditing,dgAlwaysShowEditor,dgTitles,dgIndicator,dgColumnResize,

dgColLines,dgRowLines,dgTabs,dgAlwaysShowSelection,dgCancelOnExit];

//Показываем режим редактирования

Active_Ed;

Screen.Cursor := crDefault;

end;

procedure TDB_Data.FDateValidate(Sender: TField);

var RD1 : TDateTime;

begin

Try

RD1 := Sender.Value;

Except

Nucll.E_Date.Text := Field_val;

If InGRD = True Then Nucll.Grid.Columns.Grid.SelectedField.Value := Field_val;

Application.MessageBox('Не верное значение даты выписки! Воспользуйтесь календарем для ввода даты.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

Abort;

End;

end;

procedure TDB_Data.N_GenPostError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

begin

{Screen.Cursor := crDefault;

Application.MessageBox('Не удается сохранить изменения в таблице. Возможно введен неуникальный номер накладной.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

SV_Click := False;

Abort;

//Выбираем оъект для предачи фокуса ввода

Case View_Mode of

vm_TR,vm_RO : Nucll.FocusControl(Nucll.E_Num); //Предаем фокус ввода первому полю редактора

vm_TO : Nucll.FocusControl(Nucll.Grid); //Предаем фокус ввода сетке

End; //Case}

end;

procedure TDB_Data.N_GenNewRecord(DataSet: TDataSet);

begin

Num.Value := MN.Value + 1; //Увиличиваем номер на 1 и вставляем в таблицу

FDate.Value := Date; //Вставляем текущую дату

Sum.Value := 0.00; //Вставляем начальную сумму

NSP.Value := 'Нет'; //НСП

Many.Value := 'Нет'; //Множественность записей

Sile.Value := 'Нет'; //Отметка об уплате

Num_Ins := DB_Data.Num.Value;

end;

procedure TDB_Data.N_GenAfterInsert(DataSet: TDataSet);

begin

TAMode := am_Add; //Фиксируем режим добавления

Nucll.Grid.Options := [dgEditing,dgAlwaysShowEditor,dgTitles,dgIndicator,dgColumnResize,

dgColLines,dgRowLines,dgTabs,dgAlwaysShowSelection,dgCancelOnExit];

//Показываем режим добавления

Active_Ed;

Screen.Cursor := crDefault;

end;

procedure TDB_Data.NSPValidate(Sender: TField);

begin

//Проверяем правильность значений логических полей

Sub_Program.Bool_ValiDate(NSP);

end;

procedure TDB_Data.SileValidate(Sender: TField);

begin

Sub_Program.Bool_ValiDate(Sile);

end;

procedure TDB_Data.ManyValidate(Sender: TField);

begin

Sub_Program.Bool_ValiDate(Many);

end;

procedure TDB_Data.SumValidate(Sender: TField);

begin

//Проверяем правильность введенной суммы

If Sum.Value < 0 Then

begin

Nucll.E_Sum.Text := Field_val;

If InGRD = True Then Nucll.Grid.Columns.Grid.SelectedField.Value := Field_val;Application.MessageBox('Не верное значение! Сумма накладной не может быть отрицательной.',

'D-Art: Aurora', mb_Ok+mb_IconStop);

Abort;

end;

end;

procedure TDB_Data.N_MIONewRecord(DataSet: TDataSet);

begin

M_id.Value := Id.Value; //Указываем номер нокладной (реальной записи)

M_Count.Value := 1;

M_Values.Value := 'Товар '+IntToStr(Num.Value);

M_SW.Value := 0;

end;

procedure TDB_Data.N_GenBeforePost(DataSet: TDataSet);

begin

//ShowMessage('POST!');

If SV_Click = False Then

begin

SV_Qes :=Application.MessageBox(PChar('Не были сохранены изменения в накладной №'+ DB_Data.Num.AsString + '. Сохранить изменения?' ),

'D-Art: Aurora',mb_OkCancel+mb_IconExclamation);

Case SV_Qes of

idOk : SSh;

idCancel : Abort; //Отменяем сохранение

End; //Case

end //If SV_Click = False

Else Sub_Program.SSh;

end;

procedure TDB_Data.N_GenBeforeEdit(DataSet: TDataSet);

begin

Screen.Cursor := crHourGlass;

end;

procedure TDB_Data.N_GenAfterDelete(DataSet: TDataSet);

begin

Screen.Cursor := crDefault;

Write_Stat(DB_Data.N_Gen,DB_Data.Primtabs,General.Gen_Stat);

end;

procedure TDB_Data.N_GenBeforeDelete(DataSet: TDataSet);

begin

Screen.Cursor := crHourGlass;

DB_Data.N_MIO.First;

While not DB_Data.N_MIO.Eof do DB_Data.N_MIO.Delete;

end;

procedure TDB_Data.N_GenDeleteError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

begin

Screen.Cursor := crDefault;

end;

{procedure ReFresh_Tab(NewVal: string);

begin

if View_Mode = vm_TR Then Nucll.Ap_Button.Focused;

//Обновляем номера накладных в таблице С.М.Т.

DB_Data.Fresh_ML.Parameters[0].Value := StrToInt(NewVal); //Новое значение

DB_Data.Fresh_ML.Parameters[1].Value := Num_Ins; //Старое значение

DB_Data.Fresh_ML.ExecSQL; //Выполняем запрос

DB_Data.N_MiO.Requery; //Обновляем таблицу

end;}

procedure TDB_Data.N_GenEditError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

begin

Screen.Cursor := crDefault;

end;

procedure TDB_Data.T_WorkBeforePost(DataSet: TDataSet);

begin

RL_Ctrl := rl_None;

If DOQAS = True Then

QLib.CB1.Text := DataSet.Fields[0].AsString;

Listred.List_Grid.Options := [dgTitles,dgIndicator,dgRowSelect,

dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit] //FocusControl(List_Grid);

end;

procedure TDB_Data.N_GenAfterScroll(DataSet: TDataSet);

begin

Cancel_Cls := False;

GEneral.Gen_Stat.Panels[2].Text := 'Текущая запись: ' + IntToStr(N_Gen.RecNo);

end;

procedure TDB_Data.N_MIOAfterInsert(DataSet: TDataSet);

begin

No_Adding := False;

end;

procedure TDB_Data.N_MIOPostError(DataSet: TDataSet; E: EDatabaseError;

var Action: TDataAction);

begin

//Ошибка при сохранении

Application.MessageBox('Не удается сохранить изменения!','D-Art: Aurora',mb_IconStop + mb_Ok);

Abort;

MS_Click := False;

end;

procedure TDB_Data.N_MIOAfterPost(DataSet: TDataSet);

begin

M_Mode := mr_None;

N_MIO.UpdateBatch;

Many_List.All_ManySum;

end;

procedure TDB_Data.N_MIOAfterScroll(DataSet: TDataSet);

begin

M_Mode := mr_None;

end;

procedure TDB_Data.N_MIOCalcFields(DataSet: TDataSet);

begin

AllSum.Value := M_SW.Value * M_Count.Value; //Формируем значение вычисляемого поля

Mnds.Value := AllSum.Value - (AllSum.Value * 100)/(100 + 100 * Nds_v); //Сумма НДС

MWnds.Value := AllSum.Value - Mnds.Value; //Сумма без НДС

end;

procedure TDB_Data.N_MIOBeforePost(DataSet: TDataSet);

begin

//Many_List.Edit1.Text := FloatToStr(StrToFloat(MAny_List.Edit1.Text)+M_SW.Value);

end;

//Функция вставки подстроки в строку

Function TDB_Data.Ins_Str(SubS, S: string; Index: integer): string;

var Res_Str, Site_Str, Site_Chr, Rs, Ls : string;

j: byte;

begin

Ls := '';

Rs := '';

Site_Str := S;

Site_Chr := SubS;

If Index <= 1 Then

Res_Str := Site_Chr + Site_Str

Else

begin

For j := 1 to Index - 1 do

Ls := Ls + Site_Str[j];

For j := Index to Length(Site_Str) do

Rs := Rs + Site_Str[j];

Res_Str := Ls + Site_Chr +Rs;

end;

Ins_Str := Res_Str;

end;

procedure TDB_Data.Q_TeachCalcFields(DataSet: TDataSet);

var ORW, ANDW, LKW, str_f, fld_s, U1, U2, U2p, ULK,

U1_n, U2_n, U2p_n, Empt_U : string;

i, Num_a: integer;

HLib: THandle; //Дискрептор DLL

SFI: Array[1..255] of integer; //Позиции для вставки наименований полей

Kav_USL : Boolean;

begin

if QTValues.Value <> '' Then

begin

Kav_USL := False; //Обнуляем все значения переменных

Teach_V.Value := '';

str_f := QTValues.Value;

i := 0;

While i <> Length(QTValues.Value) Do

begin

i := i + 1;

If str_f[i] = '"' Then //Определяем часть строки условия как значение поля

Case Kav_USL of

True: Kav_USL := False;

False: Kav_USL := True;

End;

//Проверяем вхождение слов связи условий (И, ИЛИ) в условие запроса

ORW := str_f[i-1] + str_f[i] + str_f[i+1] + str_f[i+2] + str_f[i+3];

ANDW := str_f[i-1] + str_f[i] + str_f[i+1];

If i = 1 Then LKW := str_f[i] + str_f[i+1] + str_f[i+2] + str_f[i+3]

Else LKW := str_f[i-1] + str_f[i] + str_f[i+1] + str_f[i+2] + str_f[i+3];

HLib := LoadLibrary(PChar(Prog_Dir + 'String_DLL.dll')); //Загружаем DLL в память

If HLib <> 0 Then

begin

Str_UP := GetProcAddress(HLib,'RS_UP'); //Определяем адрес функции

ORW := StrPas(Str_UP(PChar(ORW))); //Преобразуем регистр

ANDW := StrPas(Str_UP(PChar(ANDW)));

LKW := StrPas(Str_UP(PChar(LKW)));

FreeLibrary(HLib);

//ShowMessage('*' + ORW + '*');

end;

//Меняем русские условия на английские

If Kav_USL = False Then

begin

If (ORW <> ' ИЛИ ') And (ANDW <> ' И ') And (LKW <> ' КАК ') And (LKW <> 'КАК ') Then

Teach_V.Value := Teach_V.Value + str_f[i]

Else

begin

If ORW = ' ИЛИ ' Then

begin

i := i + 2;

Teach_V.Value := Teach_V.Value + 'Or';

end;

If ANDW = ' И ' Then

Teach_V.Value := Teach_V.Value + 'And';

end;

If (LKW = ' КАК ') Or (LKW = 'КАК ') Then

begin

i := i + 2;

Teach_V.Value := Teach_V.Value + 'Like';

end;

end

Else Teach_V.Value := Teach_V.Value + str_f[i];

end; //While

//Подставляем наименование поля

For i := 1 To 255 Do

SFI[i] := -1;

Num_a := 1;

str_f := Teach_V.Value;

For i := 1 To Length(str_f) Do

begin

//Проверяем вхождение условий запроса (=, <>, >, < и т.д.)

U1 := str_f[i] + str_f[i+1];

U2 := str_f[i] + str_f[i+1] + str_f[i+2];

U2p := str_f[i-1] + str_f[i] + str_f[i+1];

ULK := str_f[i] + str_f[i+1] + str_f[i+2] + str_f[i+3] + str_f[i+4] + str_f[i+5];

U1_n := str_f[i];

U2_n := str_f[i] + str_f[i+1];

U2p_n := str_f[i-1] + str_f[i];

//Выясняем позиции для вставки наименования поля

If (((DT.Value=1)Or(DT.Value=2)) And ((((U1='="')Or(U1='>"')Or(U1='<"'))And((U2p<>'<>"')And(U2p<>'>="')And(U2p<>'<="')))Or(U2='<>"')Or(U2='>="')Or(U2='<="')Or(ULK='Like "'))) Or (((DT.Value=0)Or(DT.Value=2)) And ((((U1_n='=')Or(U1_n='>')Or(U1_n='<'))And((U2p_n<>'<>')And(U2p_n<>'>=')And(U2p_n<>'<=')))Or(U2_n='<>')Or(U2_n='>=')Or(U2_n='<=')Or(ULK='Like "'))) Then

begin

SFI[Num_a] := i;

Num_a := Num_a + 1;

end;

end; //For

fld_s := Teach_F.Value;

//tch_s := Teach_V.Value;

//Вставляем наименование поля

For i := 1 To Num_a Do

If SFI[i] <> -1 Then

begin

//ShowMessage(IntToStr(SFI[i]));

{HLib := LoadLibrary('String_Dll.dll'); //Загрузка бибилиотеки

Ins_Str := GetProcAddress(HLib,'INS_STR'); //Определяем адрес функции}

Teach_V.Value := Ins_Str(fld_s,Teach_V.Value,SFI[i]);

//Смещаем указатель на символьную длинну имени поля * на количество вставленных

//наименований поля, с учетом непустого значения следующей ячейки

if SFI[i+1] <> -1 Then SFI[i+1] := SFI[i+1] + Length(fld_s)* i;

//FreeLibrary(HLib); //Освобождаем библиотеку

end;

str_f := Teach_V.Value;

For i := 1 To 255 Do

SFI[i] := -1;

Num_a := 1;

For i := 1 To Length(Teach_V.Value) Do

begin

ULK := str_f[i] + str_f[i+1] + str_f[i+2] + str_f[i+3] + str_f[i+4] + str_f[i+5];

If ULK = 'Like "' Then

begin

SFI[Num_a] := i;

Num_a := Num_a + 1;

end;

end;

For i := 1 To Num_a Do

If SFI[i] <> -1 Then

begin

Teach_V.Value := Ins_Str(' ',Teach_V.Value,SFI[i]);

If SFI[i+1] <> -1 Then SFI[i+1] := SFI[i+1] + i;

end;

ToE := Length(Teach_V.Value);

end; //If QTVaalues.Value <> ''

If Selnull.Value = True Then

begin

ToE := Length(Teach_V.Value);

If ToE = 0 Then Empt_U := ''

Else Empt_U := ' Or ';

Teach_V.Value := Teach_V.Value + Empt_U + '(' + Teach_F.Value + ' IS NULL)';

end;

end;

procedure TDB_Data.Q_TeachAfterScroll(DataSet: TDataSet);

begin

{With FQuery Do

begin

If DOQAS = True Then

If DB_Data.DT.Value = 0 Then DBGrid1.Columns[1].ButtonStyle := cbsAuto

Else DBGrid1.Columns[1].ButtonStyle := cbsEllipsis;

end;}

end;

procedure TDB_Data.QTValuesChange(Sender: TField);

begin

If (QTValues.Value = '') And (Selnull.Value = True) Then

If Application.MessageBox('Удалить условие выборки пустых значений указанного столбца?',PChar(Application.Title),mb_IconQuestion+mb_YesNo) = idYes Then

Selnull.Value := False;

end;

procedure CH_Date(FLD: TWideStringField);

var sa_date, YNow, ISDate, Ydt : string;

NumP, i: integer;

begin

With DB_Data Do

Begin

NumP := StrToInt(FQuery.PC1.ActivePage.GetNamePath[Length(FQuery.PC1.ActivePage.GetNamePath)]); If (Teach_F.Value = 'TDate') And ((NumP = 2)Or(NumP = 4)) And (FLD.Value <> '') Thenbegin

For i := 1 To Length(FLD.Value) Do

If FLD.Value[i] = '.' Then sa_date := Sa_date + '/'

Else sa_date := sa_date + FLD.Value[i];

If FLD.Value[1] = '(' Then i := 2

Else i := 1;

If FLD.Value[i] <> '#' Then sa_date := '#' + sa_date;

If FLD.Value[Length(FLD.Value)] = ')' Then i := Length(FLD.Value) - 1

Else i := Length(FLD.Value);

If FLD.Value[i] <> '#' Then sa_date := sa_date + '#';

For i := 8 To Length(sa_date)-1 Do YNow := YNow + FLD.Value[i];

Case Length(YNow) Of

1 : ISDate := '200';

2 : ISDate := '20';

End;

If (Length(YNow) < 4) Then sa_date := DB_Data.Ins_Str(ISDate,sa_date,8);

For i := 8 To Length(sa_date) Do Ydt := Ydt + sa_date[i];

sa_date := sa_date[1]+sa_date[5]+sa_date[6]+sa_date[4]+sa_date[2]+sa_date[3]+sa_date[7]+Ydt;

FLD.Value := sa_date;

end

end;

end;

procedure TDB_Data.Q_TeachBeforePost(DataSet: TDataSet);

var NumP : integer;

begin

Lng.Value := ToE;

NumP := StrToInt(FQuery.PC1.ActivePage.GetNamePath[Length(FQuery.PC1.ActivePage.GetNamePath)]);

If NumP = 2 Then CH_Date(QTValues);

CH_Date(NewData);

end;

procedure TDB_Data.FDateSetText(Sender: TField; const Text: String);

var RD1 : TDateTime;

begin

//Проверяем правильность введенной даты

Try

FDate.Value := StrToDate(Text);

Except

Nucll.E_Date.Text := Field_val;

If InGRD = True Then Nucll.Grid.Columns.Grid.SelectedField.Value := Field_val;

Application.MessageBox('Не верное значение даты выписки! Воспользуйтесь календарем для ввода даты.',

'D-Art: Aurora',mb_Ok + mb_IconHand);

Abort;

End;

end;

procedure TDB_Data.Q_RepCalcFields(DataSet: TDataSet);

begin

If Q_Rep.RecNo > 0 Then Q_RepNumpp.Value := Q_Rep.RecNo

Else Q_RepNumpp.Value := 1;

end;

procedure TDB_Data.Q_Rep2CalcFields(DataSet: TDataSet);

begin

If Q_Rep2.RecNo > 0 Then Q_Rep2Numpp.Value := Q_Rep2.RecNo

Else Q_Rep2Numpp.Value := 1;

end;

procedure TDB_Data.QOUAfterOpen(DataSet: TDataSet);

var i : integer;

begin

//ShowMessage(IntToStr(DataSet.Fields.Count));

DataSet.FieldByName('id').Index := 12;

For i := 0 To DataSet.Fields.Count-1 Do

If (Active_Tab.Fields[i].FieldKind <> fkCalculated) Then

DataSet.Fields[i].DisplayLabel := Active_Tab.Fields[i].DisplayLabel;

end;

end.

ПРИЛОЖЕНИЕ 2

«Экранные формы программы»

1. Главная форма и форма накладных

2. Форма запросов

3. Форма печати

4.Форма редактора списков

5.Форма фильтрации и поиска данных

ПРИЛОЖЕНИЕ 3

«Результаты тестирования программы»

№п/п	Название испытания	Цель	Объект	Значение	Результат
1	Проверка контроля ввода значений	Проверка корректности работы пользовательского интерфейса	Ввод значения в поле «№ Накладной» таблицы накладных	-126 (Недопустимое значение)	Программа выдает сообщение об ошибке при переходе к другому полю или попытке сохранить запись, так же программа возвращает корректное значение поля.
2	----#----	----#----	----#----	1 (допустимое, но не уникальное значение)	При попытке сохранить запись с неуникальным значением индекса программа выдает сообщение об ошибке, отменяет действие и возвращает корректное значение поля
3	----#----	----#----	----#----	10 (допустимое значение)	Программа сохраняет запись в таблице, при отсутствии других ошибок
4	Проверка правильности ввода условия запроса	Проверка контроля правильности ввода условий запроса	Значение, введенное в таблицу условий	Недопустимое значение (содержание лишней кавычки, ошибочный тип данных)	Программа проверяет каждую строку условия и в случае ошибки останавливает процесс выполнения запроса и, указывая на строку с ошибкой, выдает сообщение об ошибке.
5	----#----	----#----	----#----	Допустимое значение (условие с корректным синтаксисом)	Программа считывает введенные условия, формирует текст запроса и выполняет его. При невозможности выполнить запрос по другим причинам, программа выдает соответствующее сообщение об ошибке