Добавил:

sbmpei Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Смоленский Филиал Национальный Исследовательский Университет Московский Энергетический Институт

Предмет:

Проектирование информационных систем

Файл:

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

.pdf

Скачиваний:

Добавлен:

17.06.2023

Размер:

2.58 Mб

Скачать

☆

<<< < Предыдущая 1 2 34 / 84 5 6 7 8 > Следующая >>>

uses	{$R *.dfm}
SysUtils, Classes, Dialogs, DB, ADODB, ExtCtrls;	procedure Tdm.Timer1Timer(Sender: TObject);
type	begin
Tdm = class(TDataModule)	try
ado: TADOConnection;	if dg.Active=true then
temp: TADODataSet;	begin
od: TOpenDialog;	rind:=dg.RecNo;
com: TADOCommand;	dg.Requery();
dg: TADODataSet;	dg.RecNo:=rind;
dgs: TDataSource;	end;
ot: TADODataSet;	if ot.Active=true then
ots: TDataSource;	begin
vr: TADODataSet;	rind:=ot.RecNo;
vrs: TDataSource;	ot.Requery();
pal: TADODataSet;	ot.RecNo:=rind;
pals: TDataSource;	end;
pac: TADODataSet;	if vr.Active=true then
pacs: TDataSource;	begin
dp: TADODataSet;	rind:=vr.RecNo;
dps: TDataSource;	vr.Requery();
bl: TADODataSet;	vr.RecNo:=rind;
bls: TDataSource;	end;
Timer1: TTimer;	if pal.Active=true then
procedure Timer1Timer(Sender: TObject);	begin
private	rind:=pal.RecNo;
{ Private declarations }	pal.Requery();
public	pal.RecNo:=rind;
{ Public declarations }	end;
end;	if pac.Active=true then
var	begin
dm: Tdm;	rind:=pac.RecNo;
tmp,tmps,foto:string;	pac.Requery();
ind,rind,tm:integer;	pac.RecNo:=rind;
id_ot,id_vr,id_pal,id_pac,id_dg:string;	end;
implementation	if dp.Active=true then

begin rind:=dp.RecNo; dp.Requery(); dp.RecNo:=rind;

end;

if bl.Active=true then

begin

rind:=bl.RecNo;

bl.Requery();

bl.RecNo:=rind;

end;

except

end;

end. var

Fpass: TFpass;

implementation

uses datm, main, otdel, Palata, Vrach, Pacient, Diagnoz;

{$R *.dfm}

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

begin

key:=#0;

end;

procedure TFpass.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

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

begin

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

begin

dm.ado.Connected:=false;

application.Terminate;

end

else canclose:=false;

end;

procedure TFpass.FormShow(Sender: TObject);

var inifile:tinifile;

dbp:string;

begin

fpass.Caption:=application.Title;

IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Data\options.ini' );

DBP := IniFile.ReadString('base', 'Path', '');

IniFile.Free;

dm.od.InitialDir:=ExtractFilePath(Application.ExeName)+'Data\';

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)+'Data\options.ini' );

inifile.WriteString('base','path',dm.od.FileName);

IniFile.Free;

dbp:=dm.od.FileName;	else
dm.ADO.Connected:=false;	begin
	if e1.Text<>'' then
dm.ADO.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data
Source='+dbp+';Persist Security Info=False';	begin
dm.ADO.Connected:=true;	dm.temp.Active:=false;
end	dm.temp.CommandText:='Select r from pass where
	(login="'+cb.Text+'") and (pass="'+e1.Text+'")';
else
	dm.temp.Active:=true;
begin
	if dm.temp.RecordCount=0 then showmessage('Данный пароль не
dm.ado.Connected:=false;	соответствует выбранному имени пользователя')
showmessage('Вы вышли из программы');	else
application.Terminate;
end;	begin
end
else	//админ
begin	if dm.temp.Fields[0].asinteger=0 then
dm.ado.Connected:=false;	begin
showmessage('Вы вышли из программы');	fpass.Hide;
application.Terminate;	fmain.ShowModal;
end;	end
end;	//работник
dm.temp.Active:=false;	else
dm.temp.CommandText:='Select login from pass order by login';	begin
dm.temp.Active:=true;	fmain.N6.Enabled:=false;
while not dm.temp.Eof do	fmain.N2.Enabled:=false;
begin	fotdel.N3.Enabled:=false;
cb.Items.Add(dm.temp.Fields[0].AsString);	fpalata.N3.Enabled:=false;
dm.temp.Next;	fvrach.N3.Enabled:=false;
end;	fpacient.N3.Enabled:=false;
	fdiagnoz.N3.Enabled:=false;
end;	fpass.Hide;
	fmain.ShowModal;
procedure TFpass.BitBtn1Click(Sender: TObject);	end
begin	end;
if cb.Text='' then showmessage('Вы не выбрали имя пользователя')	end
else if (e1.Text='') and (cb.Text<>'Гость') then showmessage('Вы не	else
ввели пароль')

begin	BitBtn1: TBitBtn;
fmain.N6.Enabled:=false;	BitBtn2: TBitBtn;
fmain.N2.Enabled:=false;	cb1: TComboBox;
fmain.N8.Enabled:=false;	procedure cb1Change(Sender: TObject);
fmain.N14.Enabled:=false;	procedure cb1KeyPress(Sender: TObject; var Key: Char);
fmain.N15.Enabled:=false;	procedure BitBtn1Click(Sender: TObject);
fmain.N16.Enabled:=false;	procedure BitBtn2Click(Sender: TObject);
fotdel.N1.Enabled:=false;	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
fotdel.N2.Enabled:=false;	private
fotdel.N3.Enabled:=false;	{ Private declarations }
fpalata.N1.Enabled:=false;	public
fpalata.N2.Enabled:=false;	{ Public declarations }
fpalata.N3.Enabled:=false;	end;
fvrach.N1.Enabled:=false;	var
fvrach.N2.Enabled:=false;	FaBolList: TFaBolList;
fvrach.N3.Enabled:=false;	implementation
fpass.Hide;	uses datm;
fmain.ShowModal;	{$R *.dfm}
end;	procedure TFaBolList.cb1Change(Sender: TObject);
end;	begin
end;	if id_vr<>'' then
end.	begin
unit aBolList;	dm.com.CommandText:='Update vrach set log_vr=false WHERE
	(id_vr='+id_vr+')';
	dm.com.Execute;
interface
	id_vr:='';
	end;
uses
	dm.temp.Active:=false;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,	dm.temp.CommandText:='select id_vr from vrach where (fio_vr =
	"'+cb1.text+'") and (log_vr=false)';
Dialogs, StdCtrls, Buttons, ExtCtrls;
	dm.temp.Active:=true;
	if dm.temp.RecordCount=0 then
type
	begin
TFaBolList = class(TForm)
	showmessage('Запись используется другим пользователем');
Panel1: TPanel;
	id_vr:='';
Label1: TLabel;
	cb1.Text:='';
Panel2: TPanel;

end else

begin id_vr:=dm.temp.fields[0].asstring;

dm.com.CommandText:='Update vrach set log_vr=true WHERE (id_vr='+id_vr+')';

dm.com.Execute;

end;

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

key:=#0;

end;

procedure TFaBolList.BitBtn1Click(Sender: TObject); begin

if (id_vr='')then showmessage('Вы не заполнили одно или несколько полей')

else begin

dm.com.CommandText:='Insert into BolList (id_pac_bl,id_vr_bl,datav_bl) values ('+id_pac+','+id_vr+',date())';

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

begin cb1.Clear;

if id_vr<>'' then begin

dm.com.CommandText:='Update vrach set log_vr=false WHERE (id_vr='+id_vr+')';

dm.com.Execute; id_vr:='';

end;

close;

end;

end.

unit aDgPac;

interface

dm.com.Execute;

dm.com.CommandText:='Update pacient set datak_pac=date() where (id_pac='+id_pac+')';

dm.com.Execute;

showmessage('Запись успешно добавлена');

uses

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

Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

dm.pac.Requery();	type
closequery;	TFaDgPac = class(TForm)
	Panel1: TPanel;
end;	Label1: TLabel;
end;	Panel2: TPanel;
	BitBtn1: TBitBtn;
procedure TFaBolList.BitBtn2Click(Sender: TObject);	BitBtn2: TBitBtn;
begin	cb1: TComboBox;
	procedure cb1KeyPress(Sender: TObject; var Key: Char);
closequery;	procedure BitBtn2Click(Sender: TObject);
end;	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

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

private

{Private declarations } public

{Public declarations } end;

var

FaDgPac: TFaDgPac;

implementation

uses datm;

{$R *.dfm}

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

begin

key:=#0;

end;

procedure TFaDgPac.BitBtn2Click(Sender: TObject); begin

closequery;

end;

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

begin

cb1.Clear;

if id_dg<>'' then

begin

dm.com.Execute; id_dg:='';

end;

close;

end;

procedure TFaDgPac.BitBtn1Click(Sender: TObject); begin

if (id_dg='')then showmessage('Вы не заполнили одно или несколько полей')

else begin

dm.com.CommandText:='Insert into dgpac (id_dg_dp,id_pac_dp) values ('+id_dg+','+id_pac+')';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.dp.Requery();

closequery;

end;

procedure TFaDgPac.cb1Change(Sender: TObject);

begin

if id_dg<>'' then

begin

dm.com.CommandText:='Update diagnoz set log_dg=false WHERE (id_dg='+id_dg+')';

dm.com.Execute; id_dg:='';

end;

dm.temp.Active:=false;

dm.com.CommandText:='Update diagnoz set log_dg=false WHERE (id_dg='+id_dg+')';

dm.temp.CommandText:='select id_dg from diagnoz where (nazv_dg = "'+cb1.text+'") and (log_dg=false)';

dm.temp.Active:=true;	procedure BitBtn2Click(Sender: TObject);
if dm.temp.RecordCount=0 then	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin	procedure BitBtn1Click(Sender: TObject);
showmessage('Запись используется другим пользователем');	private
id_dg:='';	{ Private declarations }
cb1.Text:='';	public
end	{ Public declarations }
else	end;
begin
id_dg:=dm.temp.fields[0].asstring;	var
dm.com.CommandText:='Update diagnoz set log_dg=true WHERE	FaDiagnoz: TFaDiagnoz;
(id_dg='+id_dg+')';
dm.com.Execute;
	implementation
end;
end;
	uses datm;
end.
	{$R *.dfm}
unit aDiagnoz;
	procedure TFaDiagnoz.BitBtn2Click(Sender: TObject);
interface
	begin
	closequery;
uses
	end;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TFaDiagnoz = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Label2: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

e1: TEdit;

e2: TEdit;

procedure TFaDiagnoz.FormCloseQuery(Sender: TObject;

var CanClose: Boolean); begin

e1.Clear;e2.Clear;

if tm=1 then

begin

dm.com.CommandText:='Update diagnoz set log_dg=FALSE WHERE (id_dg='+tmp+')';

dm.com.Execute;

end;

close;

end;

procedure TFaDiagnoz.BitBtn1Click(Sender: TObject);	dm.dg.Requery();
begin	//dm.dg.recno:=ind;
if (e1.Text='')or (e2.Text='') then showmessage('Вы не заполнили одно	closequery;
или несколько полей')
	end;
else
	end;
begin
	end;
	end;
if tm=0 then
begin
	end.
dm.temp.Active:=false;
	unit aOtdel;
dm.temp.CommandText:='Select id_dg from diagnoz where
(nazv_dg="'+e1.Text+'") OR (sh_dg="'+e2.text+'")';
dm.temp.Active:=true;	interface

if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Insert into diagnoz (nazv_dg,sh_dg) values ("'+e1.Text+'","'+e2.text+'")';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.dg.Requery();

closequery;

end;

end

else

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_dg from diagnoz where (nazv_dg="'+e1.Text+'") OR (sh_dg="'+e2.text+'")';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Update diagnoz SET nazv_dg="'+e1.Text+'",sh_dg="'+e2.text+'" WHERE (id_dg='+tmp+')';

dm.com.Execute;

showmessage('Запись успешно изменена');

uses

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

Forms,

Dialogs, StdCtrls, Buttons, ExtCtrls;

type

TFaOtdel = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

e1: TEdit;

procedure BitBtn2Click(Sender: TObject);

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

procedure BitBtn1Click(Sender: TObject);

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

private

{Private declarations } public

{Public declarations } end;

var

FaOtdel: TFaOtdel;

implementation

uses datm;

dm.temp.CommandText:='Select id_ot from otdel where (nazv_ot="'+e1.Text+'")';

dm.temp.Active:=true;

if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

else

begin

{$R *.dfm}

procedure TFaOtdel.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

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

begin

e1.Clear;

if tm=1 then

begin

dm.com.CommandText:='Update otdel set log_ot=FALSE WHERE (id_ot='+tmp+')';

dm.com.Execute;

end;

close;

end;

procedure TFaOtdel.BitBtn1Click(Sender: TObject);

begin

if (e1.Text='')then showmessage('Вы не заполнили одно или несколько полей')

else

begin

if tm=0 then begin

dm.temp.Active:=false;

dm.com.CommandText:='Insert into otdel (nazv_ot) values ("'+e1.Text+'")';

dm.com.Execute;

showmessage('Запись успешно добавлена');

dm.ot.Requery();

closequery;

end;

end

else

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_ot from otdel where (nazv_ot="'+e1.Text+'")';

dm.temp.Active:=true;

if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

else

begin

dm.com.CommandText:='Update otdel SET nazv_ot="'+e1.Text+'" WHERE (id_ot='+tmp+')';

dm.com.Execute;

showmessage('Запись успешно изменена');

dm.ot.Requery();

//dm.ot.recno:=ind;

closequery;

end;

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

begin	Label9: TLabel;
key:=#0;	e4: TEdit;
end;	Label10: TLabel;
	e5: TEdit;
end.	procedure cb3KeyPress(Sender: TObject; var Key: Char);
unit aPacient;	procedure e1KeyPress(Sender: TObject; var Key: Char);
	procedure e5KeyPress(Sender: TObject; var Key: Char);
interface	procedure e4KeyPress(Sender: TObject; var Key: Char);
	procedure cb1Change(Sender: TObject);
uses	procedure cb3Change(Sender: TObject);
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,	procedure cb2Change(Sender: TObject);
Forms,
	procedure BitBtn1Click(Sender: TObject);
Dialogs, Spin, StdCtrls, Buttons, ExtCtrls, ComCtrls;
	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
	procedure BitBtn2Click(Sender: TObject);
type
	private
TFaPacient = class(TForm)
	{ Private declarations }
Panel1: TPanel;
	public
Label1: TLabel;
	{ Public declarations }
Label2: TLabel;
	end;
Label3: TLabel;
Label4: TLabel;
	var
Panel2: TPanel;
	FaPacient: TFaPacient;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
	implementation
cb1: TComboBox;
cb3: TComboBox;
	uses datm;
cb2: TComboBox;
dtp2: TDateTimePicker;
	{$R *.dfm}
Label5: TLabel;
e1: TEdit;
	procedure TFaPacient.cb3KeyPress(Sender: TObject; var Key: Char);
Label6: TLabel;
	begin
e2: TEdit;
	key:=#0;
Label7: TLabel;
	end;
e3: TEdit;
Label8: TLabel;
	procedure TFaPacient.e1KeyPress(Sender: TObject; var Key: Char);
dtp1: TDateTimePicker;

<<< < Предыдущая 1 2 34 / 84 5 6 7 8 > Следующая >>>

Соседние файлы в папке Курсовые работы

#
17.06.20231.23 Mб10ПРИС П _13.pdf
#
17.06.20231.94 Mб9ПРИС П _14.pdf
#
17.06.20232.42 Mб9ПРИС П _15.pdf
#
17.06.20232.44 Mб9ПРИС П _16.pdf
#
17.06.20231.68 Mб9ПРИС П _17.pdf
#
17.06.20232.58 Mб9ПРИС П _18.pdf
#
17.06.20231.04 Mб10ПРИС П _19.pdf
#
17.06.20231.4 Mб9ПРИС П _2.pdf
#
17.06.20231.42 Mб8ПРИС П _20.pdf
#
17.06.20232.07 Mб10ПРИС П _21.pdf
#
17.06.20231.75 Mб8ПРИС П _22.pdf