86
produre TFrm1.FrmShow(Send: TObject);
begin
Adotbl1.open;
Adotbl1.Sort:='FIO ASC';
DbGrid1.Collums[0].Width:=ROUND(DbGrid1.Width*0.65);
DbGrid1.Collums[1].Width:=ROUND(DbGrid1.Width*0.25);
Adotbl2.open;
Adotbl2.Sort:='caption ASC';
DbGrid2.Collums[0].Width:=ROUND(DbGrid2.Width*0.65);
DbGrid2.Collums[1].Width:=ROUND(DbGrid2.Width*0.28);
end;
produre TFrm1.Edt1Change(Send: TObject);
begin
if Edt1.text<>'' then
begin
DbGrid1.DataSource.DataSet.Filtered:=false;
DbGrid1.DataSource.DataSet.Filter:='FIO like %'+Edt1.Text+'%';
DbGrid1.DataSource.DataSet.Filtered:=true;
end
else
begin
DbGrid1.DataSource.DataSet.Filtered:=false;
DbGrid1.DataSource.DataSet.Filter:='';
end;
end;
produre TFrm1.N7Click(Send: TObject);
begin
Dbgrid2.DataSource.DataSet.Close;
DbGrid2.DataSource.DataSet.open;
Adotbl2.Sort:='caption ASC';
DbGrid2.Collums[0].Width:=ROUND(DbGrid2.Width*0.65);
DbGrid2.Collums[1].Width:=ROUND(DbGrid2.Width*0.28);
end;
produre TFrm1.N8Click(Send: TObject);
begin
Dbgrid1.DataSource.DataSet.Close;
DbGrid1.DataSource.DataSet.open;
Adotbl1.Sort:='FIO ASC';
DbGrid1.Collums[0].Width:=ROUND(DbGrid1.Width*0.65);
DbGrid1.Collums[1].Width:=ROUND(DbGrid1.Width*0.25);
end;
produre TFrm1.N5Click(Send: TObject);
begin
if not DbGrid1.DataSource.DataSet.FieldByName('id').IsNull then
begin
Frm2.Edt1.Text:=DbGrid2.DataSource.DataSet.FieldByName('caption').AsString;
87
Frm2.Edt2.Text:=DbGrid2.DataSource.DataSet.FieldByName('path').AsString;
Frm2.Caption:='Редактирование шаблона';
Frm2.Label3.Caption:= DbGrid2.DataSource.DataSet.FieldByName('id').AsString;
Frm2.show;
end;
end;
produre TFrm1.N6Click(Send: TObject);
var
s: string;
begin
s := InputBox('Ввод данных','Необходимо указать название нового шаблона','');
if s<>'' then
begin
With AdoQuery1 do
begin
close;
SQL.Clear;
SQl.add('INSERT INTO shablon (caption) VALUES ( :caption )');
Parameters.ParamByName('caption').Value:=s;
EXECSQL;
end;
n7.Click;
end;
end;
produre TFrm1.N4Click(Send: TObject);
var
Word:Variant;
begin
if not DBGrid1.DataSource.DataSet.FieldByName('id').IsNull then
begin
if
fileExists(ExtractFilePath(ParamStr(0))+'shablon\'+DbGrid2.DataSource.DataSet.FieldByNa
me('path').AsString) then
begin
Word := CreateOleObject('Word.Application');
Word.Documents.Add(ExtractFilePath(ParamStr(0))+'shablon\'+DbGrid2.DataSource.DataSe
t.FieldByName('path').AsString);
Word.visible:=true;
end
else
begin
Showmessage(' Файл '+DbGrid2.DataSource.DataSet.FieldByName('path').AsString+' не
найден в папке shablon.'+#10+#13+'Проверьте правильность названия файла и его
наличие в указанной папке.');
end;
end;
end;
88
produre TFrm1.N2Click(Send: TObject);
begin
n7.Click;
n8.Click;
end;
produre TFrm1.FrmResize(Send: TObject);
begin
panel1.Width:=Round((frm1.Width-50)*0.5);
panel2.Width:=Round((frm1.Width-50)*0.5);
panel1.Width:=Round(frm1.Width*0.5);
BitBtn3.Left:=Round(panel5.Width*0.5)-Round(Bitbtn3.Width*0.5);
DbGrid2.Collums[0].Width:=ROUND(DbGrid2.Width*0.65);
DbGrid2.Collums[1].Width:=ROUND(DbGrid2.Width*0.26);
DbGrid1.Collums[0].Width:=ROUND(DbGrid1.Width*0.65);
DbGrid1.Collums[1].Width:=ROUND(DbGrid1.Width*0.26);
end;
end.
unit shabl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Frms,
Dialogs, StdCtrls, Buttons, DB, ADODB, comobj;
type
TFrm2 = class(TFrm)
Label1: TLabel;
Label2: TLabel;
Edt1: TEdt;
BitBtn1: TBitBtn;
Edt2: TEdt;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
OpenDialog1: TOpenDialog;
Label3: TLabel;
ADOQuery1: TADOQuery;
produre BitBtn3Click(Send: TObject);
produre Edt1Change(Send: TObject);
produre Edt2Change(Send: TObject);
produre BitBtn1Click(Send: TObject);
produre BitBtn2Click(Send: TObject);
produre FrmClose(Send: TObject; var Action: TCloseAction);
produre BitBtn4Click(Send: TObject);
private
{ Private declarations }
89
public
{ Public declarations }
end;
var
Frm2: TFrm2;
implementation
Uses main;
{$R *.dfm}
produre TFrm2.BitBtn3Click(Send: TObject);
begin
Frm2.Close;
end;
produre TFrm2.Edt1Change(Send: TObject);
begin
if not (copy(caption,length(caption)-1,1) = '*') then caption:=caption+'*';
end;
produre TFrm2.Edt2Change(Send: TObject);
begin
if not (copy(caption,length(caption)-1,1) = '*') then caption:=caption+'*';
end;
produre TFrm2.BitBtn1Click(Send: TObject);
begin
openDialog1.InitialDir := GetCurrentDir;
if opendialog1.Execute then
begin
if FileExists(opendialog1.FileName) then
begin
Edt2.Text:=Opendialog1.FileName;
end;
end;
end;
produre TFrm2.BitBtn2Click(Send: TObject);
begin
if Edt1.text='' then begin showmessage('Имя шаблона не может быть пустым');
Edt1.SetFocus; exit; end;
if Edt2.text='' then begin showmessage('Необходимо выбрать файл'); BitBtn1.SetFocus;
exit; end;
if not (FileExists(ExtractFilePath(ParamStr(0))+'shablon\'+Edt2.Text)) or
(FileExists(Edt2.Text)) then begin showmessage('Указанный файл шаблона не найден');
BitBtn1.SetFocus; exit; end;
if OpenDialog1.filename='' then
OpenDialog1.filename:=ExtractFilePath(ParamStr(0))+'shablon\'+Edt2.Text;
90
With AdoQuery1 do
begin
close;
SQl.clear;
SQL.add('UPDATE shablon SET caption = :caption, path = :path WHERE id = :id');
Parameters.ParamByName('caption').value:=Edt1.text;
Parameters.ParamByName('path').value:=ExtractFileName(OpenDialog1.Filename);
Parameters.ParamByName('id').value:=label3.caption;
execSQL;
end;
CopyFile(Pchar(Edt2.text),
Pchar(ExtractFilePath(ParamStr(0))+'shablon\'+ExtractFileName(OpenDialog1.Filename)),
true) ;
caption:=copy(caption,0,length(caption)-2);
close;
Frm1.N7.Click;
end;
produre TFrm2.FrmClose(Send: TObject; var Action: TCloseAction);
begin
if copy(caption,length(caption)-1,1) = '*' then
begin
If MessageBox(Handle,PChar('Данные были изменены. Сохранить
изменения?'),PChar('Подтверждение'),MB_ICONINFRMATION+MB_YESNO+MB_DEF
BUTTON2)=IdYes
then BitBtn2.Click;
end;
end;
produre TFrm2.BitBtn2Click(Send: TObject);
begin
if Edt1.text='' then begin showmessage('Имя шаблона не может быть пустым');
Edt1.SetFocus; exit; end;
if Edt2.text='' then begin showmessage('Необходимо выбрать файл'); BitBtn1.SetFocus;
exit; end;
if not (FileExists(ExtractFilePath(ParamStr(0))+'shablon\'+Edt2.Text)) or
(FileExists(Edt2.Text)) then begin showmessage('Указанный файл шаблона не найден');
BitBtn1.SetFocus; exit; end;
if OpenDialog1.filename='' then
OpenDialog1.filename:=ExtractFilePath(ParamStr(0))+'shablon\'+Edt2.Text;
With AdoQuery1 do
begin
close;
SQl.clear;
SQL.add('UPDATE shablon SET caption = :caption, path = :path WHERE id = :id');
Parameters.ParamByName('caption').value:=Edt1.text;
Parameters.ParamByName('path').value:=ExtractFileName(OpenDialog1.Filename);
Parameters.ParamByName('id').value:=label3.caption;
execSQL;
end;
91
produre TFrm2.BitBtn4Click(Send: TObject);
var
Word:Variant;
begin
if fileExists(Edt2.text) then
begin
Word := CreateOleObject('Word.Application');
Word.Documents.Add(Edt2.text);
if not (copy(caption,length(caption)-1,1) = '*') then caption:=caption+'*';
Word.visible:=true;
end
else
begin
Showmessage(' Файл '+Edt2.text+' не найден.'+#10+#13+'Проверьте правильность
названия файла и его наличие в указанной папке.');
end;
end;
end.
unit Connect;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm5 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
92
implementation
Uses DataM;
{$R *.dfm}
procedure TForm5.BitBtn1Click(Sender: TObject);
var
SetF : TextFile;
s:array[1..9] of string;
i:integer;
begin
if Edit1.text='' then begin showmessage('Укажите имя сервера'); exit; end;
if Edit2.text='' then begin showmessage('Укажите логин'); exit; end;
if Edit3.text='' then begin showmessage('Укажите пароль'); exit; end;
if Edit4.text='' then begin showmessage('Укажите имя базы данных'); exit; end;
AssignFile(SetF, ExtractFilePath(ParamStr(0))+'SetF.cfg');
reset(SetF);
For i:=1 to 4 do Readln(Setf,s[i]);
closeFile(SetF);
s[1]:=edit1.text;
s[2]:=edit2.text;
s[3]:=edit3.text;
s[4]:=edit4.text;
Rewrite(SetF);
For i:=1 to 9 do Writeln(Setf,s[i]);
closefile(Setf);
Close;
end;
end.
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, ExtCtrls, Menus, ComObj;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
93
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N3: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
Panel1: TPanel;
ADOConnection1: TADOConnection;
Sotr: TADOTable;
Label1: TLabel;
Label2: TLabel;
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;
94
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;
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;
95
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;
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;