Вход

Поиск

Опрос

Наполнение сайта?
Всего ответов: 6

Чат

Партнеры

Последние престанище космос
Суббота, 18.05.2024, 15:14
Приветствую Вас Гость
Главная | Регистрация | Вход | RSS
Главная » Файлы » Программы

Программа для расчета критериев устойчивости
[ Скачать с сервера (226.5 Kb) ] 18.01.2018, 09:15

Листинг Программы:

unit Unit1;

interface

 

uses

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

  Dialogs, StdCtrls, ExtCtrls, jpeg, Menus, Buttons, TeEngine, Series,

  TeeProcs, Chart, TeeFunci;

 

type

  TForm1 = class(TForm)

    mm1: TMainMenu;    N1: TMeuItem;    img1: TImage;

    lbl1: TLabel;    img2: TImage;    lbl2: TLabel;

    lbledt1: TLabeledEdit;    lbledt2: TLabeledEdit;

    lbledt3: TLabeledEdit;    lbledt4: TLabeledEdit;

    lbledt5: TLabeledEdit;    lbledt6: TLabeledEdit;

    lbledt7: TLabeledEdit;    lbledt8: TLabeledEdit;

    btn1: TBitBtn;    btn2: TBitBtn;    btn3: TBitBtn;

    lbl3: TLabel;    lbl4: TLabel;    lbl5: TLabel;

    cht1: TChart;    Series1: TLineSeries;

    TeeFunction1: TAddTeeFunction;

    procedure N1Click(Sender: TObject);    procedure btn1Click(Sender: TObject);

    procedure btn2Click(Sender: TObject);   procedure btn3Click(Sender: TObject);

  private    { Private declarations }

  public    { Public declarations }

  end;

var

  Form1: TForm1;  k1,k3,k4,k5,t4,t2,t5,a0,a1,a2,a3,c5:Real;

  procedure chit();//считывание коэффициентов;

  procedure vish();//Проверка по Вишнеградову;

  procedure gyrv();//Проверка по Гурвицу;

  procedure mich();//Проверка по Михайлову; 

implementation{$R *.dfm}

procedure TForm1.N1Click(Sender: TObject);

begin Close(); end;

procedure chit();

begin

  k1:=StrToFloat(Form1.lbledt1.text);  t2:=StrToFloat(Form1.lbledt1.text);

  k3:=StrToFloat(Form1.lbledt1.text);  k4:=StrToFloat(Form1.lbledt1.text);

  t4:=StrToFloat(Form1.lbledt1.text);  k5:=StrToFloat(Form1.lbledt1.text);

  t5:=StrToFloat(Form1.lbledt1.text);  c5:=StrToFloat(Form1.lbledt1.text);

end;

procedure vish();

begin

    a0:=Sqr(t5)*t4;a1:=2*t5*c5*t4+sqr(t5);a2:=t4+2*t5*c5;a3:=1

    if (a0>0)and(a1>0)and(a2>0)and(a3>0)and((a1*a2-a0*a3)>0) then

    begin

    Form1.lbl3.Caption:=('УСТОЙЧИВА');Form1.lbl3.Color:=clGreen;

    end

    else

    begin

    Form1.lbl3.Caption:=('НЕ УСТОЙЧИВА');Form1.lbl3.Color:=clRed;

    end;end;

procedure gyrv();

begin

    a0:=Sqr(t5)*t4;a1:=2*t5*c5*t4+sqr(t5);a2:=t4+2*t5*c5;a3:=1;

    if (a1>0)and((a1*a2-a0*a3)>0)and((a3*(a1*a2-a0*a3))>0) then

    begin

    Form1.lbl4.Caption:=('УСТОЙЧИВА');Form1.lbl4.Color:=clGreen;

    end

    else

    begin

    Form1.lbl4.Caption:=('НЕ УСТОЙЧИВА');Form1.lbl4.Color:=clRed;

    end;end;

procedure mich();

var q:Integer;

    w,e,r:Real;

    t:Boolean;

begin    Form1.Series1.Clear;Form1.lbl5.Caption:=('Проверяется');Form1.lbl5.Color:=clBlue;

    w:=0;

    for q:=0 to 9  do

    begin

    w:=w+0.2;

    e:=-a0*(w*w*w)+a2*w;

    r:=-a1*(w*w)+a3;

    form1.Series1.AddXY(r,e);

    if (r<-3)and(e>0) then t:=True;

    end;

    if t=true then

    begin

    Form1.lbl5.Caption:=('УСТОЙЧИВА');Form1.lbl5.Color:=clGreen;

    end

    else

    begin

    Form1.lbl5.Caption:=('НЕ УСТОЙЧИВА');Form1.lbl5.Color:=clRed;

    end;end;

procedure TForm1.btn1Click(Sender: TObject);

begin  chit(); vish();end;

procedure TForm1.btn2Click(Sender: TObject);

begin chit(); gyrv();end;

procedure TForm1.btn3Click(Sender: TObject);

begin chit();mich();end;

end.

 

Категория: Программы | Добавил: MVD
Просмотров: 235 | Загрузок: 103
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]