Цветков А. А. Биоимпедансные методы контроля системной гемодинамики. – М. : издательство ооо фирма «слово», 2010.

3. Полищук В.И., Терехова Л.Г. Техника и методика реографии и реоплетизмографии. – М.: Медицина, 1983.

4. Хаютин В.М., Лукошкова Е.В., Ермишкин В.В., Сонина Р.С. Показатель сократимости сердца человека – период предызгнания. Неинвазивное определение при каждом сокращении. Успехи физиол. наук, 2009.

Реография в клинической практике. Справочное пособие. – Санкт-Петербург: издательство ЗАО «ДИАМАНТ», 1998.

Федотов А.А., Акулов С.А. Измерительные преобразователи биоимпедансных сигналов систем клинического мониторинка. – М.: Радио и связь, 2013.

7. Хемминг Р.В. Цифровые фильтры: Пер. с англ. М.: Недра, 1987.

Приложение А.

unit Unit1;

interface

uses

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

Dialogs, ActnList, Menus, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Image1: TImage;

OpenDialog1: TOpenDialog;

Memo1: TMemo;

procedure Image1Click(Sender: TObject);

procedure MaxR;

procedure MaxM;

procedure GelZ;

procedure GelY;

procedure PorR;

procedure PorM;

procedure Action1Execute(Sender: TObject);

procedure Action2Execute(Sender: TObject);

procedure Action3Execute(Sender: TObject);

procedure Action4Execute(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const Gc=500;

var

Form1: TForm1;

F:TextFile;

I1,I2,J1,J2,Predel:integer;

ARR:array of smallint;

h1,h2,h3:smallint;

C: array of array of real;

e,PorogM,PorogR:smallint;

q,w,q2,w2,q3,w3,q4,w4,a1,a2,a3,a4:real;

 

implementation

{$R *.dfm}

 

////процедура при нажатии на кнопке Открыть ЭКГ

procedure TForm1.Action1Execute(Sender: TObject);

var i,j: integer;

S: string;

begin

SetLength(C,10);

OpenDialog1.Filter:='Файлы данных (*.txt)|*.txt|Все файлы|*.*';

OpenDialog1.FilterIndex:=1;

OpenDialog1.Title:='Выбор файла';

if OpenDialog1.Execute then

begin

try

AssignFile(F,OpenDialog1.FileName); ////Открытие файла

Reset(F);

i:=0;

SetLength(C[1],0);

SetLength(C[6],0);

SetLength(C[2],0);

while not EOF(F) do

begin

Readln(F,S);

S:= StringReplace(S, '.', ',', [ rfReplaceAll, rfIgnoreCase ]);

SetLength(C[1],i+1);

C[1,i]:=StrToFloat(S);

i:=i+1;

end; ////Чтение данных из файла в переменную

CloseFile(F); ////Закрытие файла

Button4.Enabled:=True;

 

SetLength(C[6],1); //Фильтр

C[6,0]:=C[1,0]/2;

SetLength(C[2],1);

C[2,0]:=C[1,0]-C[6,0];

 

for j:=1 to Length(C[1])-1 do

begin

SetLength(C[6],j+1);

SetLength(C[2],j+1);

C[6,j]:=C[6,j-1] - (1/Gc)*(C[6,j-1]-C[1,j]);

C[2,j]:=C[1,j]-C[6,j];

end;

 

except ////Обработка исключительных ситуаций

on E:EInOutError do ShowMessage(E.Message);

end;

end

end;

 

procedure TForm1.Action4Execute(Sender: TObject); /// Загрузить Реограмму

var i,j: integer; S:string;

begin

OpenDialog1.Filter:='Файлы данных (*.txt)|*.txt|Все файлы|*.*';

OpenDialog1.FilterIndex:=1;

OpenDialog1.Title:='Выбор файла';

if OpenDialog1.Execute then

begin

try

AssignFile(F,OpenDialog1.FileName); ////Открытие файла

Reset(F);

i:=0;

SetLength(C[3],0);

while not EOF(F) do

begin

Readln(F,S);

S:= StringReplace(S, '.', ',', [ rfReplaceAll, rfIgnoreCase ]);

SetLength(C[3],i+1);

C[3,i]:=StrToFloat(s);

i:=i+1;

end; ////Чтение данных из файла в переменную

CloseFile(F); ////Закрытие файла

Button2.Enabled:=True;

 

SetLength(C[4],0);

for j:=2 to Length(C[3])-3 do

begin

SetLength(C[4],j-1);

C[4,j-2]:=(1/35)*(-3*(C[3,j-2])+12*C[3,j-1]+17*C[3,j]+12*C[3,j+1]-3*C[3,j+2]);

end;

 

SetLength(C[5],0);

for j:=10 to Length(C[4])-11 do

begin

SetLength(C[5],j-9);

C[5,j-10]:=0.1*(-2*C[4,j-10]-C[4,j-5]+C[4,j+5]+2*C[4,j+10])/(1/Gc);

end;

 

SetLength(C[9],0);

for j:=2 to Length(C[5])-3 do

begin

SetLength(C[9],j-1);

C[9,j-2]:=(1/35)*(-3*(C[5,j-2])+12*C[5,j-1]+17*C[5,j]+12*C[5,j+1]-3*C[5,j+2]);

end;

 

SetLength(C[10],0);

for j:=10 to Length(C[9])-11 do

begin

SetLength(C[10],j-9);

C[10,j-10]:=0.1*(-2*C[9,j-10]-C[9,j-5]+C[9,j+5]+2*C[9,j+10])/(1/Gc);

end;

 

except ////Обработка исключительных ситуаций

on E:EInOutError do ShowMessage(E.Message);

end;

end

end;

 

 

////Нахождение минимального значения

function Min(i:integer):real;

var j:integer;

begin

Result:=C[i,0];

for j:=1 to Length(C[i])-1 do

if C[i,j]<Result then Result:=C[i,j];

end;

 

////Нахождение максимального значения

function Max(i:integer):real;

var j:integer;

begin

Result:=C[i,0];

for j:=1 to Length(C[i])-1 do

if C[i,j]>Result then Result:=C[i,j];

end;

 

 

////процедура при нажатии на кнопке Нарисовать - построение графика

procedure TForm1.Action2Execute(Sender: TObject);

var j:integer;

begin

Image1.Picture:=nil;////Очистка TImage1

I1:=0; ////Ввод координат, в пределах которых будет происходить построение графиков

I2:=Image1.Width; //длина

J2:=Image1.Height; //высота

J1:=round(J2/4);

 

e:=Image1.Height div 20;

 

q:=J1/(Abs(Max(2))+Abs(Min(2)));

q2:=J1/(Abs(Max(3))+Abs(Min(3)));

q3:=J1/(Abs(Max(5))+Abs(Min(5)));

q4:=J1/(Abs(Max(10))+Abs(Min(10)));

 

w:=I2/Length(C[2]);

w2:=I2/Length(C[3]);

 

a1:=(1/(Abs(Min(2))+Abs(Max(2)))*Abs(Max(2)))*J1;

a2:=(1+(1/(Abs(Min(3))+Abs(Max(3)))*Abs(Max(3))))*J1;

a3:=(2+(1/(Abs(Min(5))+Abs(Max(5)))*Abs(Max(5))))*J1;

a4:=(3+(1/(Abs(Min(10))+Abs(Max(10)))*Abs(Max(10))))*J1;

 

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(a1));

Image1.Canvas.LineTo(I2,round(a1));

Image1.Canvas.Pen.Color:=clRed;

Image1.Canvas.MoveTo(round((1)*w),round(a1+(-1)*C[2,1]*q));

for j:=2 to Length(C[2])-1 do ////Построение графиков

begin

Image1.Canvas.LineTo(round((j-1)*w),round(a1+(-1)*C[2,j-1]*q));

end;

 

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(a2));

Image1.Canvas.LineTo(I2,round(a2));

Image1.Canvas.Pen.Color:=clBlue;

Image1.Canvas.MoveTo(round((1)*w2),round(a2+(-1)*C[3,1]*q2));

for j:=2 to Length(C[3])-1 do ////Построение графиков

begin

Image1.Canvas.LineTo(round((j-1)*w2),round(a2+(-1)*C[3,j-1]*q2));

end;

 

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(a3));

Image1.Canvas.LineTo(I2,round(a3));

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(round((1)*w2),round(a3+(-1)*C[5,1]*q3));

for j:=2 to Length(C[5])-1 do ////Построение графиков

begin

Image1.Canvas.LineTo(round((j-1)*w2),round(a3+(-1)*C[5,j-1]*q3));

end;

 

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(a4));

Image1.Canvas.LineTo(I2,round(a4));

Image1.Canvas.Pen.Color:=clGreen;

Image1.Canvas.MoveTo(round((1)*w2),round(a4+(-1)*C[10,1]*q4));

for j:=2 to Length(C[10])-1 do ////Построение графиков

begin

Image1.Canvas.LineTo(round((j-1)*w2)+1,round(a4+(-1)*C[10,j-1]*q4));

end;

 

end;

 

 

////нахождение порогового значения (для поиска R-зубцов)

procedure TForm1.PorR;

var j:integer; sum,max:real;

begin sum:=0;

for j:=0 to Length(C[2])-1 do

sum:=sum+C[2,j];

max:=C[2,0];

for j:=1 to Length(C[2])-1 do

if C[2,j]>max then max:=C[2,j];

PorogR:=Round(sum/(Length(C[2])-1)+max/2);

end;

 

////нахождение порогового значения (для поиска M-зубцов)

procedure TForm1.PorM;

var j:integer; sum,max:real;

begin sum:=0;

for j:=0 to Length(C[5])-1 do

sum:=sum+C[5,j];

max:=C[5,0];

for j:=1 to Length(C[5])-1 do

if C[5,j]>max then max:=C[5,j];

PorogM:=Round(sum/(Length(C[5])-1)+max/2);

end;

 

////нахождение R-зубцов

procedure TForm1.MaxR;

var j,p,k:integer;

Ry,Rx:real;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlack;

Image1.Canvas.Pen.Color:=clBlack;

for j:=0 to Length(C[2])-1 do

if (C[2,j]<=PorogR) and (C[2,j+1]>PorogR) then

begin

for k:=j+1 to Length(C[2])-1 do

if ((C[2,k]>PorogR) and (C[2,k+1]<=PorogR)) then

begin

Rx:=j+1;

Ry:=C[2,j+1];

for p:=j+1 to k do

if C[2,p]>Ry then

begin

Ry:=C[2,p];

Rx:=p;

end;

Image1.Canvas.MoveTo(round((Rx)*w),round(a1+(-1)*Ry*q)+e);

Image1.Canvas.LineTo(round((Rx)*w),round(a1+(-1)*Ry*q)-e);

end;

end;

end;

 

////нахождение максимумов дифференцированной реограммы

procedure TForm1.MaxM;

var Mx,a,j,k,p:integer;

My:real;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clRed;

Image1.Canvas.Pen.Color:=clRed;

SetLength(ARR,0);

SetLength(ARR,1);

ARR[0]:=1;

a:=2;

 

for j:=0 to Length(C[5])-1 do

if ((C[5,j]<PorogM) and (C[5,j+1]>PorogM)) then

begin

for k:=j+1 to Length(C[5])-1 do

if ((C[5,k]>PorogM) and (C[5,k+1]<PorogM)) then //C[5,k]<0

begin

Mx:=j+1;

My:=C[2,j+1];

for p:=j+1 to k do

if C[5,p]>My then

begin

My:=C[5,p];

Mx:=p;

end;

if Mx>ARR[a-2] then

begin

SetLength(ARR,a);

ARR[a-1]:=round(Mx);

a:=a+1; ////заполнение массива координатами точек максимума дифференцированной реограммы по оси Х

 

Image1.Canvas.MoveTo(round((Mx)*w2),round(a3+(-1)*My*q3)+e);

Image1.Canvas.LineTo(round((Mx)*w2),round(a3+(-1)*My*q3)-e);

end;

 

end;

end;

SetLength(ARR,a);

ARR[a-1]:=round(Length(C[5]));

end;

 

////Нахождение точек начала изгнания крови из левого желудочка сердца

procedure TForm1.GelZ;

var b,e9,Px:integer;

Max:real;

begin

Px:=1;

SetLength(C[7],0);

for b:=0 to Length(ARR)-3 do

begin

Max:=0.0001;

for e9:=ARR[b]+1 to ARR[b+1] do

begin

if ((C[5,e9+1]-C[5,e9-1])/2>Max) and (C[5,e9]>0) then

begin

Max:=(C[5,e9+1]-C[5,e9-1])/2;

Px:=e9;

end;

end;

 

SetLength(C[7],b+1);

C[7,b]:=(Px-C[5,Px]/Max)/Gc;

 

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlue;

Image1.Canvas.Pen.Color:=clBlue;

Image1.Canvas.MoveTo(round((Px-C[5,Px]/Max)*w2),round(a3+5)+e*2);

Image1.Canvas.LineTo(round((Px-C[5,Px]/Max)*w2),round(a3+5)-e*2);

 

if Length(C[10])-Px>0 then begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlack;

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(round((Px-C[5,Px]/Max)*w2),round(a4-40)+e*2);

Image1.Canvas.LineTo(round((Px-C[5,Px]/Max)*w2),round(a4-40)-e*2);

end;

end;

 

end;

 

////Нахождение точек конца изгнания крови из левого желудочка сердца

procedure TForm1.GelY;

var b,e9,Px,Px2:integer;

Min1,Min2:real;

begin

for b:=1 to Length(ARR)-2 do

begin

Px2:=0;

Min1:=C[5,ARR[b]];

for e9:=ARR[b] to ARR[b+1] do

if (Min1>C[5,e9]) and ((C[5,e9-1]<C[5,e9]) and (C[5,e9]<C[5,e9+1])) then

begin

Min1:=C[5,e9];

Px2:=e9; //Изначально Px

end;

 

{Min2:=C[5,ARR[b]];

Px2:=1;

for e9:=ARR[b]+1 to Px-1 do

if ((Min2>C[5,e9]) and ((C[5,e9-1]<C[5,e9]) and (C[5,e9]<C[5,e9+1]))) then

begin

Min2:=C[5,e9];

Px2:=e9;

end;

 

if Px2 = 1 then Px2:=Px; }

 

if Length(C[10])-Px2>-10 then begin

 

Memo1.Lines.Add('C '+FloatToSTR(round(C[7,b-1]*100)/100)+'c.'+

' По '+(FloatToStr(round((Px2/Gc)*100)/100)+'c.') +

' = '+FloatToSTR(round(((Px2/Gc) - C[7,b-1])*100)/100) +'c.');

 

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clGreen;

Image1.Canvas.Pen.Color:=clGreen;

Image1.Canvas.MoveTo(round((Px2)*w2),round(a3+5)+e*2);

Image1.Canvas.LineTo(round((Px2)*w2),round(a3+5)-e*2);

end;

end;

end;

 

procedure TForm1.Image1Click(Sender: TObject);

begin

Image1.Width:=Form1.Width-190;

Image1.Height:=Form1.Height - 70;

end;

 

////процедура при нажатии на кнопку Разместить

procedure TForm1.Action3Execute(Sender: TObject);

begin

Memo1.Lines.Clear;

PorR;

PorM;

MaxR;

MaxM;

GelZ;

GelY;

end;

 

end.