Скачиваний:
9
Добавлен:
17.06.2023
Размер:
1.94 Mб
Скачать

Рисунок А.13–Удаление данных (3 уровень)

32

Рисунок А.14– Структура функциональной модели

33

ПРИЛОЖЕНИЕ Б

Дерево программных модулей

Рисунок Б.1– Дерево программных модулей

34

ПРИЛОЖЕНИЕ В

Листингпрограммы

unit Pass;

dbp:string;

 

 

 

interface

begin

 

 

showmessage('Вывышлиизпрограмм

uses

fpass.Caption:=application.

ы');

Windows, Messages,

Title;

 

 

application.Terminate;

SysUtils, Variants,

IniFile

:=

 

end;

Classes, Graphics,

TIniFile.Create(ExtractFile

end;

Controls, Forms,

Path(Application.ExeName)+'

cb.Clear; e.Clear;

Dialogs, StdCtrls,

options.ini');

//

dm.temp.Active:=false;

Buttons, ExtCtrls,inifiles;

загрузкаизфаланастроекпутик

dm.temp.CommandText:='Select

type

базе

 

 

login from pass order by

TFPass = class(TForm)

DBP :=

 

 

login';

Label1: TLabel;

IniFile.ReadString('options

dm.temp.Active:=true;

e: TEdit;

', 'dbPath', '');

 

while not dm.temp.Eof do

Label2: TLabel;

IniFile.Free;

 

 

begin

cb: TComboBox;

dm.od.InitialDir:=ExtractFi

cb.Items.Add(dm.temp.Fields[0]

Label3: TLabel;

lePath(Application.ExeName)

.AsString);

BitBtn4: TBitBtn;

;

 

 

dm.temp.Next;

Button1: TButton;

try

 

 

end;

procedure

dm.ADO.Connected:=false;

end;

BitBtn1Click(Sender:

dm.ADO.ConnectionString:='P

procedure

TObject);

rovider=Microsoft.Jet.OLEDB

TFPass.cbKeyPress(Sender:

procedure

.4.0;Data

 

 

TObject; var Key: Char);

FormCloseQuery(Sender:

Source='+dbp+';Persist

begin

TObject; var CanClose:

Security Info=False';

key:=#0;

Boolean);

dm.ADO.Connected:=true;

end;

procedure

except

 

 

procedure

FormShow(Sender: TObject);

if

 

 

TFPass.Button1Click(Sender:

procedure

application.MessageBox('Оши

TObject);

cbKeyPress(Sender: TObject;

бкаприподключенииБД!'#13'Св

begin

var Key: Char);

язатьсБД?','Базаданных',mb_

if cb.Text='' then

procedure

yesno+mb_iconquestion)=idye

showmessage('Выберитепользоват

Button1Click(Sender:

s then

 

 

еля')

TObject);

begin

 

 

else if (e.Text='') and

private

if dm.od.Execute then

(cb.Text<>'Гость') then

{ Private declarations

begin

 

 

showmessage('Введитепароль')

}

IniFile

 

:=

else

public

TIniFile.Create(ExtractFile

begin

{ Public declarations }

Path(Application.ExeName)+'

if cb.Text='Гость' then

end;

options.ini');

 

begin

var

inifile.WriteString('option

fmain.N3.Visible:=false;

FPass: TFPass;

s','dbpath',dm.od.FileName)

fmain.N2.Visible:=false;

implementation

;

 

 

fmain.N9.Visible:=false;

uses datm, Main, Lekar;

IniFile.Free;

 

fmain.N12.Visible:=false;

{$R *.dfm}

dbp:=dm.od.FileName;

fmain.N10.Visible:=false;

 

 

 

 

flekar.N1.Visible:=false;

procedure

dm.ADO.Connected:=false;

flekar.N2.Visible:=false;

TFPass.BitBtn1Click(Sender:

dm.ADO.ConnectionString:='P

flekar.N3.Visible:=false;

TObject);

rovider=Microsoft.Jet.OLEDB

flekar.N4.Visible:=false;

begin

.4.0;Data

 

 

fpass.Hide;

closequery;

Source='+dbp+';Persist

fmain.ShowModal;

end;

Security Info=False';

end

procedure

 

 

 

else

TFPass.FormCloseQuery(Sende

dm.ADO.Connected:=true;

begin

r: TObject; var CanClose:

end

 

 

dm.TEMP.Active:=false;

Boolean);

else

 

 

 

begin

begin

 

 

dm.TEMP.CommandText:='Select

if

 

 

 

log fROM pass WHERE

application.MessageBox('Вый

dm.ado.Connected:=false;

(login="'+cb.Text+'") AND

ти?','Выход',mb_yesno+mb_ic

showmessage('Вы вышли

(pass="'+e.Text+'")';

onquestion)=idyes then

из программы');

 

dm.TEMP.Active:=true;

begin

application.Terminate;

if dm.TEMP.RecordCount=0

application.Terminate;

end;

 

 

then

end

end

 

 

showmessage('Ошибкавлогинеи(ил

else canclose:=false;

else

 

 

и) пароле')

end;

begin

 

 

else

procedure

 

 

 

begin

TFPass.FormShow(Sender:

dm.ado.Connected:=false;

if

TObject);

 

 

 

dm.temp.fields[0].asboolean=tr

var inifile:tinifile;

 

 

 

ue then

35

begin

while not dm.temp.Eof do

id_lk:string;

fpass.Hide;

begin

implementation

fmain.ShowModal;

cb.Items.Add(dm.temp.Fields

{$R *.dfm}

 

end

[0].AsString);

end.

 

else

dm.temp.Next;

unit Lgot;

 

begin

end;

interface

 

 

end;

uses

 

fmain.N3.Visible:=false;

procedure

Windows, Messages, SysUtils,

 

TFChPass.BitBtn1Click(Sende

Variants, Classes, Graphics,

fmain.N2.Visible:=false;

r: TObject);

Controls, Forms,

fpass.Hide;

begin

Dialogs, Menus, Grids,

fmain.ShowModal;

closequery;

DBGrids, jpeg, ExtCtrls;

end;

end;

type

 

end;

procedure

TFLgot = class(TForm)

end;

TFChPass.BitBtn2Click(Sende

DBGrid1: TDBGrid;

end;

r: TObject);

PopupMenu1: TPopupMenu;

end;

begin

N1: TMenuItem;

end.

if cb.Text='' then

N2: TMenuItem;

unit ChPass;

showmessage('Выберетеимяпол

N3: TMenuItem;

interface

ьзователя')

N4: TMenuItem;

uses

else if e1.Text='' then

N5: TMenuItem;

Windows, Messages,

showmessage('Введитепароль'

N6: TMenuItem;

SysUtils, Variants,

)

N7: TMenuItem;

Classes, Graphics,

elseife2.Text=''

N8: TMenuItem;

Controls, Forms,

thenshowmessage('Вы не

N9: TMenuItem;

Dialogs, StdCtrls,

ввели подтверждение

N10: TMenuItem;

Buttons, ExtCtrls;

пароля')

N11: TMenuItem;

type

elseife2.Text<>e1.Textthens

N12: TMenuItem;

TFChPass = class(TForm)

howmessage('Пароль и

N13: TMenuItem;

Label1: TLabel;

подтверждение пароля не

Image1: TImage;

cb: TComboBox;

совпадают')

procedure N1Click(Sender:

Label2: TLabel;

else

TObject);

 

e1: TEdit;

begin

procedure N2Click(Sender:

Label3: TLabel;

 

TObject);

 

e2: TEdit;

dm.com.Commandtext:='Update

procedure N3Click(Sender:

BitBtn2: TBitBtn;

pass Set pass="'+e2.Text+'"

TObject);

 

BitBtn1: TBitBtn;

where (login =

procedure N6Click(Sender:

procedure

"'+cb.Text+'")';

TObject);

 

FormCloseQuery(Sender:

dm.com.Execute;

procedure N10Click(Sender:

TObject; var CanClose:

 

TObject);

 

Boolean);

showmessage('Парольизменен'

procedure N5Click(Sender:

procedure

);

TObject);

 

FormShow(Sender: TObject);

closequery;

procedure N8Click(Sender:

procedure

end;

TObject);

 

BitBtn1Click(Sender:

end;

procedure N12Click(Sender:

TObject);

end.

TObject);

 

procedure

unit datm;

procedure N13Click(Sender:

BitBtn2Click(Sender:

interface

TObject);

 

TObject);

uses

private

 

private

SysUtils, Classes,

{ Private declarations }

{ Private declarations

Dialogs, DB, ADODB;

public

 

}

type

{ Public declarations }

public

Tdm = class(TDataModule)

end;

 

{ Public declarations }

ado: TADOConnection;

var

 

end;

com: TADOCommand;

FLgot: TFLgot;

var

temp: TADODataSet;

implementation

FChPass: TFChPass;

od: TOpenDialog;

uses datm, aLgot, Main,

implementation

lk: TADODataSet;

LgLk, LekRec;

 

uses datm;

lks: TDataSource;

{$R *.dfm}

 

{$R *.dfm}

lg: TADODataSet;

procedure

 

procedure

lgs: TDataSource;

TFLgot.N1Click(Sender:

TFChPass.FormCloseQuery(Sen

ll: TADODataSet;

TObject);

//добавить

der: TObject; var CanClose:

lls: TDataSource;

begin

 

Boolean);

lr: TADODataSet;

tm:=0;

 

begin

lrs: TDataSource;

faLgot.Caption:=n1.Caption;

cb.Clear;

Rec: TADODataSet;

faLgot.showmodal;

e1.Text:='';e2.Text:='';

Recs: TDataSource;

end;

 

close;

Sos: TADODataSet;

procedure

 

end;

Soss: TDataSource;

TFLgot.N2Click(Sender:

procedure

private

TObject);

//изменение

TFChPass.FormShow(Sender:

{ Private declarations

begin

 

TObject);

}

if dm.lg.Fields[0].AsString=''

begin

public

then

 

cb.Clear;

{ Public declarations }

begin

 

dm.temp.Active:=false;

end;

showmessage('Нетзаписей');

dm.temp.CommandText:='Selec

var

exit;

 

t login from pass order by

dm: Tdm;

end;

 

login';

tmp:string;

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

dm.temp.Active:=true;

tm,rec:integer;

 

 

36

rec:=dm.lg.recno;

dm.lg.Active:=false;

рецепты!'+#13+'Обратитесь в

//присваиваем номер текущей

dm.lg.CommandText:='Select

следующем месяце!');

строки

 

id_lg,fio_lg,dr_lg,sp_lg,np

exit;

tm:=1;

 

_lg,kt_lg from lgot WHERE

end;

//*************************

(fio_lg like "%'+tmp+'%")';

rec:=dm.lg.recno;

*****

 

dm.lg.Active:=true;

tm:=1;

if

 

end;

if

fmain.Update('lg','Lgot')=f

procedure

fmain.Update('lg','Lgot')=fals

alse then

 

TFLgot.N8Click(Sender:

e then

begin

 

TObject);

begin

showmessage('Запись

//сортировкаподатерождения

showmessage('Запись

редактируется другим

begin

редактируется другим

пользователем');

dm.lg.Active:=false;

пользователем!');

exit;

 

dm.lg.CommandText:='Select

exit;

end;

 

id_lg,fio_lg,dr_lg,sp_lg,np

end;

faLgot.e1.Text:=dm.lg.field

_lg,kt_lg from lgot ORDER

flekRec.Caption:=n13.Caption;

byname('fio_lg').AsString;

BY dr_lg';

flekRec.ShowModal;

faLgot.e2.Text:=dm.lg.field

dm.lg.Active:=true;

end;

byname('kt_lg').AsString;

end;

end.

faLgot.e3.Text:=dm.lg.field

procedure

unit aLgot;

byname('sp_lg').AsString;

TFLgot.N12Click(Sender:

interface

faLgot.e4.Text:=dm.lg.field

TObject);

uses

byname('np_lg').AsString;

//списокдоступныхлекарств

Windows, Messages, SysUtils,

faLgot.dtp1.date:=dm.lg.fie

begin

Variants, Classes, Graphics,

ldbyname('dr_lg').asdatetim

if

Controls, Forms,

e;

 

dm.lg.Fields[0].AsString=''

Dialogs, StdCtrls, ExtCtrls,

faLgot.Caption:=n2.Caption;

then

ComCtrls;

faLgot.ShowModal;

begin

type

end;

 

 

TFaLgot = class(TForm)

procedure

 

showmessage('Нетзаписей');

Label1: TLabel;

TFLgot.N3Click(Sender:

exit;

e1: TEdit;

TObject);

//удаление

end;

Label2: TLabel;

begin

 

tmp:=dm.lg.Fields[0].AsStri

e2: TEdit;

if

 

ng;

e3: TEdit;

dm.lg.Fields[0].AsString=''

rec:=dm.lg.recno;

Label3: TLabel;

then

 

tm:=1;

Label4: TLabel;

begin

 

if

e4: TEdit;

showmessage('Нет доступных

fmain.Update('lg','Lgot')=f

Label5: TLabel;

записей');

 

alse then

dtp1: TDateTimePicker;

exit;

 

begin

Button1: TButton;

end;

 

showmessage('Запись

Button2: TButton;

tmp:=dm.lg.Fields[0].AsStri

редактируется другим

procedure

ng;tm:=1;

 

пользователем');

Button2Click(Sender: TObject);

if

 

exit;

procedure

fmain.Delete('lg','Lgot',tm

end;

FormCloseQuery(Sender:

p)=false then

flglk.Caption:=n12.Caption;

TObject; var CanClose:

begin

 

flglk.ShowModal;

Boolean);

showmessage('Запись

end;

procedure

редактируется другим

 

Button1Click(Sender: TObject);

пользователем');

procedure

private

exit;

 

TFLgot.N13Click(Sender:

{ Private declarations }

end

 

TObject);

public

else dm.lg.Requery();

begin

{ Public declarations }

end;

 

if

end;

procedure

 

dm.lg.Fields[0].AsString=''

var

TFLgot.N6Click(Sender:

then

FaLgot: TFaLgot;

TObject);

//показатьвсе

begin

implementation

begin

 

 

uses Main, datm;

dm.lg.Active:=false;

showmessage('Нетзаписей');

{$R *.dfm}

dm.lg.CommandText:='Select

exit;

procedure

id_lg,fio_lg,dr_lg,sp_lg,np

end;

TFaLgot.Button2Click(Sender:

_lg,kt_lg from lgot';

tmp:=dm.lg.Fields[0].AsStri

TObject);

dm.lg.Active:=true;

ng;

begin

end;

 

dm.temp.Active:=false;

closequery;

procedure

 

dm.temp.CommandText:='Selec

end;

TFLgot.N10Click(Sender:

t count(id_lg_rec) from

 

TObject); //обновление

recept where

procedure

var ind:integer;

(id_lg_rec='+tmp+') and

TFaLgot.FormCloseQuery(Sender:

begin

 

(year(data_rec)=year(Date()

TObject; var CanClose:

ind:=dm.lg.RecNo;

)) and

Boolean);

dm.lg.Requery();

(month(data_rec)=month(date

begin

dm.lg.RecNo:=ind;

()))';

fmain.Zan('lg','Lgot');

end;

 

dm.temp.Active:=true;

e1.Clear;e2.Clear;e3.Clear;e4.

procedure

 

if

Clear;

TFLgot.N5Click(Sender:

dm.temp.Fields[0].AsInteger

close;

TObject);

//поискпоФИО

=10 then

end;

begin

 

begin

procedure

tmp:=inputbox('Поиск','Введ

showmessage('Первышен лимит

TFaLgot.Button1Click(Sender:

итепараметр','');

на

TObject);

37

begin

 

 

faLekar.showmodal;

if (e1.Text='') or

dm.com.CommandText:='Update

end;

(e2.text='') or

Lgot SET

 

procedure

(e3.text='') or

fio_lg="'+e1.text+'",kt_lg=

TFLekar.N2Click(Sender:

(e4.text='') then

"'+e2.text+'",sp_lg="'+e3.t

TObject);

showmessage('Вызаполнилинев

ext+'",np_lg="'+e4.text+'",

begin

седанные')

dr_lg="'+datetostr(dtp1.dat

if dm.lk.Fields[0].AsString=''

else

e)+'" WHERE

then

begin

(id_lg='+tmp+')';

begin

try

dm.com.Execute;

showmessage('Нет записей в

strtoint(e3.Text);strtoint(

 

 

таблице');

e4.Text);

application.MessageBox('Изм

exit;

if (length(e3.Text)<>4)

енениепрошлоуспешно','Редак

end;

OR (length(e4.Text)<>6)

тированиесписка',mb_ok+mb_i

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

then

conasterisk);

rec:=dm.lk.recno;

begin

dm.lg.Requery();

tm:=1;

showmessage('Ошибка!

dm.lg.RecNo:=rec;

if

Проверьтеформат! Серия - 4

closequery;

fmain.Update('lk','Lekar')=fal

цифры; Номер - 6 цифр!');

end;

 

se then

exit;

end;

 

begin

end;

end;

 

showmessage('Запись

except

end;

 

редактируется другим

showmessage('Ошибка!

end.

 

пользователем');

Проверьте формат! Серия - 4

unit Lekar;

exit;

цифры; Номер - 6 цифр!');

interface

 

end;

exit;

uses

 

faLekar.e1.Text:=dm.lk.fieldby

end;

Windows, Messages,

name('nazv_lk').AsString;

if tm=0 then

SysUtils, Variants,

faLekar.e2.Text:=dm.lk.fieldby

begin

Classes, Graphics,

name('st_lk').AsString;

dm.temp.Active:=false;

Controls, Forms,

faLekar.Caption:=n2.Caption;

 

Dialogs, Grids, DBGrids,

faLekar.ShowModal;

dm.temp.CommandText:='Selec

Menus, jpeg, ExtCtrls;

end;

t id_lg from Lgot where

type

 

procedure

(sp_lg = '+e3.text+') and

TFLekar = class(TForm)

TFLekar.N3Click(Sender:

(np_lg='+e4.text+')';

DBGrid1: TDBGrid;

TObject);

dm.temp.Active:=true;

PopupMenu1: TPopupMenu;

begin

if

N1: TMenuItem;

if dm.lk.Fields[0].AsString=''

dm.temp.RecordCount>0 then

N2: TMenuItem;

then

showmessage('Ужесуществует'

N3: TMenuItem;

begin

)

N4: TMenuItem;

showmessage('Нет записей в

else

N5: TMenuItem;

таблице');

begin

N6: TMenuItem;

exit;

 

N7: TMenuItem;

end;

dm.com.CommandText:='Insert

N8: TMenuItem;

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

into Lgot

N9: TMenuItem;

tm:=1;

(fio_lg,kt_lg,sp_lg,np_lg,d

N10: TMenuItem;

dm.com.CommandText:='Update

r_lg) values

Image1: TImage;

Lekar Set dataU_lk=date()

("'+e1.text+'","'+e2.text+'

procedure

WHERE (id_lk='+tmp+')';

",'+e3.text+','+e4.text+',"

N1Click(Sender: TObject);

dm.com.Execute;

'+datetostr(dtp1.date)+'")'

procedure

dm.lk.Requery();

;

N2Click(Sender: TObject);

end;

dm.com.Execute;

procedure

procedure

 

N3Click(Sender: TObject);

TFLekar.N10Click(Sender:

application.MessageBox('Доб

procedure

TObject);

авлено','Редактированиеспис

N10Click(Sender: TObject);

var ind:integer;

ка',mb_ok+mb_iconasterisk);

procedure

begin

dm.lg.Requery();

N6Click(Sender: TObject);

ind:=dm.lk.RecNo;

dm.lg.Last;

procedure

dm.lk.Requery();

closequery;

N8Click(Sender: TObject);

dm.lk.RecNo:=ind;

end;

procedure

end;

end

N5Click(Sender: TObject);

procedure

else

private

 

TFLekar.N6Click(Sender:

begin

{ Private declarations

TObject);

dm.temp.Active:=false;

}

 

begin

 

public

 

dm.lk.Active:=false;

dm.temp.CommandText:='Selec

{ Public declarations }

dm.lk.CommandText:='select

t id_lg from Lgot where

end;

 

id_lk, nazv_lk, st_lk from

(sp_lg = '+e3.text+') and

var

 

Lekar where (datau_lk is

(np_lg='+e4.text+')';

FLekar: TFLekar;

null)';

dm.temp.Active:=true;

implementation

dm.lk.Active:=true;

if

uses datm, aLekar, Main;

end;

(dm.temp.RecordCount>0) and

{$R *.dfm}

 

 

(tmp<>dm.temp.Fields[0].ass

procedure

 

procedure

tring) then

TFLekar.N1Click(Sender:

TFLekar.N8Click(Sender:

showmessage('Ужесуществует'

TObject);

 

TObject);

)

begin

 

//сортировкапостоимости

else

tm:=0;

//режимдобавления

begin

begin

faLekar.Caption:=n1.Caption

dm.lk.Active:=false;

 

;

 

 

38

dm.lk.CommandText:='select

begin

("'+e1.text+'","'+e2.Text+'",D

id_lk, nazv_lk, st_lk from

if (e1.Text='') or

ate())';

Lekar where (datau_lk is

(e2.Text='') then

dm.com.Execute;

null) order by st_lk';

showmessage('Невсеполязапол

application.MessageBox('Добавл

dm.lk.Active:=true;

нены!')

ено','Редактированиесписка',mb

end;

else

_ok+mb_iconasterisk);

procedure

begin

dm.lk.Requery();

TFLekar.N5Click(Sender:

try

dm.lk.Last;

TObject);

e2.Text:=floattostr(

closequery;

//поискпоназванию

roundto(strtofloat(e2.Text)

end;

begin

,-2) );

end

tmp:=inputbox('Поиск','Введ

except

else

итепараметр','');

showmessage('Ошибка! нужно

begin

dm.lk.Active:=false;

проверить ввод стоимости');

dm.temp.Active:=false;

dm.lk.CommandText:='select

exit;

 

id_lk, nazv_lk, st_lk from

end;

dm.temp.CommandText:='Select

Lekar where (datau_lk is

if tm=0 then

dataU_lk,id_lk from Lekar

null) and (nazv_lk like

begin

where (nazv_lk =

"%'+tmp+'%")';

dm.temp.Active:=false;

"'+e1.text+'")';

dm.lk.Active:=true;

 

dm.temp.Active:=true;

end;

dm.temp.CommandText:='Selec

if (dm.temp.RecordCount>0)

end.

t dataU_lk,id_lk from Lekar

and

unit aLekar;

where (nazv_lk =

(tmp<>dm.temp.Fields[1].asstri

interface

"'+e1.text+'")';

ng) then

uses

dm.temp.Active:=true;

begin

Windows, Messages,

if

if

SysUtils, Variants,

(dm.temp.RecordCount>0)

(dm.temp.Fields[0].AsString<>'

Classes, Graphics,

then

' ) then

Controls, Forms,

begin

begin

Dialogs, ExtCtrls,

if

if

StdCtrls,math;

(dm.temp.Fields[0].AsString

application.MessageBox('Подобн

type

<>'' ) then

аязаписьужесодержитьвБД,

TFaLekar = class(TForm)

begin

ноудалена'+#13+'Хотитееевосста

Label1: TLabel;

if

новить?','Восстановление',mb_y

e1: TEdit;

application.MessageBox('Под

esno+mb_iconquestion)=idyes

Label2: TLabel;

обнаязаписьужесодержитьвБД,

then

e2: TEdit;

ноудалена'+#13+'Хотитееевос

begin

Button1: TButton;

становить?','Восстановление

 

Button2: TButton;

',mb_yesno+mb_iconquestion)

dm.com.CommandText:='Update

procedure

=idyes then

Lekar set dataU_lk = Null

Button2Click(Sender:

begin

where

TObject);

 

(id_lk='+dm.temp.Fields[1].AsS

procedure

dm.com.CommandText:='Update

tring+')';

FormCloseQuery(Sender:

Lekar set dataU_lk = Null

dm.com.Execute;

TObject; var CanClose:

where

dm.lk.Requery();

Boolean);

(id_lk='+dm.temp.Fields[1].

 

procedure

AsString+')';

application.MessageBox('Восста

Button1Click(Sender:

dm.com.Execute;

новлениепрошлоуспешно','Редакт

TObject);

dm.lk.Requery();

ированиесписка',mb_ok+mb_icona

private

 

sterisk);

{ Private declarations

application.MessageBox('Вос

closequery;

}

становлениепрошлоуспешно','

end

public

Редактированиесписка',mb_ok

else

{ Public declarations }

+mb_iconasterisk);

begin

end;

closequery;

 

var

end

showmessage('Ужесуществует');

FaLekar: TFaLekar;

else

exit;

implementation

begin

end;

uses Main, datm;

 

end

{$R *.dfm}

showmessage('Ужесуществует'

else

procedure

);

begin

TFaLekar.Button2Click(Sende

exit;

 

r: TObject);

end;

showmessage('Ужесуществует');

begin

end

exit;

closequery;

else

end;

end;

begin

end

procedure

 

else

TFaLekar.FormCloseQuery(Sen

showmessage('Ужесуществует'

begin

der: TObject; var CanClose:

);

 

Boolean);

exit;

dm.com.CommandText:='Update

begin

end;

Lekar SET

fmain.Zan('lk','Lekar');

end

nazv_lk="'+e1.text+'",st_lk="'

e1.Clear;

else

+e2.Text+'" WHERE

e2.Clear;

begin

(id_lk='+tmp+')';

close;

 

dm.com.Execute;

end;

dm.com.CommandText:='Insert

 

procedure

into Lekar

application.MessageBox('Измене

TFaLekar.Button1Click(Sende

(nazv_lk,st_lk,dataD_lk)

ниепрошлоуспешно','Редактирова

r: TObject);

values

 

39

ниесписка',mb_ok+mb_iconast erisk);

dm.lk.Requery();

dm.lk.RecNo:=rec;

closequery;

end;

end;

end;

end;

end.

unit Recept; interface uses

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

Dialogs, Menus, Grids, DBGrids, jpeg, ExtCtrls; type

TFRecept = class(TForm) DBGrid1: TDBGrid; PopupMenu1: TPopupMenu; N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N1: TMenuItem;

N2: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

Image1: TImage; procedure

N6Click(Sender: TObject); procedure

N10Click(Sender: TObject); procedure

N8Click(Sender: TObject); procedure

N2Click(Sender: TObject); procedure

N5Click(Sender: TObject); procedure

N1Click(Sender: TObject); procedure

N3Click(Sender: TObject); procedure

N12Click(Sender: TObject); procedure

N13Click(Sender: TObject); procedure

N15Click(Sender: TObject); private

{ Private declarations

}

public

{ Public declarations } end;

var

FRecept: TFRecept; implementation

uses datm, Main, Sostav; {$R *.dfm}

procedure TFRecept.N6Click(Sender: TObject);

begin dm.rec.Active:=false; dm.rec.CommandText:='Select id_rec,fio_lg,fio_rec,data_ rec,datav_rec from

recept,lgot WHERE (id_lg=id_lg_rec)'; dm.rec.Active:=true; end;

procedure TFRecept.N10Click(Sender: TObject);

var ind:integer; begin ind:=dm.rec.RecNo; dm.rec.Requery(); dm.rec.RecNo:=ind;

end;

procedure TFRecept.N8Click(Sender: TObject);

begin dm.rec.Active:=false; dm.rec.CommandText:='Select id_rec,fio_lg,fio_rec,data_ rec,datav_rec from recept,lgot WHERE (id_lg=id_lg_rec) Order by Data_rec'; dm.rec.Active:=true;

end; procedure

TFRecept.N2Click(Sender:

TObject); begin

dm.rec.Active:=false;

dm.rec.CommandText:='Select id_rec,fio_lg,fio_rec,data_ rec,datav_rec from recept,lgot WHERE (id_lg=id_lg_rec) Order by DataV_rec'; dm.rec.Active:=true;

end; procedure

TFRecept.N5Click(Sender:

TObject); begin

tmp:=inputbox('Поиск','Введ итепараметр',''); dm.rec.Active:=false; dm.rec.CommandText:='Select id_rec,fio_lg,fio_rec,data_ rec,datav_rec from recept,lgot WHERE (id_lg=id_lg_rec) AND (fio_lg like "%'+tmp+'%")'; dm.rec.Active:=true;

end; procedure

TFRecept.N1Click(Sender:

TObject); begin

tmp:=inputbox('Поиск','Введ итепараметр',''); dm.rec.Active:=false; dm.rec.CommandText:='Select id_rec,fio_lg,fio_rec,data_ rec,datav_rec from recept,lgot WHERE (id_lg=id_lg_rec) AND (fio_rec like "%'+tmp+'%")'; dm.rec.Active:=true;

end; procedure

TFRecept.N3Click(Sender:

TObject); begin

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

40

begin showmessage('Таблицапуста'); exit;

end;

tmp:=dm.rec.Fields[0].AsString

;tm:=1; if

fmain.Delete('rec','recept',tm p)=false then

begin showmessage('Запись занята!

Попробуйте позже'); exit;

end

else dm.rec.Requery(); end;

procedure TFRecept.N12Click(Sender: TObject);

begin if

dm.rec.Fields[0].AsString='' then

begin showmessage('Таблицапуста'); exit;

end;

tmp:=dm.rec.Fields[0].AsString

;

if dm.Rec.Fieldbyname('datav_rec' ).AsString<>'' then showmessage('Поданномурецептул екарстваужевыданы')

else begin

dm.com.CommandText:='Update Recept SET datav_rec=date() WHERE (id_rec='+tmp+')';

dm.com.Execute;

dm.Rec.Requery(); showmessage('Лекарства

успешно выданы'); end;

end; procedure

TFRecept.N13Click(Sender:

TObject); begin

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

begin showmessage('Таблицапуста'); exit;

end;

tmp:=dm.rec.Fields[0].AsString

;

if dm.Rec.Fieldbyname('datav_rec' ).AsString='' then showmessage('Поданномурецептул екарстваещеневыданы')

else begin

dm.com.CommandText:='Update Recept SET datav_rec=Null WHERE (id_rec='+tmp+')';

dm.com.Execute;

dm.Rec.Requery(); showmessage('Пометка о

выдаче лекарств снята'); end;

end; procedure

TFRecept.N15Click(Sender:

TObject); begin

if

procedure

begin

dm.rec.Fields[0].AsString='

TFLekRec.cb1KeyPress(Sender

dm.com.CommandText:='Delete

' then

: TObject; var Key: Char);

* from LekRec WHERE

begin

begin

(id_rec_lr=0)';

 

key:=#0;

dm.com.Execute;

showmessage('Таблицапуста')

end;

end;

;

procedure

fmain.Zan('lg','Lgot');

exit;

TFLekRec.cb1Change(Sender:

dm.lg.RecNo:=rec;

end;

TObject);

close;

tmp:=dm.rec.Fields[0].AsStr

begin

end;

ing;

dm.temp.Active:=false;

procedure

dm.Sos.Active:=false;

dm.temp.CommandText:='Selec

TFLekRec.FormShow(Sender:

dm.Sos.CommandText:='select

t id_lk from lekar WHERE

TObject);

nazv_lk,st_lk FROM

(nazv_lk =

begin

lekar,lekRec WHERE

"'+cb1.Text+'")';

cb1.Clear;

(id_lk=id_lk_lr) and

dm.temp.Active:=true;

dm.temp.Active:=false;

(id_rec_lr='+tmp+')';

id_lk:=dm.temp.fields[0].as

dm.temp.CommandText:='Select

dm.Sos.Active:=true;

string;

nazv_lk from lekar WHERE

fsostav.Caption:=n15.Captio

end;

(id_lk not in (select id_lk_lr

n;

procedure

from LekRec WHERE

fsostav.ShowModal;

TFLekRec.FormCloseQuery(Sen

(id_rec_lr=0))) and (id_lk in

end;

der: TObject; var CanClose:

(select id_lk_ll from LgLk

end.

Boolean);

WHERE (id_lg_ll='+tmp+')))';

unit LekRec;

var fiovr:string;

dm.temp.Active:=true;

interface

begin

While not dm.temp.Eof do

uses

if

begin

Windows, Messages,

application.MessageBox('Сох

cb1.Items.Add(dm.temp.Fields[0

SysUtils, Variants,

ранитьрецепт?','Сохранениер

].AsString);

Classes, Graphics,

ецепта',mb_yesno+mb_iconque

dm.temp.Next;

Controls, Forms,

stion)=idyes then

end;

Dialogs, StdCtrls,

begin

dm.lr.Active:=false;

Buttons, ExtCtrls, Grids,

if

dm.lr.CommandText:='Select

DBGrids, jpeg;

dm.lr.Fields[0].AsString<>

id_lr,nazv_lk from

type

'' then

lekar,LekRec WHERE

TFLekRec = class(TForm)

begin

(id_rec_lr=0) and

DBGrid1: TDBGrid;

fiovr:='';

(id_lk=id_lk_lr)';

Label1: TLabel;

While length(fiovr)<10

dm.lr.Active:=true;

cb1: TComboBox;

do

end;

SpeedButton1:

begin

procedure

TSpeedButton;

 

TFLekRec.SpeedButton1Click(Sen

SpeedButton2:

fiovr:=inputbox('ФИОВрача',

der: TObject);

TSpeedButton;

'ВведитеФИОврача','');

begin

SpeedButton3:

if length(fiovr)<10

if cb1.Text='' then

TSpeedButton;

then

begin

Image1: TImage;

showmessage('ФИОвведенонеко

showmessage('

procedure

рректно!');

Препаратневыбран');

cb1KeyPress(Sender:

end;

exit;

TObject; var Key: Char);

 

end;

procedure

dm.com.CommandText:='Insert

if

cb1Change(Sender: TObject);

into recept

application.MessageBox('Добави

procedure

(fio_rec,data_rec,id_lg_rec

тьзапись?','Добавление',mb_yes

FormCloseQuery(Sender:

) values

no+mb_iconquestion)=idyes then

TObject; var CanClose:

("'+fiovr+'",date(),'+tmp+'

begin

Boolean);

)';

dm.com.CommandText:='Insert

procedure

dm.com.Execute;

into LekRec (id_lk_lr) values

FormShow(Sender: TObject);

dm.temp.Active:=false;

('+id_lk+')';

procedure

 

dm.com.Execute;

SpeedButton1Click(Sender:

dm.temp.CommandText:='Selec

dm.lr.Requery();

TObject);

t max(id_rec) from recept';

showmessage('Добавлено');

procedure

dm.temp.Active:=true;

cb1.Clear;

SpeedButton2Click(Sender:

 

dm.temp.Active:=false;

TObject);

dm.com.CommandText:='Update

dm.temp.CommandText:='Select

procedure

LekRec SET

nazv_lk from lekar WHERE

SpeedButton3Click(Sender:

id_rec_lr="'+dm.temp.Fields

(id_lk not in (select id_lk_lr

TObject);

[0].AsString+'" where

from LekRec WHERE

 

(id_rec_lr=0)';

(id_rec_lr=0))) and (id_lk in

private

dm.com.Execute;

(select id_lk_ll from LgLk

{ Private declarations

 

WHERE (id_lg_ll='+tmp+')))';

}

showmessage('Сохранено');

dm.temp.Active:=true;

public

end

While not dm.temp.Eof do

{ Public declarations }

else

begin

end;

begin

 

var

showmessage('Не выбрано ни

cb1.Items.Add(dm.temp.Fields[0

FLekRec: TFLekRec;

одного

].AsString);

implementation

лекарства!'+#13+'Сохранение

dm.temp.Next;

uses datm, Main;

произведено не будет');

end;

{$R *.dfm}

end;

end;

 

end

end;

 

else

 

41

Соседние файлы в папке Курсовые работы