RSS    

   Реферат: Исследование и моделирование с помощью компьютера электрических полей

 If O=3 then begin Ekv[X+1,Y-1]:=True; Ekv[X-1,Y-1]:=True; end;

 If O=4 then begin Ekv[X+1,Y-1]:=True; Ekv[X+1,Y+1]:=True; end;

 If O=1 then begin En[EnNow].X:=X+1; En[EnNow].Y:=Y+1; En[EnNow+1].X:=X-1; En[EnNow+1].Y:=Y+1; end;

 If O=2 then begin En[EnNow].X:=X-1; En[EnNow].Y:=Y-1; En[EnNow+1].X:=X-1; En[EnNow+1].Y:=Y+1; end;

 If O=3 then begin En[EnNow].X:=X+1; En[EnNow].Y:=Y-1; En[EnNow+1].X:=X-1; En[EnNow+1].Y:=Y-1; end;

 If O=4 then begin En[EnNow].X:=X+1; En[EnNow].Y:=Y-1; En[EnNow+1].X:=X+1; En[EnNow+1].Y:=Y+1; end;

 Inc(EnNow,2); If EnNow>=9 then EnNow:=EnNow-9;

 Ekv[En[EnNow].X,En[EnNow].Y]:=False;

 Ekv[En[EnNow+1].X,En[EnNow+1].Y]:=False;

 Xt:=X; Yt:=Y; Min:=1;

 While Min<9 do begin

  Min:=1; While (M[Min]=False) and (Min<5) do Min:=Min+1;

  For I:=1 to 4 do If (P[I]<P[Min]) and (M[I]=True) then Min:=I;

  Xt:=X; Yt:=Y;

  Case Min of

   1: Yt:=Y-1;

   2: Xt:=X+1;

   3: Yt:=Y+1;

   4: Xt:=X-1;

  end;

  If Ekv[Xt,Yt]=False then Break;

  If (Xt=EkX) and (Yt=EkY) and (A>2) then Break;

  M[Min]:=False;

  If (M[1]=False) and(M[2]=False) and(M[3]=False) and(M[4]=False) then Break;

 end;

 Form1.Image1.Canvas.MoveTo(X,Y);

 X:=Xt; Y:=Yt; Ekv[X,Y]:=True;

 Form1.Image1.Canvas.LineTo(X,Y);

 Inc(A); If A>1000 then A:=5;

 If (X>1000) or (Y>1000) or (X<-1000) or (Y<-1000) then Exit;{begin

  PaintEkvi(EkX-1,EkY-1,Potenc(EkX,EkY),0);

 end;}

 If (Xt=EkX) and (Yt=EkY) and (A>2) then Exit;

 PaintEkvi(X,Y,Pot,Min);

End;

procedure TForm1.FormResize(Sender: TObject);

Var I,P:SmallInt;

begin

 If Xxl=False then Exit;

 If Form1.StatusBar1.Panels.Items[4].Text<>'Редактор' then Exit;

 DrawGrid;

 For I:=0 to 63 do For P:=0 to 47 do RefreshSquare(I,P);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 Form1.StatusBar1.Panels.Items[4].Text:='Редактор';

 Form1.WindowState:=wsMaximized;

 DrawGrid;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Var Xq,Yq:Byte;

begin

 Xq:=X div 25;

 Yq:=Y div 25;

 RefreshStatus(Xq,Yq);

 If Button=mbLeft then If Qc[Xq,Yq]<3 then Inc(Qc[Xq,Yq]);

 If Button=mbRight then If Qc[Xq,Yq]>-3 then Dec(Qc[Xq,Yq]);

 If Button=mbMiddle then Qc[Xq,Yq]:=0;

 RefreshSquare(Xq,Yq);

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

begin

 If Xxl=False then Xxl:=True;

 RefreshStatus(X div 25,Y div 25);

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

 Stop; Redactor;

end;

procedure TForm1.N6Click(Sender: TObject);

Var I,P:SmallInt;

begin

 Stop; Redactor;

 For I:=0 to 63 do For P:=0 to 47 do Qc[I,P]:=0;

 For I:=1 to Nc do For P:=1 to 3 do Qrc[I,P]:=0;

 Image1.Align:=alNone;

 Form1.Refresh;

 DrawGrid;

 Nc:=0;

 For I:=0 to 63 do For P:=0 to 47 do RefreshSquare(I,P);

 Form1.StatusBar1.Panels.Items[4].Text:='Редактор';

end;

procedure TForm1.N2Click(Sender: TObject);

begin

 Close;

end;

procedure TForm1.N8Click(Sender: TObject);

Var I,P:SmallInt;

    Name,Ex:String;

begin

 SaveDialog1.Execute;

 Name:=SaveDialog1.FileName;

 DrawGrid; For I:=0 to 63 do For P:=0 to 47 do RefreshSquare(I,P);

 If Name='' then Exit;

 Stop; Redactor;

 If Name[Length(Name)-3]<>'.' then Name:=Name+'.mez';

 For I:=Length(Name)-2 to Length(Name) do Ex:=Ex+UpCase(Name[I]);

 If Ex<>'MEZ' then Name:=Name+'.mez';

 If FileExists(Name) then

   If Application.MessageBox('Файл с таким именем уже существует.'+#13+'Вы хотите перезаписать файл?','Сохранение файла',mb_yesno+mb_defbutton2+mb_iconexclamation)=idNo then Exit;

 AssignFile(F,Name);

 Rewrite(F);

 Write(F,Qc);

 CloseFile(F);

end;

procedure TForm1.N7Click(Sender: TObject);

{Const Dop:Set of Char=['э','ю','я','_',' '];}

Var Name,Ex:String;

    I,P:SmallInt;

    Sym:LongWord;

    Fault:Boolean;

begin

 If OpenDialog1.Execute=False then Exit;

 Name:=OpenDialog1.FileName;

 Memo1.Lines.LoadFromFile(Name);

 Sym:=0; Fault:=False;

 For I:=0 to Memo1.Lines.Count-1 do

   For P:=1 to Length(Memo1.Lines[I]) do {If Memo1.Lines[I][P] in Dop then} Inc(Sym) {else Fault:=True};

 If Sym<>3072 then Fault:=True;

 If Fault=True then begin

   Application.MessageBox('Невозможно открыть файл. Возможно, файл поврежден.','Ошибка',mb_iconstop);

   Exit;

 end;

 DrawGrid; For I:=0 to 63 do For P:=0 to 47 do RefreshSquare(I,P);

 If Name='' then Exit;

 Stop; Redactor;

 If Name[Length(Name)-3]<>'.' then Name:=Name+'.mez';

 For I:=Length(Name)-2 to Length(Name) do Ex:=Ex+UpCase(Name[I]);

 If Ex<>'MEZ' then Name:=Name+'.mez';

 AssignFile(F,Name);

 Reset(F);

 Read(F,Qc);

 CloseFile(F);

 DrawGrid; For I:=0 to 63 do For P:=0 to 47 do RefreshSquare(I,P);

end;

procedure TForm1.N12Click(Sender: TObject);

Var I,P:SmallInt;

begin

 For I:=1 to Nc do For P:=1 to 3 do Qrc[I,P]:=0; Nc:=0;

 Stop; PaintLines; CalcA:=True;

end;

procedure TForm1.N13Click(Sender: TObject);

begin

 StatusBar1.Panels.Items[4].Text:='Исследование линий напряженности...';

 Stop;

 Prepare; ElRefresh;

 Form1.Image1.Repaint;

 Form1.Image1.Canvas.Pen.Color:=clSilver;

 LineExpl:=True;

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Var I,P:Integer;

    B,E:LongWord;

    T,N,Vx,Vy,Deg,Dx,Dy:Real;

begin

 If (LineExpl=True) then begin

  Form1.Image1.Canvas.Pen.Color:=clSilver;

  ElTrackForMoving(X,Y,1,0);

  ElTrackForMoving(X,Y,-1,0);

 end else

 If (EkviExpl=True) then begin

  B:=DateTimeToTimeStamp(Now).Time;

  If Potenc(X,Y)=0 then Exit;

  Form1.Image1.Canvas.Pen.Color:=clRed;

  For I:=-1600 to 1600 do For P:=-1200 to 1200 do Ekv[I,P]:=False; A:=0;

  EkX:=X; EkY:=Y; Ekv[X,Y]:=True; EnNow:=0;

  PaintEkvi(X,Y,Potenc(X,Y),0);

  E:=DateTimeToTimeStamp(Now).Time;

  Form1.Image1.Refresh;

  Form1.StatusBar1.Panels.Items[3].Text:=FloatToStr((E-B)/1000)+' сек';

 end else

 If (CalcA=True) then begin

  Vx:=0; Vy:=0;

  For I:=1 to Nc do begin

   Dx:=(Qrc[I,1]-X)/25*StrToFloat(Form2.Edit2.Text);

   Dy:=(Qrc[I,2]-Y)/25*StrToFloat(Form2.Edit2.Text);

   Deg:=Sqrt(Dx*Dx+Dy*Dy);

   Deg:=Deg*Deg*Deg;

   If Deg=0 then Exit;

   Vx:=Vx+(9*10E9*(Qrc[I,3])*StrToFloat(Form2.Edit1.Text)*Dx/Deg/StrToFloat(Form2.Edit3.Text));

   Vy:=Vy+(9*10E9*(Qrc[I,3])*StrToFloat(Form2.Edit1.Text)*Dy/Deg/StrToFloat(Form2.Edit3.Text));

  end;

  N:=Sqrt(Vx*Vx+Vy*Vy);

  Form3.Label7.Caption:= FloatToStr(N);

  Form3.Label2.Caption:= FloatToStr(RealPotenc(X,Y));

  If Vx<>0 then begin

    T:=180*ArcTan(-Vy/Vx)/Pi;

    If (Vy>=0) and (Vx>0) then T:=T+180 else

    If (Vy<0) and (Vx>0) then T:=T+180 else

    If (Vy<0) and (Vx<0) then T:=T+360;

  end else If Vy>0 then T:=90 else T:=270;

  Form3.Label10.Caption:=FloatToStr(T);

  With Form3 do begin

   Label1.Left:=Label7.Left+Label7.Width+5;

   Label3.Left:=Label2.Left+Label2.Width+5;

   Label11.Left:=Label10.Left+Label10.Width+2;

   If Label1.Left+Label1.Width>Label3.Left+Label3.Width then Form3.Width:=Label1.Left+Label1.Width+20 else Form3.Width:=Label3.Left+Label3.Width+20;

  end;

  Form3.Show;

 end;

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

begin

 StatusBar1.Panels.Items[0].Text:='X = '+IntToStr(X);

 StatusBar1.Panels.Items[1].Text:='Y = '+IntToStr(Y);

end;

procedure TForm1.N9Click(Sender: TObject);

begin

 Stop; Prepare; ElRefresh;

 If N10.Checked=True then PaintLines;

 StatusBar1.Panels.Items[4].Text:='Исследование эквипотенциальных линий...';

 Form1.Image1.Repaint;

 Form1.Image1.Canvas.Pen.Color:=clRed;

 EkviExpl:=True;

end;

procedure TForm1.N10Click(Sender: TObject);

begin

 N10.Checked:=not N10.Checked;

end;

procedure TForm1.N11Click(Sender: TObject);

begin

 Stop; Redactor;

end;

procedure TForm1.N16Click(Sender: TObject);

begin

 Form2.Show;

end;

procedure TForm1.N19Click(Sender: TObject);

begin

 StatusBar1.Panels.Items[4].Text:='Исследование линий напряженности...';

 Stop;

 Prepare; ElRefresh;

 Form1.Image1.Repaint;

 Form1.Image1.Canvas.Pen.Color:=clSilver;

 CalcA:=True;

end;

procedure TForm1.N20Click(Sender: TObject);

Var I,P:Byte;

    Ex:Boolean;

begin

 Ex:=False;

 For I:=0 to 63 do For P:=0 to 47 do If Qc[I,P]<>0 then Ex:=True;

 If Ex=False then begin

  Application.MessageBox('В системе нет ни одного заряда!','Нет зарядов',mb_iconexclamation);

  Exit;

 end;

 StatusBar1.Panels.Items[4].Text:='Исследование линий напряженности...';

 Stop;

 Prepare; ElRefresh;

 Form1.Image1.Repaint;

 Form1.Image1.Canvas.Pen.Color:=clSilver;

 CalcA:=True;

end;

procedure TForm1.N14Click(Sender: TObject);

begin

 Form4.Show;

end;

end.


Модуль Option.pas


unit Option;

interface

uses

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

  StdCtrls, ComCtrls, Spin, ExtCtrls;

type

  TForm2 = class(TForm)

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    Button1: TButton;

    Label1: TLabel;

    SpinEdit1: TSpinEdit;

    TabSheet2: TTabSheet;

    Label2: TLabel;

    Edit1: TEdit;

    Label3: TLabel;

    Label4: TLabel;

    Bevel1: TBevel;

    Label5: TLabel;

    Edit2: TEdit;

    Label6: TLabel;

    Label7: TLabel;

    ComboBox1: TComboBox;

    Image1: TImage;

    Edit3: TEdit;

    Bevel2: TBevel;

    RadioButton1: TRadioButton;

    RadioButton2: TRadioButton;

    Panel1: TPanel;

    RadioButton3: TRadioButton;

    RadioButton4: TRadioButton;

    CheckBox1: TCheckBox;

    CheckBox2: TCheckBox;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure ComboBox1Change(Sender: TObject);

    procedure RadioButton2Click(Sender: TObject);

    procedure RadioButton1Click(Sender: TObject);

    procedure RadioButton3Click(Sender: TObject);

    procedure RadioButton4Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

type Table=record

 Name:String[30];

 Di:Real;

end;

var

  Form2: TForm2;

  F:Text;

  Tab:Array of Table;

implementation

uses Main;

{$R *.DFM}

procedure TForm2.Button1Click(Sender: TObject);

begin

 Z:=SpinEdit1.Value;

 Form2.Close;

end;

procedure TForm2.FormCreate(Sender: TObject);

Var S:String;

    I,P:Integer;

begin

 Z:=SpinEdit1.Value; I:=0;

 AssignFile(F,'dielectr.dat'); Reset(F);

 SetLength(Tab,1);

 While not Eof(F) do begin

  Readln(F,S); SetLength(Tab,Length(Tab)+1);Inc(I);

  Tab[I].Name:=Copy(S,1,Pos('$',S)-1);

  Delete(S,1,Pos('$',S));

  Tab[I].Di:=StrToFloat(S);

 end;

 CloseFile(F);

 For P:=1 to I do ComboBox1.Items.Add(Tab[P].Name);

end;

procedure TForm2.ComboBox1Change(Sender: TObject);

Var I:Integer;

begin

For I:=1 to Length(Tab) do If ComboBox1.Text=Tab[I].Name then begin

 Edit3.Text:=FloatToStr(Tab[I].Di); Break; End;

end;

procedure TForm2.RadioButton2Click(Sender: TObject);

begin

 Edit3.Enabled:=True;

 ComboBox1.Enabled:=False;

 ComboBox1.Text:='Другая...';

end;

procedure TForm2.RadioButton1Click(Sender: TObject);

begin

 Edit3.Enabled:=False;

 ComboBox1.Enabled:=True;

end;

procedure TForm2.RadioButton3Click(Sender: TObject);

begin

 CheckBox1.Enabled:=False;

 CheckBox2.Enabled:=False;

end;

procedure TForm2.RadioButton4Click(Sender: TObject);

begin

 CheckBox1.Enabled:=True;

 CheckBox2.Enabled:=True;

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 If (StrToFloat(Edit1.Text)=0) or

    (StrToFloat(Edit2.Text)=0) then begin

     Application.MessageBox('Некорректно введены некоторые данные','Ошибка данных',mb_iconstop);

 end;

end;

end.


Модуль Calc.pas


unit Calc;

interface

uses

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

  ExtCtrls, StdCtrls;

type

  TForm3 = class(TForm)

    Label4: TLabel;

    Label5: TLabel;

    Label6: TLabel;

    Label7: TLabel;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label8: TLabel;

    Label9: TLabel;

    Label10: TLabel;

    Label11: TLabel;

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form3: TForm3;

implementation

{$R *.DFM}

end.


Модуль About.pas


unit About;

interface

uses

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

  StdCtrls, ExtCtrls, RXCtrls, ComCtrls;

type

  TForm4 = class(TForm)

    PageControl1: TPageControl;

    TabSheet1: TTabSheet;

    SecretPanel1: TSecretPanel;

    Label1: TLabel;

    Label2: TLabel;

    Image1: TImage;

    procedure TabSheet1Exit(Sender: TObject);

    procedure TabSheet1Enter(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form4: TForm4;

implementation

{$R *.DFM}

procedure TForm4.TabSheet1Exit(Sender: TObject);

begin

 SecretPanel1.Active:=False;

end;

procedure TForm4.TabSheet1Enter(Sender: TObject);

begin

 SecretPanel1.Active:=True;

end;

end.



Страницы: 1, 2, 3, 4


Новости


Быстрый поиск

Группа вКонтакте: новости

Пока нет

Новости в Twitter и Facebook

                   

Новости

Обратная связь

Поиск
Обратная связь
Реклама и размещение статей на сайте
© 2010.