Использование технологии Macromedia Flash для создания интерактивных учебных материалов по курсу "Историческая геология"

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Edit1: TEdit;

    Edit2: TEdit;

    Edit3: TEdit;

    Edit4: TEdit;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    procedure RadioButton1Click(Sender: TObject);

    procedure RadioButton2Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var Form1: TForm1;

  x, y, d, g, p, Q: array of Double;

  n, count: integer;

implementation 

{$R *.dfm}

procedure activateItems(flag1: BOOL; flag2: BOOL); // Изменить видимость объектов

begin

Form1.Label1.Visible:=flag1; Form1.Label2.Visible:=flag1;

Form1.Label3.Visible:=flag1; Form1.Label4.Visible:=flag1;

Form1.Label5.Visible:=flag2; Form1.Edit1.Visible:=flag1;

Form1.Edit2.Visible:=flag1;  Form1.Edit3.Visible:=flag1;

Form1.Edit4.Visible:=flag2;  Form1.Button1.Visible:=flag1;

Form1.Button3.Visible:=flag1;

if (flag1=False) AND (flag2=False) then

  begin

  Form1.Edit1.Clear;  Form1.Edit2.Clear;

  Form1.Edit3.Clear;  Form1.Edit4.Clear;

  end;

end; 

procedure TForm1.RadioButton1Click(Sender: TObject);

begin

activateItems(True,True);

n:=4;

end;

procedure TForm1.RadioButton2Click(Sender: TObject);

begin

activateItems(True,False);

n:=3;

end; 

procedure TForm1.Button2Click(Sender: TObject); // Выход

begin

Form1.Close;  Form2.Close;

end; 

procedure TForm1.Button3Click(Sender: TObject); // Сброс

begin

activateItems(False,False);

RadioButton1.Checked:=False;

RadioButton2.Checked:=False;

end; 

function f(x: array of Double): Double;        //  Значение функции

var a, b, c: Double;

begin

if (n=4) then

  begin

  a:=sqr(x[0]+10*x[1])+5*sqr(x[2]-x[3]);

  b:=sqr(x[1]-2*x[2]);

  c:=sqr(x[0]-x[3]);

  Result:=a+sqr(b)+10*sqr(c);

  end

else

if (n=3) then

  begin

  a:=3*sqr(x[0]-4);

  b:=5*sqr(x[1]+3);

  c:=7*sqr(2*x[2]+1);

  Result:=a+b+c;

  end;

end; 

function Gradient(x: array of Double; n: integer): Double;     // Значение градиента

var ggg: Double;

begin

ggg:=0;

if (n=4) then

  begin

  g[0]:=2*(x[0]+10*x[1])+40*sqr(x[0]-x[3])*(x[0]-x[3]);

  g[1]:=20*(x[0]+10*x[1])+4*sqr(x[1]-2*x[2])*(x[1]-2*x[2]);

  g[2]:=10*(x[2]-x[3])-8*sqr(x[1]-2*x[2])*(x[1]-2*x[2]);

  g[3]:=-10*(x[2]-x[3])-40*sqr(x[0]-x[3])*(x[0]-x[3]);

      // Вычисляем норму градиента

  ggg:=g[0]*g[0];   ggg:=ggg+sqr(g[1]);  ggg:=ggg+sqr(g[2]);   ggg:=ggg+sqr(g[3]);

  end

else

if (n=3) then

  begin

  g[0]:=6*(x[0]-4);

  g[1]:=10*(x[1]+3);

  g[2]:=28*(2*x[2]+1);

  ggg:=sqr(g[0]);  ggg:=ggg+sqr(g[1]);  ggg:=ggg+sqr(g[2]);

  end;

Result:=sqrt(ggg);

end; 

procedure Interpolation();             // Кубическая интерполяция

var  Gp, Gq, Fp, Fq, Gr, Fr, HH, z, w, r:  Double;

var  Qx:  Double;

var  i: Integer;

begin

  Fp:=f(x);

  while True do    //  Находим направление

  begin

    Gp:=0;

    for i:=0 to n-1 do

     Gp:= Gp + g[i]*d[i];

    Qx:=ABS((2*Fp)/Gp);

    if Qx>1  then Qx:=1;

    if Gp<0  then break;

    for i:=0 to n-1 do

      begin

      x[i]:= p[i]-Qx*d[i];

      p[i]:=x[i];

      end;

    Fp:=f(x);

    Gradient(x,n);

  end;

  HH:=Qx;

  while True do   //Находим точку q

  begin

    for i:=0 to n-1 do

    begin

      Q[i]:=p[i]+ HH*d[i];

      x[i]:=Q[i];

    end;

    Fq:=f(x);

    Gradient(x,n);

    Gq:=0;

    for i:=0 to n-1 do

      Gq:=Gq+g[i]*d[i];

    if (Gq>0) or (Fq>Fp) then break;

    HH:=2*HH;

  end;

  while True do  // аппроксимация точки минимума  на (0,HH) значением r

  begin

    z:=((3*(Fp-Fq))/HH)+Gp+Gq;

    w:=z*z-Gp*Gq;

    if (w<0) then w:=0;

    w:=sqrt(w);

    r:=HH*(1-((Gq+w-z)/(Gq-Gp+2*w)));

    for i:=0 to n-1 do

      x[i]:= p[i]+ r*d[i];

    Fr:=f(x);

    Gradient(x,n);

    Gr:=0;

    for i:=0 to n-1 do

      Gr:=Gr+g[i]*d[i];

    if (Fr<=Fp) and (Fr<=Fq) then break; //условия выхода из интерполяции

    if Gr>0 then

    begin

      HH:=r;

      for i:=0 to n-1 do

        Q[i]:=x[i];

      Fq:=Fr;

      Gq:=Gr;

    end

    else

    begin

      HH:=HH-r;

      for i:=0 to n-1 do

        p[i]:=x[i];

      Fp:=Fr;

      Gp:=Gr;

    end;

  end;

end; 

procedure TForm1.Button1Click(Sender: TObject);   // Метод ДФП

var   kk, wk, dk:  Double;

var   i, j: integer;

var   U, M, V:   array of Double;

var   H:   array of array of Double;

const   Eps=0.00001; e=0.00005; // заданная точность

begin

SetLength(x,n); SetLength(H,n,n);

SetLength(d,n); SetLength(g,n);

SetLength(U,n); SetLength(p,n);

SetLength(y,n); SetLength(M,n);

SetLength(V,n); SetLength(p,n);

SetLength(Q,n);

x[0]:=StrToFloat(Edit1.Text);

x[1]:=StrToFloat(Edit2.Text);

x[2]:=StrToFloat(Edit3.Text);

if (n=4) then   x[3]:=StrToFloat(Edit4.Text);

Form2.Show;

Form2.ListBox1.Clear;

count:=0;  // количество итераций

dk:=1;

for i:=0 to n-1 do

begin

   for j:=0 to n-1 do

      H[i,j]:=0;

   H[i,i]:=1;

end;

  // Цикл Метода

  while (sqrt(dk)>=e) and (Gradient(x,n)>=Eps) do

  begin

    for i:=0 to n-1 do

    begin

      p[i]:=x[i];    y[i]:=x[i];

    end;

    Gradient(x,n);

    for i:=0 to n-1 do  //запоминаем градиент в  U[] и задаем направление спуска d[]

    begin

      U[i]:=g[i];

      d[i]:=0;

      for j:=0 to n-1 do

        d[i]:=d[i]-H[i,j]*g[j];

    end;

    Interpolation();

    kk:=0; wk:=0; dk:=0;        // обновим матрицу H

    for i:=0 to n-1 do

    begin

      U[i]:=g[i]-U[i];

      V[i]:=x[i]-y[i];

    end;

    for i:=0 to n-1 do

    begin

      M[i]:=0;

      for j:=0 to n-1 do

        M[i]:=M[i]+H[i,j]*U[j];

      kk:=kk+M[i]*U[i];

     wk:=wk+V[i]*U[i];

      dk:=dk+V[i]*V[i];

    end;

    if (kk<>0) and (wk<>0) then

    begin

      for i:=0 to n-1 do

        for j:=0 to n-1 do

        begin

          H[i,j]:=H[i,j]-(M[i]*M[j]/kk)+(V[i]*V[j]/wk);

        end;

    end;

    count:=count+1;

    Form2.ListBox1.Items.Add('                   Итерация '+IntToStr(count));

    Form2.ListBox1.Items.Add(' f(x) = '+FloatToStrF(f(x),ffGeneral,7,0));

    for i:=0 to n-1 do

      Form2.ListBox1.Items.Add('x'+IntToStr(i+1)+' = '+ FloatToStrF(x[i],ffGeneral,7,0));

    Form2.ListBox1.Items.Add('');

  end;   //  Конец цикла минимизации

Form2.ListBox1.Items.Add('                   Минимизация закончена!');

Form2.ListBox1.Items.Add('Количество  итераций:  '+IntToStr(count));

Form2.ListBox1.Items.Add('Минимум  функции f(x) = '+FloatToStrF(f(x),ffGeneral,7,0));

for i:=0 to n-1 do

  Form2.ListBox1.Items.Add('x'+IntToStr(i+1)+' = '+ FloatToStrF(x[i],ffGeneral,7,0));

end;

end. 

unit Unit2;

interface

uses

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

  Dialogs, StdCtrls;

type

  TForm2 = class(TForm)

    Label1: TLabel;

    ListBox1: TListBox;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm} 

procedure TForm2.Button1Click(Sender: TObject);  // Выход

begin

Form1.Close;

Form2.Close;

end;

end.

 
 
 
 
 
 
 
 
 
 

Образец пользовательского  интерфейса.