Курсовые работы / ПРИС П _18
.pdfuses |
{$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 |
32
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;
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;
33
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 |
ввели пароль') |
|
34
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; |
|
35
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;
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); |
36
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;
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)';
37
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;
38
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;
39
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;
end;
end;
end;
procedure TFaOtdel.cb1KeyPress(Sender: TObject; var Key: Char);
40
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; |
|
41