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

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

end;

Procedure Zan(rs,tab,temp:string;tm:integer); begin

if tm=1 then begin

dm.com.CommandText:='Update '+tab+' set log_'+rs+'=FALSE WHERE (id_'+rs+'='+temp+')';

dm.com.Execute;

end;

end;

Procedure jurnal(mesto,deis:string); begin

{mesto:=stringreplace(mesto,'"','+',[rfReplaceAll, rfIgnoreCase]); dm.com.CommandText:='Insert into jurnal (id_us_j,data_j,time_j,mesto_j,deis_j) values ('+id_us+',date(),time(),"'+mesto+'","'+deis+'")'; dm.com.Execute; }

end;

end.

Листинг Б.3 – aDiscip

unit aDiscip; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls, Spin,accessdb; type

TFaDiscip = class(TForm) Label1: TLabel;

Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; e1: TEdit; Label2: TLabel; e2: TEdit; Label3: TLabel; se1: TSpinEdit; Label4: TLabel; se2: TSpinEdit; Label5: TLabel; cb1: TComboBox;

procedure BitBtn2Click(Sender: TObject);

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

procedure BitBtn1Click(Sender: TObject);

procedure cb1KeyPress(Sender: TObject; var Key: Char); procedure cb1Change(Sender: TObject);

procedure e1KeyPress(Sender: TObject; var Key: Char); procedure e2KeyPress(Sender: TObject; var Key: Char);

private

{Private declarations } public

{Public declarations } end;

var

FaDiscip: TFaDiscip; implementation

uses datm; {$R *.dfm}

procedure TFaDiscip.BitBtn2Click(Sender: TObject); begin

closequery;

end;

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

begin accessdb.Zan('dis','discip',id_dis,tm); e1.Clear;e2.Clear; cb1.Clear; se1.Value:=1; se2.Value:=1;

close;

end;

procedure TFaDiscip.BitBtn1Click(Sender: TObject); begin

if (e1.text='') or (e2.text='') or (cb1.Text='') then showmessage('Не все поля заполнены')

else begin

if tm=0 then begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_dis from discip where (nazv_dis="'+e1.text+'") and (sem_dis='+se2.text+')';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='INSERT INTO discip (nazv_dis,fio_dis,lek_dis,sem_dis,id_kf_dis) values ("'+e1.text+'","'+e2.text+'",'+se1.text+','+se2.text+','+id_kf+')';

dm.com.Execute;

application.MessageBox('Добавление прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.dis.Requery();

closequery;

end; end

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_dis from discip where (nazv_dis="'+e1.text+'") and (sem_dis='+se2.text+')';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (id_dis<>dm.temp.Fields[0].asstring) then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='UPDATE discip SET nazv_dis="'+e1.text+'",id_kf_dis="'+id_kf+'",fio_dis="'+e2.text+' ",lek_dis="'+se1.text+'",sem_dis="'+se2.text+'" WHERE (id_dis='+id_dis+')';

dm.com.Execute;

application.MessageBox('Изменение прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.dis.Requery();

closequery;

end;

end;

end;

end;

procedure TFaDiscip.cb1KeyPress(Sender: TObject; var Key: Char);

begin key:=#0; end;

procedure TFaDiscip.cb1Change(Sender: TObject); begin

dm.temp.active:=false;

dm.temp.commandtext:='Select id_kf from kafedra WHERE (nazv_kf="'+cb1.text+'")';

dm.temp.active:=true; id_kf:=dm.temp.fields[0].asstring;

37

end;

procedure TFaDiscip.e1KeyPress(Sender: TObject; var Key: Char);

begin

if (key in['0'..'9']) then key:=#0; end;

procedure TFaDiscip.e2KeyPress(Sender: TObject; var Key: Char);

begin

if (key in['0'..'9']) then key:=#0; end;

end.

Листинг Б.4 – aGruppa

unit aGruppa; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls, Spin,accessdb; type

TFaGruppa = class(TForm) Label1: TLabel;

Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; e1: TEdit;

cb1: TComboBox; Label2: TLabel; Label3: TLabel; se1: TSpinEdit;

procedure cb1KeyPress(Sender: TObject; var Key: Char); procedure BitBtn2Click(Sender: TObject);

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

procedure BitBtn1Click(Sender: TObject); procedure cb1Change(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FaGruppa: TFaGruppa; implementation

uses datm; {$R *.dfm}

procedure TFaGruppa.cb1KeyPress(Sender: TObject; var Key: Char);

begin key:=#0; end;

procedure TFaGruppa.BitBtn2Click(Sender: TObject); begin

closequery;

end;

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

begin accessdb.Zan('gr','gruppa',id_gr,tm); e1.Clear; cb1.Clear; se1.value:=1; close;

end;

procedure TFaGruppa.BitBtn1Click(Sender: TObject); begin

if (e1.text='') OR (cb1.Text='') then showmessage('Не все поля заполнены')

else begin

if tm=0 then begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_gr from gruppa where (nazv_gr="'+e1.text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='INSERT INTO gruppa (nazv_gr,id_sp_gr,sem_gr) values ("'+e1.text+'",'+id_sp+','+se1.text+')';

dm.com.Execute;

application.MessageBox('Добавление прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.gr.Requery();

closequery;

end; end

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_gr from gruppa where (nazv_gr="'+e1.text+'")';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (id_gr<>dm.temp.Fields[0].asstring) then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='UPDATE gruppa SET nazv_gr="'+e1.text+'",id_sp_gr="'+id_sp+'",sem_gr="'+se1.text+' " WHERE (id_gr='+id_gr+')';

dm.com.Execute;

application.MessageBox('Изменение прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.gr.Requery();

closequery;

end;

end;

end;

end;

procedure TFaGruppa.cb1Change(Sender: TObject); begin

dm.temp.active:=false;

dm.temp.commandtext:='Select id_sp from spec WHERE (nazv_sp="'+cb1.text+'")';

dm.temp.active:=true; id_sp:=dm.temp.fields[0].asstring; end;

end.

Листинг Б.5 – aKafedra

unit aKafedra; interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls,accessdb; type

TFaKafedra = class(TForm) Panel1: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

38

Label1: TLabel; e1: TEdit; Label2: TLabel; e2: TEdit;

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

procedure BitBtn2Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject);

procedure e1KeyPress(Sender: TObject; var Key: Char); procedure e2KeyPress(Sender: TObject; var Key: Char);

private

{Private declarations } public

{Public declarations } end;

var

FaKafedra: TFaKafedra; implementation

uses datm; {$R *.dfm}

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

begin accessdb.Zan('kf','kafedra',id_kf,tm); e1.Clear;e2.Clear;

close;

end;

procedure TFaKafedra.BitBtn2Click(Sender: TObject); begin

closequery;

end;

procedure TFaKafedra.BitBtn1Click(Sender: TObject); begin

if (e1.text='') or (e2.Text='') then showmessage('Не все поля заполнены')

else begin

if tm=0 then begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_kf from kafedra where (nazv_kf="'+e1.text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='INSERT INTO kafedra (nazv_kf,fio_kf) values ("'+e1.text+'","'+e2.text+'")';

dm.com.Execute;

application.MessageBox('Добавление прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.kf.Requery();

closequery;

end; end

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_kf from kafedra where (nazv_kf="'+e1.text+'")';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (id_kf<>dm.temp.Fields[0].asstring) then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

39

dm.com.CommandText:='UPDATE kafedra SET nazv_kf="'+e1.text+'",fio_kf="'+e2.text+'" WHERE (id_kf='+id_kf+')';

dm.com.Execute;

application.MessageBox('Изменение прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.kf.Requery();

closequery;

end;

end;

end;

end;

procedure TFaKafedra.e1KeyPress(Sender: TObject; var Key: Char);

begin

if (key in['0'..'9']) then key:=#0; end;

procedure TFaKafedra.e2KeyPress(Sender: TObject; var Key: Char);

begin

if (key in['0'..'9']) then key:=#0; end;

end.

Листинг Б.6 – aspec

unit aspec; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,accessdb, StdCtrls, Buttons, ExtCtrls; type

Tfaspec = class(TForm) Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Label1: TLabel;

e1: TEdit;

procedure BitBtn2Click(Sender: TObject);

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

procedure BitBtn1Click(Sender: TObject);

procedure e1KeyPress(Sender: TObject; var Key: Char); private

{Private declarations } public

{Public declarations } end;

var

faspec: Tfaspec; implementation uses datm;

{$R *.dfm}

procedure Tfaspec.BitBtn2Click(Sender: TObject); begin

closequery;

end;

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

begin accessdb.Zan('sp','spec',id_sp,tm); e1.Clear;

close;

end;

procedure Tfaspec.BitBtn1Click(Sender: TObject); begin

if (e1.text='') then showmessage('Не все поля заполнены') else

begin

if tm=0 then begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_sp from spec where (nazv_sp="'+e1.text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='INSERT INTO spec (nazv_sp) values ("'+e1.text+'")';

dm.com.Execute;

application.MessageBox('Добавление прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.sp.Requery();

closequery;

end; end

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_sp from spec where (nazv_sp="'+e1.text+'")';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (id_sp<>dm.temp.Fields[0].asstring) then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='UPDATE spec SET nazv_sp="'+e1.text+'" WHERE (id_sp='+id_sp+')';

dm.com.Execute;

application.MessageBox('Изменение прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.sp.Requery();

closequery;

end;

end;

end;

end;

procedure Tfaspec.e1KeyPress(Sender: TObject; var Key: Char); begin

if (key in['0'..'9']) then key:=#0; end;

end.

Листинг Б.7 – aStud

unit aStud; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Spin, StdCtrls, Buttons, ExtCtrls,accessdb,UEasyPath,jpeg;

type

TFaStud = class(TForm) Label1: TLabel; Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn;

e1: TEdit;

cb1: TComboBox; Label2: TLabel; Label3: TLabel; e2: TEdit;

40

Button1: TButton; im1: TImage;

od: TOpenDialog; ch: TCheckBox;

procedure BitBtn2Click(Sender: TObject);

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

procedure BitBtn1Click(Sender: TObject); procedure cb1Change(Sender: TObject); procedure Button1Click(Sender: TObject);

procedure e1KeyPress(Sender: TObject; var Key: Char); private

begin

if tm=0 then begin

if ch.Checked=false then showmessage('Вы не выбрали фото')

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_st from stud where (nom_st="'+e2.text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then application.MessageBox('Подобная запись уже существует',pchar(Caption),mb_ok+mb_iconwarning)

else begin

dm.com.CommandText:='INSERT INTO stud (fio_st,id_gr_st,nom_st) values ("'+e1.text+'",'+id_gr+',"'+e2.text+'")';

dm.com.Execute;

dm.temp.Active:=false; dm.temp.CommandText:='Select max(id_st) from stud'; dm.temp.Active:=true; id_st:=dm.temp.Fields[0].AsString;

copyfile(pchar(od.FileName),pchar(photodir+id_st+'.'+UEasyPat h.Ext(od.FileName)),true);

application.MessageBox('Добавление прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.st.Requery();

closequery;

end;

fio_st="'+e1.text+'",id_gr_st="'+id_gr+'",nom_st="'+e2.text+'" WHERE (id_st='+id_st+')';

//showmessage(dm.com.CommandText);

dm.com.Execute;

application.MessageBox('Изменение прошло успешно',pchar(Caption),mb_ok+mb_iconasterisk);

dm.st.Requery();

closequery;

end;

end;

end;

end;

procedure TFaStud.cb1Change(Sender: TObject); begin

dm.temp.active:=false;

dm.temp.commandtext:='Select id_gr from gruppa WHERE (nazv_gr="'+cb1.text+'")';

dm.temp.active:=true; id_gr:=dm.temp.fields[0].asstring; end;

procedure TFaStud.Button1Click(Sender: TObject); begin

if od.Execute then begin

im1.Picture.LoadFromFile(od.FileName);

ch.Checked:=true;

end;

end;

procedure TFaStud.e1KeyPress(Sender: TObject; var Key: Char);

begin

if (key in['0'..'9']) then key:=#0; end;

end.

Листинг Б.8 – chpass

unit chpass; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls; type

TFchpass = class(TForm) Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Label4: TLabel;

cb1: TComboBox; Label1: TLabel; e1: TEdit; Label2: TLabel; e2: TEdit;

Label3: TLabel; e3: TEdit;

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

procedure FormShow(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fchpass: TFchpass; implementation uses datm;

{$R *.dfm}

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

begin

e1.Clear;e2.Clear; e3.Clear; close;

end;

procedure TFchpass.FormShow(Sender: TObject); begin

cb1.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

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

dm.temp.Next;

end;

end;

procedure TFchpass.BitBtn2Click(Sender: TObject); begin

closequery;

end;

procedure TFchpass.BitBtn1Click(Sender: TObject); begin

if (e1.Text='') OR (e2.text='') OR (e3.Text='') OR (cb1.text='') then showmessage('Одно из полей не заполнено')

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select * from pass where (pass="'+e1.Text+'") and (login="'+cb1.text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then showmessage('Ошибка в текущем пароле')

else begin

if e2.Text=e1.Text then showmessage('Пароли не должны совпадать')

else if e2.Text<>e3.Text then showmessage('Новый пароль и подтверждение должны совпадать')

else begin

dm.com.CommandText:='Update pass SET pass="'+e2.Text+'" where (login="'+cb1.text+'")';

dm.com.Execute; showmessage('Пароль изменен'); closequery;

end;

end;

end;

end;

end.

Листинг Б.9 – datm

unit datm; interface uses

SysUtils, Classes, Dialogs, DB, ADODB, ExtCtrls; type

Tdm = class(TDataModule) ado: TADOConnection; com: TADOCommand; temp: TADODataSet;

od: TOpenDialog; sp: TADODataSet; sps: TDataSource; kf: TADODataSet; kfs: TDataSource; dis: TADODataSet; diss: TDataSource; dsp: TADODataSet; dsps: TDataSource; gr: TADODataSet; grs: TDataSource; st: TADODataSet; sts: TDataSource; oc: TADODataSet; ocs: TDataSource; Timer1: TTimer;

procedure Timer1Timer(Sender: TObject); private

{Private declarations } public

{Public declarations } end;

var

dm: Tdm; tm:integer; avtor,grupa:string; tmp,photodir:string; rn:integer; sem:string;

id_sp,id_kf,id_dis,id_ds,id_gr,id_st,id_oc:string; implementation

{$R *.dfm}

procedure Tdm.Timer1Timer(Sender: TObject); var rn:integer;

begin try

if dm.sp.Active=true then begin

rn:=sp.RecNo;

sp.Requery();

sp.recno:=rn;

end;

if dm.kf.Active=true then begin

rn:=kf.RecNo;

kf.Requery();

kf.recno:=rn;

end;

if dm.dis.Active=true then begin

rn:=dis.RecNo;

dis.Requery();

dis.recno:=rn;

end;

if dm.gr.Active=true then begin

rn:=gr.RecNo;

gr.Requery();

gr.recno:=rn;

end;

if dm.st.Active=true then begin

rn:=st.RecNo;

st.Requery();

st.recno:=rn;

end;

if dm.oc.Active=true then begin

rn:=oc.RecNo;

oc.Requery();

oc.recno:=rn;

end; except end; end; end.

Листинг Б.10 – Discip

unit Discip; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Grids, DBGrids,accessdb;

type

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

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N6: TMenuItem;

Panel1: TPanel;

Panel2: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; DBGrid2: TDBGrid; Timer1: TTimer;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure FormShow(Sender: TObject);

procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

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

procedure DBGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure DBGrid1CellClick(Column: TColumn); procedure N7Click(Sender: TObject);

procedure N6Click(Sender: TObject); procedure N5Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FDiscip: TFDiscip;

42

gid:string; implementation

uses aDiscip, datm, Spec; {$R *.dfm}

procedure TFDiscip.N1Click(Sender: TObject); begin

fadiscip.Caption:=caption+' :: '+n1.caption; tm:=0;

dm.temp.active:=false;

dm.temp.commandtext:='Select nazv_kf from kafedra '; dm.temp.active:=true;

While not dm.temp.Eof do begin

fadiscip.cb1.items.add(dm.temp.fields[0].asstring);

dm.temp.next;

end;

fadiscip.ShowModal;

end;

procedure TFDiscip.N2Click(Sender: TObject); begin

if dm.dis.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_dis:=dm.dis.Fields[0].AsString;

if accessdb.Update('dis','discip',id_dis)=false then showmessage('Запись используется другим пользователем')

else begin

dm.temp.active:=false;

dm.temp.commandtext:='Select nazv_kf from kafedra '; dm.temp.active:=true;

While not dm.temp.Eof do begin

fadiscip.cb1.items.add(dm.temp.fields[0].asstring);

dm.temp.next;

end; fadiscip.e1.Text:=dm.dis.fieldbyname('nazv_dis').AsString; fadiscip.e2.Text:=dm.dis.fieldbyname('fio_dis').AsString; fadiscip.cb1.Text:=dm.dis.fieldbyname('nazv_kf').AsString; fadiscip.se1.Text:=dm.dis.fieldbyname('lek_dis').AsString; fadiscip.se2.Text:=dm.dis.fieldbyname('sem_dis').AsString; FaDiscip.cb1Change(Sender);

fadiscip.Caption:=caption+' :: '+n2.caption; fadiscip.ShowModal;

end;

end;

end;

procedure TFDiscip.N3Click(Sender: TObject); begin

if dm.dis.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_dis:=dm.dis.Fields[0].AsString;

if accessdb.Delete('dis','discip',id_dis)=false then showmessage('Запись используется другим пользователем')

else dm.dis.Requery(); end;

end;

procedure TFDiscip.FormShow(Sender: TObject); begin

if dm.dis.RecordCount<>0 then begin id_dis:=dm.dis.Fields[0].AsString; dm.dsp.Active:=false;

dm.dsp.CommandText:='Select id_ds,nazv_sp from disspec,spec WHERE (id_sp=id_sp_ds) and (id_dis_ds='+id_dis+')';

dm.dsp.Active:=true;

end;

end;

procedure TFDiscip.DBGrid1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState); begin

FDiscip.FormShow(Sender);

end;

procedure TFDiscip.DBGrid1KeyPress(Sender: TObject; var Key: Char);

begin FDiscip.FormShow(Sender); end;

procedure TFDiscip.DBGrid1KeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState); begin

FDiscip.FormShow(Sender);

end;

procedure TFDiscip.BitBtn1Click(Sender: TObject); begin

if dm.dis.RecordCount=0 then showmessage('Записи отсутствуют')

else begin

id_dis:=dm.dis.Fields[0].AsString; fspec.DBGrid1.PopupMenu:=nil; dm.sp.Active:=false;

dm.sp.CommandText:='Select * from spec where (ID_SP NOT in (select id_sp_ds FROM disspec WHERE (id_dis_ds = '+id_dis+')))';

dm.sp.Active:=true;

fspec.Caption:='Специальность, '+BitBtn1.Caption+' ВЫБОР ПО ДВОЙНОМУ КЛИКУ';

fspec.ShowModal;

end;

end;

procedure TFDiscip.BitBtn2Click(Sender: TObject); begin

if dm.dsp.RecordCount=0 then showmessage('Записи отсутствуют')

else begin

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

begin tmp:=dm.dsp.Fields[0].AsString;

dm.com.CommandText:='DELETE * FROM disspec WHERE (id_ds='+tmp+')';

dm.com.Execute;

dm.dsp.Requery();

end;

end;

end;

procedure TFDiscip.DBGrid1CellClick(Column: TColumn); begin

if dm.dis.RecordCount<>0 then begin id_dis:=dm.dis.Fields[0].AsString; dm.dsp.Active:=false;

dm.dsp.CommandText:='Select id_ds,nazv_sp from disspec,spec WHERE (id_sp=id_sp_ds) and (id_dis_ds='+id_dis+')';

dm.dsp.Active:=true;

end;

end;

procedure TFDiscip.N7Click(Sender: TObject); begin

dm.dis.Active:=false;

dm.dis.CommandText:='Select id_dis,nazv_dis,lek_dis,sem_dis,fio_dis,nazv_kf FROM discip,kafedra WHERE (id_kf=id_kf_dis) ';

dm.dis.Active:=true;

end;

procedure TFDiscip.N6Click(Sender: TObject); begin

dm.dis.Active:=false;

dm.dis.CommandText:='Select id_dis,nazv_dis,lek_dis,sem_dis,fio_dis,nazv_kf FROM discip,kafedra WHERE (id_kf=id_kf_dis) ORDER BY nazv_dis'; dm.dis.Active:=true;

end;

procedure TFDiscip.N5Click(Sender: TObject); begin

tmp:=inputbox('Фильтр',n5.Caption,''); dm.dis.Active:=false; dm.dis.CommandText:='Select

id_dis,nazv_dis,lek_dis,sem_dis,fio_dis,nazv_kf FROM discip,kafedra WHERE (id_kf=id_kf_dis) and (nazv_dis like "%'+tmp+'%") ';

dm.dis.Active:=true;

end;

end.

Листинг Б.11 – Gruppa

unit Gruppa; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, Grids, DBGrids,accessdb; type

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

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N6: TMenuItem;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N7Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N5Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FGruppa: TFGruppa; implementation

uses aGruppa, datm; {$R *.dfm}

procedure TFGruppa.N1Click(Sender: TObject); begin

fagruppa.Caption:=caption+' :: '+n1.caption; tm:=0;

dm.temp.active:=false;

dm.temp.commandtext:='Select nazv_sp from spec '; dm.temp.active:=true;

While not dm.temp.Eof do begin

fagruppa.cb1.items.add(dm.temp.fields[0].asstring);

dm.temp.next;

end;

fagruppa.ShowModal;

end;

procedure TFGruppa.N2Click(Sender: TObject); begin

if dm.gr.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_gr:=dm.gr.Fields[0].AsString;

if accessdb.Update('gr','gruppa',id_gr)=false then showmessage('Запись используется другим пользователем')

else begin

dm.temp.active:=false; dm.temp.commandtext:='Select nazv_sp from spec '; dm.temp.active:=true;

While not dm.temp.Eof do begin

fagruppa.cb1.items.add(dm.temp.fields[0].asstring);

dm.temp.next;

end; fagruppa.e1.Text:=dm.gr.fieldbyname('nazv_gr').AsString;

fagruppa.cb1.Text:=dm.gr.fieldbyname('nazv_sp').AsString; fagruppa.se1.Text:=dm.gr.fieldbyname('sem_gr').AsString;

FaGruppa.cb1Change(Sender); fagruppa.Caption:=caption+' :: '+n2.caption; fagruppa.ShowModal;

end;

end;

end;

procedure TFGruppa.N3Click(Sender: TObject); begin

if dm.gr.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_gr:=dm.gr.Fields[0].AsString;

if accessdb.Delete('gr','gruppa',id_gr)=false then showmessage('Запись используется другим пользователем')

else dm.gr.Requery(); end;

end;

procedure TFGruppa.N7Click(Sender: TObject); begin

dm.gr.Active:=false;

dm.gr.CommandText:='select id_gr,nazv_gr,nazv_sp,sem_gr from gruppa,spec WHERE (id_sp=id_sp_gr) '; dm.gr.Active:=true;

end;

procedure TFGruppa.N6Click(Sender: TObject); begin

dm.gr.Active:=false;

dm.gr.CommandText:='select id_gr,nazv_gr,nazv_sp,sem_gr from gruppa,spec WHERE (id_sp=id_sp_gr) ORDER BY sem_gr ';

dm.gr.Active:=true;

end;

procedure TFGruppa.N5Click(Sender: TObject); begin

tmp:=inputbox('Фильтр',n5.Caption,''); dm.gr.Active:=false;

44

dm.gr.CommandText:='select id_gr,nazv_gr,nazv_sp,sem_gr from gruppa,spec WHERE (id_sp=id_sp_gr) and (nazv_gr like "%'+tmp+'%")';

dm.gr.Active:=true;

end;

end.

Листинг Б.12 – kafedra

unit kafedra; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, Grids, DBGrids,accessdb; type

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

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N6: TMenuItem;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N7Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N5Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fkafedra: TFkafedra; implementation

uses aKafedra, datm; {$R *.dfm}

procedure TFkafedra.N1Click(Sender: TObject); begin

fakafedra.Caption:=caption+' :: '+n1.caption; tm:=0;

fakafedra.ShowModal;

end;

procedure TFkafedra.N2Click(Sender: TObject); begin

if dm.kf.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_kf:=dm.kf.Fields[0].AsString;

if accessdb.Update('kf','kafedra',id_kf)=false then showmessage('Запись используется другим пользователем')

else begin

fakafedra.e1.Text:=dm.kf.fieldbyname('nazv_kf').AsString; fakafedra.e2.Text:=dm.kf.fieldbyname('fio_kf').AsString;

fakafedra.Caption:=caption+' :: '+n2.caption; fakafedra.ShowModal;

end;

end;

end;

procedure TFkafedra.N3Click(Sender: TObject);

begin

if dm.kf.RecordCount=0 then showmessage('Записи отсутствуют')

else begin tm:=1;

id_kf:=dm.kf.Fields[0].AsString;

if accessdb.Delete('kf','kafedra',id_kf)=false then showmessage('Запись используется другим пользователем')

else dm.kf.Requery(); end;

end;

procedure TFkafedra.N7Click(Sender: TObject); begin

dm.kf.Active:=false; dm.kf.CommandText:='Select * from kafedra'; dm.kf.Active:=true;

end;

procedure TFkafedra.N6Click(Sender: TObject); begin

dm.kf.Active:=false;

dm.kf.CommandText:='Select * from kafedra ORDER BY fio_kf';

dm.kf.Active:=true;

end;

procedure TFkafedra.N5Click(Sender: TObject); begin

tmp:=inputbox('Фильтр',n5.Caption,''); dm.kf.Active:=false;

dm.kf.CommandText:='Select * from kafedra WHERE (nazv_kf like "%'+tmp+'%")';

dm.kf.Active:=true;

end;

end.

Листинг Б.13 – Ocenka

unit Ocenka; interface uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, Grids, DBGrids, StdCtrls, ExtCtrls, Buttons, WordXP,

OleServer,registry,math; type

TFOcenka = class(TForm) DBGrid1: TDBGrid; Panel1: TPanel;

Label1: TLabel; cb1: TComboBox; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; cb2: TComboBox; Label6: TLabel; Panel2: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; cb3: TComboBox;

WordApplication1: TWordApplication; WordDocument1: TWordDocument;

procedure cb1KeyPress(Sender: TObject; var Key: Char); procedure cb2KeyPress(Sender: TObject; var Key: Char); procedure FormShow(Sender: TObject);

procedure cb1Change(Sender: TObject); procedure cb2Change(Sender: TObject);

45

procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject);

procedure cb3KeyPress(Sender: TObject; var Key: Char); procedure BitBtn3Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FOcenka: TFOcenka; implementation

uses datm; {$R *.dfm}

procedure TFOcenka.cb1KeyPress(Sender: TObject; var Key: Char);

begin key:=#0; end;

procedure TFOcenka.cb2KeyPress(Sender: TObject; var Key: Char);

begin key:=#0; end;

procedure TFOcenka.FormShow(Sender: TObject); begin

cb1.Clear;

dm.temp.active:=false; dm.temp.commandtext:='Select nazv_gr from gruppa '; dm.temp.active:=true;

While not dm.temp.Eof do begin

focenka.cb1.items.add(dm.temp.fields[0].asstring);

dm.temp.next;

end;

cb2.Clear; id_dis:=''; cb2.Enabled:=false; end;

procedure TFOcenka.cb1Change(Sender: TObject); begin

dm.temp.active:=false;

dm.temp.commandtext:='Select id_gr,sem_gr,id_sp from gruppa,spec WHERE (nazv_gr="'+cb1.text+'") and (id_sp=id_sp_gr)';

dm.temp.active:=true; id_gr:=dm.temp.Fields[0].AsString; sem:=dm.temp.Fields[1].AsString; id_sp:=dm.temp.Fields[2].AsString; label6.Caption:=sem;

cb2.Clear; id_dis:=''; label3.Caption:=''; dm.temp.active:=false;

dm.temp.commandtext:='Select ([nazv_dis]&", сем.: "&[sem_dis]) as sem from discip,disspec WHERE (id_dis=id_dis_ds) and (id_sp_ds='+id_sp+') and (sem_dis='+sem+') ';

dm.temp.active:=true; While not dm.temp.Eof do

begin focenka.cb2.items.add(dm.temp.fields[0].asstring); dm.temp.next;

end;

cb2.Enabled:=true;

end;

procedure TFOcenka.cb2Change(Sender: TObject); begin

dm.temp.active:=false;

dm.temp.commandtext:='Select id_dis,fio_dis from discip WHERE (([nazv_dis]&", сем.: "&[sem_dis])="'+cb2.Text+'")'; dm.temp.active:=true;

id_dis:=dm.temp.Fields[0].AsString; label3.Caption:=dm.temp.Fields[1].AsString; end;

procedure TFOcenka.BitBtn1Click(Sender: TObject); begin

if (cb1.Text='') OR (cb2.Text='') then showmessage('Не выбраны параметры')

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_oc from ocenka WHERE (id_dis_oc='+id_dis+') and (id_gr_oc='+id_gr+')';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then begin

if application.MessageBox('Вы хотите удалить предыдущую ведомость?','Удаление',mb_yesno+mb_iconquestion)=idyes then

begin

Dm.com.CommandText:='DELETE * FROM ocenka WHERE (id_dis_oc='+id_dis+') and (id_gr_oc='+id_gr+')';

dm.com.Execute;

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_st from stud WHERE (id_gr_st='+id_gr+')';

dm.temp.Active:=true; While not dm.temp.Eof do

begin id_st:=dm.temp.Fields[0].AsString;

dm.com.CommandText:='Insert into ocenka (id_dis_oc,id_gr_oc,id_st_oc) values ('+id_dis+','+id_gr+','+id_st+')';

dm.com.Execute;

dm.temp.Next;

end;

end; end

else begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_st from stud WHERE (id_gr_st='+id_gr+')';

dm.temp.Active:=true; While not dm.temp.Eof do

begin id_st:=dm.temp.Fields[0].AsString;

dm.com.CommandText:='Insert into ocenka (id_dis_oc,id_gr_oc,id_st_oc) values ('+id_dis+','+id_gr+','+id_st+')';

dm.com.Execute;

dm.temp.Next;

end;

end;

dm.oc.Requery();

end;

end;

procedure TFOcenka.BitBtn2Click(Sender: TObject); var

Template,NewTemplate,FindText, NewStr, Replace,ReplaceWith:OleVariant;

LinkToFile,SaveWithDocument,Range:OleVariant; Table1: Table;

i: integer;

Reg: TRegistry; flag:boolean; ocen:integer;

begin

if (id_gr='') or (id_dis='') then showmessage('Не выбраны параметры')

else