Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Московский государственный технический университет им. H.Э.Баумана

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

МОБС 24.09.14..docx

Скачиваний:

Добавлен:

01.07.2025

Размер:

609 Кб

Скачать

☆

<<< < Предыдущая 1 2 3 45 / 65 6 > Следующая >>>

6. Реализация программ для выделения rr интервалов на экг и определения времени изгания по сигналу трансторакальной реограммы в среде Delphi

unit Unit1;

interface

uses

{Windows, Messages, SysUtils, Variants, Classes, Graphics,

Controls, Forms, Dialogs, ExtCtrls, Menus, StdCtrls,

{Actions, ActnList, Dialogs, Classes, ActnList, Menus, StdCtrls,

Controls, ExtCtrls; }

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;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

Image1: TImage;

PopupMenu1: TPopupMenu;

ActionList1: TActionList;

OpenDialog1: TOpenDialog;

Action1: TAction;

Action2: TAction;

Action3: TAction;

Action4: TAction;

procedure Image1Click(Sender: TObject);

procedure MaxR;

procedure MaxM;

procedure GelZ;

procedure GelY;

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[1..80] of smallint;

h1,h2,h3:smallint;

C: array of array of real;

e:smallint;

q,w,q2,w2,q3,w3:real;

implementation

{$R *.dfm}

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

procedure TForm1.Action1Execute(Sender: TObject);

var i: integer;

S: string;

begin

SetLength(C,6);

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

OpenDialog1.FilterIndex:=1;

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

if OpenDialog1.Execute then

begin

try

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

Reset(F);

i:=1;

while not EOF(F) do

begin

Readln(F,S);

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

SetLength(C[1],i);

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

i:=i+1;

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

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

Button4.Enabled:=True;

Predel:=i;

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:=1;

while not EOF(F) do

begin

Readln(F,S);

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

SetLength(C[2],i);

C[2,i-1]:=StrToFloat(s);

i:=i+1;

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

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

Button2.Enabled:=True;

for j:=0 to i-3 do

begin

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

C[3,j]:=(C[2,j+1]-C[2,j])/(1/Gc);

end;

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

begin

SetLength(C[4],j);

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

end;

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

begin

SetLength(C[5],j);

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

end;

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

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

end;

end

end;

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

function MinEKG:real;

var j:integer;

begin

Result:=C[1,0];

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

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

end;

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

function MaxEKG:real;

var j:integer;

begin

Result:=C[1,0];

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

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

end;

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

function MinReo:real;

var j:integer;

begin

Result:=C[2,0];

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

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

end;

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

function MaxReo:real;

var j:integer;

begin

Result:=C[2,0];

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

if C[2,j]>Result then Result:=C[2,j]

end;

////Нахождение минимального значения дифференцированной реограммы

function MinDifReo:real;

var j:integer;

begin

Result:=C[5,0];

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

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

end;

////Нахождение максимального значения дифференцированной реограммы

function MaxDifReo:real;

var j:integer;

begin

Result:=C[5,0];

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

if C[5,j]>Result then Result:=C[5,j]

end;

////процедура при нажатии на кнопке Данные - ввод информации в поля TEdit и построение графика

procedure TForm1.Action2Execute(Sender: TObject);

var j:integer;

begin

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

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

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

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

J1:=round(J2/3);

q:=J1/(Abs(MaxEKG)+Abs(MinEKG));

q2:=J1/(Abs(MaxReo)+Abs(MinReo));

q3:=J1/(Abs(MaxDifReo)+Abs(MinDifReo));

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

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

w3:=I2/Length(C[5]);

e:=Image1.Height div 10;

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(0.5*J1)+e);

Image1.Canvas.LineTo(I2,round(0.5*J1)+e);

Image1.Canvas.Pen.Color:=clRed;

Image1.Canvas.MoveTo(round((1)*w),round(0.5*J1+(-1)*C[1,1]*q)+e);

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

begin

Image1.Canvas.LineTo(round((j-1)*w),round(0.5*J1+(-1)*C[1,j-1]*q)+e);//round(C[1,j-1]-h1));//Image1.Canvas.LineTo(II(j+1),JJ(round(C[1,j+1]),0,h1));

end;

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(1.5*J1+5));

Image1.Canvas.LineTo(I2,round(1.5*J1+5));

Image1.Canvas.Pen.Color:=clBlue;

Image1.Canvas.MoveTo(round((1)*w2),round(1.5*J1+(-1)*C[2,1]*q2)+5);

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

begin

Image1.Canvas.LineTo(round((j-1)*w2),round(1.5*J1+(-1)*C[2,j-1]*q2)+5);//round(C[1,j-1]-h1));//Image1.Canvas.LineTo(II(j+1),JJ(round(C[1,j+1]),0,h1));

end;

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(0,round(2.5*J1+5));

Image1.Canvas.LineTo(I2,round(2.5*J1+5));

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(round((1)*w3),round(2.5*J1+(-1)*C[5,1]*q3)+5);

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

begin

Image1.Canvas.LineTo(round((j-1)*w3),round(2.5*J1+(-1)*C[5,j-1]*q3)+5);//round(C[1,j-1]-h1));//Image1.Canvas.LineTo(II(j+1),JJ(round(C[1,j+1]),0,h1));

end;

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

function PorogR:smallint;

var j:integer; sum,max:real;

begin sum:=0;

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

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

max:=C[1,0];

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

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

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

end;

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

function PorogM:smallint;

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];

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

end;

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

procedure TForm1.MaxR;

var j,p,p1,p2,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[1])-1 do

if C[1,j]<PorogR then

begin

if PorogR<C[1,j+1] then

begin

p1:=j+1;

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

if C[1,k]>PorogR then

if C[1,k+1]<PorogR then

begin

p2:=k;

Rx:=p1;

Ry:=C[1,p1];

for p:=p1 to p2 do

if C[1,p]>Ry then

begin

Ry:=C[1,p];

Rx:=p;

end;

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

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

end;

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

procedure TForm1.MaxM;

var a,i,r,r1,r2,m:integer;

Mx,My:real;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clRed;

Image1.Canvas.Pen.Color:=clRed;

ARR[1]:=1;

a:=2;

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

if C[5,i]<PorogM then

begin

if PorogM<=C[5,i+1] then

begin

r1:=i+1;

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

if C[5,m]>=PorogM then

if C[5,m+1]<PorogM then

begin

r2:=m;

Mx:=r1;

My:=C[5,r1];

for r:=r1 to r2 do

if C[5,r]>My then

begin

My:=C[5,r];

Mx:=r;

end;

ARR[a]:=round(Mx);

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

Image1.Canvas.MoveTo(round((Mx)*w3),round(2.5*J1+(-1)*My*q3)+e);

Image1.Canvas.LineTo(round((Mx)*w3),round(2.5*J1+(-1)*My*q3)-e);

//Break;

end;

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

procedure TForm1.GelZ;

var b,e9,t:integer;

Max,Px,Py:real;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlue;

Image1.Canvas.Pen.Color:=clBlue;

Px:=1;

Py:=1;

for b:=1 to 80 do

begin

Max:=0.00000001;

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

begin

if (C[5,e9+15]-C[5,e9-15])/(1/Gc)>Max then

begin

Max:=(C[5,e9+15]-C[5,e9-15])/0.002;

Px:=e9;

Py:=C[5,e9];

end;

t:=Round(Px);//-Py/Max);

Image1.Canvas.MoveTo(round((t)*w3),round(2.5*J1+5)+e*2);

Image1.Canvas.LineTo(round((t)*w3),round(2.5*J1+5)-e*2);

end;

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

procedure TForm1.GelY;

var b,e9,t,o,op:integer;

Max,Min,Px,Py:real;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlack;

Image1.Canvas.Pen.Color:=clBlack;

Px:=1;

Py:=1;

o:=50;

for b:=1 to 80 do

begin

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

begin

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

op:=ARR[b];

while Min>C[5,op] do

begin

Min:=C[5,op];

op:=op+o;

end;

op:=op+o;

Max:= C[5,op];

while Max<C[5,op] do

begin

Max:=C[5,op];

op:=op+o;

end;

op:=op+10;

Min:=C[5,op];

while Min>C[5,op] do

begin

Min:=C[5,op];

op:=op+o;

end;

op:=op+o;

t:=Round(op);

Image1.Canvas.MoveTo(round((t)*w3),round(2.5*J1+5)+e*2);

Image1.Canvas.LineTo(round((t)*w3),round(2.5*J1+5)-e*2);

end;

procedure TForm1.Image1Click(Sender: TObject);

begin

Image1.Width:=Form1.Width-180;

Image1.Height:=Form1.Height - 70;

end;

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

procedure TForm1.Action3Execute(Sender: TObject);

begin

MaxR;

MaxM;

GelZ;

GelY;

end;

end.

<<< < Предыдущая 1 2 3 45 / 65 6 > Следующая >>>

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]

#
09.02.2015114 Кб14мифы.docx
#
20.04.20199 Мб130МКонспект_по_Деталям_Машин.doc
#
09.11.20193 Мб39ММТП 2011 - 1.doc
#
08.05.20192 Мб9МНК (Л.И. и Т.В.) итоговая 7.doc
#
01.07.20254 Мб1Множест. регрессия 2 (теория).docx
#
01.07.2025609 Кб2МОБС 24.09.14..docx
#
01.07.2025537 Кб2МОБС 28.09.14..docx
#
12.11.2019385 Кб17Моделирование ЦУ на ПЛИС.doc
#
07.07.2019471 Кб33модернизация РН Протон.doc
#
09.02.2015126 Кб278модудь 2 задача 3.doc
#
23.03.2016493 Кб39модуль 1 сильная группа (30августа).docx