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

else begin

dm.com.Commandtext:='Update pass Set pass="'+e2.Text+'" where (login = "'+cb1.Text+'")';

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

end;

end;

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

begin cb1.Clear;e1.Clear;e2.Clear; close;

end;

procedure TFchPass.FormShow(Sender: TObject); begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select login from pass WHERE (login<>"Гость") 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;

end.

unit DgPac;

interface

uses

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

Forms,

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

type

TFDgPac = class(TForm)

Panel1: TPanel;

Label1: TLabel;

e1: TEdit; DBGrid1: TDBGrid;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N3: TMenuItem;

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

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

private

{Private declarations } public

{Public declarations } end;

var

FDgPac: TFDgPac;

implementation

uses datm, aDgPac;

{$R *.dfm}

procedure TFDgPac.N1Click(Sender: TObject);

begin

fadgpac.Caption:=Caption+' :: '+n1.Caption;

dm.temp.Active:=false;

dm.temp.CommandText:='select nazv_dg from diagnoz where (id_dg not in (select id_dg_dp from dgpac WHERE (id_pac_dp='+id_pac+')))';

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

begin

fadgpac.cb1.items.add(dm.temp.Fields[0].AsString);

dm.temp.Next;

end;

fadgpac.ShowModal;

end;

procedure TFDgPac.N3Click(Sender: TObject);

begin

if dm.dp.Fields[0].AsString='' then

begin

showmessage('Запись для редактирования отсутствует');

exit;

end;

tmp:=dm.dp.Fields[0].AsString;

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

begin

dm.com.CommandText:='Delete * from dgpac where (id_dp='+tmp+')';

dm.com.Execute;

dm.dp.Requery();

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

end;

end;

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

begin e1.Clear;

dm.dp.Active:=false;

end;

procedure TFDgPac.e1Change(Sender: TObject); begin

dm.dp.Active:=false;

dm.dp.CommandText:='Select id_dp,nazv_dg from diagnoz,dgpac WHERE (id_dg=id_dg_dp) and (id_pac_dp='+id_pac+') and (nazv_dg like "%'+e1.Text+'%")';

dm.dp.Active:=true;

end;

end.

unit Diagnoz;

interface

uses

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

Forms,

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

type

TFDiagnoz = class(TForm)

Panel1: TPanel;

DBGrid1: TDBGrid;

Label1: TLabel;

e1: TEdit;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

procedure N1Click(Sender: TObject);

procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure e1Change(Sender: TObject);

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

{Private declarations } public

{Public declarations } end;

53

end. unit ot1;

interface

uses

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

Forms,

Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls,registry, WordXP,

OleServer;

type

TFot1 = class(TForm) Panel1: TPanel; Label1: TLabel; Panel2: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; cb1: TComboBox; Label2: TLabel;

dtp1: TDateTimePicker; dtp2: TDateTimePicker; Label3: TLabel; Label4: TLabel;

WordApplication1: TWordApplication; WordDocument1: TWordDocument; procedure BitBtn1Click(Sender: TObject);

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

procedure BitBtn2Click(Sender: TObject);

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

private

{Private declarations } public

{Public declarations }

end;

var

Fot1: TFot1;

implementation

uses datm, main;

{$R *.dfm}

procedure TFot1.BitBtn1Click(Sender: TObject); var data:tdatetime;

Template,NewTemplate,FindText, NewStr,

Replace,ReplaceWith:OleVariant;

LinkToFile,SaveWithDocument,Range:OleVariant;

Table1: Table;

i: integer; flag:boolean; Reg: TRegistry;

begin

if dtp1.Date>dtp2.Date then begin

showmessage('Ошибка в последовательности дат'); exit;

end;

//Проверяем, инсталлирован ли Word

Reg := TRegistry.Create;

Reg.RootKey := HKEY_CLASSES_ROOT; flag:=reg.KeyExists('Word.Application'); reg.Free;

//flag:=true;

if flag=false then begin

55

//Открываем шаблон otchet.dot в Word

Template:=ExtractFilePath(Application.EXEName)+'\Data\Шаблоны\Бо лЛист.dot'; //путь к шаблону документа

WordApplication1.Documents.Add(Template,EmptyParam,EmptyParam, EmptyParam);// создаем документ на основе шаблона

WordDocument1.ConnectTo(WordApplication1.ActiveDocument); //Связываем компонент WordDocument1 c активным документом (т.е. с только что созданным документом)

//Заполняем таблицу списка объектов

Table1:=WordDocument1.Tables.Item(1); //связываем имя Table1 с

первой таблицей документа

//WordDocument1.Tables - это массив таблиц документа (тип

Tables), а WordDocument1.Tables.Item(i) - i-ая таблица

Replace:=true; // параметр, задающий режим замены

FindText:='#1'; // что меняем

ReplaceWith:=cb1.Text; // на что меняем

WordDocument1.Range.Find.Execute(FindText,EmptyParam,EmptyPara m, EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,ReplaceWith,Replace,EmptyParam,EmptyPar

am,EmptyParam,EmptyParam);

Replace:=true; // параметр, задающий режим замены

FindText:='#2'; // что меняем

ReplaceWith:='с '+datetostr(dtp1.date)+' по '+datetostr(dtp2.date);

WordDocument1.Range.Find.Execute(FindText,EmptyParam,EmptyPara m, EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,ReplaceWith,Replace,EmptyParam,EmptyPar

am,EmptyParam,EmptyParam);

dm.temp.Active:=false;

dm.temp.CommandText:='Select fio_pac,fio_vr,datav_bl,id_pac_bl from bollist,pacient,vrach where (id_pac=id_pac_bl) and

While (not dm.temp.Eof)do begin

Table1.Rows.Add(EmptyParam);

Table1.Cell(i, 1).Range.Text := dm.temp.Fields[0].AsString;

Table1.Cell(i, 2).Range.Text := dm.temp.Fields[1].AsString;

Table1.Cell(i, 3).Range.Text := dm.temp.Fields[2].AsString;

inc(i);dm.temp.next;

end;

Table1.Rows.Item(i).Delete;

WordApplication1.Visible:=true; //делаем приложение MS Word

видимым

WordApplication1.Disconnect; // Разрываем связь с серверо

end;

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

key:=#0;

end;

procedure TFot1.cb1Change(Sender: TObject);

begin

dm.temp.Active:=false;

dm.temp.CommandText:='select id_vr from vrach where (fio_vr = "'+cb1.text+'")';

dm.temp.Active:=true;

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

end;

procedure TFot1.BitBtn2Click(Sender: TObject);

begin

56

closequery;

end;

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

begin cb1.Clear; close; end;

procedure TFot1.FormShow(Sender: TObject); begin

dtp1.Date:=date;

dtp2.Date:=date;

end;

end. unit ot2;

interface

uses

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

Forms,

Dialogs, WordXP, OleServer, ComCtrls, StdCtrls, Buttons,

ExtCtrls,registry;

type

TFot2 = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

cb1: TComboBox;

WordApplication1: TWordApplication;

WordDocument1: TWordDocument;

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

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

private

{Private declarations } public

{Public declarations } end;

var

Fot2: TFot2;

implementation

uses datm;

{$R *.dfm}

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

begin cb1.Text:=''; close;

end;

procedure TFot2.BitBtn2Click(Sender: TObject);

begin

closequery;

end;

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

begin

key:=#0;

end;

57

procedure TFot2.BitBtn1Click(Sender: TObject);

var data:tdatetime;

Template,NewTemplate,FindText, NewStr,

Replace,ReplaceWith:OleVariant;

LinkToFile,SaveWithDocument,Range:OleVariant;

Table1: Table;

i: integer;

flag:boolean;

Reg: TRegistry;

begin

//Проверяем, инсталлирован ли Word

Reg := TRegistry.Create;

Reg.RootKey := HKEY_CLASSES_ROOT;

flag:=reg.KeyExists('Word.Application');

reg.Free;

//flag:=true;

if flag=false then

begin

application.MessageBox('Word не устанволен','Отчет',mb_ok+mb_iconstop);

exit;

end;

WordApplication1.Connect; // Устанавливаем связь с сервером

//Открываем шаблон otchet.dot в Word

Template:=ExtractFilePath(Application.EXEName)+'\Data\Шаблоны\Па латы.dot'; //путь к шаблону документа

WordApplication1.Documents.Add(Template,EmptyParam,EmptyParam, EmptyParam);// создаем документ на основе шаблона

WordDocument1.ConnectTo(WordApplication1.ActiveDocument); //Связываем компонент WordDocument1 c активным документом (т.е. с только что созданным документом)

//Заполняем таблицу списка объектов

Table1:=WordDocument1.Tables.Item(1); //связываем имя Table1 с

первой таблицей документа

//WordDocument1.Tables - это массив таблиц документа (тип

Tables), а WordDocument1.Tables.Item(i) - i-ая таблица

dm.temp.Active:=false;

dm.temp.CommandText:='Select nom_pal,nazv_ot,pol_pal,km_pal,km_pal-(select count(id_pac) from pacient where (id_pal_pac=id_pal)) as sm, fio_vr from vrach,otdel,palata WHERE (id_vr=id_vr_pal) and (id_ot=id_ot_pal) and (pol_pal="'+cb1.text+'") and (km_pal-(select count(id_pac) from pacient where (id_pal_pac=id_pal))>0)';

dm.temp.Active:=true;

i:=2;

While (not dm.temp.Eof)do

begin

Table1.Rows.Add(EmptyParam);

Table1.Cell(i, 1).Range.Text := dm.temp.Fields[0].AsString;

Table1.Cell(i, 2).Range.Text := dm.temp.Fields[1].AsString;

Table1.Cell(i, 3).Range.Text := dm.temp.Fields[2].AsString;

Table1.Cell(i, 4).Range.Text := dm.temp.Fields[3].AsString;

Table1.Cell(i, 5).Range.Text := dm.temp.Fields[4].AsString;

Table1.Cell(i, 6).Range.Text := dm.temp.Fields[5].AsString;

inc(i);dm.temp.next;

end;

Table1.Rows.Item(i).Delete;

WordApplication1.Visible:=true; //делаем приложение MS Word

видимым

WordApplication1.Disconnect; // Разрываем связь с серверо

end;

end.

unit ot3;

interface

uses

58

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

Forms,

Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls;

type

TFot3 = class(TForm)

Panel1: TPanel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Panel2: TPanel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

dtp1: TDateTimePicker; dtp2: TDateTimePicker;

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

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

private

{Private declarations } public

{Public declarations } end;

closequery;

end;

procedure TFot3.FormShow(Sender: TObject);

begin

dtp1.Date:=date;

dtp2.Date:=date;

end;

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

begin

close;

end;

procedure TFot3.BitBtn1Click(Sender: TObject);

var maxZn:string;

begin

if dtp1.Date>dtp2.Date then

begin

showmessage('Ошибка в последовательности дат');

exit;

end;

if tm=0 then

begin

var

Fot3: TFot3;

implementation

uses datm, main;

{$R *.dfm}

procedure TFot3.BitBtn2Click(Sender: TObject);

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select fio_vr,count(fio_vr) from bollist,vrach where (id_vr=id_vr_bl) and (datav_bl between #'+fmain.data(dtp1.Date)+'# and #'+fmain.data(dtp2.Date)+'#) GROUP BY fio_vr ORDER BY count(fio_vr) desc';

dm.temp.Active:=true;

tmp:=dm.temp.Fields[0].AsString+#13;

maxzn:=dm.temp.Fields[1].AsString;

if not dm.temp.Eof then dm.temp.Next;

While not dm.temp.Eof do

begin

if dm.temp.Fields[1].AsString=maxzn then tmp:=tmp+dm.temp.Fields[0].AsString+#13;

59

dm.temp.Next;

end;

showmessage('ОТЧЕТ: "Врач, обслуживший наибольшее количество пациентов"'+#13+#13+

'ПЕРИОД: с '+datetostr(dtp1.Date)+' по '+datetostr(dtp2.Date)+#13+#13+

'Ф.И.О. врача: '+#13+tmp+#13+

'Количество пациентов: '+maxzn);

end

else if tm=1 then

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select ([nazv_ot]&", №:

"&[nom_pal]),round(((select count(id_pac) from pacient where (id_pal_pac=id_pal) and ((datan_pac BETWEEN #'+fmain.data(dtp1.Date)+'# and #'+fmain.data(dtp2.Date)+'#) OR (datak_pac BETWEEN #'+fmain.data(dtp1.Date)+'# and #'+fmain.data(dtp2.Date)+'#)))/km_pal)*100,2) from palata,otdel where (id_ot=id_ot_pal)';

dm.temp.Active:=true;

tmp:='';

while not dm.temp.Eof do

begin

if dm.temp.Fields[1].AsFloat<50 then tmp:=dm.temp.Fields[0].AsString+' - '+dm.temp.Fields[1].AsString+' %'+#13;

dm.temp.next;

end;

showmessage('ОТЧЕТ: "Палаты, которые заполнены менее чем на

50%"'+#13+#13+

'ПЕРИОД: с '+datetostr(dtp1.Date)+' по '+datetostr(dtp2.Date)+#13+#13+

'ПЕРЕЧЕНЬ ПАЛАТ:'+#13+tmp);

end;

end;

end.

unit otdel;

interface

uses

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

Forms,

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

type

TFotdel = class(TForm)

Panel1: TPanel;

Label1: TLabel;

e1: TEdit; DBGrid1: TDBGrid;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

procedure N1Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure e1Change(Sender: TObject);

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

private

{Private declarations } public

{Public declarations } end;

var

Fotdel: TFotdel;

implementation

uses datm, aOtdel, main;

{$R *.dfm}

procedure TFotdel.N1Click(Sender: TObject);

begin

faotdel.Caption:=Caption+' :: '+n1.Caption;

60