Рисунок №1. Общий вид экрана.
Меню
Меню элементов
Рабочее поле
Указатель мыши
 |
Строка статуса
Индекатор свободной памяти
Рисунок №2. Меню – Файл.
Меню – Файл
 |
Рисунок №3. Открытие файла, сохраненного на диске.
Открытие файла со схемой
 |
Рисунок №4. Вид экрана с изображением схемы.
Изображение схемы
 |
Расчет схемы
Рисунок №5. Вывод результата вычисления токов в ветвях схемы.
Результаты вычислений
 |
Токи
Резисторы
Рисунок №6. Просмотр направления токов в ветвях схемы.
Значения токов
Направления токов
 |
Рисунок №7. Вид экрана при сохранении схемы в файл.
Сохранение схемы
Рисунок №8. Меню – Окно.
Работа с окнами
Рисунок №9. Вид экрана при закрытии всех окон.
Указатель мыши
Меню
 |
Строка статуса
Информация о свободной памяти
Рисунок №10. Окно помощи выводимое на экран при нажатии клавиши F1.
Закрытие окна
 |
Окно с помощью программы
 |
Горизонтальный скролинг
Вертикальный скролинг
II. Листинг программы на языке Паскаль.
Основная программа
Program UzPotenc; {Метод узловых потенциалов}
{$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;
Procedure CurView; {Просмотр значений токов}
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
f1:=False;
l:=PrevDiv(k);
For m:=0 To Sizex-k Do
A[l+m]:=A[k+m];
Sizex:=Sizex-(k-l);
i:=NextDiv(i)+1;
If i=1
Then i:=Sizex+1;
End
Else
j:=k-i;
End;
End;
i:=0;
{Исключает пустые ветви}
While i<=Sizex Do
Begin
j:=NextDiv(i);
If j-i=3
Then
Begin
For k:=1 To Sizex-j Do
End;
If j<>0
Then i:=j
Else i:=Sizex+1;
End;
{Считаем сколько узлов с учётом соединений}
NCount:=NoDecount;
For i:=1 To NoDecount Do
If NNum[i]<>i
Then Dec(NCount);
If NCount<>NoDecount
Then
For i:=1 To NoDecount Do
Begin
j:=0;
For k:=1 To NoDecount Do
If NNum[k]=i
Then j:=1;
If j=0
Then
For k:=1 To NoDecount Do
If NNum[k]>i
Then Dec(NNum[k]);
End;
i:=1;
j:=0;
Repeat
Inc(j);
k:=NextDiv(i);
With Brunches[j] Do
Begin
AEDS:=0;
ARes:=0;
For l:=i To k Do
With A[l] Do
Case Typ Of
3..6: If Dir
Then EDS:=AEDS+EDS[Str,Col]
Else EDS:=AEDS-EDS[Str,Col];
7..8: ARes:=ARes+abs(Res[Str,Col]);
End;
FromN:=NNum[A[i].Num];
If k<>0
Then
Begin
ToN:=NNum[A[k-1].Num];
i:=k+1;
End
Else
Begin
ToN:=NNum[A[Sizex-1].Num];
i:=Sizex+1;
End;
End;
Until i>Sizex;
BrunchCount:=j;
{Заполняем систему}
For i:=1 To BrunchCount Do
With Brunches[i] Do
Begin
Equals[FromN,FromN]:=Equals[FromN,FromN]+1/ARes;
Equals[ToN,NCount+1]:=Equals[ToN,NCount+1]+AEDS/ARes;
End;
{Решаем систему}
For i:=2 To NCount Do
Begin
Ratio:=Equals[i,i];
For j:=2 To NCount+1 Do
Equals[i,j]:=Equals[i,j]/Ratio;
For k:=2 To NCount Do
If k<>i
For i:=1 To NCount+1 Do
Begin
Equals[1,i]:=0;
Equals[i,1]:=0;
End;
{После решения расставляем токи}
For i:=1 To RCount Do
Begin
j:=1;
While (j<=Sizex) And Not ((A[j].Typ In [7,8]) And (A[j].Num=i)) Do
Inc(j); k:=0; l:=j;
Repeat
k:=k+1; j:=PrevDiv(j);
Until j=0;
With Brunches[k] Do
Begin
Currents[i]:=(AEDS-Equals[ToN,NCount+1]+Equals[FromN,NCount+1])/ARes;
If Not A[l].Dir
Then Currents[i]:=-Currents[i];
End;
End;
CurView;
End;
Procedure TMyCollection.FreeItem;
Begin
If Item<>Nil
Then DisposeStr(PString(Item));
End;
BEGIN
MyApp.Init;
MyApp.Run;
MyApp.Done;
END.
Дата: 2019-05-29, просмотров: 183.
