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

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

procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure e1Change(Sender: TObject); procedure e2Change(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FLgL: TFLgL;

implementation uses datm;

{$R *.dfm}

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

begin

dm.COM.CommandText:='Update lgot set log_lg = FALSE WHERE id_lg='+tmp+''; dm.COM.Execute;

end;

procedure TFLgL.SpeedButton1Click(Sender: TObject);

begin

if ll1.Fields[0].AsString='' then exit; dm.TEMP.Active:=false; dm.TEMP.CommandText:='select id_ll FROM lgl WHERE (id_l_ll='+ll1.Fields[0].AsString+') AND (id_lg_ll='+tmp+')';

dm.TEMP.Active:=true;

if dm.TEMP.RecordCount>0 then begin

showmessage('Данноое лекарство уже естьв списке');

exit; end

else begin

dm.COM.CommandText:='Insert into lgl (id_l_ll,id_lg_ll) values ('+ll1.Fields[0].AsString+','+tmp+')';

dm.COM.Execute;

ll1.Requery();

ll2.Requery(); showmessage('Лекарство добавлено'); end;

end;

procedure TFLgL.SpeedButton2Click(Sender: TObject);

begin

if ll2.Fields[0].AsString='' then exit;

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

begin

dm.COM.CommandText:='delete * from lgl WHERE (id_l_ll = '+ll2.Fields[0].AsString+') AND (id_lg_ll = '+tmp+')';

dm.COM.Execute;

ll1.Requery();

ll2.Requery(); showmessage('Лекарство удалено'); end;

end;

procedure TFLgL.e1Change(Sender: TObject); begin

Flgl.LL1.Active:=false; Flgl.LL1.CommandText:='select id_l,nazv_l FROM lek WHERE id_l not in (select id_l_ll from lgl WHERE (id_lg_ll='+tmp+')) AND (nazv_l like "%'+e1.Text+'%") ';

Flgl.LL1.Active:=true;

end;

procedure TFLgL.e2Change(Sender: TObject); begin

Flgl.LL2.Active:=false; Flgl.LL2.CommandText:='select id_l,nazv_l FROM lek WHERE id_l in (select id_l_ll from lgl WHERE (id_lg_ll='+tmp+')) AND (nazv_l like "%'+e2.text+'%")';

Flgl.LL2.Active:=true;

end;

end.

unit Lgot; interface uses

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

Dialogs, Menus, Grids, DBGrids;

type

TFLgot = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N10Click(Sender: TObject); procedure N9Click(Sender: TObject);

private

{ Private declarations } public

{ Public declarations } end;

var

FLgot: TFLgot; implementation

uses datm, ALgot, LgL, Rec; {$R *.dfm}

procedure TFLgot.N1Click(Sender: TObject); begin

tm:=0;

falgot.ShowModal;

end;

procedure TFLgot.N2Click(Sender: TObject); begin

if dm.lg.Fields[0].AsString='' then exit; tm:=1;

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

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_lg from lgot where id_lg = '+tmp+'';

dm.TEMP.Active:=true;

if dm.TEMP.Fields[0].AsBoolean=true then begin

showmessage('Запись используется другим пользователем!');

exit; end

else begin

dm.COM.CommandText:='Update lgot set log_lg = TRUE WHERE id_lg='+tmp+'';

dm.COM.Execute;

end;

falgot.e1.Text:=dm.lg.Fields[1].AsString;

falgot.e3.Text:=dm.lg.Fields[2].AsString;

falgot.e4.Text:=dm.lg.Fields[3].AsString;

falgot.dtp.date:=dm.lg.Fields[4].AsDateTime;

falgot.e2.Text:=dm.lg.Fields[5].AsString;

falgot.ShowModal;

end;

procedure TFLgot.N3Click(Sender: TObject); begin

if dm.lg.Fields[0].AsString='' then exit; tmp:=dm.lg.Fields[0].AsString;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_lg from lgot where id_lg = '+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 lgl WHERE (id_lg_ll='+tmp+')';

dm.COM.Execute; dm.COM.CommandText:='delete * FROM lgot

WHERE (id_lg='+tmp+')'; dm.COM.Execute; dm.lg.Requery(); showmessage('Запись удалена'); end;

end;

procedure TFLgot.N5Click(Sender: TObject); begin

if dm.lg.Fields[0].AsString='' then exit; tmp:=dm.lg.Fields[0].AsString;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_lg from lgot where id_lg = '+tmp+'';

dm.TEMP.Active:=true;

if dm.TEMP.Fields[0].AsBoolean=true then begin

showmessage('Запись используется другим пользователем!');

exit; end

else begin

dm.COM.CommandText:='Update lgot set log_lg = TRUE WHERE id_lg='+tmp+'';

dm.COM.Execute;

end;

Flgl.Label2.Caption:=dm.LG.Fields[1].AsString;

Flgl.LL1.Active:=false; Flgl.LL1.CommandText:='select id_l,nazv_l FROM lek WHERE id_l not in (select id_l_ll from lgl WHERE (id_lg_ll='+tmp+')) '; Flgl.LL1.Active:=true;

Flgl.LL2.Active:=false; Flgl.LL2.CommandText:='select id_l,nazv_l FROM lek WHERE id_l in (select id_l_ll from lgl WHERE (id_lg_ll='+tmp+')) ';

Flgl.LL2.Active:=true;

flgl.ShowModal;

end;

procedure TFLgot.N6Click(Sender: TObject); begin

if dm.lg.Fields[0].AsString='' then exit; tmp:=dm.lg.Fields[0].AsString;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_lg from lgot where id_lg = '+tmp+'';

dm.TEMP.Active:=true;

if dm.TEMP.Fields[0].AsBoolean=true then begin

showmessage('Запись используется другим пользователем!');

exit; end

else begin

dm.COM.CommandText:='Update lgot set log_lg = TRUE WHERE id_lg='+tmp+'';

dm.COM.Execute;

end;

tmp2:='0';

Frec.Label2.Caption:=dm.LG.Fields[1].AsString;

Frec.rc1.Active:=false; Frec.rc1.CommandText:='select id_l,nazv_l FROM lek WHERE id_l in ((select id_l_ll from lgl WHERE (id_lg_ll='+tmp+'))) AND (id_l not in (select id_l_rl FROM recl WHERE (id_rc_rl='+tmp2+')))'; Frec.rc1.Active:=true;

Frec.rc2.Active:=false; Frec.rc2.CommandText:='select nazv_l from lek WHERE id_l in (select id_l_rl from recL WHERE (id_rc_rl = '+tmp2+'))';

Frec.rc2.Active:=true;

Frec.ShowModal;

end;

procedure TFLgot.N10Click(Sender: TObject); begin

dm.Lg.Active:=false;

dm.Lg.CommandText:='select id_lg,fio_lg,sp_lg,np_lg,data_lg,tel_lg from lgot'; dm.Lg.Active:=true;

end;

procedure TFLgot.N9Click(Sender: TObject); var zap:string;

begin

zap:=inputbox('Поиск льготников','Паспорт! Формат: Серия-Номер',''); dm.Lg.Active:=false; dm.Lg.CommandText:='select id_lg,fio_lg,sp_lg,np_lg,data_lg,tel_lg from lgot WHERE (sp_lg & "-" & np_lg) = "'+zap+'"'; dm.Lg.Active:=true;

end;

end.

unit main; interface uses

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

Dialogs, Menus, ComCtrls,inifiles;

type

TFmain = class(TForm) StatusBar1: TStatusBar; MainMenu1: TMainMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N15: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

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

procedure N4Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N12Click(Sender: TObject); procedure N13Click(Sender: TObject); function data(data:tdatetime):string; procedure N17Click(Sender: TObject); procedure N16Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

Fmain: TFmain; implementation

uses datm, Lek, Lgot, Vr4, Vrec, ot, chpass; {$R *.dfm}

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

begin

if application.MessageBox('Вы хоите выйти из программы?','Выход',mb_yesno+mb_iconquestion)=i dyes then

begin application.Terminate; end

else canclose:=false; end;

procedure TFmain.N4Click(Sender: TObject); begin

dm.L.Active:=false; dm.L.CommandText:='Select * from lek'; dm.L.Active:=true;

flek.ShowModal;

end;

procedure TFmain.N5Click(Sender: TObject); begin

dm.Lg.Active:=false;

dm.Lg.CommandText:='select id_lg,fio_lg,sp_lg,np_lg,data_lg,tel_lg from lgot'; dm.Lg.Active:=true;

flgot.ShowModal;

end;

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

Reg := TRegistry.Create;

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

//flag:=true; if tm=0 then

begin

IF flag then //Если Word установлен, работаем дальше

begin {if}

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

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

Template:=ExtractFilePath(Application.EXEName)+'

Льготники.dot'; //путь к шаблону документа

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

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

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select fio_lg,data_rl

from lgot,lek,recl,rec WHERE (id_lg=id_lg_rc) AND (id_rc = id_rc_rl) AND (id_l_rl = id_l) AND (log_rc = true) AND (data_rl between #'+fmain.data(dtp1.Date)+'# AND #'+fmain.data(dtp2.Date)+'#) group by id_rc_rl,fio_lg,data_rl';

dm.TEMP.Active:=true;

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

Table1:=WordDocument1.Tables.Item(1);

//связываем имя Table1 с первой таблицей документа

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

WordDocument1.Tables.Item(i) - i-ая таблица i:=2;

dm.temp.First;

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;

inc(i);dm.temp.next;

end; Table1.Rows.Item(i).Delete;

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

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

end {if}

else MessageDlg('MS Word не установлен', mtInformation, [mbOK],0);

end else

begin

IF flag then //Если Word установлен, работаем дальше

begin {if}

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

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

Template:=ExtractFilePath(Application.EXEName)+'

Лекарства.dot'; //путь к шаблону документа

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

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

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select nazv_l from

lgot,lek,recl,rec WHERE (id_lg=id_lg_rc) AND (id_rc = id_rc_rl) AND (id_l_rl = id_l) AND (log_rc = true) AND (data_rl between #'+fmain.data(dtp1.Date)+'# AND #'+fmain.data(dtp2.Date)+'#) group by nazv_l';

dm.TEMP.Active:=true;

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

Table1:=WordDocument1.Tables.Item(1);

//связываем имя Table1 с первой таблицей документа

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

WordDocument1.Tables.Item(i) - i-ая таблица i:=2;

dm.temp.First;

While not dm.temp.Eof do begin

Table1.Rows.Add(EmptyParam); Table1.Cell(i, 1).Range.Text :=

dm.temp.Fields[0].AsString;

inc(i);dm.temp.next;

end; Table1.Rows.Item(i).Delete;

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

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

end {if}

else MessageDlg('MS Word не установлен', mtInformation, [mbOK],0);

end;

end;

end.

unit pass; interface uses

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

Dialogs, StdCtrls, Buttons, ExtCtrls,inifiles; type

TFpass = class(TForm) Panel1: TPanel; Panel2: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Label1: TLabel;

cb: TComboBox;

Label2: TLabel; e: TEdit;

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

CanClose: Boolean);

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

private

{Private declarations } public

{Public declarations } end;

var

Fpass: TFpass;

implementation

uses datm, main;

{$R *.dfm}

procedure TFpass.BitBtn1Click(Sender: TObject); begin

closequery;

end;

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

begin

if application.MessageBox('Вы хоите выйти из программы?','Выход',mb_yesno+mb_iconquestion)=i dyes then

begin application.Terminate; end

else canclose:=false;

end;

procedure TFpass.BitBtn2Click(Sender: TObject); begin

if cb.Text='' then showmessage('Вы не выбрали пользователя')

else if e.Text='' then showmessage('Вы не ввели пароль')

else begin

dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * fROM pass

WHERE (log="'+cb.Text+'") AND (pass="'+e.Text+'")';

dm.TEMP.Active:=true;

if dm.TEMP.RecordCount=0 then showmessage('Ошибка в логине и(или) пароле')

else begin

if cb.ItemIndex=0 then begin fmain.N11.Visible:=false; pas:=e.Text; login:=cb.Text; fpass.Hide;

fmain.ShowModal; end

else begin

fmain.N17.Visible:=false;

pas:=e.Text;

login:=cb.Text;

fpass.Hide;

fmain.ShowModal;

end;

end;

end;

end;

procedure TFpass.FormShow(Sender: TObject); var inifile:tinifile;

dbp:string; begin IniFile :=

TIniFile.Create(ExtractFilePath(Application.ExeName )+'options.ini'); // загрузка из фала настроек пути к базе

DBP := IniFile.ReadString('Options', 'DBPath', ExtractFilePath(Application.ExeName)+'DB\Base_V1 1.mdb');

//proc := IniFile.ReadString('Options', 'proc', ExtractFilePath(Application.ExeName)+'DataBase\'); IniFile.Free;

dm.ADO.Connected:=false;

dm.ADO.ConnectionString:='Provider=Microsoft.Jet. OLEDB.4.0;Data Source='+dbp+';Persist Security Info=False';

dm.ADO.Connected:=true;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select * fROM pass'; dm.TEMP.Active:=true;

While not dm.TEMP.Eof do begin

cb.Items.Add(dm.TEMP.Fields[0].AsString);

dm.TEMP.Next;

end;

end;

end.

unit Rec;

interface

uses

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

Dialogs, DB, ADODB, Buttons, Grids, DBGrids, StdCtrls, ExtCtrls, ComCtrls;

type

TFRec = class(TForm) Panel1: TPanel; Label1: TLabel;

Label2: TLabel;

Panel2: TPanel; GroupBox1: TGroupBox; Panel4: TPanel;

e1: TEdit; DBGrid1: TDBGrid; Panel3: TPanel;

GroupBox2: TGroupBox; Panel5: TPanel;

e2: TEdit; DBGrid2: TDBGrid;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton; Rc1: TADODataSet;

rc1s: TDataSource; rc2: TADODataSet; rc2s: TDataSource; Panel6: TPanel; Label3: TLabel; cb: TComboBox;

dtp: TDateTimePicker; Label4: TLabel; SpeedButton3: TSpeedButton; SpeedButton4: TSpeedButton;

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

procedure FormShow(Sender: TObject); procedure cbChange(Sender: TObject); procedure SpeedButton4Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure e1Change(Sender: TObject); procedure e2Change(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FRec: TFRec;

implementation uses datm;

{$R *.dfm}

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

begin

if (tmp2<>'0') then begin

dm.TEMP.Active:=false; dm.TEMP.CommandText:='Select id_rl from recl

WHERE (id_rc_rl = '+tmp2+')'; dm.TEMP.Active:=true;

if dm.TEMP.RecordCount=0 then begin

dm.COM.CommandText:='delete * from rec WHERE (id_rc='+tmp2+')';

dm.COM.Execute;

showmessage('Рецепт, который не содержал ни одного ликрства был удален');

end;

tmp2:='0';

end;

dm.COM.CommandText:='Update lgot set log_lg = FALSE WHERE id_lg='+tmp+''; dm.COM.Execute;

end;

procedure TFRec.FormShow(Sender: TObject); begin

cb.Clear;tmp2:='0';id_vr:=''; dm.TEMP.Active:=false; dm.TEMP.CommandText:='select fio_vr from vr4'; dm.TEMP.Active:=true;

While not dm.TEMP.Eof do begin

cb.Items.Add(dm.TEMP.Fields[0].AsString);

dm.TEMP.Next;

end;

end;

procedure TFRec.cbChange(Sender: TObject); begin

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select id_vr from vr4 WHERE (fio_vr = "'+cb.Text+'")'; dm.TEMP.Active:=true; id_vr:=dm.TEMP.Fields[0].AsString;

end;

procedure TFRec.SpeedButton4Click(Sender: TObject);

begin

if (id_vr='') then showmessage('Не все поля заполнены')

else if (tmp2<>'0') then showmessage('Вы уже начали выписывать рецепт')

else begin

dm.COM.CommandText:='Insert into rec (id_lg_rc,id_vr_rc,data_rc) values ('+tmp+','+id_vr+',"'+datetostr(dtp.Date)+'")';

dm.COM.Execute;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select max(id_rc) from

rec';

dm.TEMP.Active:=true;

tmp2:=dm.TEMP.Fields[0].AsString; showmessage('Теперь внесите лекарства в

рецепт'); end;

end;

procedure TFRec.SpeedButton1Click(Sender: TObject);

begin

if tmp2='0' then exit;

if rc1.Fields[0].AsString='' then exit;

dm.COM.CommandText:='Insert into recl (id_l_rl,id_rc_rl) values ('+rc1.Fields[0].AsString+','+tmp2+')'; dm.COM.Execute; Frec.rc1.Active:=false;

Frec.rc1.CommandText:='select id_l,nazv_l FROM lek WHERE id_l in ((select id_l_ll from lgl WHERE (id_lg_ll='+tmp+'))) AND (id_l not in (select id_l_rl FROM recl WHERE (id_rc_rl='+tmp2+')))'; Frec.rc1.Active:=true;

Frec.rc2.Active:=false; Frec.rc2.CommandText:='select id_l,nazv_l from lek WHERE id_l in (select id_l_rl from recL WHERE (id_rc_rl = '+tmp2+'))';

Frec.rc2.Active:=true;

showmessage('Лекарство добавлено в рецепт'); end;

procedure TFRec.SpeedButton2Click(Sender: TObject);

begin

if tmp2='0' then exit;

if rc2.Fields[0].AsString='' then exit;

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

begin

dm.COM.CommandText:='delete * from recl WHERE (id_l_rl = '+rc2.Fields[0].AsString+') AND (id_rc_rl = '+tmp2+')';

dm.COM.Execute;

Frec.rc1.Active:=false; Frec.rc1.CommandText:='select id_l,nazv_l FROM

lek WHERE id_l in ((select id_l_ll from lgl WHERE (id_lg_ll='+tmp+'))) AND (id_l not in (select id_l_rl FROM recl WHERE (id_rc_rl='+tmp2+')))';

Frec.rc1.Active:=true;

Frec.rc2.Active:=false; Frec.rc2.CommandText:='select nazv_l from lek

WHERE id_l in (select id_l_rl from recL WHERE (id_rc_rl = '+tmp2+'))';

Frec.rc2.Active:=true; showmessage('Лекарство удалено'); end;

end;

procedure TFRec.SpeedButton3Click(Sender: TObject);

begin

if (tmp2='0') then showmessage('Вы еще не начали выписывать рецепт')

else begin

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

begin

dm.COM.CommandText:='delete * from recl WHERE (id_rc_rl='+tmp2+')';

dm.COM.Execute;

dm.COM.CommandText:='delete * from rec WHERE (id_rc='+tmp2+')';

dm.COM.Execute;

tmp2:='0';

Frec.rc1.Active:=false; Frec.rc1.CommandText:='select id_l,nazv_l FROM

lek WHERE id_l in ((select id_l_ll from lgl WHERE (id_lg_ll='+tmp+'))) AND (id_l not in (select id_l_rl FROM recl WHERE (id_rc_rl='+tmp2+')))';

Frec.rc1.Active:=true;

Frec.rc2.Active:=false; Frec.rc2.CommandText:='select id_l,nazv_l from

lek WHERE id_l in (select id_l_rl from recL WHERE (id_rc_rl = '+tmp2+'))';

Frec.rc2.Active:=true; showmessage('Рецепт удален'); end;

end;

end;

procedure TFRec.e1Change(Sender: TObject); begin

Frec.rc1.Active:=false; Frec.rc1.CommandText:='select id_l,nazv_l FROM

lek WHERE id_l in ((select id_l_ll from lgl WHERE (id_lg_ll='+tmp+'))) AND (id_l not in (select id_l_rl FROM recl WHERE (id_rc_rl='+tmp2+'))) AND (nazv_l like "%'+e1.Text+'%")';

Frec.rc1.Active:=true;

end;

procedure TFRec.e2Change(Sender: TObject); begin

Frec.rc2.Active:=false; Frec.rc2.CommandText:='select id_l,nazv_l from

lek WHERE id_l in (select id_l_rl from recL WHERE (id_rc_rl = '+tmp2+')) AND (nazv_l like "%'+e1.Text+'%")';

Frec.rc2.Active:=true;

end;

end.

unit SpL; interface

uses

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

Dialogs, Grids, DBGrids;

type

TFSpL = class(TForm) DBGrid1: TDBGrid;

private

{Private declarations } public

{Public declarations } end;

var

FSpL: TFSpL;

implementation uses datm;

{$R *.dfm}

end.

unit Vr4; interface uses

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

Dialogs, Menus, Grids, DBGrids;

type

TFVr4 = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

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

private

{Private declarations } public

{Public declarations } end;

var

FVr4: TFVr4;

implementation uses datm, Avr4;

{$R *.dfm}

procedure TFVr4.N1Click(Sender: TObject); begin

tm:=0;

favr4.ShowModal;

end;

procedure TFVr4.N2Click(Sender: TObject); begin

if dm.vr.Fields[0].AsString='' then exit; tm:=1;

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

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_vr from vr4 where id_vr = '+tmp+'';

dm.TEMP.Active:=true;

if dm.TEMP.Fields[0].AsBoolean=true then begin

showmessage('Запись используется другим пользователем!');

exit; end

else begin

dm.COM.CommandText:='Update vr4 set log_vr = TRUE WHERE id_vr='+tmp+'';

dm.COM.Execute;

end;

favr4.e1.Text:=dm.vr.Fields[1].AsString;

favr4.e3.Text:=dm.vr.Fields[2].AsString;

favr4.e4.Text:=dm.vr.Fields[3].AsString;

favr4.dtp.date:=dm.vr.Fields[4].AsDateTime;

favr4.e2.Text:=dm.vr.Fields[5].AsString;

favr4.ShowModal;

end;

procedure TFVr4.N3Click(Sender: TObject); begin

if dm.vr.Fields[0].AsString='' then exit; tmp:=dm.vr.Fields[0].AsString;

dm.TEMP.Active:=false; dm.TEMP.CommandText:='select log_vr from vr4 where id_vr = '+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 vr4 WHERE (id_vr='+tmp+')';

dm.COM.Execute;

dm.vr.Requery(); showmessage('Запись удалена'); end;

end;

end.

unit Vrec;

interface uses

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

Dialogs, Grids, DBGrids, Menus;

type

TFVrec = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

procedure N2Click(Sender: TObject); procedure N1Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N7Click(Sender: TObject); procedure N4Click(Sender: TObject);

private

{Private declarations } public

{Public declarations } end;

var

FVrec: TFVrec; implementation

uses datm, SpL; {$R *.dfm}

procedure TFVrec.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if dm.Rc.FieldByName('log_rc').AsBoolean=false then

begin

DBGrid1.Canvas.brush.color := Clskyblue; end

else begin

DBGrid1.Canvas.brush.color := Clmoneygreen; end;

dbgrid1.DefaultDrawColumnCell(rect, DataCol, Column, State)

end;

procedure TFVrec.N2Click(Sender: TObject); begin

if dm.Rc.Fields[0].AsString='' then exit; tmp:=dm.Rc.Fields[0].AsString;

if dm.Rc.FieldByName('log_rc').AsBoolean=true then begin

showmessage('Лекарства по данному рецепту уже выданы');

end else

begin dm.TEMP.Active:=false;

dm.TEMP.CommandText:='SELECT Count(id_rc) FROM rec WHERE (((log_rc)=True) AND ((id_rc) In (select distinct id_rc_rl from recL where (year(data_rl) = year(date())) AND (month(data_rl) = month(date())) ))) AND (id_lg_rc = '+dm.Rc.fieldbyname('id_lg').AsString+')';

dm.TEMP.Active:=true;

if dm.TEMP.Fields[0].AsInteger=10 then begin

showmessage('В этом месяце данному льготнику выдано уже 10 рецептов' +#13+ 'Выдача лекарств по данному рецепту возможна только в следующем месяце' );

exit;

end;

dm.COM.CommandText:='Update rec set log_rc=TRUE WHERE (id_rc='+tmp+')';

dm.COM.Execute; dm.COM.CommandText:='Update recl set

data_rl="'+datetostr(date)+'" WHERE (id_rc_rl='+tmp+')';

dm.COM.Execute;

dm.Rc.Requery(); showmessage('Лекарства выданы!'); end;

end;

procedure TFVrec.N1Click(Sender: TObject); begin

dm.L.Active:=false;

dm.L.CommandText:='select nazv_l,cena_l,data_rl from lek,recL WHERE (id_l = id_l_rl) AND (id_rc_rl = '+dm.Rc.Fields[0].AsString+')';

dm.L.Active:=true;

fspl.ShowModal;

end;

procedure TFVrec.N5Click(Sender: TObject); begin

dm.rc.Active:=false;

dm.rc.CommandText:='select id_rc,fio_lg,fio_vr,data_rc,log_rc,id_lg FROM rec,lgot,vr4 WHERE (id_lg=id_lg_rc) AND (id_vr = id_vr_rc)';

dm.rc.Active:=true;

end;

procedure TFVrec.N6Click(Sender: TObject); begin

dm.rc.Active:=false;

dm.rc.CommandText:='select id_rc,fio_lg,fio_vr,data_rc,log_rc,id_lg FROM rec,lgot,vr4 WHERE (id_lg=id_lg_rc) AND (id_vr = id_vr_rc) AND (log_rc=TRUE)'; dm.rc.Active:=true;

end;

procedure TFVrec.N7Click(Sender: TObject); begin

dm.rc.Active:=false;

dm.rc.CommandText:='select id_rc,fio_lg,fio_vr,data_rc,log_rc,id_lg FROM rec,lgot,vr4 WHERE (id_lg=id_lg_rc) AND (id_vr = id_vr_rc) AND (log_rc=FALSE)'; dm.rc.Active:=true;

end;

procedure TFVrec.N4Click(Sender: TObject); var zap:string;

begin

zap:=inputbox('Поиск льготников','Паспорт! Формат: Серия-Номер',''); dm.rc.Active:=false; dm.rc.CommandText:='select id_rc,fio_lg,fio_vr,data_rc,log_rc,id_lg FROM

rec,lgot,vr4 WHERE (id_lg=id_lg_rc) AND (id_vr = id_vr_rc) AND ((sp_lg & "-" & np_lg) = "'+zap+'")'; dm.rc.Active:=true;

end;

end.