Смекни!
smekni.com
Информатика

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

'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 ----#---- ----#---- ----#---- Допустимое значение (условие с корректным синтаксисом) Программа считывает введенные условия, формирует текст запроса и выполняет его. При невозможности выполнить запрос по другим причинам, программа выдает соответствующее сообщение об ошибке
 
назад
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.