Курсовые работы / ПРИС КП_И_7
.pdf
Рисунок А.9 - Уровень А32. Изменить лекарство
Рисунок А.10 - Уровень А4. Работа со справочником льготников
32
Рисунок А.11 - Уровень А41. Добавить льготника
Рисунок А.12 - Уровень А42. Изменить льготника
33
Рисунок А.13 - Уровень А45. Выписать рецепт
Рисунок А.14 - Уровень А5. Работа со справочником врачей
34
Рисунок А.15 - Уровень А6. Выдача лекарств по рецептам
Рисунок А.16 - Уровень А61. Выбрать рецепт
35
Рисунок А.17 - Уровень А7. Администрирование
36
ПРИЛОЖЕНИЕ Б
Листинг программы
unit Alek; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons; type
TFAlek = class(TForm) Panel1: TPanel; Panel2: TPanel;
e1: TEdit; e2: TEdit;
Label1: TLabel;
Label2: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var
CanClose: Boolean);
procedure BitBtn2Click(Sender: TObject); procedure e2KeyPress(Sender: TObject; var Key:
Char); private
{Private declarations } public
{Public declarations } end;
var
FAlek: TFAlek; implementation uses datm;
{$R *.dfm}
procedure TFAlek.BitBtn1Click(Sender: TObject); begin
closequery;
end;
procedure TFAlek.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if tm=1 then begin
dm.COM.CommandText:='Update lek set log_l = FALSE WHERE id_l='+tmp+'';
dm.COM.Execute;
end;
e1.Text:='';
e2.Text:='';
close;
end;
procedure TFAlek.BitBtn2Click(Sender: TObject); begin
if (e1.Text='') OR (e2.Text='') then showmessage('Не все поля заполнены')
else begin try
strtofloat(e2.Text); except
showmessage('Ошибка при вводе цены'); exit;
end;
if tm=0 then begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from lek
WHERE (nazv_l = "'+e1.Text+'")'; dm.TEMP.Active:=true;
if dm.TEMP.RecordCount>0 then exit; dm.COM.CommandText:='Insert into lek
(nazv_l,cena_l) values ("'+e1.Text+'","'+e2.Text+'")'; dm.COM.Execute;
dm.l.Requery(); showmessage('Запись добавлена'); end
else begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from lek
WHERE (nazv_l = "'+e1.Text+'")'; dm.TEMP.Active:=true;
if (dm.TEMP.RecordCount>0) AND (tmp<>dm.TEMP.Fields[0].asstring) then exit;
dm.COM.CommandText:='UPDATE lek SET nazv_l="'+e1.Text+'",cena_l="'+e2.Text+'" WHERE (id_l='+tmp+')';
dm.COM.Execute;
dm.l.Requery(); showmessage('Запись изменена'); end;
falek.CloseQuery;
end;
end;
procedure TFAlek.e2KeyPress(Sender: TObject; var Key: Char);
begin
if key='.' then key:=','; end;
end.
unit ALgot; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls;
37
type
TFALgot = class(TForm) Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Panel2: TPanel; Label1: TLabel; Label2: TLabel;
e1: TEdit; e2: TEdit;
dtp: TDateTimePicker; Label3: TLabel; GroupBox1: TGroupBox; Label4: TLabel;
e3: TEdit; Label5: TLabel; e4: TEdit;
procedure BitBtn1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var
CanClose: Boolean);
procedure BitBtn2Click(Sender: TObject); private
{Private declarations } public
{Public declarations } end;
var
FALgot: TFALgot; implementation uses datm, Alek; {$R *.dfm}
procedure TFALgot.BitBtn1Click(Sender: TObject); begin
closequery;
end;
procedure TFALgot.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if tm=1 then begin
dm.COM.CommandText:='Update lgot set log_lg = FALSE WHERE id_lg='+tmp+'';
dm.COM.Execute;
end;
e1.Text:=''; e2.Text:=''; e3.Text:=''; e4.Text:=''; dtp.Date:=date;
close;
end;
procedure TFALgot.BitBtn2Click(Sender: TObject); begin
if (e1.Text='') OR (e2.Text='') OR (e3.Text='') OR (e4.Text='') then showmessage('Не все поля заполнены')
else begin try
strtoint(e3.Text);
strtoint(e4.Text); except
showmessage('Ошибка при вводе серии и номера паспорта');
exit;
end;
if (length(e3.Text)<>4) OR (length(e4.Text)<>6) then
begin
showmessage('Ошибка при вводе серии и номера паспорта');
exit;
end;
if tm=0 then begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from lgot
WHERE (sp_lg = '+e3.Text+') AND (np_lg='+e4.text+')';
dm.TEMP.Active:=true;
if dm.TEMP.RecordCount>0 then exit; dm.COM.CommandText:='Insert into lgot
(fio_lg,sp_lg,np_lg,data_lg,tel_lg) values ("'+e1.Text+'",'+e3.Text+','+e4.Text+',"'+datetostr(dtp. Date)+'","'+e2.Text+'")';
dm.COM.Execute;
dm.lg.Requery(); showmessage('Запись добавлена'); end
else begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from lgot
WHERE (sp_lg = '+e3.Text+') AND (np_lg='+e4.text+')';
dm.TEMP.Active:=true;
if (dm.TEMP.RecordCount>0) AND (tmp<>dm.TEMP.Fields[0].asstring) then exit;
dm.COM.CommandText:='UPDATE lgot SET fio_lg="'+e1.Text+'",sp_lg="'+e3.Text+'",np_lg="'+e4
.Text+'",data_lg="'+datetostr(dtp.Date)+'",tel_lg="'+e 2.Text+'" WHERE (id_lg='+tmp+')';
dm.COM.Execute;
dm.lg.Requery(); showmessage('Запись изменена'); end;
falgot.CloseQuery;
end;
end;
end.
unit Avr4; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls; type
TFAvr4 = class(TForm) Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Panel2: TPanel; Label1: TLabel;
38
Label2: TLabel;
Label3: TLabel; e1: TEdit;
e2: TEdit;
dtp: TDateTimePicker; GroupBox1: TGroupBox; Label4: TLabel;
Label5: TLabel; e3: TEdit;
e4: TEdit;
procedure BitBtn1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var
CanClose: Boolean);
procedure BitBtn2Click(Sender: TObject); private
{Private declarations } public
{Public declarations } end;
var
FAvr4: TFAvr4; implementation uses datm;
{$R *.dfm}
procedure TFAvr4.BitBtn1Click(Sender: TObject); begin
closequery;
end;
procedure TFAvr4.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if tm=1 then begin
dm.COM.CommandText:='Update vr4 set log_vr = FALSE WHERE id_vr='+tmp+'';
dm.COM.Execute;
end;
e1.Text:=''; e2.Text:=''; e3.Text:=''; e4.Text:=''; dtp.Date:=date;
close;
end;
procedure TFAvr4.BitBtn2Click(Sender: TObject); begin
if (e1.Text='') OR (e2.Text='') OR (e3.Text='') OR (e4.Text='') then showmessage('Не все поля заполнены')
else begin try
strtoint(e3.Text);
strtoint(e4.Text); except
showmessage('Ошибка при вводе серии и номера паспорта');
exit;
end;
if (length(e3.Text)<>4) OR (length(e4.Text)<>6) then
begin
showmessage('Ошибка при вводе серии и номера паспорта');
exit;
end;
if tm=0 then begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from vr4
WHERE (sp_vr = '+e3.Text+') AND (np_vr='+e4.text+')';
dm.TEMP.Active:=true;
if dm.TEMP.RecordCount>0 then exit; dm.COM.CommandText:='Insert into vr4
(fio_vr,sp_vr,np_vr,data_vr,tel_vr) values ("'+e1.Text+'",'+e3.Text+','+e4.Text+',"'+datetostr(dtp. Date)+'","'+e2.Text+'")';
dm.COM.Execute;
dm.vr.Requery(); showmessage('Запись добавлена'); end
else begin
dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * from vr4
WHERE (sp_vr = '+e3.Text+') AND (np_vr='+e4.text+')';
dm.TEMP.Active:=true;
if (dm.TEMP.RecordCount>0) AND (tmp<>dm.TEMP.Fields[0].asstring) then exit;
dm.COM.CommandText:='UPDATE vr4 SET fio_vr="'+e1.Text+'",sp_vr="'+e3.Text+'",np_vr="'+e4
.Text+'",data_vr="'+datetostr(dtp.Date)+'",tel_vr="'+e 2.Text+'" WHERE (id_vr='+tmp+')';
dm.COM.Execute;
dm.vr.Requery(); showmessage('Запись изменена'); end;
favr4.CloseQuery;
end;
end;
end.
unit chpass; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TFchpass = class(TForm) Panel1: TPanel; Label1: TLabel; Label2: TLabel;
e1: TEdit; e2: TEdit;
Panel2: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn;
procedure BitBtn1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var
CanClose: Boolean);
procedure BitBtn2Click(Sender: TObject); private
39
{ Private declarations } |
{ Private declarations } |
public |
public |
{ Public declarations } |
{ Public declarations } |
end; |
end; |
var |
var |
Fchpass: TFchpass; |
DM: TDM; |
implementation |
tm:integer; |
uses datm; |
tmp,tmp2:string; |
{$R *.dfm} |
id_vr:string; |
|
pas,login:string; |
procedure TFchpass.BitBtn1Click(Sender: TObject); |
implementation |
begin |
uses LgL, Rec; |
closequery; |
{$R *.dfm} |
end; |
|
|
procedure TDM.Timer1Timer(Sender: TObject); |
procedure TFchpass.FormCloseQuery(Sender: |
var ind:integer; |
TObject; var CanClose: Boolean); |
begin |
begin |
if dm.l.Active=true then |
e1.Text:=''; |
begin |
e2.Text:=''; |
ind:=dm.l.RecNo; |
close; |
dm.l.Requery(); |
end; |
dm.l.RecNo:=ind; |
|
end; |
procedure TFchpass.BitBtn2Click(Sender: TObject); |
if dm.lg.Active=true then |
begin |
begin |
if (e1.Text='') OR (e2.Text='') then showmessage('Вы |
ind:=dm.lg.RecNo; |
не ввели всю информацию') |
dm.lg.Requery(); |
else if e1.Text<>pas then |
dm.lg.RecNo:=ind; |
showmessage('Неправильный старый пароль') |
end; |
else |
if dm.vr.Active=true then |
begin |
begin |
dm.COM.CommandText:='update pass set |
ind:=dm.vr.RecNo; |
pass="'+e2.Text+'" WHERE log = "'+login+'"'; |
dm.vr.Requery(); |
dm.COM.Execute; |
dm.vr.RecNo:=ind; |
pas:=e2.Text; |
end; |
showmessage('Пароль изменен успешно'); |
if dm.rc.Active=true then |
BitBtn1Click(Sender); |
begin |
end; |
ind:=dm.rc.RecNo; |
end; |
dm.rc.Requery(); |
end. |
dm.rc.RecNo:=ind; |
|
end; |
|
if flgl.LL1.Active=true then |
unit datm; |
begin |
interface |
ind:=flgl.LL1.RecNo; |
uses |
flgl.LL1.Requery(); |
SysUtils, Classes, ADODB, DB, ExtCtrls; |
flgl.LL1.RecNo:=ind; |
|
end; |
type |
if flgl.LL2.Active=true then |
TDM = class(TDataModule) |
begin |
ADO: TADOConnection; |
ind:=flgl.LL2.RecNo; |
TEMP: TADODataSet; |
flgl.LL2.Requery(); |
COM: TADOCommand; |
flgl.LL2.RecNo:=ind; |
L: TADODataSet; |
end; |
Ls: TDataSource; |
if frec.rc1.Active=true then |
LG: TADODataSet; |
begin |
LGs: TDataSource; |
ind:=frec.rc1.RecNo; |
Vr: TADODataSet; |
frec.rc1.Requery(); |
VrS: TDataSource; |
frec.rc1.RecNo:=ind; |
Rc: TADODataSet; |
end; |
RcS: TDataSource; |
if frec.rc2.Active=true then |
Timer1: TTimer; |
begin |
procedure Timer1Timer(Sender: TObject); |
ind:=frec.rc2.RecNo; |
private |
frec.rc2.Requery(); |
40
frec.rc2.RecNo:=ind;
end;
end;
end.
unit Lek; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, DBGrids;
type
TFLek = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure N1Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N2Click(Sender: TObject);
private
{Private declarations } public
{Public declarations } end;
var
FLek: TFLek;
implementation uses datm, Alek;
{$R *.dfm}
procedure TFLek.N1Click(Sender: TObject); begin
tm:=0;
falek.ShowModal;
end;
procedure TFLek.N3Click(Sender: TObject); begin
if dm.l.Fields[0].AsString='' then exit; tmp:=dm.l.Fields[0].AsString; dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_l from lek where id_l = '+tmp+'';
dm.TEMP.Active:=true;
if dm.TEMP.Fields[0].AsBoolean=true then begin
showmessage('Запись используется другим пользователем!');
exit;
end;
if application.MessageBox('Вы хотите удалить запись?','Удаление', mb_yesno+mb_iconquestion)=idyes then
begin
dm.COM.CommandText:='delete * FROM lek WHERE (id_l='+tmp+')';
dm.COM.Execute;
dm.l.Requery(); showmessage('Запись удалена'); end;
end;
procedure TFLek.N2Click(Sender: TObject); begin
if dm.l.Fields[0].AsString='' then exit; tm:=1;
tmp:=dm.l.Fields[0].AsString;
dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_l from lek where id_l = '+tmp+'';
dm.TEMP.Active:=true;
if dm.TEMP.Fields[0].AsBoolean=true then begin
showmessage('Запись используется другим пользователем!');
exit; end
else begin
dm.COM.CommandText:='Update lek set log_l = TRUE WHERE id_l='+tmp+'';
dm.COM.Execute;
end;
falek.e1.Text:=dm.l.Fields[1].AsString;
falek.e2.Text:=dm.l.Fields[2].AsString;
falek.ShowModal;
end;
end.
unit LgL; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Buttons, Grids, DBGrids, StdCtrls, ExtCtrls;
type
TFLgL = class(TForm) Panel1: TPanel; Label1: TLabel; Label2: TLabel; Panel2: TPanel; Panel3: TPanel;
GroupBox1: TGroupBox; Panel4: TPanel;
e1: TEdit;
GroupBox2: TGroupBox; Panel5: TPanel;
e2: TEdit; DBGrid1: TDBGrid; DBGrid2: TDBGrid;
SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; LL1: TADODataSet;
LL1s: TDataSource;
LL2: TADODataSet;
LL2s: TDataSource;
41