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

Таким образом мы продолжаем строить линию до тех пор, пока не вернемся в первоначальную точку.

Возможности программы

Программа может применяться как демонстрация теоретического материала, изложенного на уроке физики. Кроме того, программа позволяет заниматься поверхностной исследовательской деятельностью.

Список возможностей программы (считается, что электрическое поле задано расстановкой зарядов):

1. По данному электрическому полю рисовать общий план линий напряженности

2. По данному электрическому полю исследовать линии напряженности (т.е. строить через заданную точку линию напряженности).

3. По данному электрическому полю исследовать эквипотенциальные линии (т.е. строить через данную точку эквипотенциальную линию).

4. По данному электрическому полю вычислять напряженность и потенциал в заданной точке поля.

5. По данному электрическому полю вычислять параметры электрического поля в заданной точке.

Список используемой литературы

1. Буховцев Б.Б., Климонтович Ю.Л., Мякишев Г.Я., «Физика. Учебное пособие для 9 класса», М: «Просвещение», 1975.

2. Дик Ю.И., Кабардин О.Ф. и другие «Физика. Учебное пособие для 10 класса», М: «Просвещение», 1993.

Приложение

Листинг программы

Модуль Main.pas

unit Main;

interface

uses

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

Menus, ComCtrls, ExtCtrls, ImgList, Math, StdCtrls;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11, N12, N13, N14, N15, N16, N17, N18, N19, N20, N21, N23 : TMenuItem;

StatusBar1: TStatusBar;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

Image1: TImage;

Memo1: TMemo;

procedure FormResize(Sender: TObject);

procedure FormCreate(Sender: TObject);

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

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

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

procedure N6Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N12Click(Sender: TObject);

procedure N13Click(Sender: TObject);

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

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

procedure N9Click(Sender: TObject);

procedure N10Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure N16Click(Sender: TObject);

procedure N19Click(Sender: TObject);

procedure N20Click(Sender: TObject);

procedure N14Click(Sender: TObject);

private

public

end;

Procedure DrawGrid;

Procedure RefreshSquare(X,Y:Byte);

Procedure Circle(X,Y,R:Real;W:Byte);

Procedure RefreshStatus(X,Y:Byte);

Procedure ElTrack(X,Y:Real;B,K:Integer);

Procedure ElTrackForMoving(X,Y:Real;K:Integer;Stop:Real);

Procedure ElRefresh;

Procedure Prepare;

Procedure Stop;

Procedure Redactor;

Procedure PaintLines;

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

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

type Matrix=Array[0..63,0..47] of ShortInt;

type Position=Record

X:Integer;

Y:Integer;

end;

var

Form1: TForm1;

En:Array[0..9] of Position;

Z,EnNow:ShortInt;

Qc : Matrix;

Qrc: Array [1..3071,1..3] of SmallInt;

Last,LastEkv:Array of Array [1..2] of SmallInt;

Ekv: Array[-1600..1600,-1200..1200] of Boolean;

Nc:SmallInt;

EkX,EkY,A:Integer;

F : File of Matrix;

Xxl,CalcA,EkviExpl,LineExpl:Boolean;

Xm,Ym,LastSin:Real;

E0:Array of Position;

implementation

uses Option, Calc, About;

{$R *.DFM}

Procedure DrawGrid;

Var I:Integer;

Begin

Form1.Canvas.Pen.Color:=clWhite; I:=0;

While (I<=Form1.Width) and (I<1601) do begin

Form1.Canvas.MoveTo(I,0);

Form1.Canvas.LineTo(I,Form1.Height);

Inc(I,25);

end; I:=0;

While (I<=Form1.Height) and (I<1201) do begin

Form1.Canvas.MoveTo(0,I);

Form1.Canvas.LineTo(Form1.Width,I);

Inc(I,25);

end;

End;

Procedure RefreshSquare(X,Y:Byte);

Begin

Form1.Canvas.Pen.Color:=clBlack;

Form1.Canvas.Brush.Color:=clBlack; Circle(X*25+13,Y*25+13,12,0);

RefreshStatus(X,Y);

If Qc[X,Y]=0 then Exit;

Form1.Canvas.Pen.Color:=clWhite;

If Qc[X,Y]>0 then Form1.Canvas.Brush.Color:=clRed

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

Circle(X*25+13,Y*25+13,Abs(4*Qc[X,Y])-1,0);

End;

Procedure Circle(X,Y,R:Real;W:Byte);

Begin

If W=0 then Form1.Canvas.Ellipse(Round(X-R),Round(Y-R),Round(X+R),Round(Y+R));

If W=1 then Form1.Image1.Canvas.Ellipse(Round(X-R),Round(Y-R),Round(X+R),Round(Y+R));

End;

Procedure RefreshStatus(X,Y:Byte);

Var Q:Integer;

St:String;

Begin

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

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

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

If Qc[X,Y]=0 then Exit;

Q:=Abs(Qc[X,Y])-1;

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

If Qc[X,Y]<0 then Q:=-Q;

St:='X = '+IntToStr(X*25+13)+'('+IntToStr(X)+')'; Form1.StatusBar1.Panels.Items[0].Text:=St;

St:='Y = '+IntToStr(Y*25+13)+'('+IntToStr(Y)+')'; Form1.StatusBar1.Panels.Items[1].Text:=St;

St:='Q = '+IntToStr(Q)+'q'; Form1.StatusBar1.Panels.Items[2].Text:=St;

End;

Procedure PaintLines;

Var I,P:Integer;

B,E:LongWord;

Begin

B:=DateTimeToTimeStamp(Now).Time;

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

Prepare;

ElRefresh;

Form1.Image1.Repaint;

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

For I:=1 to Nc do If Qrc[I,3]<0 then begin

If Qrc[I,3]=-1 then For P:=1 to Z do ElTrack(Qrc[I,1]+3*Cos(((P-1)*360/Z)*Pi/180),Qrc[I,2]+3*Sin(((P-1)*360/Z)*Pi/180),I,1);

If Qrc[I,3]=-2 then For P:=1 to 2*Z do ElTrack(Qrc[I,1]+3*Cos(((P-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;

For I:=1 to Nc do If Qrc[I,3]>0 then begin

If Qrc[I,3]=1 then For P:=1 to Z do ElTrack(Qrc[I,1]+3*Cos(((P-1)*360/Z)*Pi/180),Qrc[I,2]+3*Sin(((P-1)*360/Z)*Pi/180),I,-1);

If Qrc[I,3]=2 then For P:=1 to 2*Z do ElTrack(Qrc[I,1]+3*Cos(((P-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.Height));

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 then Q:=-Q;

Qrc[Nc,3]:=Q;

end;

End;

Procedure ElTrack(X,Y:Real;B,K:Integer);

Var U,Vx,Vy,Dx,Dy,Deg:Real;

I,P,Num:Integer;

Br,Alr:Boolean;

Begin

Num:=0; Br:=False; Alr:=False;

SetLength(Last,0);

While (X>0) and (Y>0) and (X

Vx:=0; Vy:=0; Deg:=0;

For I:=1 to Nc do begin

Dx:=Qrc[I,1]-X;

Dy:=Qrc[I,2]-Y;

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

If (Deg<3) and (I<>B) then Break;

Deg:=Deg*Deg*Deg;

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

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

end;

If (Deg<3) and (I<>B) 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 (I

If Form2.RadioButton3.Checked=True then Exit;

If Form2.CheckBox1.Checked=True then begin

For P:=0 to Length(E0)-1 do

If (Abs(Round(X)-E0[P].X)<=1) and (Abs(Round(Y)-E0[P].Y)<=1) then begin

Alr:=True; Break; end;

If Alr=False then begin

with Form1.Image1.Canvas do begin

Brush.Style:=bsClear; Pen.Color:=clYellow;

Ellipse(Round(X-5),Round(Y-5),Round(X+5),Round(Y+5));

Font.Color:=clYellow;

TextOut(Round(X-8),Round(Y+6),'E=0');

Pen.Color:=clSilver;

end;

SetLength(E0,Length(E0)+1);

E0[Length(E0)-1].X:=Round(X); E0[Length(E0)-1].Y:=Round(Y);

end;

end;

Br:=True;

If Form2.RadioButton4.Checked=True then Break;

end;

If Br=True then Break;

Inc(Num); SetLength(Last,Num);

Last[Num-1,1]:=Round(X); Last[Num-1,2]:=Round(Y);

End;

If (Br=True) and (Form2.CheckBox2.Checked=True) and (Form2.RadioButton4.Checked=True) then

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

For I:=1 to Num-2 do begin

Form1.Image1.Canvas.MoveTo(Last[I,1],Last[I,2]);

Form1.Image1.Canvas.LineTo(Last[I+1,1],Last[I+1,2]);

end;

End;

Procedure ElTrackForMoving(X,Y:Real;K:Integer;Stop:Real);

Var Xb,U,Vx,Vy,Dx,Dy,Deg:Real;

Num,I:Integer;

Begin

Num:=0; Xb:=X;

While (X>0) and (Y>0) and (X

Vx:=0; Vy:=0;

For I:=1 to Nc do begin

Dx:=Qrc[I,1]-X;

Dy:=Qrc[I,2]-Y;

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

If (Deg

Deg:=Deg*Deg*Deg;

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

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

end;

U:=1;

If Sqrt(Vx*Vx+Vy*Vy)<>0 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 (I

Inc(Num); SetLength(Last,Num);

Last[Num-1,1]:=Round(X); Last[Num-1,2]:=Round(Y);

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

If Stop<>0 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 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]

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

.