81
ПРИЛОЖЕНИЯ
Исходный код программных модулей
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Frms,
Dialogs, Menus, DB, ADODB, StdCtrls, Buttons, Grids, DBGrids,
comobj,
ExtCtrls;
type
TFrm1 = class(TFrm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
ADOConnection1: TADOConnection;
DBGrid1: TDBGrid;
Label1: TLabel;
Edt1: TEdt;
BitBtn1: TBitBtn;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
DBGrid2: TDBGrid;
Label2: TLabel;
Edt2: TEdt;
BitBtn2: TBitBtn;
Adotbl1: TAdotbl;
Adotbl1Id: TAutoIncField;
Adotbl1FIO: TWideStringField;
Adotbl1Phone: TWideStringField;
Adotbl1Address: TWideStringField;
Adotbl1Passport: TWideStringField;
DataSource1: TDataSource;
DataSource2: TDataSource;
Adotbl2: TAdotbl;
Adotbl2id: TAutoIncField;
Adotbl2caption: TWideStringField;
Adotbl2path: TWideStringField;
PopupMenu1: TPopupMenu;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
PopupMenu2: TPopupMenu;
N8: TMenuItem;
82
ADOQuery1: TADOQuery;
N9: TMenuItem;
N10: TMenuItem;
BitBtn3: TBitBtn;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
produre N3Click(Send: TObject);
produre BitBtn1Click(Send: TObject);
produre BitBtn2Click(Send: TObject);
produre FrmShow(Send: TObject);
produre Edt1Change(Send: TObject);
produre N7Click(Send: TObject);
produre N8Click(Send: TObject);
produre N5Click(Send: TObject);
produre N6Click(Send: TObject);
produre N4Click(Send: TObject);
produre N2Click(Send: TObject);
produre FrmResize(Send: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Frm1: TFrm1;
implementation
uses shabl;
{$R *.dfm}
produre TFrm1.N3Click(Send: TObject);
begin
frm1.Close;
end;
produre TFrm1.BitBtn1Click(Send: TObject);
begin
Edt1.Clear;
Edt1.SetFocus;
end;
produre TFrm1.BitBtn2Click(Send: TObject);
begin
83
Edt2.Clear;
Edt2.SetFocus;
end;
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);
84
begin
if not DbGrid1.DataSource.DataSet.FieldByName('id').IsNull then
begin
Frm2.Edt1.Text:=DbGrid2.DataSource.DataSet.FieldByName('caption'
).AsString;
Frm2.Edt2.Text:=DbGrid2.DataSource.DataSet.FieldByName('path').A
sString;
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.DataS
ource.DataSet.FieldByName('path').AsString) then
begin
Word := CreateOleObject('Word.Application');
Word.Documents.Add(ExtractFilePath(ParamStr(0))+'shablon\'+DbGri
d2.DataSource.DataSet.FieldByName('path').AsString);
85
Word.visible:=true;
end
else
begin
Showmessage(' Файл
'+DbGrid2.DataSource.DataSet.FieldByName('path').AsString+' не
найден в папке shablon.'+#10+#13+'Проверьте правильность
названия файла и его наличие в указанной папке.');
end;
end;
end;
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;
86
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 }
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;
87
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\'+Ed
t2.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(OpenDialog
1.Filename);
Parameters.ParamByName('id').value:=label3.caption;
execSQL;
end;
CopyFile(Pchar(Edt2.text),
Pchar(ExtractFilePath(ParamStr(0))+'shablon\'+ExtractFileName(Op
enDialog1.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+M
B_DEFBUTTON2)=IdYes
then BitBtn2.Click;
end;
end;
produre TFrm2.BitBtn2Click(Send: TObject);
88
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\'+Ed
t2.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(OpenDialog
1.Filename);
Parameters.ParamByName('id').value:=label3.caption;
execSQL;
end;
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;
89
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;
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');
90
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;
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;