Вот нашел в интернете программу, моделирующую электрическое поле. Сам я делфи не знаю, мне надо всего лишь посмотреть на результаты работы программы. Но компилятор выдает много ошибок. Исправьте плиз кому не сложно.
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 (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.
А что полностью проекта нету ? Как-то геморно мне кажется будет все формы, кнопочки,менюшки, имеджи итд по коду восстанавливать, а уж их расположение выходит вообще великая тайна, боюсь задача из разряда нереальных.
Очень жаль, значит придется самому понимать как выглядит электрическое поле. Но все равно спасибо за попытку помочь.
Понимать, как выглядит электрическое поле, гораздо лучше по учебнику физики, чем по программе на Паскале.