Курсовые работы / ПРИС П _3

com: TADOCommand; temp: TADODataSet; od: TOpenDialog;

p: TADODataSet; ps: TDataSource; t: TADODataSet; ts: TDataSource;

tov: TADODataSet; tovs: TDataSource; skl: TADODataSet; sklS: TDataSource; pos: TADODataSet; posS: TDataSource; pok: TADODataSet; poks: TDataSource; pr: TADODataSet; prs: TDataSource; ras: TADODataSet; rass: TDataSource; poz: TADODataSet; pozs: TDataSource;

temp2: TADODataSet; rc: TADODataSet; rcs: TDataSource;

private

{Private declarations } public

{Public declarations } end;

var

DM: TDM; tm:integer; tmp,tmpc:string;

id_t,id_p,id_tov,id_pos,id_pok:string; pr:integer;

implementation

{$R *.dfm}

end.

unit Dostav;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, ADODB;

type

TFDostav = class(TForm) ADOConnection1: TADOConnection; ADOQuery1: TADOQuery; DataSource1: TDataSource; DBGrid1: TDBGrid;

private

{Private declarations } public

{Public declarations } end;

var

FDostav: TFDostav;

implementation

{$R *.dfm}

end.

42!

unit main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,inifiles, Menus, ExtCtrls,jpeg,registry, WordXP, OleServer;

type

TFmain = class(TForm) MainMenu1: TMainMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

Image1: TImage;

N9: TMenuItem;

N18: TMenuItem;

N19: TMenuItem;

N20: TMenuItem;

WordApplication1: TWordApplication; WordDocument1: TWordDocument; N21: TMenuItem;

N22: TMenuItem;

N23: TMenuItem;

N24: TMenuItem;

N25: TMenuItem;

N26: TMenuItem;

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure N3Click(Sender: TObject);

procedure N4Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure FormShow(Sender: TObject); function data(data:tdatetime):string; function Update(rs,tab:string):boolean; function Delete(rs,tab,temp:string):boolean; procedure N8Click(Sender: TObject); procedure N10Click(Sender: TObject); procedure N15Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N13Click(Sender: TObject); procedure N14Click(Sender: TObject); procedure N16Click(Sender: TObject); procedure N17Click(Sender: TObject); procedure N18Click(Sender: TObject); procedure N20Click(Sender: TObject); procedure N21Click(Sender: TObject); procedure N22Click(Sender: TObject); procedure N23Click(Sender: TObject); procedure N26Click(Sender: TObject); procedure N24Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

43!

var

Fmain: TFmain;

implementation

uses datm, chpass, Proiz, Tip, tovar, Sklad, Post, Pokup, Prixod, Rasxod, Dati;

{$R *.dfm}

procedure TFmain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin

if application.MessageBox('Вы хоите выйти из программы?','Выход',mb_yesno+mb_iconquestion)=idyes then begin

application.Terminate; end

else canclose:=false; end;

procedure TFmain.N3Click(Sender: TObject); var inifile:tinifile;

dbp:string; begin

if dm.od.Execute then begin

if application.MessageBox('Вы хотите сохранить путь к данной БД в файле настроек?','Путь к БД',mb_yesno +mb_iconquestion)=idyes then

begin

IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'options.ini'); inifile.WriteString('options','dbpath',dm.od.FileName);

IniFile.Free;

end;

dbp:=dm.od.FileName;

dm.ADO.Connected:=false;

dm.ADO.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+dbp+';Persist Security Info=False'; dm.ADO.Connected:=true;

end;

end;

procedure TFmain.N4Click(Sender: TObject); var inifile:tinifile;

dbp:string; begin

IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'options.ini'); // загрузка из фала настроек пути к базе

DBP := IniFile.ReadString('options', 'dbPath', ''); IniFile.Free;

copyfile(pchar(DBP),pchar(ExtractFilePath(Application.ExeName)+'Архив\base_'+datetostr(date) +'_'+stringreplace(timetostr(time),':','.',[rfReplaceAll, rfIgnoreCase])+'.mdb'),true);

if fileexists(ExtractFilePath(Application.ExeName)+'Архив\base_'+datetostr(date)+'_'+stringreplace(timetostr(time),':','.', [rfReplaceAll, rfIgnoreCase])+'.mdb') =true then showmessage('Резервная копия создана успешно')

else showmessage('Ошибка при создании резервной копии'); end;

procedure TFmain.N6Click(Sender: TObject); begin

fchpass.ShowModal;

end;

procedure TFmain.N2Click(Sender: TObject); begin

closequery;

end;

procedure TFmain.FormShow(Sender: TObject); begin

if fileexists('photo.jpg') then begin

image1.Picture.LoadFromFile('photo.jpg');

end;

44!

end;

function TFmain.data (data:tdatetime):string; var g,m,d:word;

begin decodedate(data,g,m,d);

result:=''+currtostr(m)+'/'+currtostr(d)+'/'+currtostr(g)+'';

end;

function TFmain.Update(rs,tab:string):boolean; begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select log_'+rs+' from '+tab+' where (id_'+rs+'='+tmp+')'; dm.temp.Active:=true;

if dm.temp.Fields[0].AsBoolean=true then begin

result:=false; end

else begin

dm.com.CommandText:='Update '+tab+' set log_'+rs+'=TRUE where id_'+rs+'='+tmp+''; dm.com.Execute;

result:=true;

end;

end;

function TFmain.Delete(rs,tab,temp:string):boolean; begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select log_'+rs+' from '+tab+' where (id_'+rs+'='+tmp+')'; dm.temp.Active:=true;

if dm.temp.Fields[0].AsBoolean=true then begin

result:=false; end

else if application.MessageBox('Вы хотите удалить запись?','Удаление',mb_yesno+mb_iconquestion)=idyes then begin

dm.com.CommandText:='Delete * from '+tab+' where (id_'+rs+'='+tmp+')'; dm.com.Execute;

result:=true;

showmessage('Удаление прошло успешно'); end;

end;

procedure TFmain.N8Click(Sender: TObject); begin

dm.p.Active:=false;

dm.p.CommandText:='select id_p, nazv_p from Proiz'; dm.p.Active:=true;

fproiz.showmodal;

end;

procedure TFmain.N10Click(Sender: TObject); begin

dm.t.Active:=false;

dm.t.CommandText:='select id_t, nazv_t from tip'; dm.t.Active:=true;

ftip.showmodal;

end;

procedure TFmain.N15Click(Sender: TObject); begin

dm.tov.Active:=false;

dm.tov.CommandText:='select id_tov,nazv_tov,nazv_p,nazv_t,rasf_tov,st_tov from tovar,proiz,tip where (id_t=id_t_tov) and (id_p_tov=id_p)';

dm.tov.Active:=true;

ftovar.showmodal;

end;

procedure TFmain.N9Click(Sender: TObject); begin

dm.skl.Active:=false;

45!

dm.skl.CommandText:='select ([nazv_tov]&", произв.: "&[nazv_p]&", тип:"&[nazv_t]&", расфс."&[rasf_tov]) as tov,kol_tov from tovar,proiz,tip where (id_t=id_t_tov) and (id_p_tov=id_p)';

dm.skl.Active:=true;

fsklad.showmodal;

end;

procedure TFmain.N13Click(Sender: TObject); begin

dm.pos.Active:=false;

dm.pos.CommandText:='select id_pos, nazv_pos, adr_pos, fio_pos, kt_pos, rs_pos from Post'; dm.pos.Active:=true;

fPost.showmodal;

end;

procedure TFmain.N14Click(Sender: TObject); begin

dm.pok.Active:=false;

dm.pok.CommandText:='select id_pok, nazv_pok, adr_pok, fio_pok, kt_pok, rs_pok from Pokup'; dm.pok.Active:=true;

fpokup.showmodal;

end;

procedure TFmain.N16Click(Sender: TObject); begin

dm.pr.Active:=false;

dm.pr.CommandText:='select id_pr,([nazv_tov]&", произв.: "&[nazv_p]&", тип:"&[nazv_t]&", расфс."&[rasf_tov]) as tov,cena_pr,kol_pr,(cena_pr*kol_pr) as st,nazv_pos,data_pr'+

' from tovar,proiz,tip,prixod,post where (id_t=id_t_tov) and (id_p_tov=id_p) and (id_pos=id_pos_pr) and (id_tov=id_tov_pr)'; dm.pr.Active:=true;

fprixod.showmodal;

end;

procedure TFmain.N17Click(Sender: TObject); begin

dm.ras.Active:=false;

dm.ras.CommandText:='select id_ras,nazv_pok,(select count(id_poz) from pozicii where (id_ras=id_ras_poz)) as pozic,(select sum(st_poz) '+

'from pozicii where (id_ras=id_ras_poz)) as summa,data_ras from rasxod,pokup where (id_pok=id_pok_ras)'; dm.ras.Active:=true;

fRasxod.showmodal;

end;

IniFile.writeInteger('options', 'pr', pr); IniFile.Free;

bl:=true;

end; except

showmessage('Наценка должна быть целым числом!'); end;

end;

end;

procedure TFmain.N20Click(Sender: TObject); var

46!

Template,NewTemplate,FindText, NewStr, Replace,ReplaceWith:OleVariant; LinkToFile,SaveWithDocument,Range:OleVariant;

Table1: Table; i: integer; flag:boolean; Reg: TRegistry;

begin

//Проверяем, инсталлирован ли Word Reg := TRegistry.Create;

Reg.RootKey := HKEY_CLASSES_ROOT; flag:=reg.KeyExists('Word.Application'); reg.Free;

//flag:=true;

if flag=false then begin

application.MessageBox('Word не устанволен','Отчет',mb_ok+mb_iconstop); exit;

end;

WordApplication1.Connect; // Устанавливаем связь с сервером //Открываем шаблон otchet.dot в Word

Template:=ExtractFilePath(Application.EXEName)+'\Шаблоны\Прайс.dot'; //путь к шаблону документа WordApplication1.Documents.Add(Template,EmptyParam,EmptyParam,EmptyParam);// создаем документ на основе

шаблона

WordDocument1.ConnectTo(WordApplication1.ActiveDocument); //Связываем компонент WordDocument1 c активным документом (т.е. с только что созданным документом)

//Заполняем таблицу списка объектов

Table1:=WordDocument1.Tables.Item(1); //связываем имя Table1 с первой таблицей документа //WordDocument1.Tables - это массив таблиц документа (тип Tables), а WordDocument1.Tables.Item(i) - i-ая таблица

Replace:=true; // параметр, задающий режим замены

FindText:='#1'; // что меняем ReplaceWith:=datetostr(Date); // на что меняем

WordDocument1.Range.Find.Execute(FindText,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,ReplaceWith,Replace,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

dm.temp2.Active:=false;

dm.temp2.CommandText:='select id_tov_rc,max(data_rc) from rcen WHERE (data_rc<=#'+fmain.data(Date)+'#) group by id_tov_rc';

dm.temp2.Active:=true;

i:=2;

while not dm.temp2.Eof do begin

dm.temp.Active:=false;

dm.temp.CommandText:='select id_tov,nazv_tov,nazv_p,nazv_t,rasf_tov,st_tov from tovar,proiz,tip,rcen where (id_t=id_t_tov) and (id_p_tov=id_p) and (id_tov=id_tov_rc) and (data_rc=#'+fmain.data(dm.temp2.Fields[1].asdatetime)+'#) and (id_tov_rc = '+dm.temp2.Fields[0].AsString+') ';

dm.temp.Active:=true;

Table1.Rows.Add(EmptyParam);

Table1.Cell(i, 1).Range.Text := dm.temp.Fields[1].AsString; Table1.Cell(i, 2).Range.Text := dm.temp.Fields[2].AsString; Table1.Cell(i, 3).Range.Text := dm.temp.Fields[3].AsString; Table1.Cell(i, 4).Range.Text := dm.temp.Fields[4].AsString; Table1.Cell(i, 5).Range.Text := dm.temp.Fields[5].AsString; inc(i);dm.temp2.next;

end;

Table1.Rows.Item(i).Delete;

WordApplication1.Visible:=true; //делаем приложение MS Word видимым

WordApplication1.Disconnect; // Разрываем связь с серверо

end;

procedure TFmain.N21Click(Sender: TObject); begin

tm:=3;

fdati.ShowModal;

end;

47!

procedure TFmain.N22Click(Sender: TObject); begin

tm:=4;

fdati.ShowModal;

end;

procedure TFmain.N23Click(Sender: TObject); begin

FDostav.Show;

end;

procedure TFmain.N26Click(Sender: TObject); begin

FZakazi.Show;

end;

procedure TFmain.N24Click(Sender: TObject); begin

FDostav.Show;

end;

end.

unit pass;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,inifiles;

type

TFpass = class(TForm) Panel1: TPanel; Panel2: TPanel; Button1: TButton; Button2: TButton; Label1: TLabel;

cb: TComboBox; Label2: TLabel; e: TEdit;

procedure cbKeyPress(Sender: TObject; var Key: Char);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormShow(Sender: TObject);

procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fpass: TFpass;

implementation

uses datm, main;

{$R *.dfm}

procedure TFpass.cbKeyPress(Sender: TObject; var Key: Char); begin

key:=#0;

end;

procedure TFpass.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin

if application.MessageBox('Вы хоите выйти из программы?','Выход',mb_yesno+mb_iconquestion)=idyes then begin

application.Terminate;

48!

end

else canclose:=false; end;

DBP := IniFile.ReadString('options', 'dbPath', ''); pr := IniFile.ReadInteger('options', 'pr', 0); IniFile.Free;

dm.od.InitialDir:=ExtractFilePath(Application.ExeName); try

dm.ADO.Connected:=false;

dm.ADO.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+dbp+';Persist Security Info=False'; dm.ADO.Connected:=true;

except

if application.MessageBox('Произошла ошибка при подключении к базе данных!'#13'Хотите указать месторасположение базы данных?','База данных',mb_yesno+mb_iconquestion)=idyes then

begin

if dm.od.Execute then begin

IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'options.ini'); inifile.WriteString('options','dbpath',dm.od.FileName);

IniFile.Free;

dbp:=dm.od.FileName;

dm.ADO.Connected:=false;

dm.ADO.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+dbp+';Persist Security Info=False'; dm.ADO.Connected:=true;

end else

begin dm.ado.Connected:=false;

showmessage('Вы вышли из программы'); application.Terminate;

end; end

else begin

dm.ado.Connected:=false; showmessage('Вы вышли из программы'); application.Terminate;

end;

end;

cb.Clear; e.Clear; dm.temp.Active:=false;

dm.temp.CommandText:='Select login from pass order by login'; dm.temp.Active:=true;

while not dm.temp.Eof do begin

cb.Items.Add(dm.temp.Fields[0].AsString);

dm.temp.Next;

end;

end;

procedure TFpass.Button1Click(Sender: TObject); begin

closequery;

end;

procedure TFpass.Button2Click(Sender: TObject); begin

if cb.Text='' then showmessage('Вы не выбрали пользователя') else if e.Text='' then showmessage('Вы не ввели пароль')

else begin

dm.TEMP.Active:=false;

dm.TEMP.CommandText:='Select log fROM pass WHERE (login="'+cb.Text+'") AND (pass="'+e.Text+'")'; dm.TEMP.Active:=true;

49!

if dm.TEMP.RecordCount=0 then showmessage('Ошибка в логине и(или) пароле') else

begin

if dm.temp.fields[0].asboolean=true then begin

fpass.Hide;

fmain.ShowModal; end

else begin

fmain.N19.Visible:=false;

fmain.N6.Visible:=false;

fmain.N4.Visible:=false;

fmain.N3.Visible:=false;

fmain.N7.Visible:=false;

fpass.Hide;

fmain.ShowModal;

end;

end;

end;

end;

end.

unit Pokup;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, Grids, DBGrids;

type

TFPokup = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N11Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FPokup: TFPokup;

implementation

uses aPokup, datm, main;

{$R *.dfm}

procedure TFPokup.N1Click(Sender: TObject); begin

50!

tm:=0;

fapokup.ShowModal;

end;

procedure TFPokup.N2Click(Sender: TObject); begin

if dm.pok.Fields[0].AsString='' then begin

showmessage('Запись для редактирования отсутствует'); exit;

end;

tmp:=dm.pok.Fields[0].AsString;tm:=1;

//****************************** if fmain.Update('pok','pokup')=false then

begin

showmessage('Данная запись используется другим пользователем'); exit;

end;

//******************************

fapokup.e1.Text:=dm.pok.fieldbyname('nazv_pok').AsString; fapokup.e2.Text:=dm.pok.fieldbyname('adr_pok').AsString; fapokup.e3.Text:=dm.pok.fieldbyname('fio_pok').AsString; fapokup.e4.Text:=dm.pok.fieldbyname('kt_pok').AsString; fapokup.e5.Text:=dm.pok.fieldbyname('rs_pok').AsString;

fapokup.ShowModal;

end;

procedure TFPokup.N3Click(Sender: TObject); begin

if dm.pok.Fields[0].AsString='' then begin

showmessage('Запись для редактирования отсутствует'); exit;

end;

tmp:=dm.pok.Fields[0].AsString;tm:=1;

if fmain.Delete('pok','pokup',tmp)=false then begin

showmessage('Данная запись используется другим пользователем'); exit;

end

else dm.pok.Requery(); end;

procedure TFPokup.N8Click(Sender: TObject); begin

dm.pok.Active:=false;

dm.pok.CommandText:='select id_pok, nazv_pok, adr_pok, fio_pok, kt_pok, rs_pok from Pokup'; dm.pok.Active:=true;

end;

procedure TFPokup.N5Click(Sender: TObject); begin

dm.pok.Active:=false;

dm.pok.CommandText:='select id_pok, nazv_pok, adr_pok, fio_pok, kt_pok, rs_pok from Pokup order by fio_pok'; dm.pok.Active:=true;

end;

procedure TFPokup.N6Click(Sender: TObject); begin

dm.pok.Active:=false;

dm.pok.CommandText:='select id_pok, nazv_pok, adr_pok, fio_pok, kt_pok, rs_pok from Pokup order by nazv_pok'; dm.pok.Active:=true;

end;

procedure TFPokup.N9Click(Sender: TObject); begin

tmp:=inputbox('Поиск','Введите значение',''); dm.pok.Active:=false;

dm.pok.CommandText:='select id_pok, nazv_pok, adr_pok, fio_pok, kt_pok, rs_pok from Pokup where (nazv_pok like "%'+tmp +'%")';

51!