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.
