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

1)*180/Z)*Pi/180),Qrc[I,2]+3*Sin(((P-1)*180/Z)*Pi/180),I,-1);

If Qrc[I,3]=4 then For P:=1 to 4*Z do ElTrack(Qrc[I,1]+3*Cos(((P-

1)*90/Z)*Pi/180),Qrc[I,2]+3*Sin(((P-1)*90/Z)*Pi/180),I,-1);

Form1.Image1.Repaint;

end;

ElRefresh;

E:=DateTimeToTimeStamp(Now).Time;

Form1.StatusBar1.Panels.Items[4].Text:='Готово...';

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

End;

Procedure Prepare;

Var I,P,Q:SmallInt;

Begin

Form1.Image1.Align:=alClient;

Form1.Image1.Canvas.Brush.Color:=clBlack;

Form1.Image1.Canvas.FillRect(Rect(0,0,Form1.Image1.Width,Form1.Image1.Heigh

t));

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

For I:=0 to 63 do For P:=0 to 47 do

If Qc[I,P]<>0 then begin

Inc(Nc);

Qrc[Nc,1]:=I*25+13;

Qrc[Nc,2]:=P*25+13;

Q:=Abs(Qc[I,P])-1;

Q:=Round(Exp(Q*Ln(2)));

If Qc[I,P]0) and (Y>0) and (XB) then Break;

Deg:=Deg*Deg*Deg;

Vx:=Vx+(K*Qrc[I,3]*Dx/Deg);

Vy:=Vy+(K*Qrc[I,3]*Dy/Deg);

end;

If (DegB) then Break;

U:=1; If Sqrt(Vx*Vx+Vy*Vy)=0 then Break;

If Sqrt(Vx*Vx+Vy*Vy)<>0 then U:=1/Sqrt(Vx*Vx+Vy*Vy);

Vx:=U*Vx; Vy:=U*Vy; X:=X+Vx; Y:=Y+Vy;

For I:=0 to Num-1 do If (Last[I,1]=Round(X)) and (Last[I,2]=Round(Y)) and

(I0) and (Y>0) and (X0 then U:=1/Sqrt(Vx*Vx+Vy*Vy);

Vx:=U*Vx; Vy:=U*Vy;

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

X:=X+Vx; Y:=Y+Vy;

For I:=0 to Num-1 do If (Last[I,1]=Round(X)) and (Last[I,2]=Round(Y)) and

(I0 then If Abs(Xb-X)>Stop then Exit;

End;

SetLength(Last,0);

End;

Procedure ElRefresh;

Var I:Integer;

Begin

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

For I:=1 to Nc do begin

If Qrc[I,3]>0 then Form1.Image1.Canvas.Brush.Color:=clRed else

Form1.Image1.Canvas.Brush.Color:=clBlue;

If Abs(Qrc[I,3])<>4 then Circle(Qrc[I,1],Qrc[I,2],Abs(4*Qrc[I,3])-1,1)

else

Circle(Qrc[I,1],Qrc[I,2],11,1);

end;

End;

Procedure Stop;

Begin

LineExpl:=False; EkviExpl:=False;

SetLength(E0,0);

Form1.StatusBar1.Panels.Items[0].Text:='';

Form1.StatusBar1.Panels.Items[1].Text:='';

Form1.StatusBar1.Panels.Items[2].Text:='';

End;

Procedure Redactor;

Var I,P:SmallInt;

Begin

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

Form1.Image1.Align:=alNone;

Form1.Image1.Height:=0; Form1.Image1.Width:=0;

Form1.Refresh; DrawGrid;

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

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

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

End;

Function Potenc(X,Y:Integer):Real;

Var I:Integer;

Tmp,Dist:Real;

Begin

Tmp:=0;

For I:=1 to Nc do begin

Dist:=Sqrt(((Qrc[I,1]-X)*(Qrc[I,1]-X)+(Qrc[I,2]-Y)*(Qrc[I,2]-Y)));

If Dist<>0 then Tmp:=Tmp+(Qrc[I,3]/Dist) else begin Potenc:=0; Exit; end;

end;

Potenc:=Tmp;

End;

Function RealPotenc(X,Y:Integer):Real;

Var I:Integer;

Dx,Dy,Tmp,Dist:Real;

Begin

Tmp:=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);

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

If Dist<>0 then Tmp:=Tmp+(Qrc[I,3]*StrToFloat(Form2.Edit1.Text)/Dist)

else begin RealPotenc:=0; Exit; end;

end;

RealPotenc:=Tmp/StrToFloat(Form2.Edit3.Text);

End;

Function CheckEkviBegin(X,Y:Integer):Boolean;

Begin

CheckEkviBegin:=False;

If (X-1=EkX) and ((Y-1=EkY) or (Y=EkY) or (Y+1=EkY)) then

CheckEkviBegin:=True;

If (X+1=EkX) and ((Y-1=EkY) or (Y=EkY) or (Y+1=EkY)) then

CheckEkviBegin:=True;

If (X=EkX) and ((Y-1=EkY) or (Y+1=EkY)) then CheckEkviBegin:=True;

End;

Procedure PaintEkvi(X,Y:Integer;Pot:Real;O:Byte);

Var P:Array[1..4] of Real;

M:Array[1..4] of Boolean;

Xt,Yt:Integer;

I,Min:Byte;

Begin

For I:=1 to 4 do P[I]:=0; For I:=1 to 4 do M[I]:=True;

P[1]:=Abs(Pot-Potenc(X,Y-1)); P[2]:=Abs(Pot-Potenc(X+1,Y));

P[3]:=Abs(Pot-Potenc(X,Y+1)); P[4]:=Abs(Pot-Potenc(X-1,Y));

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

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

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

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

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

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

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 Min2) 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 (X2) 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 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(For

m2.Edit3.Text));

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

m2.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 (Vy0) then T:=T+180 else

If (Vy0 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