| |||||
МЕНЮ
| Исследование и моделирование с помощью компьютера электрических полей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 |
ИНТЕРЕСНОЕ | |||
|