91
GrUser: TADOTable;
Sotrid: TAutoIncField;
SotrFIO: TWideStringField;
SotrPhone: TWideStringField;
SotrGrUser: TIntegerField;
SotrGruserL: TStringField;
SotrPass: TWideStringField;
EdIzm: TADOTable;
Label3: TLabel;
EdIzmid: TAutoIncField;
EdIzmnaim: TWideStringField;
EdIzmPrim: TWideStringField;
N17: TMenuItem;
ZakazClient: TADOQuery;
ZakazClientid: TAutoIncField;
ZakazClientDater: TDateTimeField;
ZakazClientSumm: TBCDField;
ZakazClientStatus: TIntegerField;
ZakazClientSotrFIO: TWideStringField;
ZakazClientKlientFIO2: TWideStringField;
Label4: TLabel;
klient: TADOTable;
Label5: TLabel;
Postav: TADOTable;
Label6: TLabel;
klientid: TAutoIncField;
klientFIO: TWideStringField;
klientphone: TWideStringField;
klientadres: TWideStringField;
klientprim: TWideStringField;
Postavid: TAutoIncField;
PostavNaim: TWideStringField;
PostavPhone: TWideStringField;
PostavAdres: TWideStringField;
PostavPrim: TWideStringField;
ZakazPostav: TADOQuery;
Label7: TLabel;
ZakazPostavid: TAutoIncField;
ZakazPostavDater: TDateTimeField;
ZakazPostavFIO: TWideStringField;
ZakazPostavNaim: TWideStringField;
ZakazPostavStatus: TIntegerField;
ZakazPostavidSotr: TIntegerField;
ZakazPostavidPostav: TIntegerField;
Postup: TADOQuery;
Label8: TLabel;
PostupidZakaz: TIntegerField;
PostupPrim: TWideStringField;
PostupStatus: TIntegerField;
Postupdater: TDateTimeField;
PostupSumm: TBCDField;
92
PostupFIO: TWideStringField;
Prihod: TADOQuery;
Prihodid: TAutoIncField;
PrihodidZakaz: TIntegerField;
Prihodsumm: TBCDField;
PrihodDater: TDateTimeField;
PrihodPrim: TWideStringField;
PrihodidSotr: TIntegerField;
PrihodStatus: TIntegerField;
PrihodFIO: TWideStringField;
Label9: TLabel;
Rashod: TADOQuery;
Label10: TLabel;
RashodFIO: TWideStringField;
Rashodid: TAutoIncField;
Rashoddater: TDateTimeField;
Rashodsumm: TBCDField;
RashodidSotr: TIntegerField;
RashodPoluch: TWideStringField;
RashodPrim: TWideStringField;
RashodStatus2: TIntegerField;
Otgruz: TADOQuery;
Otgruzid: TAutoIncField;
OtgruzidZakaz: TIntegerField;
OtgruzSumm: TBCDField;
OtgruzidSotr: TIntegerField;
OtgruzPrim: TWideStringField;
OtgruzStatus: TIntegerField;
OtgruzDater: TDateTimeField;
OtgruzFIO: TWideStringField;
ZakaKlientTovar: TADOTable;
ZakaKlientTovarid: TAutoIncField;
ZakaKlientTovaridZakaz: TIntegerField;
ZakaKlientTovaridTovar: TIntegerField;
ZakaKlientTovarnum: TIntegerField;
ZakaKlientTovarprice: TBCDField;
Tovar: TADOTable;
Tovarid: TAutoIncField;
Tovarnaim: TWideStringField;
Tovarostatok: TIntegerField;
Tovared: TIntegerField;
ZakaKlientTovarTovarL: TStringField;
ZakaKlientTovarStoim: TCurrencyField;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
TovarEdL: TStringField;
ZakazClientPrim: TWideStringField;
ZakazClientidKlient: TIntegerField;
ZakazClientidSotr: TIntegerField;
TovarPrice: TBCDField;
93
TovarOstatokL: TFloatField;
ZakaKlientTovarOstatok: TFloatField;
OtgruzTovar: TADOTable;
AutoIncField1: TAutoIncField;
StringField1: TStringField;
IntegerField1: TIntegerField;
IntegerField2: TIntegerField;
IntegerField3: TIntegerField;
BCDField1: TBCDField;
CurrencyField1: TCurrencyField;
FloatField1: TFloatField;
ZakaKlientTovarnumOt: TIntegerField;
OtgruzTovarnumOt: TIntegerField;
OtgruzTovarT: TADOTable;
OtgruzTovarTid: TAutoIncField;
OtgruzTovarTidOtgruz: TIntegerField;
OtgruzTovarTidTovar: TIntegerField;
OtgruzTovarTnum: TIntegerField;
OtgruzTovarTPrice: TBCDField;
OtgruzTovarTTovarL: TStringField;
OtgruzTovarTStoim: TCurrencyField;
ZakaKlientTovarRez: TIntegerField;
OtgruzTovarRez: TIntegerField;
OtgruzTovarnumot1: TIntegerField;
N21: TMenuItem;
ADOQuery1: TADOQuery;
ZakazPostavTovar: TADOTable;
Label14: TLabel;
ZakazPostavTovarid: TAutoIncField;
ZakazPostavTovaridTovar: TIntegerField;
ZakazPostavTovaridZakaz: TIntegerField;
ZakazPostavTovarnum: TIntegerField;
ZakazPostavTovarTovarL: TStringField;
ZakazPostavTovarprice: TBCDField;
ZakazPostavTovarStoim: TCurrencyField;
ZakazPostavPrim: TWideStringField;
ZakazPostavSumm: TBCDField;
Tovarzakupprice: TBCDField;
Tovarzakazano: TIntegerField;
PostupTovarT: TADOTable;
Label15: TLabel;
Label16: TLabel;
PostupTovar: TADOTable;
PostupTovarTid: TAutoIncField;
PostupTovarTidtovar: TIntegerField;
PostupTovarTidPostup: TIntegerField;
PostupTovarTnum: TIntegerField;
PostupTovarid: TAutoIncField;
PostupTovaridTovar: TIntegerField;
PostupTovaridZakaz: TIntegerField;
PostupTovarnum: TIntegerField;
94
PostupTovarprice: TBCDField;
PostupTovarTovarL: TStringField;
PostupTovarStoim: TFloatField;
PostupTovarTprice: TBCDField;
PostupTovarTnumpostup: TIntegerField;
PostupTovarTTovarL: TStringField;
PostupTovarTStoim: TFloatField;
PostupTovarnumpostup: TIntegerField;
ZakazPostavpostup: TIntegerField;
Postupid: TAutoIncField;
PostupidSotr: TAutoIncField;
procedure CreateSpravForm(const childName, id: string;
table: TDataset;
p: integer);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure ZakaKlientTovarCalcFields(DataSet: TDataSet);
procedure N14Click(Sender: TObject);
procedure TovarCalcFields(DataSet: TDataSet);
procedure OtgruzTovarCalcFields(DataSet: TDataSet);
procedure OtgruzTovarTCalcFields(DataSet: TDataSet);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure Othet(const Data: TADOQUERY; Otchetname: string);
procedure N18Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure ZakazPostavTovarCalcFields(DataSet: TDataSet);
procedure PostupTovarCalcFields(DataSet: TDataSet);
procedure PostupTovarTCalcFields(DataSet: TDataSet);
private
procedure CreateDocForm(const childName: string; table:
TDataset;
p: integer);
procedure CreateOtchetForm(const childName:String; p:
integer);
{ Private declarations }
public
95
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Sprav, Doc, Login, Otchet;
{$R *.dfm}
//процедура для создания формы для ввода параметров отчета
procedure TForm1.CreateOtchetForm(const childName:String; p:
integer); //параметры - название формы и индекс отчета
var
Child: TForm9;
i,k :integer;
f : boolean;
begin
f:=False; //влаг-ложь
k:=0;
for i:=0 to Form1.MDIChildCount-1 do //проверяем
создан ли экземнляр такого окна
if (Form1.MDIChildren[i] is TForm9) then
begin
f:=True;
k:=i;
end;
if (f) then //если создан, то
Form1.MDIChildren[k].Close; //переносим его
вперед
Child := TForm9.Create(Application);
Child.Caption := childName; //задаем название
формы
Child.DateTimePicker1.DateTime:=now-30; //устанавливаем
дату на 30 дней меньше текущей
Child.DateTimePicker2.datetime:=now; //устанавливаем
текущую дату
Child.Label3.Caption:=IntTOStr(p); //индекс отчета
end;
//создание формы для работы со справочником
procedure TForm1.CreateSpravForm(const childName, id : string;
table: TDataset; p: integer);
var
Child: TForm2;
i,k :integer;
f : boolean;
begin
96
f:=False; //влаг -ложь
k:=0;
for i:=0 to Form1.MDIChildCount-1 do //проверяем
создан ли экземнляр такого окна
if (Form1.MDIChildren[i] is TForm2) and
(Form1.MDIChildren[i].caption=childName) then
begin
f:=True;
k:=i;
end;
if (f) and (Form1.MDIChildren[k].Caption=childName) then begin
//если создан, то
Form1.MDIChildren[k].bringToFront;
//переносим его вперед
if Form1.MDIChildren[k].WindowState=wsMinimized then
Form1.MDIChildren[k].WindowState:=wsNormal;
end
else
begin //иначе - создаем форму
Child := TForm2.Create(Application);
Child.Caption := childName; //задаем название
Child.DBGrid1.DataSource.DataSet:=table; //задаем таблицу
справочник, с которой будем работать
table.active:=true; //делаем таблицу
активной
Child.Setgridcolumnwidths; //выравниваем
ширину столбцов
Child.Label1.Caption:=id; //передаем ид
Case p of
1: Child.n1.visible:=true; //отображаем первый пункт
сонтекстного меню
2: Child.n2.visible:=true; //отображаем второй пункт
контекстрого меню
{3: Child.n3.visible:=true; //отображаем третий пункт
контекстного меню
4: Child.n4.visible:=true; //отображаем четвертый пункт
контекстного меню
5: begin Child.n5.visible:=true; //отображаем четвертый
пункт контекстного меню
Child.Panel2.visible:=false; }
end;
end;
end;
//процедура создания формы для работы со списком документов
procedure TForm1.CreateDocForm(const childName : string; table:
TDataset; p: integer); //название формы, таблица - источник
данных и индекс документа
var
Child: TForm3;
97
i,k :integer;
f : boolean;
begin
f:=False; //влаг-ложь
k:=0;
for i:=0 to Form1.MDIChildCount-1 do //проверяем
создан ли экземнляр такого окна
if (Form1.MDIChildren[i] is TForm3) and
(Form1.MDIChildren[i].caption=childName) then
begin
f:=True;
k:=i;
end;
if (f) and (Form1.MDIChildren[k].Caption=childName) then begin
//если создан, то
Form1.MDIChildren[k].bringToFront;
//переносим его вперед
if Form1.MDIChildren[k].WindowState=wsMinimized then
Form1.MDIChildren[k].WindowState:=wsNormal;
end
else
begin //иначе - создаем форму
Child := TForm3.Create(Application);
Child.Caption := childName; //задаем название формы
Child.DBGrid1.DataSource.DataSet:=table; //задаем источник
данных
table.open; //открываем источник данных
Child.Setgridcolumnwidths; //выравниваем ширину столбцов
Child.label1.caption:=IntToStr(p); //параметр для
определения типа открытого документа
Case p of //в зависимости от типа документов настраиваем
выпадающие списки/прячем их
1: begin
Child.Combobox2.Items.Add('Все'); //добавляем элементы
для заказов покупателей
Child.Combobox2.Items.Add('Оплаченные');
Child.Combobox2.Items.Add('Неоплаченные');
Child.ComboBox2.ItemIndex:=0;
Child.Combobox3.Items.Add('Все');
Child.Combobox3.Items.Add('Отгруженные');
Child.Combobox3.Items.Add('Неотгруженные');
Child.ComboBox3.ItemIndex:=0;
end;
2: begin //для
заказов поставщиков
Child.GroupBox3.Caption:='Поступление';
Child.ComboBox2.Items.Clear;
Child.ComboBox2.Items.Add('Все');
Child.ComboBox2.Items.Add('Поступившие');
Child.ComboBox2.Items.Add('Непоступившие');
Child.ComboBox2.ItemIndex:=0;
98
Child.GroupBox4.Visible:=false;
end;
3,4,5,6: begin //прячем фильтры
Child.GroupBox3.visible:=false;;
Child.GroupBox4.Visible:=false;
end;
end;
end;
end;
procedure TForm1.N15Click(Sender: TObject);
begin
CreateSpravForm('Сотрудники','',Form1.Sotr,0); //Вызов
процедуры для работы со Справочником Сотрудники
end;
procedure TForm1.N16Click(Sender: TObject);
begin
CreateSpravForm('Единицы измерений','',Form1.EdIzm,0); //ниже
вызываются процедуры для других справочников
end;
procedure TForm1.N7Click(Sender: TObject);
begin
CreateDocForm('Заказы покупателей',Form1.ZakazClient,1);
//вызываем процедуру для работы с заказами покупателей
end;
procedure TForm1.N9Click(Sender: TObject);
begin
CreateSpravForm('Покупатели','',Form1.klient,0);
end;
procedure TForm1.N10Click(Sender: TObject);
begin
CreateSpravForm('Поставщики','',Form1.Postav,0);
end;
procedure TForm1.N8Click(Sender: TObject);
begin
CreateDocForm('Заказы поставщикам',Form1.ZakazPostav,2);
//Вызываем процедуру для создания формы работы с документами
end;
procedure TForm1.N11Click(Sender: TObject);
begin
CreateDocForm('Поступления товаров на склад',Form1.Postup,3);
//Поступления
end;
99
procedure TForm1.N12Click(Sender: TObject);
begin
CreateDocForm('Приходные кассовые ордеры',Form1.Prihod,4);
//приходники
end;
procedure TForm1.N17Click(Sender: TObject);
begin
CreateDocForm('Расходные кассовые ордеры',Form1.Rashod,5);
//расходники
end;
procedure TForm1.N13Click(Sender: TObject);
begin
CreateDocForm('Отгрузки товаров',Form1.Otgruz,6); //отгрузки
end;
procedure TForm1.ZakaKlientTovarCalcFields(DataSet: TDataSet);
//автоподсчет стоимости товара по позиции в заказах
begin
ZakaKlientTovar.FieldByName('Stoim').Value:=ZakaKlientTovar.Fiel
dByName('Price').Value*ZakaKlientTovar.FieldByName('Num').Value
end;
procedure TForm1.N14Click(Sender: TObject);
begin
CreateSpravForm('Товары','',Form1.Tovar,0);
end;
procedure TForm1.TovarCalcFields(DataSet: TDataSet);
//автоподсчет остатка товара в таблице справочнике товаров. если
меньше 0, то отображаем 0
begin
if Tovar.FieldByName('Ostatok').Value<0 then
Tovar.FieldByName('OstatokL').Value:=0
else
Tovar.FieldByName('OstatokL').Value:=Tovar.FieldByName('Ostatok'
).Value;
end;
procedure TForm1.OtgruzTovarCalcFields(DataSet: TDataSet);
//стоимость для отгрузок
begin
OtgruzTovar.FieldByName('Stoim').Value:=OtgruzTovar.FieldByName(
'Price').Value*OtgruzTovar.FieldByName('Numot1').Value
end;
procedure TForm1.OtgruzTovarTCalcFields(DataSet: TDataSet);
begin
100
OtgruzTovarT.FieldByName('Stoim').Value:=OtgruzTovarT.FieldByNam
e('Price').Value*OtgruzTovarT.FieldByName('Num').Value
end;
procedure TForm1.FormShow(Sender: TObject); //создаем форму
для авторизации
var
Child: TForm8;
begin
Child := TForm8.Create(Application);
Child.Width:=319;
Child.Height:=153;
end;
procedure TForm1.FormCreate(Sender: TObject); //прячем главное
меню (до момента успешного прохождения авторизации)
begin
Menu:=nil;
end;
Function IndToCol(const ind:integer):String; //функция для
перевода номер столбца Excel в его текстовой индекс
begin
case ind of
0: result:='A';
1: result:='B';
2: result:='C';
3: result:='D';
4: result:='E';
5: result:='F';
6: result:='G';
7: result:='H';
8: result:='J';
9: result:='K';
10: result:='L';
11: result:='M';
12: result:='N';
13: result:='O';
14: result:='P';
15: result:='Q';
16: result:='R';
17: result:='S';
18: result:='T';
19: result:='U';
end;
end;
Procedure TForm1.Othet(const Data: TADOQUERY; Otchetname:
string); //процедура для выгрузки отчета в Excel на основании
запроса к БД
var