Математическое моделирование физических задач на ЭВМ (стр. 5 из 8)
Рисунок №9. Окно помощи выводимое на экран при нажатии клавиши F1.................................... 29
II. Листинг программы на языке Паскаль............................................................................... 30
1. Основная программа.................................................................................................................. 30
2. Модуль с библиотекой элементов.............................................................................................. 36
3. Модуль вычисления токов ветвей............................................................................................... 48
I. Рисунки с видами экрана при работе с программой
МенюМеню элементов
Рабочее поле 
Указатель мыши  |
Индекатор свободной памяти
Рисунок №2. Меню – Файл.
Меню – Файл
 |
Рисунок №3. Открытие файла, сохраненного на диске.
Открытие файла со схемой
 |
Рисунок №4. Вид экрана с изображением схемы.
Изображение схемы
 |
Рисунок №5. Вывод результата вычисления токов в ветвях схемы.
Результаты вычислений
 |
Резисторы
Рисунок №6. Просмотр направления токов в ветвях схемы.
Значения токовНаправления токов
 |
Рисунок №7. Вид экрана при сохранении схемы в файл.
Сохранение схемы 
Работа с окнами 
Рисунок №9. Вид экрана при закрытии всех окон.
Указатель мыши
Меню
 |
 |
Информация о свободной памяти
Рисунок №10. Окно помощи выводимое на экран при нажатии клавиши F1.
Закрытие окна
 |
Окно с помощью программы
 |
Горизонтальный скролинг
Вертикальный скролинг
II. Листинг программы на языке Паскаль.
ProgramUzPotenc; {Метод узловых потенциалов}
{$F+,O+,X+,V-,R-,I-,S-}
Uses
Crt, Applic1, Objects, Drivers, Dialogs, Views, Menus, App, StdDlg,
Fonts, HelpFile, MsgBox, TxtRead, WInDows, PalObj, Grv16, DemoHlp,
Types2;
Type TNewApp=Object(TMyApp)
Procedure ReCounte; Virtual;
End;
Var MyApp:TNewApp;
Type
PMyCollection=^TMyCollection;
TMyCollection=Object(TCollection)
Procedure FreeItem(Item:poInter); Virtual;
End;
ProcedureCurView; {Просмотр значений токов}
Var R,R1:TRect;
D:PDialog;
L:PListBox;
C:PMyCollection;
Sb:PScrollBar;
i:Integer;
s:String;
Begin
Sb:=Nil;
MyApp.ShemeWInDow^.GeTextentWIn(R);
R.B.X:=R.A.X+(R.B.X-R.A.X) Div 4;
D:=New(PDialog,Init(R,'Значения токов'));
D^.GeTextentWIn(R);
Inc(R.A.Y,CurrentFont^.Height*2);
R1.Copy(R);
R1.A.X:=R1.B.X-CurrentFont^.Width*2;
If RCount>(R.B.Y-R.A.Y) Div CurrentFont^.Height
Then
Begin
Sb:=D^.StAndardScrollBar(sbVertical+sbHAndleKeyBoard);
End;
C:=New(PMyCollection,Init(RCount,1));
For i:=1 To RCount Do
Begin
Str(abs(Currents[i]):9:6,s);
If i Div 10>0
Then C^.Insert(NewStr('I'+IntToStr(i)+'='+s+'A'))
Else C^.Insert(NewStr(' I'+IntToStr(i)+'='+s+'A'))
End;
L:=New(PListBox,Init(R,1,Sb));
L^.NewList(C);
D^.Insert(L);
R.B.Y:=R.A.Y;
Dec(R.A.Y,CurrentFont^.Height*2);
D^.Insert(New(PLabel,Init(R,' Токи в ветвях',L)));
DeskTop^.Insert(D);
End;
Procedure TNewApp.ReCounte;{Обсчет}
Var
i,j,k,l,m,Ii,Sizex,Index:Integer;
A:TElAr;
f1,f2:Boolean;
Ratio:Real;
Function Vetv1(Ai,Aj,Ad:Integer):Boolean;
{Функция сохраняет в A ветвь от элемента (Ai,Aj) в направлении Ad (0-Up,1-Down,2-Left,3-Right и возвращает TRUE, если она содержит элементы}
Var i,j,k,l:Integer;
Flag1,Flag2:Boolean;
Begin
Flag1:=True;
Flag2:=False;
With A[Index] Do
Begin
Str:=Ai; Col:=Aj;
Num:=Sheme[Ai,Aj,2];
Typ:=Sheme[Ai,Aj,1];
End;
Inc(Index);
Case Ad Of
0: Begin i:=Ai+1; j:=Aj-1; End;
1: Begin i:=Ai-1; j:=Aj+1; End;
2: Begin i:=Ai-1; j:=Aj+1; End;
3: Begin i:=Ai+1; j:=Aj-1; End;
End;
While Flag1 And (i>0) And (j>0) And (i<=nS) And (j<=mS) And Not
(Sheme[i,j,1] In [0,14..18]) Do
Begin
If Sheme[i,j,1] In [3..8]
Then
Begin
Flag2:=True;
With A[Index] Do
Begin
Str:=i;
Col:=j;
Num:=Sheme[i,j,2];
Typ:=Sheme[i,j,1];
Case Ad Of
0:Dir:=Typ In [5,8];
1:Dir:=Typ=6;
2:Dir:=Typ=4;
3:Dir:=Typ In [3,7];
End;
End;
Inc(Index);
End;
Case Ad Of
0: Case Sheme[i,j,1] Of
2,5,6,8,9 : Dec(i);
10 : Begin Inc(j); Ad:=3; End;
11 : Begin Dec(j); Ad:=2; End;
Else Flag1:=False;
End;
1: Case Sheme[i,j,1] Of
2,5,6,8,9 : Inc(i);
12 : Begin Inc(j); Ad:=3; End;
13 : Begin Dec(j); Ad:=2; End;
Else Flag1:=False;
End;
2: Case Sheme[i,j,1] Of
1,3,4,7,9 : Dec(j);
10 : Begin Inc(i); Ad:=1; End;
12 : Begin Dec(i); Ad:=0; End;
Else Flag1:=False;
End;
3: Case Sheme[i,j,1] Of
1,3,4,7,9 : Inc(j);
13 : Begin Dec(i); Ad:=0; End;
11 : Begin Inc(i); Ad:=1; End;
Else Flag1:=False;
End;
End;
End;
If Sheme[i,j,1] In [14..18]
Then
Begin
With A[Index] Do
Begin
Str:=i;
Col:=j;
Num:=Sheme[i,j,2];
Typ:=Sheme[i,j,1];
End;
Inc(Index);
With A[Index] Do
Begin
Str:=0;
Col:=0;
Num:=0;
Typ:=0;
End;
Inc(Index);
End;
If Not Flag2
Then
Begin
For k:=1 To NoDecount Do
If (Nodes[k,1]=i) And (Nodes[k,2]=j)
Then l:=k;
NNum[l]:=NNum[Ii]; {Исключение накоротко замкнутых ветвей}
End;
Vetv1:=Flag2;
End;
Function ElEqu(Var Src,Dst:TEl):Boolean; {Returns TRUE, If Src=Dst}
Begin
With Src Do
ElEqu:=(Str=Dst.Str)And(Col=Dst.Col)And(Typ=Dst.Typ)And(Num=Dst.Num);
End;
Function IsDiv(Var Src:TEl):Boolean; {Returns TRUE, If Src - Divider}
Begin
With Src Do
IsDiv:=(Str=0)And(Col=0)And(Typ=0)And(Num=0);
End;
Function NextDiv(i:Integer):Integer; {Поиск след. разд. элемента в массиве}
Begin
Repeat
Inc(i);
Until (i>Sizex) Or IsDiv(A[i]);
If i<=Sizex
Then NextDiv:=i
End;
Function PrevDiv(i:Integer):Integer; {Поиск пред. разд. элемента в массиве}
Begin
Repeat
Dec(i);
Until (i<1) Or IsDiv(A[i]);
If i>=1
Then PrevDiv:=i
Else PrevDiv:=0;
End;
Begin
For i:=1 To nS*mS Div 2 Do
For j:=1 To nS*mS Div 2 Do
Equals[i,j]:=0;
For Ii:=1 To NoDecount Do
NNum[Ii]:=Ii;
Index:=1;
For Ii:=1 To NoDecount Do
Begin
Case Sheme[Nodes[Ii,1],Nodes[Ii,2],1] Of
14:Begin
Vetv1(Nodes[Ii,1],Nodes[Ii,2],0); Vetv1(Nodes[Ii,1],Nodes[Ii,2],1);
End;
15:Begin
Vetv1(Nodes[Ii,1],Nodes[Ii,2],0); Vetv1(Nodes[Ii,1],Nodes[Ii,2],1);
End;
16:Begin
Vetv1(Nodes[Ii,1],Nodes[Ii,2],0); Vetv1(Nodes[Ii,1],Nodes[Ii,2],1);
End;
17:Begin
Vetv1(Nodes[Ii,1],Nodes[Ii,2],1); Vetv1(Nodes[Ii,1],Nodes[Ii,2],2);
End;
18:Begin
Vetv1(Nodes[Ii,1],Nodes[Ii,2],0); Vetv1(Nodes[Ii,1],Nodes[Ii,2],2);
End;
End;
End;
Sizex:=Index-1;
{Оставляет нужные ветви}
i:=1;
While i<=Sizex Do
Begin
j:=0;
f1:=True;
While (i+j<=Sizex) And f1 Do
Begin
k:=NextDiv(i+j);
If ElEqu(A[k-1],A[i])And ElEqu(A[k-2],A[i+1])
Then
Begin