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

unit Pass; interface uses

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

Forms,

Dialogs,inifiles, StdCtrls, Buttons, ExtCtrls; type

TFpass = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

Label1: TLabel;

Label2: TLabel;

cb: TComboBox; e1: TEdit; BitBtn1: TBitBtn; BitBtn2: TBitBtn;

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

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

procedure BitBtn1Click(Sender: TObject); private

{Private declarations } public

{Public declarations } end;

unit main; interface uses

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

Forms,

Dialogs,jpeg,inifiles, Menus, ExtCtrls; type

TFmain = class(TForm)

Image1: TImage;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

N18: TMenuItem;

N19: TMenuItem;

N20: TMenuItem;

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

procedure N4Click(Sender: TObject); function data(data:tdatetime):string; function Update(rs,tab:string):boolean;

function Delete(rs,tab,temp:string):boolean; procedure N2Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N12Click(Sender: TObject); procedure N10Click(Sender: TObject);

procedure N14Click(Sender: TObject);

procedure N15Click(Sender: TObject);

procedure N17Click(Sender: TObject);

procedure N18Click(Sender: TObject);

procedure N19Click(Sender: TObject);

procedure N20Click(Sender: TObject);

procedure N6Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fmain: TFmain;

implementation

uses datm, Diagnoz, otdel, Vrach, Palata, Pacient, BolList, ot1, ot2, ot3,

chPass;

{$R *.dfm}

procedure TFmain.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 TFmain.FormShow(Sender: TObject);

begin

if fileexists(ExtractFilePath(Application.ExeName)+'Data\photo.jpg') then

begin

image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName)+'D

ata\photo.jpg');

end;

end;

procedure TFmain.N4Click(Sender: TObject);

begin

closequery;

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;

29

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.N2Click(Sender: TObject);

var inifile:tinifile;

dbp:string;

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

IniFile.Free;

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

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

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

end;

procedure TFmain.N8Click(Sender: TObject);

begin

fdiagnoz.Caption:=n8.Caption;

fdiagnoz.DBGrid1.PopupMenu:=fdiagnoz.PopupMenu1;

fdiagnoz.DBGrid1.DataSource:=dm.dgs;

dm.dg.Active:=false;

dm.dg.CommandText:='Select * from diagnoz';

dm.dg.Active:=true;

fdiagnoz.ShowModal;

end;

procedure TFmain.N9Click(Sender: TObject);

begin

fotdel.Caption:=n9.Caption;

fotdel.DBGrid1.PopupMenu:=fotdel.PopupMenu1;

fotdel.DBGrid1.DataSource:=dm.ots;

dm.ot.Active:=false;

dm.ot.CommandText:='Select * from otdel';

dm.ot.Active:=true;

fotdel.ShowModal;

end;

procedure TFmain.N12Click(Sender: TObject);

begin

fvrach.Caption:=n12.Caption;

fvrach.DBGrid1.PopupMenu:=fvrach.PopupMenu1;

fvrach.DBGrid1.DataSource:=dm.vrs;

dm.vr.Active:=false;

dm.vr.CommandText:='Select * from vrach';

dm.vr.Active:=true;

fvrach.ShowModal;

end;

procedure TFmain.N10Click(Sender: TObject);

begin

fpalata.Caption:=n10.Caption;

fpalata.DBGrid1.PopupMenu:=fpalata.PopupMenu1;

fpalata.DBGrid1.DataSource:=dm.pals;

dm.pal.Active:=false;

dm.pal.CommandText:='Select id_pal,nom_pal,nazv_ot,km_pal,km_pal- (select count(id_pac) from pacient where (id_pal_pac=id_pal) and (datak_pac is null) ) as sm, pol_pal,fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal)';

30

dm.pal.Active:=true;

fpalata.ShowModal;

end;

procedure TFmain.N14Click(Sender: TObject);

begin

fpacient.Caption:=n14.Caption;

fpacient.DBGrid1.PopupMenu:=fpacient.PopupMenu1;

fpacient.DBGrid1.DataSource:=dm.pacs;

dm.pac.Active:=false;

dm.pac.CommandText:='Select id_pac,fio_pac,pol_pac,adr_pac,sp_pac,np_pac,kem_pac,kogda_pac,([naz v_ot]&", №: "&[nom_pal]) as pal,nazv_ot,nom_pal,id_pal,datan_pac,datak_pac from pacient,palata,otdel where (id_pal=id_pal_pac) and (id_ot=id_ot_pal)';

dm.pac.Active:=true;

fpacient.ShowModal;

end;

procedure TFmain.N15Click(Sender: TObject);

begin

fbollist.Caption:=n15.Caption;

fbollist.DBGrid1.PopupMenu:=fbollist.PopupMenu1;

fbollist.DBGrid1.DataSource:=dm.bls;

dm.bl.Active:=false;

dm.bl.CommandText:='Select id_bl,fio_pac,fio_vr,datav_bl,id_pac_bl from bollist,pacient,vrach where (id_pac=id_pac_bl) and (id_vr=id_vr_bl)';

dm.bl.Active:=true;

fbollist.ShowModal;

end;

procedure TFmain.N17Click(Sender: TObject);

begin

fot1.Caption:=n17.Caption;

fot1.cb1.clear;

dm.temp.Active:=false;

dm.temp.CommandText:='Select fio_vr from vrach';

dm.temp.Active:=true;

WHILE not dm.temp.Eof do

begin

31

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

dm.temp.Next;

end;

fot1.ShowModal;

end;

procedure TFmain.N18Click(Sender: TObject); begin

fot2.Caption:=n18.Caption;

fot2.ShowModal;

end;

procedure TFmain.N19Click(Sender: TObject);

begin

tm:=0;

fot3.Caption:=n19.Caption;

fot3.ShowModal;

end;

procedure TFmain.N20Click(Sender: TObject);

begin

tm:=1;

fot3.Caption:=n20.Caption;

fot3.ShowModal;

end;

procedure TFmain.N6Click(Sender: TObject);

begin

fchpass.Caption:=n6.Caption;

fchpass.ShowModal;

end;

end.

unit datm;

interface