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

dm.com.CommandText:='Insert

end;

id_vid:=dm.temp.Fields[0].AsS

into pacdig

end.

tring;

(id_d_pd,id_pc_pd) values

unit aSprav;

e1.Text:=dm.temp.Fields[1].As

('+id_d+','+tmp2+')';

interface

String;

dm.com.Execute;

uses

end;

dm.temp.Active:=false;

Windows, Messages,

procedure

 

SysUtils, Variants, Classes,

TFaSprav.BitBtn2Click(Sender:

dm.temp.CommandText:='Select

Graphics, Controls, Forms,

TObject);

nazv_d from diagnoz where

Dialogs, ComCtrls,

begin

(id_d not in (select id_d_pd

StdCtrls, Buttons, ExtCtrls;

closequery;

from pacdig where

type

end;

id_pc_pd='+tmp2+'))';

TFaSprav = class(TForm)

procedure

dm.temp.Active:=true;

Panel1: TPanel;

TFaSprav.FormCloseQuery(Sende

fapacient.cb.Clear;

BitBtn1: TBitBtn;

r: TObject; var CanClose:

while not dm.temp.Eof do

BitBtn2: TBitBtn;

Boolean);

begin

Panel2: TPanel;

begin

fapacient.cb.Items.Add(dm.tem

Label1: TLabel;

if tm=1 then

p.fields[0].AsString);

Label2: TLabel;

begin

dm.temp.Next;

e1: TEdit;

dm.com.CommandText:='Update

end;

Label3: TLabel;

sprav set log_sp=FALSE WHERE

pd.Requery();

cb1: TComboBox;

(id_sp='+tmp+')';

end;

cb2: TComboBox;

dm.com.Execute;

end;

Label4: TLabel;

end;

procedure

dtp1: TDateTimePicker;

cb1.Clear;cb2.Clear;e1.Clear;

TFaPacient.SpeedButton2Click(

procedure

dtp1.Date:=date;

Sender: TObject);

cb2KeyPress(Sender: TObject;

close;

begin

var Key: Char);

end;

if pd.Fields[0].AsString=''

procedure

procedure

then

cb1Change(Sender: TObject);

TFaSprav.BitBtn1Click(Sender:

begin

procedure

TObject);

showmessage('Запись для

cb2Change(Sender: TObject);

begin

редактирования отсутствует');

procedure

if (e1.Text='') or

exit;

BitBtn2Click(Sender:

(cb1.Text='') or

end;

TObject);

(cb2.Text='') then

id_pd:=pd.Fields[0].AsString;

procedure

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

if

FormCloseQuery(Sender:

оилинесколькополей')

application.MessageBox('Выхот

TObject; var CanClose:

else

итеудалитьдиагноз?','Удаление

Boolean);

begin

',mb_yesno+mb_iconquestion)=i

procedure

if tm=0 then

dyes then

BitBtn1Click(Sender:

begin

begin

TObject);

 

dm.com.CommandText:='Delete

private

dm.com.CommandText:='Insert

* from pacdig where

{ Private declarations }

into sprav

(id_pd='+id_pd+')';

public

(id_pc_sp,id_vid_sp,data_sp,c

dm.com.Execute;

{ Public declarations }

ena_sp) values

dm.temp.Active:=false;

end;

('+id_pc+','+id_vid+',"'+date

 

var

tostr(dtp1.Date)+'","'+e1.Tex

dm.temp.CommandText:='Select

FaSprav: TFaSprav;

t+'")';

nazv_d from diagnoz where

implementation

dm.com.Execute;

(id_d not in (select id_d_pd

uses datm;

 

from pacdig where

{$R *.dfm}

showmessage('Записьуспешнодоб

id_pc_pd='+tmp2+'))';

procedure

авлена');

dm.temp.Active:=true;

TFaSprav.cb2KeyPress(Sender:

dm.sp.Requery();

fapacient.cb.Clear;

TObject; var Key: Char);

closequery;

while not dm.temp.Eof do

begin

end

begin

key:=#0;

else

fapacient.cb.Items.Add(dm.tem

end;

begin

p.fields[0].AsString);

procedure

 

dm.temp.Next;

TFaSprav.cb1Change(Sender:

dm.com.CommandText:='Update

end;

TObject);

sprav SET

pd.Requery();

begin

id_pc_sp="'+id_pc+'",id_vid_s

end;

dm.temp.Active:=false;

p="'+id_vid+'",data_sp="'+dat

end;

dm.temp.CommandText:='Select

etostr(dtp1.Date)+'",cena_sp=

procedure

id_pc from pacient where

"'+e1.Text+'" WHERE

TFaPacient.Image1Click(Sender

(([id_pc]&")

(id_sp='+tmp+')';

: TObject);

"&[fio_pc])="'+cb1.Text+'")';

dm.com.Execute;

begin

dm.temp.Active:=true;

 

if od.Execute then

id_pc:=dm.temp.Fields[0].AsSt

showmessage('Записьуспешноизм

begin

ring;

енена');

image1.Picture.LoadFromFile(o

end;

dm.sp.Requery();

d.FileName);

procedure

closequery;

//showmessage(NameFile(od.Fil

TFaSprav.cb2Change(Sender:

end;

eName,true));

TObject);

end;

end;

begin

end;

end;

dm.temp.Active:=false;

end.

procedure

dm.temp.CommandText:='Select

unit avidacha;

TFaPacient.FormShow(Sender:

id_vid,st_vid from vidacha

interfaceuses

TObject);

where

Windows, Messages,

begin

(kto_vid="'+cb2.Text+'")';

SysUtils, Variants, Classes,

dbgrid1.DataSource:=pds;

dm.temp.Active:=true;

Graphics, Controls, Forms,

32

Dialogs, StdCtrls, Buttons,

showmessage('Подобнаязаписьуж

else

ExtCtrls;

есуществует')

begin

type

else

 

TFavidacha = class(TForm)

begin

dm.com.CommandText:='update

Panel1: TPanel;

 

rCen set

BitBtn1: TBitBtn;

dm.com.CommandText:='Insert

cena_rc="'+e2.Text+'" where

BitBtn2: TBitBtn;

into vidacha (kto_vid,st_vid)

id_rc='+dm.temp.Fields[0].AsS

Panel2: TPanel;

values

tring+'';

Label1: TLabel;

("'+e1.Text+'","'+e2.Text+'")

dm.com.Execute;

Label2: TLabel;

';

end;

e1: TEdit;

dm.com.Execute;

end;

e2: TEdit;

dm.temp.Active:=false;

 

procedure

 

showmessage('Записьуспешноизм

BitBtn2Click(Sender:

dm.temp.CommandText:='Select

енена');

TObject);

max(id_vid) from mater';

dm.vid.Requery();

procedure

dm.temp.Active:=true;

closequery;

FormCloseQuery(Sender:

 

end;

TObject; var CanClose:

tmpC:=dm.temp.Fields[0].AsStr

end;

Boolean);

ing;

end;

procedure

 

end;

BitBtn1Click(Sender:

dm.com.CommandText:='Insert

end.

TObject);

into rCen

unit Chpass;

private

(id_vid_rc,cena_rc,data_rc)

interface

{ Private declarations }

values

uses

public

('+tmpC+',"'+e2.Text+'","'+da

Windows, Messages,

{ Public declarations }

tetostr(date)+'")';

SysUtils, Variants, Classes,

end;

dm.com.Execute;

Graphics, Controls, Forms,

var

 

Dialogs, StdCtrls, Buttons,

Favidacha: TFavidacha;

showmessage('Записьуспешнодоб

ExtCtrls;

implementation

авлена');

type

uses datm, main;

dm.vid.Requery();

TFChpass = class(TForm)

{$R *.dfm}

closequery;

Panel1: TPanel;

procedure

end;

BitBtn1: TBitBtn;

TFavidacha.BitBtn2Click(Sende

end

BitBtn2: TBitBtn;

r: TObject);

else

Panel2: TPanel;

begin

begin

Label1: TLabel;

closequery;

dm.temp.Active:=false;

Label2: TLabel;

end;

 

Label3: TLabel;

procedure

dm.temp.CommandText:='Select

e1: TEdit;

TFavidacha.FormCloseQuery(Sen

id_vid from vidacha where

e2: TEdit;

der: TObject;

(kto_vid="'+e1.Text+'")';

e3: TEdit;

var CanClose: Boolean);

dm.temp.Active:=true;

Label4: TLabel;

begin

if

e4: TEdit;

if tm=1 then

(dm.temp.RecordCount>0) and

procedure

begin

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

BitBtn2Click(Sender:

dm.com.CommandText:='Update

ing) then

TObject);

vidacha set log_vid=FALSE

showmessage('Подобнаязаписьуж

procedure

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

есуществует')

FormCloseQuery(Sender:

dm.com.Execute;

else

TObject; var CanClose:

end;

begin

Boolean);

e1.Clear;e2.Clear;

 

procedure

close;

dm.com.CommandText:='Update

BitBtn1Click(Sender:

end;

vidacha SET

TObject);

procedure

kto_vid="'+e1.Text+'",st_vid=

private

TFavidacha.BitBtn1Click(Sende

"'+e2.Text+'" WHERE

{ Private declarations }

r: TObject);

(id_vid='+tmp+')';

public

begin

dm.com.Execute;

{ Public declarations }

if (e1.Text='') or

if tmpc<>e2.Text then

end;

(e2.Text='') then

begin

var

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

 

FChpass: TFChpass;

одно или несколько полей')

dm.temp.Active:=false;

implementation

else

 

uses datm;

begin

dm.temp.CommandText:='Select

{$R *.dfm}

try

id_rc from rCen WHERE

procedure

strtofloat(e2.Text);

(id_vid_rc='+tmp+') and

TFChpass.BitBtn2Click(Sender:

except

(data_rc =

TObject);

showmessage('Некорректный

#'+fmain.data(date)+'#)';

begin

ввод стоимости');

dm.temp.Active:=true;

closequery;

exit;

if

end;

end;

dm.temp.RecordCount=0 then

procedure

if tm=0 then

begin

TFChpass.FormCloseQuery(Sende

begin

 

r: TObject; var CanClose:

dm.temp.Active:=false;

dm.com.CommandText:='Insert

Boolean);

 

into rCen

begin

dm.temp.CommandText:='Select

(id_vid_rc,cena_rc,data_rc)

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

id_vid from vidacha where

values

.clear;

(kto_vid="'+e1.Text+'")';

('+tmp+',"'+e2.Text+'","'+dat

close;

dm.temp.Active:=true;

etostr(date)+'")';

end;

if dm.temp.RecordCount>0

dm.com.Execute;

 

then

end

 

33

procedure

{$R *.dfm}

procedure

TFChpass.BitBtn1Click(Sender:

procedure

FormShow(Sender: TObject);

TObject);

Tdm.Timer1Timer(Sender:

private

begin

TObject);

{ Private declarations }

if e1.Text='' then

var ind:integer;

public

showmessage('Выневвелиимяполь

begin

{ Public declarations }

зователя')

if d.Active=true then

end;

else if e2.Text='' then

begin

var

showmessage('Выневвелитекущий

ind:=d.RecNo;

Fdiagnoz: TFdiagnoz;

пароль')

d.Requery();

implementation

else if e3.Text='' then

d.RecNo:=ind;

uses datm, aDiagnoz,

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

end;

main;

роль')

if pc.Active=true then

{$R *.dfm}

else if e3.Text<>e4.Text then

begin

procedure

begin

ind:=pc.RecNo;

TFdiagnoz.Button1Click(Sender

showmessage('Пароли не

pc.Requery();

: TObject);

совпадают');

pc.RecNo:=ind;

begin

e3.Clear;e4.Clear;

end;

tm:=0;

end

if vid.Active=true then

fadiagnoz.ShowModal;

else

begin

end;

begin

ind:=vid.RecNo;

procedure

dm.temp.Active:=false;

vid.Requery();

TFdiagnoz.Button2Click(Sender

 

vid.RecNo:=ind;

: TObject);

dm.temp.CommandText:='select

end;

begin

login from pass where

if sp.Active=true then

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

(login="'+e1.Text+'") and

begin

then

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

ind:=sp.RecNo;

begin

dm.temp.Active:=true;

sp.Requery();

showmessage('Запись для

if dm.temp.RecordCount=0

sp.RecNo:=ind;

редактирования отсутствует');

then

end;

exit;

showmessage('Ошибкавимениполь

end;

end;

зователяилипароле')

end.

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

else

unit diagnoz;

tm:=1;

begin

interface

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

 

uses

***

dm.com.CommandText:='Update

Windows, Messages,

if

pass set pass="'+e3.Text+'"

SysUtils, Variants, Classes,

fmain.Update('d','diagnoz')=f

where login="'+e1.Text+'"';

Graphics, Controls, Forms,

alse then

dm.com.Execute;

Dialogs, Grids, DBGrids,

begin

 

StdCtrls, ToolWin, ComCtrls;

showmessage('Данная запись

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

type

используется другим

closequery;

TFdiagnoz = class(TForm)

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

end;

ToolBar1: TToolBar;

exit;

end;

Button1: TButton;

end;

end;

Button2: TButton;

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

end.

Button3: TButton;

***

unit datm;

ToolBar2: TToolBar;

fadiagnoz.e1.Text:=dm.d.field

interface

e1: TEdit;

byname('nazv_d').AsString;

uses

Button4: TButton;

fadiagnoz.e2.Text:=dm.d.field

SysUtils, Classes, DB,

ToolBar3: TToolBar;

byname('sh_d').AsString;

ADODB, Dialogs, ExtCtrls;

Button5: TButton;

fadiagnoz.ShowModal;

type

Button6: TButton;

end;

Tdm = class(TDataModule)

DBGrid1: TDBGrid;

procedure

ado: TADOConnection;

Button7: TButton;

TFdiagnoz.Button3Click(Sender

od: TOpenDialog;

procedure

: TObject);

temp: TADODataSet;

Button1Click(Sender:

begin

com: TADOCommand;

TObject);

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

d: TADODataSet;

procedure

then

ds: TDataSource;

Button2Click(Sender:

begin

pc: TADODataSet;

TObject);

showmessage('Запись для

pcs: TDataSource;

procedure

редактирования отсутствует');

vid: TADODataSet;

Button3Click(Sender:

exit;

vids: TDataSource;

TObject);

end;

sp: TADODataSet;

procedure

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

sps: TDataSource;

FormCloseQuery(Sender:

tm:=1;

temp2: TADODataSet;

TObject; var CanClose:

if

Timer1: TTimer;

Boolean);

fmain.Delete('d','diagnoz',tm

procedure

procedure

p)=false then

Timer1Timer(Sender: TObject);

Button4Click(Sender:

begin

private

TObject);

showmessage('Данная запись

{ Private declarations }

procedure

используется другим

public

Button7Click(Sender:

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

{ Public declarations }

TObject);

exit;

end;

procedure

end

var

Button5Click(Sender:

else dm.d.Requery();

dm: Tdm;

TObject);

end;

tmp,tmp2,id_d,id_pd,foto,id_p

procedure

procedure

c,id_vid,tmpc:string;

Button6Click(Sender:

TFdiagnoz.FormCloseQuery(Send

tm:integer;

TObject);

er: TObject; var CanClose:

implementation

 

Boolean);

34

begin

N13: TMenuItem;

begin

 

e1.Clear;close;

N14: TMenuItem;

showmessage('Программа

end;

N15: TMenuItem;

будет закрыта!');

procedure

N141: TMenuItem;

application.Terminate;

TFdiagnoz.Button4Click(Sender

N16: TMenuItem;

end

 

: TObject);

N17: TMenuItem;

else canclose:=false;

begin

N18: TMenuItem;

end;

 

dm.d.Active:=false;

N19: TMenuItem;

procedure

 

dm.d.CommandText:='select

WordApplication1:

Tfmain.N5Click(Sender:

id_d,nazv_d,sh_d from diagnoz

TWordApplication;

TObject);

 

WHERE (nazv_d like

WordDocument1:

var inifile:tinifile;

"%'+e1.Text+'%") or (sh_d

TWordDocument;

dbp:string;

like "%'+e1.Text+'%")';

N20: TMenuItem;

begin

 

dm.d.Active:=true;

Image1: TImage;

IniFile

:=

end;

procedure

TIniFile.Create(ExtractFilePa

procedure

FormCloseQuery(Sender:

th(Application.ExeName)+'opti

TFdiagnoz.Button7Click(Sender

TObject; var CanClose:

ons.ini');

//

: TObject);

Boolean);

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

begin

procedure N5Click(Sender:

зе

 

e1.Clear;

TObject);

DBP :=

 

dm.d.Active:=false;

procedure N3Click(Sender:

IniFile.ReadString('options',

dm.d.CommandText:='select

TObject);

'dbpath', '');

id_d,nazv_d,sh_d from

procedure N2Click(Sender:

IniFile.Free;

diagnoz';

TObject);

//showmessage(dbp);

dm.d.Active:=true;

procedure N6Click(Sender:

copyfile(pchar(DBP),pchar(Ext

end;

TObject);

ractFilePath(Application.ExeN

procedure

procedure N9Click(Sender:

ame)+'Архив\base_'+datetostr(

TFdiagnoz.Button5Click(Sender

TObject);

date)+'_'+stringreplace(timet

: TObject);

function

ostr(time),':','.',[rfReplace

begin

data(data:tdatetime):string;

All,

 

dm.d.Active:=false;

function

rfIgnoreCase])+'.mdb'),true);

dm.d.CommandText:='select

Update(rs,tab:string):boolean

if

 

id_d,nazv_d,sh_d from diagnoz

;

fileexists(ExtractFilePath(Ap

order by nazv_d';

function

plication.ExeName)+'Архив\bas

dm.d.Active:=true;

Delete(rs,tab,temp:string):bo

e_'+datetostr(date)+'_'+strin

end;

olean;

greplace(timetostr(time),':',

procedure

procedure N8Click(Sender:

'.',[rfReplaceAll,

TFdiagnoz.Button6Click(Sender

TObject);

rfIgnoreCase])+'.mdb') =true

: TObject);

procedure

then

 

begin

N10Click(Sender: TObject);

showmessage('Резервнаякопиясо

dm.d.Active:=false;

procedure

зданауспешно')

dm.d.CommandText:='select

N12Click(Sender: TObject);

else showmessage('Ошибка при

id_d,nazv_d,sh_d from diagnoz

procedure

создании

резервной копии');

order by sh_d';

N15Click(Sender: TObject);

end;

 

dm.d.Active:=true;

procedure

procedure

 

end;

N16Click(Sender: TObject);

Tfmain.N3Click(Sender:

 

procedure

TObject);

 

procedure

N141Click(Sender: TObject);

begin

 

TFdiagnoz.FormShow(Sender:

procedure

closequery;

TObject);

N17Click(Sender: TObject);

end;

 

begindbgrid1.DataSource:=dm.d

procedure

procedure

 

s;

N18Click(Sender: TObject);

Tfmain.N2Click(Sender:

end;

procedure

TObject);

 

end.

N19Click(Sender: TObject);

begin

 

unit main;

procedure

Fpass.SpeedButton1Click(Sende

interface

N20Click(Sender: TObject);

r);

 

uses

procedure

end;

 

Windows, Messages,

FormShow(Sender: TObject);

procedure

 

SysUtils, Variants, Classes,

private

Tfmain.N6Click(Sender:

Graphics, Controls, Forms,

{ Private declarations }

TObject);

 

Dialogs,inifiles,

public

begin

 

Menus,UEasyPath,dateutils,ado

{ Public declarations }

fchpass.ShowModal;

db,db, WordXP,

end;

end;

 

OleServer,registry,

var

procedure

 

ExtCtrls;

fmain: Tfmain;

Tfmain.N9Click(Sender:

type

implementation

TObject);

 

Tfmain = class(TForm)

uses pass, Chpass, datm,

begin

 

MainMenu1: TMainMenu;

diagnoz, pacient, Vidacha,

dm.d.Active:=false;

N1: TMenuItem;

Sprav, ot1, ot2;

dm.d.CommandText:='select

N2: TMenuItem;

{$R *.dfm}

id_d,nazv_d,sh_d from

N3: TMenuItem;

procedure

diagnoz';

 

N4: TMenuItem;

Tfmain.FormCloseQuery(Sender:

dm.d.Active:=true;

N5: TMenuItem;

TObject; var CanClose:

fdiagnoz.ShowModal;

N6: TMenuItem;

Boolean);

end;

 

N7: TMenuItem;

begin

function TFmain.data

N8: TMenuItem;

if

(data:tdatetime):string;

N9: TMenuItem;

application.MessageBox('Выхот

var g,m,d:word;

N10: TMenuItem;

итевыйтиизпрограммы?','Выходи

begin

 

N11: TMenuItem;

зпрограммы',mb_yesno+mb_iconq

decodedate(data,g,m,d);

N12: TMenuItem;

uestion)=idyes then

 

 

35

result:=''+currtostr(m)+'/'+c

procedure

procedure

urrtostr(d)+'/'+currtostr(g)+

Tfmain.N12Click(Sender:

Tfmain.N18Click(Sender:

'';

TObject);

TObject);

end;

begin

begin

function

dm.sp.Active:=false;

tm:=1;

TFmain.Update(rs,tab:string):

dm.sp.CommandText:='(select

fot1.ShowModal;

boolean;

id_sp,fio_pc,kto_vid,cena_sp,

end;

begin

data_sp,lg_vid from

procedure

dm.temp.Active:=false;

vidacha,pacient,sprav where

Tfmain.N19Click(Sender:

dm.temp.CommandText:='Select

(id_pc=id_pc_sp) and

TObject);

log_'+rs+' from '+tab+' where

(id_vid=id_vid_sp)) UNION

var

(id_'+rs+'='+tmp+')';

(select

 

dm.temp.Active:=true;

id_np,fio_np,kto_vid,cena_np,

Template,NewTemplate,FindText

if

data_np,lg_np from

, NewStr,

dm.temp.Fields[0].AsBoolean=t

vidacha,NePsix where

Replace,ReplaceWith:OleVarian

rue then

(id_vid=id_vid_np))';

t;

begin

dm.sp.Active:=true;

LinkToFile,SaveWithDocument,R

result:=false;

fsprav.ShowModal;

ange:OleVariant;

end

end;

Table1: Table;

else

procedure

i: integer;

begin

Tfmain.N15Click(Sender:

flag:boolean;

dm.com.CommandText:='Update

TObject);

Reg: TRegistry;

'+tab+' set log_'+rs+'=TRUE

begin

begin

where id_'+rs+'='+tmp+'';

dm.temp.Active:=false;

//Проверяем,

dm.com.Execute;

dm.temp.CommandText:='Select

инсталлированлиWord

result:=true;

count(id_pc) from pacient

Reg := TRegistry.Create;

end;

where (adr_pc like

Reg.RootKey :=

end;

"%бомж%")';

HKEY_CLASSES_ROOT;

function

dm.temp.Active:=true;

 

TFmain.Delete(rs,tab,temp:str

showmessage('Количество

flag:=reg.KeyExists('Word.App

ing):boolean;

"бомжей":

lication');

begin

'+dm.temp.Fields[0].asstring)

reg.Free;

dm.temp.Active:=false;

;

//flag:=true;

dm.temp.CommandText:='Select

end;

if flag=false then

log_'+rs+' from '+tab+' where

procedure

begin

(id_'+rs+'='+tmp+')';

Tfmain.N16Click(Sender:

 

dm.temp.Active:=true;

TObject);

application.MessageBox('Word

if

begin

неустанволен','Отчет',mb_ok+m

dm.temp.Fields[0].AsBoolean=t

dm.temp.Active:=false;

b_iconstop);

rue then

dm.temp.CommandText:='Select

exit;

begin

count(id_pc) from pacient

end;

result:=false;

where (trud_pc = "нет")';

WordApplication1.Connect; //

end

dm.temp.Active:=true;

Устанавливаемсвязьссервером

else if

showmessage('Количествобезраб

 

application.MessageBox('Выхот

отных:

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

итеудалитьзапись?','Удаление'

'+dm.temp.Fields[0].asstring)

ordTemplate:=ExtractFilePath(

,mb_yesno+mb_iconquestion)=id

;

Application.EXEName)+'\Шаблон

yes then

end;

ы\Диагнозы.dot';

begin

procedure

//путькшаблонудокумента

dm.com.CommandText:='Delete

Tfmain.N141Click(Sender:

WordApplication1.Documents.Ad

* from '+tab+' where

TObject);

d(Template,EmptyParam,EmptyPa

(id_'+rs+'='+tmp+')';

var i:integer;

ram,EmptyParam);//

dm.com.Execute;

begin

создаемдокументнаосновешаблон

result:=true;

i:=0;

аWordDocument1.ConnectTo(Word

showmessage('Удаление прошло

dm.temp.Active:=false;

Application1.ActiveDocument);

успешно');

dm.temp.CommandText:='Select

//СвязываемкомпонентWordDocum

end;

dr_pc from pacient where

ent1 cактивнымдокументом

end;

(datas_pc is null)';

(т.е.

procedure

dm.temp.Active:=true;

столькочтосозданнымдокументом

Tfmain.N8Click(Sender:

While not dm.temp.Eof do

)

TObject);

begin

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

begin

//showmessage(inttostr(yearsb

объектов

dm.pc.Active:=false;

etween(date,dm.temp.Fields[0]

 

dm.pc.CommandText:='select *

.AsDateTime)));

Table1:=WordDocument1.Tables.

from pacient';

if

Item(1); //связываем имя

dm.pc.Active:=true;

yearsbetween(date,dm.temp.Fie

Table1 с первой таблицей

fpacient.ShowModal;

lds[0].AsDateTime)<14 then

документа

end;

inc(i);

//WordDocument1.Tables -

procedure

dm.temp.Next;

это массив таблиц документа

Tfmain.N10Click(Sender:

end;

(тип Tables), а

TObject);

showmessage('Количествомладше

WordDocument1.Tables.Item(i)

begin

14: '+ inttostr(i));

- i-ая таблица

dm.vid.Active:=false;

end;

dm.temp.Active:=false;

dm.vid.CommandText:='select

procedure

 

id_vid, kto_vid, st_vid from

Tfmain.N17Click(Sender:

dm.temp.CommandText:='select

Vidacha';

TObject);

nazv_d,count(id_pc_pd) from

dm.vid.Active:=true;

begin

diagnoz,pacdig,pacient where

fvidacha.ShowModal;

tm:=0;

(id_d=id_d_pd) and

end;

fot1.ShowModal;

(id_pc=id_pc_pd) and

 

end;

 

36

(datas_pc is null) group by

private

//Связываем компонент

nazv_d';

{ Private declarations }

WordDocument1 c активным

dm.temp.Active:=true;

public

документом (т.е. с только что

i:=2;

{ Public declarations }

созданным документом)

while not dm.temp.Eof do

end;

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

begin

var

объектов

 

fot1: Tfot1;

 

Table1.Rows.Add(EmptyParam);

implementation

Table1:=WordDocument1.Tables.

Table1.Cell(i,

uses datm, main;

Item(1); //связываем имя

1).Range.Text :=

{$R *.dfm}

Table1 с первой таблицей

dm.temp.Fields[0].AsString;

procedure

документа

Table1.Cell(i,

Tfot1.BitBtn2Click(Sender:

//WordDocument1.Tables -

2).Range.Text :=

TObject);

это массив таблиц документа

dm.temp.Fields[1].AsString;

begin

(тип Tables), а

inc(i);dm.temp.next;

closequery;

WordDocument1.Tables.Item(i)

end;

end;

- i-ая таблица

Table1.Rows.Item(i).Delete;

procedure

Replace:=true; // параметр,

 

Tfot1.FormShow(Sender:

задающий режим замены

WordApplication1.Visible:=tru

TObject);

FindText:='#1'; // что

e; //делаемприложение MS Word

begin

меняем

видимым

dtp1.Date:=date;dtp2.Date:=da

ReplaceWith:=datetostr(dtp1.D

 

te;

ate); //

WordApplication1.Disconnect;

end;

начтоменяемWordDocument1.Rang

// Разрываемсвязьссерверо

procedure

e.Find.Execute(FindText,Empty

end;

Tfot1.BitBtn1Click(Sender:

Param,EmptyParam,

procedure

TObject);

EmptyParam,EmptyParam,EmptyPa

Tfmain.N20Click(Sender:

var

ram,EmptyParam,

TObject);

 

EmptyParam,EmptyParam,Replace

begin

Template,NewTemplate,FindText

With,Replace,EmptyParam,Empty

fot2.ShowModal;

, NewStr,

Param,EmptyParam,EmptyParam);

end;

Replace,ReplaceWith:OleVarian

Replace:=true; // параметр,

procedure

t;

задающий режим замены

Tfmain.FormShow(Sender:

LinkToFile,SaveWithDocument,R

FindText:='#2'; // что

TObject);

ange:OleVariant;

меняем

begin

Table1: Table;

ReplaceWith:=datetostr(dtp2.D

if fileexists('photo.jpg')

i: integer;

ate); //

then

flag:boolean;

начтоменяемWordDocument1.Rang

begin

Reg: TRegistry;

e.Find.Execute(FindText,Empty

 

begin

Param,EmptyParam,

image1.Picture.LoadFromFile('

if dtp2.Date<dtp1.Date then

EmptyParam,EmptyParam,EmptyPa

photo.jpg');

begin

ram,EmptyParam,

end;

showmessage('Неправильная

EmptyParam,EmptyParam,Replace

end;

последовательность дат');

With,Replace,EmptyParam,Empty

end.

exit;

Param,EmptyParam,EmptyParam);

unit ot1;

end;

dm.temp.Active:=false;

interface

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

 

uses

ли Word

dm.temp.CommandText:='select

Windows, Messages,

Reg := TRegistry.Create;

fio_pc,kto_vid,st_vid,data_sp

SysUtils, Variants, Classes,

Reg.RootKey :=

from vidacha,pacient,sprav

Graphics, Controls, Forms,

HKEY_CLASSES_ROOT;

where (id_pc=id_pc_sp) and

Dialogs, StdCtrls, Buttons,

 

(id_vid=id_vid_sp) and

ExtCtrls,registry, WordXP,

flag:=reg.KeyExists('Word.App

(data_sp between

OleServer,

lication');

#'+fmain.data(dtp1.date)+'#

ComCtrls;

reg.Free;

and

type

//flag:=true;

#'+fmain.data(dtp2.date)+'#)'

Tfot1 = class(TForm)

if flag=false then

;

Panel1: TPanel;

begin

dm.temp.Active:=true;

BitBtn1: TBitBtn;

 

i:=2;

BitBtn2: TBitBtn;

application.MessageBox('Word

while not dm.temp.Eof do

Panel2: TPanel;

неустанволен','Отчет',mb_ok+m

begin

Label1: TLabel;

b_iconstop);

 

Label2: TLabel;

exit;

Table1.Rows.Add(EmptyParam);

dtp1: TDateTimePicker;

end;

Table1.Cell(i,

dtp2: TDateTimePicker;

if tm=0 then

1).Range.Text :=

WordApplication1:

begin

dm.temp.Fields[0].AsString;

TWordApplication;

WordApplication1.Connect; //

Table1.Cell(i,

WordDocument1:

Устанавливаем связь с

2).Range.Text :=

TWordDocument;

сервером

dm.temp.Fields[1].AsString;

procedure

//Открываем шаблон

Table1.Cell(i,

BitBtn2Click(Sender:

otchet.dot в Word

3).Range.Text :=

TObject);

Template:=ExtractFilePath(App

dm.temp.Fields[3].AsString;

procedure

lication.EXEName)+'\Шаблоны\С

Table1.Cell(i,

FormShow(Sender: TObject);

правки.dot'; //путь к шаблону

4).Range.Text :=

procedure

документа

dm.temp.Fields[2].AsString;

BitBtn1Click(Sender:

WordApplication1.Documents.Ad

inc(i);dm.temp.next;

TObject);

d(Template,EmptyParam,EmptyPa

end;

procedure

ram,EmptyParam);// создаем

Table1.Rows.Item(i).Delete;

FormCloseQuery(Sender:

документ на основе шаблона

 

TObject; var CanClose:

WordDocument1.ConnectTo(WordA

WordApplication1.Visible:=tru

Boolean);

pplication1.ActiveDocument);

 

37

e; //делаемприложение MS Word

procedure

WordDocument1 c

видимым

BitBtn1Click(Sender:

активнымдокументом (т.е.

 

TObject);

столькочтосозданнымдокументом

WordApplication1.Disconnect;

procedure

)

// Разрываемсвязьссерверо

FormCloseQuery(Sender:

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

end

TObject; var CanClose:

объектов

else

Boolean);

 

begin

private

Table1:=WordDocument1.Tables.

dm.temp.Active:=false;

{ Private declarations }

Item(1); //связываем имя

 

public

Table1 с первой таблицей

dm.temp.CommandText:='select

{ Public declarations }

документа

count(id_sp),sum(cena_sp)

end;

//WordDocument1.Tables -

from pacient,sprav where

var

это массив таблиц документа

(id_pc=id_pc_sp) and (data_sp

Fot2: TFot2;

(тип Tables), а

between

implementation

WordDocument1.Tables.Item(i)

#'+fmain.data(dtp1.date)+'#

uses datm, main;

- i-ая таблица

and

{$R *.dfm}

Replace:=true; // параметр,

#'+fmain.data(dtp2.date)+'#)'

procedure

задающий режим замены

;

TFot2.BitBtn2Click(Sender:

FindText:='#1'; // что

dm.temp.Active:=true;

TObject);

меняем

dm.temp2.Active:=false;

begin

ReplaceWith:=datetostr(dtp1.D

 

closequery;

ate); //

dm.temp2.CommandText:='select

end;

начтоменяемWordDocument1.Rang

count(id_np),sum(cena_np)

procedure

e.Find.Execute(FindText,Empty

from nepsix where (data_np

TFot2.FormShow(Sender:

Param,EmptyParam,

between

TObject);

EmptyParam,EmptyParam,EmptyPa

#'+fmain.data(dtp1.date)+'#

begin

ram,EmptyParam,

and

dtp1.Date:=date;

EmptyParam,EmptyParam,Replace

#'+fmain.data(dtp2.date)+'#)'

end;

With,Replace,EmptyParam,Empty

;

procedure

Param,EmptyParam,EmptyParam);

dm.temp2.Active:=true;

TFot2.BitBtn1Click(Sender:

dm.temp2.Active:=false;

showmessage('Запериодс

TObject);

 

'+datetostr(dtp1.Date)+' по

var

dm.temp2.CommandText:='select

'+

 

id_vid_rc,max(data_rc) from

datetostr(dtp2.date)+#13'Было

Template,NewTemplate,FindText

rcen WHERE

выдано:

, NewStr,

(data_rc<=#'+fmain.data(dtp1.

'+inttostr(dm.temp.Fields[0].

Replace,ReplaceWith:OleVarian

Date)+'#) group by

asinteger+dm.temp2.Fields[0].

t;

id_vid_rc';

asinteger)+'

LinkToFile,SaveWithDocument,R

dm.temp2.Active:=true;

справок(ки)'#13'Насумму:

ange:OleVariant;

i:=2;

'+floattostr(dm.temp.fields[1

Table1: Table;

while not dm.temp2.Eof do

].AsFloat+dm.temp2.fields[1].

i: integer;

begin

AsFloat ) +' руб.');

flag:boolean;

dm.temp.Active:=false;

end;

Reg: TRegistry;

 

end;

begin

dm.temp.CommandText:='select

procedure

//Проверяем,

id_vid,kto_vid,cena_rc from

Tfot1.FormCloseQuery(Sender:

инсталлированлиWord

vidacha,rcen WHERE

TObject; var CanClose:

Reg := TRegistry.Create;

(id_vid=id_vid_rc) and

Boolean);

Reg.RootKey :=

(data_rc=#'+fmain.data(dm.tem

begin

HKEY_CLASSES_ROOT;

p2.Fields[1].asdatetime)+'#)

close;

 

and (id_vid_rc =

end;

flag:=reg.KeyExists('Word.App

'+dm.temp2.Fields[0].AsString

end.

lication');

+') ';

unit ot2;

reg.Free;

dm.temp.Active:=true;

interface

//flag:=true;

 

uses

if flag=false then

Table1.Rows.Add(EmptyParam);

Windows, Messages,

begin

Table1.Cell(i,

SysUtils, Variants, Classes,

 

1).Range.Text :=

Graphics, Controls, Forms,

application.MessageBox('Word

dm.temp.Fields[1].AsString;

Dialogs, WordXP, OleServer,

неустанволен','Отчет',mb_ok+m

Table1.Cell(i,

ComCtrls, StdCtrls, Buttons,

b_iconstop);

2).Range.Text :=

ExtCtrls,registry;

exit;

dm.temp.Fields[2].AsString;

type

end;

inc(i);dm.temp2.next;

TFot2 = class(TForm)

WordApplication1.Connect; //

end;

Panel1: TPanel;

Устанавливаемсвязьссервером

Table1.Rows.Item(i).Delete;

BitBtn1: TBitBtn;

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

 

BitBtn2: TBitBtn;

в Word

WordApplication1.Visible:=tru

Panel2: TPanel;

 

e; //делаемприложение MS Word

Label1: TLabel;

Template:=ExtractFilePath(App

видимым

dtp1: TDateTimePicker;

lication.EXEName)+'\Шаблоны\П

 

WordApplication1:

райс.dot';

WordApplication1.Disconnect;

TWordApplication;

//путькшаблонудокумента

// Разрываемсвязьссерверо

WordDocument1:

WordApplication1.Documents.Ad

end;

TWordDocument;

d(Template,EmptyParam,EmptyPa

procedure

procedure

ram,EmptyParam);//

TFot2.FormCloseQuery(Sender:

BitBtn2Click(Sender:

создаемдокументнаосновешаблон

TObject; var CanClose:

TObject);

а

Boolean);

procedure

WordDocument1.ConnectTo(WordA

begin

FormShow(Sender: TObject);

pplication1.ActiveDocument);

close;

 

//Связываемкомпонент

end;

38

end.

(select id_d_pd from pacdig

fapacient.pd.active:=true;

unit pacient;

where id_pc_pd='+tmp2+'))';

}

interface

fapacient.pd.active:=true;

fapacient.pd.active:=false;

uses

}

fapacient.pd.CommandText:='Se

Windows, Messages,

fapacient.pd.active:=false;

lect distinct id_pd,nazv_d

SysUtils, Variants, Classes,

fapacient.pd.CommandText:='Se

from diagnoz,pacdig where

Graphics, Controls, Forms,

lect distinct id_pd,nazv_d

(id_d=id_d_pd) and

Dialogs, Grids, DBGrids,

from diagnoz,pacdig where

(id_pc_pd='+tmp2+')';

StdCtrls, ToolWin, ComCtrls;

(id_d=id_d_pd) and

fapacient.pd.active:=true;

type

(id_pc_pd='+tmp2+')';

dm.temp.Active:=false;

TFpacient = class(TForm)

fapacient.pd.active:=true;

dm.temp.CommandText:='Select

ToolBar1: TToolBar;

dm.temp.Active:=false;

nazv_d from diagnoz where

Button1: TButton;

dm.temp.CommandText:='Select

(id_d not in (select id_d_pd

Button2: TButton;

nazv_d from diagnoz where

from pacdig where

Button3: TButton;

(id_d not in (select id_d_pd

id_pc_pd='+tmp2+'))';

ToolBar2: TToolBar;

from pacdig where

dm.temp.Active:=true;

e1: TEdit;

id_pc_pd='+tmp2+'))';

fapacient.cb.Clear;

Button4: TButton;

dm.temp.Active:=true;

while not dm.temp.Eof do

Button7: TButton;

fapacient.cb.Clear;

begin

ToolBar3: TToolBar;

while not dm.temp.Eof do

fapacient.cb.Items.Add(dm.tem

Button5: TButton;

begin

p.fields[0].AsString);

Button6: TButton;

fapacient.cb.Items.Add(dm.tem

dm.temp.Next;

DBGrid1: TDBGrid;

p.fields[0].AsString);

end;

Button8: TButton;

dm.temp.Next;

fapacient.od.FileName:=Extrac

Button9: TButton;

end;

tFilePath(Application.ExeName

Button10: TButton;

fapacient.ShowModal;

)+'Фото\'+dm.pc.fieldbyname('

ToolButton1: TToolButton;

end;

foto_pc').AsString;

procedure

procedure

foto:=dm.pc.fieldbyname('foto

Button1Click(Sender:

TFpacient.Button2Click(Sender

_pc').AsString;

TObject);

: TObject);

if foto='' then

procedure

begin

fapacient.Image1.Picture.Load

Button2Click(Sender:

if

FromFile(ExtractFilePath(Appl

TObject);

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

ication.ExeName)+'Фото\anonim

procedure

then

.jpeg')

Button3Click(Sender:

begin

else

TObject);

showmessage('Запись для

fapacient.Image1.Picture.Load

procedure

редактирования отсутствует');

FromFile(ExtractFilePath(Appl

Button7Click(Sender:

exit;

ication.ExeName)+'Фото\'+dm.p

TObject);

end;

c.fieldbyname('foto_pc').AsSt

procedure

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

ring);

Button4Click(Sender:

;tm:=1;

fapacient.ShowModal;

TObject);

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

end;

procedure

***

procedure

Button5Click(Sender:

if

TFpacient.Button3Click(Sender

TObject);

fmain.Update('pc','pacient')=

: TObject);

procedure

false then

begin

Button6Click(Sender:

begin

if

TObject);

showmessage('Данная запись

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

procedure

используется другим

then

Button8Click(Sender:

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

begin

TObject);

exit;

showmessage('Запись для

procedure

end;

редактирования отсутствует');

Button9Click(Sender:

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

exit;

TObject);

***

end;

procedure

fapacient.e1.Text:=dm.pc.fiel

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

Button10Click(Sender:

dbyname('fio_pc').AsString;

;tm:=1;

TObject);

fapacient.e2.Text:=dm.pc.fiel

if

procedure

dbyname('adr_pc').AsString;

fmain.Delete('pc','pacient',t

FormShow(Sender: TObject);

fapacient.e3.Text:=dm.pc.fiel

mp)=false then

private

dbyname('tel_pc').AsString;

begin

{ Private declarations }

fapacient.cb1.Text:=dm.pc.fie

showmessage('Данная запись

public

ldbyname('pol_pc').AsString;

используется другим

{ Public declarations }

fapacient.cb2.Text:=dm.pc.fie

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

end;

ldbyname('trud_pc').AsString;

exit;

var

fapacient.cb3.Text:=dm.pc.fie

end

Fpacient: TFpacient;

ldbyname('inv_pc').AsString;

else dm.pc.Requery();

implementation

fapacient.dtp1.date:=dm.pc.fi

end;

uses datm, main, aPacient;

eldbyname('dr_pc').AsDateTime

procedure

{$R *.dfm}

;

TFpacient.Button7Click(Sender

procedure

fapacient.dtp2.date:=dm.pc.fi

: TObject);

TFpacient.Button1Click(Sender

eldbyname('datap_pc').AsDateT

begin

: TObject);

ime;

e1.Clear;

begin

tmp2:=tmp;

dm.pc.Active:=false;

tm:=0;

{fapacient.pd.active:=false;

dm.pc.CommandText:='select *

tmp2:='0';

fapacient.pd.CommandText:='Se

from pacient';

{fapacient.pd.active:=false;

lect distinct id_pd,nazv_d

dm.pc.Active:=true;

fapacient.pd.CommandText:='Se

from diagnoz,pacdig where

end;

lect distinct id_pd,nazv_d

(id_d=id_d_pd) and (id_d in

procedure

from diagnoz,pacdig where

(select id_d_pd from pacdig

TFpacient.Button4Click(Sender

(id_d=id_d_pd) and (id_d in

where id_pc_pd='+tmp2+'))';

: TObject);

39

begin

procedure

exit;

dm.pc.Active:=false;

TFpacient.Button8Click(Sender

end;

dm.pc.CommandText:='select *

: TObject);

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

from pacient where (fio_pc

begin

;

like "%'+e1.Text+'%") or

e1.Clear;

if

(pol_pc like

dm.pc.Active:=false;

dm.pc.FieldByName('datas_pc')

"%'+e1.Text+'%")';

dm.pc.CommandText:='select *

.AsString<>'' then

dm.pc.Active:=true;

from pacient order by

begin

end;

datap_pc';

showmessage('Данный пациент

procedure

dm.pc.Active:=true;

снят с учета');

TFpacient.Button5Click(Sender

end;

exit;

: TObject);

procedure

end

begin

TFpacient.Button9Click(Sender

else

e1.Clear;

: TObject);

begin

dm.pc.Active:=false;

begin

dm.com.commandtext:='Update

dm.pc.CommandText:='select *

e1.Clear;

pacient set datas_pc=date()

from pacient order by dr_pc';

dm.pc.Active:=false;

where (id_pc='+tmp+')';

dm.pc.Active:=true;

dm.pc.CommandText:='select *

dm.com.Execute;

end;

from pacient order by

dm.pc.Requery();

procedure

datas_pc';

showmessage('Пациент снят с

TFpacient.Button6Click(Sender

dm.pc.Active:=true;

учета');

: TObject);

end;

end;

begin

procedure

end;

e1.Clear;

TFpacient.Button10Click(Sende

procedure

dm.pc.Active:=false;

r: TObject);

TFpacient.FormShow(Sender:

dm.pc.CommandText:='select *

begin

TObject);

from pacient order by

if

begin

pol_pc';

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

dbgrid1.DataSource:=dm.pcs;

dm.pc.Active:=true;

then

end;

end;

begin

end.

 

showmessage('Запись для

 

 

редактирования отсутствует');

 

40

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