оформление (1017078), страница 3

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 3)

Так как график функции строился по точкам и представляет собой ломанную, то провести касательную к одной точке не представляется возможным. Однако, по определению касательной можно воспользоваться двумя соседними точками и провести через них секущую (касательная является предельным случаем секущей, см. рис.13).

Геометрический смысл производной - коэффициент наклона прямой, т.е. тангенс угла наклона. Тангенс – это отношение противолежащего катета прямоугольного треугольника к прилежащему. Следовательно,

Далее ищется максимальная производная на всем периоде с помощью функции Max (см. пункт 1.5). Абсцисса точки начала выброса определяется через тангенс угла. Чтобы компенсировать сдвиг между секущей и касательной (они параллельны), в формулу будет подставляться координата точки i.

Пусть t – абсцисса точки начала выброса крови. Она равна разности абсциссы точки максимума производной i и основания касательной к точке i.

, где i – точка максимума второй производной основной реограммы.

Рис. 13. Нахождение производной и её геометрический смысл

нет да

нет да

Рис. 14. Блок-схема для алгоритма нахождения точек начала изгнания крови из левого желудочка сердца.

1. Работа с канвой принтера

Для работой с принтером необходимо подключить модуль Printers. Начало и окончание печати сигнализируются операторами BeginDoc и EndDoc.

Для вывода текста применяются метод канвы принтера TextOut(X,Y:integer; Текст:string). Для печати графиков применяются методы MoveTo и LineTo. Их действие описано в п.1.8.

Пересчёт координат с экрана на лист осуществляется с помощью специальных функций.

Result:=GetDeviceCaps(Printer.Canvas.Handle, VertRes) – получение высоты страницы в пикселях, заданной в свойствах принтера. Метод Handle берёт эту информацию из API Windows. Аналогично действует получение ширины страницы, но вместо параметра VertRes используется HorzRes.

Result:=round(GetDeviceCaps(printer.Handle,LogPixelsX)/25.4*x) – преобразование координат по оси Х с экрана на бумагу по формуле: , где PPI – количество пикселей на дюйм. Т.к. в русской системе предпочтительнее использовать миллиметры, то значение PPI надо разделить на количество миллиметров в дюйме – 25.4 мм. LogPixelsX возвращает PPI по оси Х. Аналогично происходит пересчёт координат заменой Х на Y.

Заключение

Программа имеет вид, представленный на рисунках 16-18.

Рис. 15. Окно программы до открытия файла.

Рис. 16. Окно программы после нажатия на кнопку Данные

Рис. 17. Окно программы после нажатия на кнопку Разместить

Приложение А. Листинг основной программы.

unit Unit1;

interface

uses

Windows, Classes, ActnList, Dialogs, Menus, StdCtrls, Controls, ExtCtrls,

Printers, Messages, SysUtils, Variants, Graphics, Forms,

Buttons, Grids;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

PopupMenu1: TPopupMenu;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Edit7: TEdit;

Edit8: TEdit;

Edit9: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

OpenDialog1: TOpenDialog;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

ActionList1: TActionList;

Action1: TAction;

Image1: TImage;

Action2: TAction;

Action3: TAction;

Action4: TAction;

procedure Action1Execute(Sender: TObject);

procedure Action2Execute(Sender: TObject);

procedure Action3Execute(Sender: TObject);

procedure Action4Execute(Sender: TObject);

procedure MaxR;

procedure MaxM;

procedure GelZ;

procedure PrintGrafik;

procedure PrintZ;

procedure PrintR;

procedure PrintM;

private

{ Private declarations }

public

{ Public declarations }

end;

function WidthX: Integer;

function HeightY: Integer;

function II(x:smallint):integer;

function JJ(y,y1,y2:smallint):integer;

const

Predel=7000;

type TReo=record

RegNumber:smallint;

Da_ta,Name:shortstring;

Distance,Perimetr:smallint;

Leng_s,Weight:smallint;

Sist_BP,Diast_BP:smallint;

B:array[1..4,1..Predel] of smallint;

Kalibr_Z0,Kalibr_DZ:Real48;

end;

var

Form1: TForm1;

Reo1: TReo;

F:file of TReo;

I1,I2,J1,J2:integer;

ARR:array[1..80] of smallint;

h1,h2,h3:smallint;

implementation

{$R *.dfm}

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

procedure TForm1.Action1Execute(Sender: TObject);

begin

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

OpenDialog1.FilterIndex:=1;

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

if OpenDialog1.Execute then

begin

try

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

Reset(F);

Read(F,Reo1); ////Чтение данных из файла в переменную

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

Button2.Enabled:=True;

Button3.Enabled:=True;

Button4.Enabled:=True;

N3.Enabled:=True;

N4.Enabled:=True;

N5.Enabled:=True;

N7.Enabled:=True;

N8.Enabled:=True;

N9.Enabled:=True;

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

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

end;

end;

end;

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

function MinEKG:smallint;

var

j:integer;

begin

Result:=Reo1.B[1,1];

for j:=1 to Predel do

if Reo1.B[1,j]<Result then Result:=Reo1.B[1,j];

end;

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

function MaxEKG:smallint;

var

j:integer;

begin

Result:=Reo1.B[1,1];

for j:=1 to Predel do

if Reo1.B[1,j]>Result then Result:=Reo1.B[1,j]

end;

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

function MinReo:smallint;

var

j:integer;

begin

Result:=Reo1.B[2,1];

for j:=1 to Predel do

if Reo1.B[2,j]<Result then Result:=Reo1.B[2,j];

end;

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

function MaxReo:smallint;

var

j:integer;

begin

Result:=Reo1.B[2,1];

for j:=1 to Predel do

if Reo1.B[2,j]>Result then Result:=Reo1.B[2,j]

end;

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

function MinFKG:smallint;

var

j:integer;

begin

Result:=Reo1.B[3,1];

for j:=1 to Predel do

if Reo1.B[3,j]<Result then Result:=Reo1.B[3,j];

end;

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

function MaxFKG:smallint;

var

j:integer;

begin

Result:=Reo1.B[3,1];

for j:=1 to Predel do

if Reo1.B[3,j]>Result then Result:=Reo1.B[3,j]

end;

////функция пересчёта координат по оси Х

function II(x:smallint):integer;

var

x1,x2:integer;

begin

x1:=1;

x2:=1000;

II:=I1+Trunc((x-x1)*(I2-I1)/(x2-x1));

end;

////функция пересчёта координат по оси Y

function JJ(y,y1,y2:smallint):integer;

begin

JJ:=J2+Trunc((y-y1)*(J1-J2)/(y2-y1));

end;

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

procedure TForm1.Action2Execute(Sender: TObject);

var

j:integer;

A:array[0..30] of char;

begin

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

Edit1.Text:=IntToStr(Reo1.RegNumber); ////Ввод данных в TEdit

Edit2.Text:=Reo1.Da_ta;

OemToChar(StrPCopy(A,Reo1.Name),A); ////Перекодировка строки из DOS в Win-1251

Edit3.Text:=A;

Edit4.Text:=IntToStr(Reo1.Distance);

Edit5.Text:=IntToStr(Reo1.Perimetr);

Edit6.Text:=IntToStr(Reo1.Leng_s);

Edit7.Text:=IntToStr(Reo1.Weight);

Edit8.Text:=IntToStr(Reo1.Sist_BP);

Edit9.Text:=IntToStr(Reo1.Diast_BP);

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

I2:=Image1.Width;

J1:=0;

J2:=Round(Image1.Height)-30;

h1:=Abs(MaxEKG)+Abs(MinEKG)+Abs(MaxFKG)+Abs(MinFKG)+Abs(MaxReo)+Abs(MinReo);

h2:=Abs(MaxEKG)+Abs(MinEKG)+Abs(MinReo);

h3:=Abs(MaxEKG)+Abs(MinEKG)+Abs(MaxReo)+Abs(MinReo)+Abs(MinFKG);

Image1.Canvas.Pen.Color:=clRed;

Image1.Canvas.MoveTo(II(1),JJ(Reo1.B[1,1],0,h1));

for j:=1 to 1000 do ////Построение графиков

begin

Image1.Canvas.LineTo(II(j+1),JJ(Reo1.B[1,j+1],0,h1));

end;

Image1.Canvas.Pen.Color:=clBlue;

Image1.Canvas.MoveTo(II(1),JJ(Reo1.B[2,1]+h2,0,h1)+5);

for j:=1 to 1000 do

begin

Image1.Canvas.LineTo(II(j+1),JJ(Reo1.B[2,j+1]+h2,0,h1)+5);

end;

Image1.Canvas.Pen.Color:=clBlack;

Image1.Canvas.MoveTo(II(1),JJ(Reo1.B[3,1]+h3,0,h1)+5);

for j:=1 to 1000 do

begin

Image1.Canvas.LineTo(II(j+1),JJ(Reo1.B[3,j+1]+h3,0,h1)+5);

end;

end;

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

function PorogR:smallint;

var

j:integer;

sum,max:smallint;

begin

sum:=0;

for j:=1 to Predel do

sum:=sum+Reo1.B[1,j];

max:=Reo1.B[1,1];

for j:=1 to Predel do

if Reo1.B[1,j]>max then max:=Reo1.B[1,j];

Result:=Round(sum/Predel+max/2);

end;

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

function PorogM:smallint;

var

j:integer;

sum,max:smallint;

begin

sum:=0;

for j:=1 to Predel do

sum:=sum+Reo1.B[2,j];

max:=Reo1.B[2,1];

for j:=1 to Predel do

if Reo1.B[2,j]>max then max:=Reo1.B[2,j];

Result:=Round(sum/Predel+max/2);

end;

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

procedure TForm1.MaxR;

var

j,Rx,Ry,p,p1,p2,k:integer;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clBlack;

Image1.Canvas.Pen.Color:=clBlack;

for j:=1 to 1000 do

if Reo1.B[1,j]<PorogR

then

begin

if PorogR<Reo1.B[1,j+1]

then

begin

p1:=j+1;

for k:=p1 to 1000 do

if Reo1.B[1,k]>PorogR

then

if Reo1.B[1,k+1]<PorogR

then

begin

p2:=k;

Rx:=p1;

Ry:=Reo1.B[1,p1];

for p:=p1 to p2 do

if Reo1.B[1,p]>Ry

then begin Ry:=Reo1.B[1,p]; Rx:=p; end;

Image1.Canvas.MoveTo(II(Rx),JJ(Ry,0,h1)-7);

Image1.Canvas.LineTo(II(Rx),JJ(Ry,0,h1));

end;

end;

end;

end;

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

procedure TForm1.MaxM;

var

a,i,Mx,My,r,r1,r2,m:integer;

begin

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Pen.Color:=clRed;

ARR[1]:=1;

a:=2;

for i:=1 to 1000 do

if Reo1.B[2,i]<PorogM

then

begin

if PorogM<=Reo1.B[2,i+1]

then

begin

r1:=i+1;

for m:=r1 to 1000 do

Характеристики

Список файлов домашнего задания