121
i:=PosEx(';',cs,pos);
len:=i-pos;
Delete(cs,pos,len);
Insert(ic,cs,pos);
DataInfo.ADOConnection.Close;
DataInfo.ADOConnection.ConnectionString:=cs;
try
DataInfo.ADOConnection.Open;
except
MessageDlg('Невозможно открыть соединение с базой данных
'+#39+ic+#39,mtError,[mbOk],0);
DataInfo.ADOConnection.Close;
Result:=False;
Exit
end;
Result:=True;
end;
procedure TPasswordDlg.FormShow(Sender: TObject);
begin
PasswordDlg.ActiveControl:=lcbUserName;
end;
procedure TPasswordDlg.btnNoClick(Sender: TObject);
begin
if MessageDlg('Заканчиваем
работу?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
ModalResult:=-1;
Exit
end;
ModalResult:=0;
122
end;
procedure TPasswordDlg.btnYesClick(Sender: TObject);
begin
if lcbUserName.Text='' then
begin
MessageDlg('Выберите пользователя',mtWarning,[mbOk],0);
ModalResult:=mrNone;
end
else
begin
UserId:=DataInfo.qListWorkers.FieldByName('Id').asInteger;
BranchId:=DataInfo.qListWorkers.FieldByName('BranchId').asInteger;
DataInfo.qListBranches.Open;
DataInfo.qListBranches.Locate('Id',BranchId,[]);
BranchName:=DataInfo.qListBranches.FieldByName('BranchName').asString;
DataInfo.qListBranches.Close;
UserName:=DataInfo.qListWorkers.FieldByName('FIO').asString+' -
'+DataInfo.qListWorkers.FieldByName('Position').asString;
isManager:=DataInfo.qListWorkers.FieldByName('isManager').asBoolean;
UserPassword:=Password.Text;
ModalResult:=1
end
end;
end.
123
Приложение 2. Листинг программных модулей тестирования
// ввод информации о тестовых ответах
unit Answers;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, dxSkinsCore, dxSkinsDefaultPainters, cxStyles, cxGraphics,
cxEdit, cxDBLookupComboBox, cxCheckBox, Menus,
cxLookAndFeelPainters,
StdCtrls, cxButtons, cxVGrid, cxDBVGrid, cxControls, cxInplaceContainer,
cxLookAndFeels, cxDropDownEdit, cxCurrencyEdit;
type
TfrmAnswers = class(TForm)
vgAnswers: TcxDBVerticalGrid;
btnYes: TcxButton;
btnNo: TcxButton;
vgAnswersQuestionId: TcxDBEditorRow;
vgAnswersAnswerText: TcxDBEditorRow;
vgAnswersisTrue: TcxDBEditorRow;
procedure FormShow(Sender: TObject);
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
124
frmAnswers: TfrmAnswers;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmAnswers.FormShow(Sender: TObject);
begin
if frmAnswers.Tag=1 then
begin
frmAnswers.Caption:='Новий ответ';
DataInfo.qListAnswers.Insert;
end
else
begin
frmAnswers.Caption:=DataInfo.qListAnswers.FieldByName('AnswerText').asString;
DataInfo.qListAnswers.Edit;
end;
end;
procedure TfrmAnswers.btnNoClick(Sender: TObject);
begin
DataInfo.qListAnswers.Cancel;
frmAnswers.Close;
end;
procedure TfrmAnswers.btnYesClick(Sender: TObject);
begin
if DataInfo.qListAnswers.FieldByName('QuestionId').isNull then
125
begin
MessageDlg('Укажите вопрос!',mtError,[mbOk],0);
Exit
end;
if DataInfo.qListAnswers.FieldByName('AnswerText').isNull then
begin
MessageDlg('Укажите ответ!',mtError,[mbOk],0);
Exit
end;
DataInfo.qListAnswers.Post;
frmAnswers.Close;
end;
end.
126
Приложение 3. Листинг программных модулей учета сотрудников
// ввод информации о сотрудниках
unit Workers;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, dxSkinsCore, dxSkinsDefaultPainters, cxStyles, cxGraphics,
cxEdit, cxDBLookupComboBox, cxCheckBox, Menus,
cxLookAndFeelPainters,
StdCtrls, cxButtons, cxVGrid, cxDBVGrid, cxControls, cxInplaceContainer,
cxLookAndFeels, cxDropDownEdit, cxCurrencyEdit;
type
TfrmWorkers = class(TForm)
vgWorkers: TcxDBVerticalGrid;
btnYes: TcxButton;
btnNo: TcxButton;
vgWorkersBranchId: TcxDBEditorRow;
vgWorkersFIO: TcxDBEditorRow;
vgWorkersPosition: TcxDBEditorRow;
vgWorkersAddress: TcxDBEditorRow;
vgWorkersPhone: TcxDBEditorRow;
vgWorkersEMail: TcxDBEditorRow;
vgWorkersPassword: TcxDBEditorRow;
vgWorkersisManager: TcxDBEditorRow;
procedure FormShow(Sender: TObject);
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
127
{ Private declarations }
public
{ Public declarations }
end;
var
frmWorkers: TfrmWorkers;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmWorkers.FormShow(Sender: TObject);
begin
if frmWorkers.Tag=1 then
begin
frmWorkers.Caption:='Новый сотрудник';
DataInfo.qListWorkers.Insert;
end
else
begin
frmWorkers.Caption:=DataInfo.qListWorkers.FieldByName('FIO').asString;
DataInfo.qListWorkers.Edit;
end;
end;
procedure TfrmWorkers.btnNoClick(Sender: TObject);
begin
DataInfo.qListWorkers.Cancel;
frmWorkers.Close;
128
end;
procedure TfrmWorkers.btnYesClick(Sender: TObject);
begin
if DataInfo.qListWorkers.FieldByName('FIO').isNull then
begin
MessageDlg('Укажите ФИО сотрудника!',mtError,[mbOk],0);
Exit
end;
DataInfo.qListWorkers.Post;
frmWorkers.Close;
end;
end.
129
Приложение 4. Листинг программных модулей формирования
календаря
// ввод информации о календаре
unit Categories;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, dxSkinsCore, dxSkinsDefaultPainters, cxStyles, cxGraphics,
cxEdit, cxDBLookupComboBox, cxCheckBox, Menus,
cxLookAndFeelPainters,
StdCtrls, cxButtons, cxVGrid, cxDBVGrid, cxControls, cxInplaceContainer,
cxLookAndFeels, cxDropDownEdit, cxCurrencyEdit;
type
TfrmCategories = class(TForm)
vgCategories: TcxDBVerticalGrid;
btnYes: TcxButton;
btnNo: TcxButton;
vgCategoriesCategoryName: TcxDBEditorRow;
vgCategoriesBonus: TcxDBEditorRow;
procedure FormShow(Sender: TObject);
procedure btnNoClick(Sender: TObject);
procedure btnYesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
130
var
frmCategories: TfrmCategories;
implementation
uses DataBase;
{$R *.dfm}
procedure TfrmCategories.FormShow(Sender: TObject);
begin
if frmCategories.Tag=1 then
begin
frmCategories.Caption:='Новая категория';
DataInfo.qListCategories.Insert;
end
else
begin
frmCategories.Caption:=DataInfo.qListCategories.FieldByName('CategoryName').asS
tring;
DataInfo.qListCategories.Edit;
end;
end;
procedure TfrmCategories.btnNoClick(Sender: TObject);
begin
DataInfo.qListCategories.Cancel;
frmCategories.Close;
end;
procedure TfrmCategories.btnYesClick(Sender: TObject);