104
dstStatClientSum: TADODataSet;
dstStatClientSumDSDesigner: TBCDField;
dstStatClientSum_: TStringField;
dstEmpJobList: TADODataSet;
dstEmpJobListDSDesigner: TWideStringField;
dstEmpJobListDSDesigner2: TAutoIncField;
dstEmpJobListDSDesigner3: TFloatField;
dstEmpJobListDSDesigner4: TWideStringField;
dsSupOrders: TDataSource;
dstSupOrders: TADODataSet;
dstSupOrdersN: TAutoIncField;
dstSupOrdersDSDesigner: TDateTimeField;
dsSupCont: TDataSource;
dstSupCont: TADODataSet;
dstSupContN: TIntegerField;
dstSupCont_ID: TIntegerField;
dstSupContDSDesigner: TIntegerField;
dstSupContField: TStringField;
dstStatSupOrderSum: TADODataSet;
BCDField3: TBCDField;
StringField1: TStringField;
tbManagersDSDesigner2: TWideStringField;
tbManagersDSDesigner3: TWideStringField;
tbStaffDSDesigner2: TWideStringField;
tbStaffDSDesigner3: TWideStringField;
dstSupOrdersID: TIntegerField;
dstSupOrdersStringField: TStringField;
dsStatus: TDataSource;
dstStatus: TADODataSet;
dstStatusID: TAutoIncField;
dstStatusDSDesigner: TWideStringField;
dstOrdersID4: TIntegerField;
dstOrdersField3: TStringField;
dstOrdersField4: TStringField;
tbClientsID: TAutoIncField;
tbClients_: TWideStringField;
tbClientsDSDesigner: TWideStringField;
tbClientsDSDesigner2: TWideStringField;
tbClientsDSDesigner3: TWideStringField;
tbClientsDSDesigner4: TWideStringField;
tbClientsDSDesigner5: TWideStringField;
tbClientsDSDesigner6: TWideStringField;
tbRequisiteDSDesigner: TWideStringField;
tbRequisiteDSDesigner2: TWideStringField;
tbRequisiteDSDesigner3: TWideStringField;
tbRequisiteDSDesigner4: TWideStringField;
tbRequisiteDSDesigner5: TWideStringField;
tbRequisiteDSDesigner6: TWideStringField;
tbRequisiteDSDesigner7: TWideStringField;
procedure tbStoreCalcFields(DataSet: TDataSet);
procedure dstJobsCalcFields(DataSet: TDataSet);
procedure dstMatCalcFields(DataSet: TDataSet);
105
procedure DataModuleDestroy(Sender: TObject);
procedure dstOrdersAfterInsert(DataSet: TDataSet);
procedure dstSupOrdersAfterInsert(DataSet: TDataSet);
procedure dstJobsIDChange(Sender: TField);
procedure dstMat_IDChange(Sender: TField);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DM: TDM;
implementation
uses LoginUnit;
{$R *.dfm}
//Расчет суммы каждой позиции материалов на складе:
procedure TDM.tbStoreCalcFields(DataSet: TDataSet);
begin
DataSet.FieldByName('Сумма').Value :=
DataSet.FieldByName('Количество').Value * DataSet.FieldByName('Цена').Value;
end;
//Расчет суммы по каждой выполняемой работе по заказу:
procedure TDM.dstJobsCalcFields(DataSet: TDataSet);
begin
DataSet.FieldByName('Сумма').Value :=
DataSet.FieldByName('Количество').Value *
DataSet.FieldByName('ОплатаЗаНорму').Value;
end;
//Расчет суммы по каждой позиции затраченной материальной ценности по
заказу:
procedure TDM.dstMatCalcFields(DataSet: TDataSet);
begin
DataSet.FieldByName('Сумма').Value :=
DataSet.FieldByName('Количество').Value * DataSet.FieldByName('Цена').Value;
end;
procedure TDM.DataModuleDestroy(Sender: TObject);
begin
ADOConnection1.Close;
end;
//Для нового заказа записывается ID приемщика:
procedure TDM.dstOrdersAfterInsert(DataSet: TDataSet);
begin
DataSet.FieldByName('МенеджерID').AsInteger := fmLogin.UserID;
106
end;
//Для новой заявки поставщику записывается ID приемщика:
procedure TDM.dstSupOrdersAfterInsert(DataSet: TDataSet);
begin
DataSet.FieldByName('РаботникID').AsInteger := fmLogin.UserID;
end;
//Для выбранной работы по заказу записывается ее стоимость за норму:
procedure TDM.dstJobsIDChange(Sender: TField);
begin
dstJobs.FieldByName('ОплатаЗаНорму').AsCurrency :=
tbPrice.FieldByName('ОплатаЗаНорму').AsCurrency;
end;
//Для выбранного комплектующегопо заказу записывается его стоимость:
procedure TDM.dstMat_IDChange(Sender: TField);
begin
dstMat.FieldByName('Цена').AsCurrency :=
tbStore.FieldByName('Цена').AsCurrency;
end;
end.
unit LoginUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, IniFiles;
type
TfmLogin = class(TForm)
Label1: TLabel;
edLogin: TEdit;
Label2: TLabel;
edPassword: TEdit;
bbtOK: TBitBtn;
bbtCancel: TBitBtn;
OpenDialog1: TOpenDialog;
procedure bbtOKClick(Sender: TObject);
procedure bbtCancelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
UserID: Integer;
DBPath: string;
end;
var
107
fmLogin: TfmLogin;
implementation
uses MainUnit, DMUnit, DB, ADODB;
{$R *.dfm}
procedure TfmLogin.bbtOKClick(Sender: TObject);
type
//Тип, определяющий элементы меню, к которым можно получить доступ
пользователю
//в зависимости от его прав доступа:
TUserGrants =
(ugSpravReq, ugSpravSpec, ugSpravManagers, ugSpravClients, ugSpravStaff,
ugSpravStore, ugSpravPrice, ugWorkOrders, ugWorkSup);
TUserGrantsSet = set of TUserGrants;
//Установка видимости заданных элементов меню для текущего пользователя:
procedure SetGrants(UserGrants: TUserGrantsSet);
begin
with fmMain do
begin
acSpravReq.Enabled := ugSpravReq in UserGrants;
acSpravSpec.Enabled := ugSpravSpec in UserGrants;
acSpravManagers.Enabled := ugSpravManagers in UserGrants;
acSpravClients.Enabled := ugSpravClients in UserGrants;
acSpravStaff.Enabled := ugSpravStaff in UserGrants;
end;
end;
begin
//Режим админа:
if (edLogin.Text = 'admin') and (edPassword.Text = 'admin') then
begin
UserID := 0;
fmLogin.Hide;
if not Assigned(fmMain) then
Application.CreateForm(TfmMain, fmMain);
SetGrants([ugSpravReq, ugSpravSpec, ugSpravManagers,
ugSpravStaff,ugSpravClients, ugSpravStore, ugSpravPrice, ugWorkOrders]);
fmMain.Caption := fmMain.Caption + ': Администратор';
fmMain.Show;
end
else
begin
//Поиск приемщика с заданными логином и паролем:
DM.tbManagers.Open;
if DM.tbManagers.Locate('Логин;Пароль', VarArrayOf([edLogin.Text,
edPassword.Text]), [loCaseInsensitive]) then
begin
UserID := DM.tbManagers.FieldByName('ТабN').AsInteger;
if not Assigned(fmMain) then
108
Application.CreateForm(TfmMain, fmMain);
fmMain.Caption := fmMain.Caption + ': ' +
DM.tbManagers.FieldByName('ФИО').AsString;
SetGrants([ugSpravClients, ugSpravStore, ugSpravPrice, ugWorkOrders]);
DM.tbManagers.Close;
fmLogin.Hide;
fmMain.Show;
end
else
begin
//Поиск мастера с заданными логином и паролем:
DM.tbStaff.Open;
if DM.tbStaff.Locate('Логин;Пароль', VarArrayOf([edLogin.Text,
edPassword.Text]), [loCaseInsensitive]) then
begin
UserID := DM.tbStaff.FieldByName('ТабN').AsInteger;
if not Assigned(fmMain) then
Application.CreateForm(TfmMain, fmMain);
fmMain.Caption := fmMain.Caption + ': ' +
DM.tbStaff.FieldByName('ФИО').AsString;
SetGrants([ugSpravClients, ugSpravStore, ugSpravPrice, ugWorkOrders,
ugWorkSup]);
DM.tbStaff.Close;
fmLogin.Hide;
fmMain.Show;
end
else
Application.MessageBox('Неверные логин или пароль!', 'Ошибка',
MB_OK+MB_ICONEXCLAMATION);
end;
DM.tbStaff.Close;
DM.tbManagers.Close;
end; //else if (edLogin.Text = 'admin')...
end;
procedure TfmLogin.bbtCancelClick(Sender: TObject);
begin
Close;
end;
procedure TfmLogin.FormShow(Sender: TObject);
begin
//Если логин сохранен с предыдущего сеанса, то фокус ввода устанавливается
на поле пароля:
if edLogin.Text <> '' then
edPassword.SetFocus;
end;
end.
unit MainUnit;
interface
109
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, XPMan, ImgList, ActnList, StdActns, ADODB, DB,
XPStyleActnCtrls, ActnMan, ToolWin, ActnCtrls, ActnMenus, jpeg,
ExtCtrls,ComObj,ExtDlgs;
type
TfmMain = class(TForm)
bbtStat: TBitBtn;
XPManifest1: TXPManifest;
ActionManager1: TActionManager;
ImageList1: TImageList;
FileExit1: TFileExit;
acSpravReq: TAction;
acSpravSpec: TAction;
acSpravManagers: TAction;
acSpravClients: TAction;
acSpravStaff: TAction;
bbtOrder: TBitBtn;
bbtPriceStore: TBitBtn;
bbtPriceJob: TBitBtn;
bbtSupOrder: TBitBtn;
ActionMainMenuBar1: TActionMainMenuBar;
SpeedButton1: TSpeedButton;
Action1: TAction;
SaveDialog1: TSaveDialog;
Image1: TImage;
procedure acSpravReqExecute(Sender: TObject);
procedure acSpravSpecExecute(Sender: TObject);
procedure acSpravManagersExecute(Sender: TObject);
procedure acSpravClientsExecute(Sender: TObject);
procedure acSpravStaffExecute(Sender: TObject);
procedure acSpravStoreExecute(Sender: TObject);
procedure acSpravPriceExecute(Sender: TObject);
procedure acWorkOrdersExecute(Sender: TObject);
procedure acWorkSupExecute(Sender: TObject);
procedure acRepStatExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButton1Click(Sender: TObject);
procedure Action1Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmMain: TfmMain;
implementation
110
uses ReqUnit, PostUnit, ManagerUnit, ClientUnit, DMUnit, StaffUnit, StoreUnit,
PriceUnit,
OrderListUnit, SupListUnit, StatUnit, DiapasonUnit, ReportsUnit, FileCtrl,
LoginUnit;
{$R *.dfm}
procedure TfmMain.acSpravReqExecute(Sender: TObject);
begin
fmRequisite.Show;
end;
procedure TfmMain.acSpravSpecExecute(Sender: TObject);
begin
fmPost.Show;
end;
procedure TfmMain.acSpravManagersExecute(Sender: TObject);
begin
fmManagers.Show;
end;
procedure TfmMain.acSpravClientsExecute(Sender: TObject);
begin
fmClients.Show;
end;
procedure TfmMain.acSpravStaffExecute(Sender: TObject);
begin
fmStaff.Show;
end;
procedure TfmMain.acSpravStoreExecute(Sender: TObject);
begin
fmStore.Show;
end;
procedure TfmMain.acSpravPriceExecute(Sender: TObject);
begin
fmPrice.Show;
end;
procedure TfmMain.acWorkOrdersExecute(Sender: TObject);
begin
fmOrderList.Show;
end;
procedure TfmMain.acWorkSupExecute(Sender: TObject);
begin
fmSupplierList.Show;
end;
111
procedure TfmMain.acRepStatExecute(Sender: TObject);
begin
fmStat.Show;
end;
procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fmLogin.Close;
end;
procedure TfmMain.SpeedButton1Click(Sender: TObject);
begin
fmMain.Hide;
fmLogin.show;
end;
procedure TfmMain.Action1Execute(Sender: TObject);
begin
if SaveDialog1.Execute then
copyfile(PAnsiChar(ExtractFilePath(application.exename )+'Service.mdb'),
PAnsiChar(SaveDialog1.FileName), false);
end;
end.
unit ManagerUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Grids, DBGrids, DBCtrls, StdCtrls, Buttons;
type
TfmManagers = class(TForm)
DBGrid1: TDBGrid;
Panel1: TPanel;
DBNavigator1: TDBNavigator;
BitBtn1: TBitBtn;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmManagers: TfmManagers;
implementation
112
uses DMUnit, OrderListUnit, OrderUnit;
{$R *.dfm}
procedure TfmManagers.FormShow(Sender: TObject);
begin
DM.tbManagers.Open;
end;
procedure TfmManagers.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//Набор данных закрывается, если он не используется в других формах:
if (not fmOrderList.Showing) and (not fmOrder.Showing) then
DM.tbManagers.Close;
end;
procedure TfmManagers.BitBtn1Click(Sender: TObject);
begin
Close;
end;
end.
unit OrderListUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Grids, DBGrids, DBCtrls, StdCtrls, Buttons, ComCtrls;
type
TfmOrderList = class(TForm)
DBGrid1: TDBGrid;
Panel1: TPanel;
bbtPrint: TBitBtn;
GroupBox1: TGroupBox;
chbDate1: TCheckBox;
chbDate2: TCheckBox;
dtpDate1: TDateTimePicker;
dtpDate2: TDateTimePicker;
chbClient: TCheckBox;
chbManager: TCheckBox;
dblcbClient: TDBLookupComboBox;
dblcbManager: TDBLookupComboBox;
BitBtn4: TBitBtn;
BitBtn1: TBitBtn;
DBNavigator2: TDBNavigator;
chbStatus: TCheckBox;
dblcbStatus: TDBLookupComboBox;
bbtNewOrder: TBitBtn;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
113
procedure bbtPrintClick(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure chbDate1Click(Sender: TObject);
procedure DBGrid1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure bbtNewOrderClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmOrderList: TfmOrderList;
implementation
uses DMUnit, ReportsUnit, ADODB, MainUnit, OrderUnit;
{$R *.dfm}
procedure TfmOrderList.FormShow(Sender: TObject);
begin
DM.dstOrders.Open;
dtpDate1.Date := Date;
dtpDate2.Date := Date;
chbDate1Click(Self);
end;
procedure TfmOrderList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DM.dstOrders.Close;
end;
procedure TfmOrderList.bbtPrintClick(Sender: TObject);
begin
Rep_Any(DBGrid1, 7, Self.Caption);
end;
//Сортировка данных в таблице по выбранному столбцу:
procedure TfmOrderList.DBGrid1TitleClick(Column: TColumn);
begin
if Column.FieldName = 'Клиент' then
DM.dstOrders.Sort := 'КлиентID'
else if Column.FieldName = 'Менеджер' then
DM.dstOrders.Sort := 'МенеджерID'
else if Column.FieldName = 'Работник' then
DM.dstOrders.Sort := 'РаботникID'
else if Column.FieldName = 'Статус' then
DM.dstOrders.Sort := 'СтатусID'
else if Column.FieldName = 'Телефоны' then