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.
2. Модуль с библиотекой элементов
Unit Types2;
Interface
Uses
Crt,
Objects, Drivers, Dialogs, Views, Menus, App, StdDlg,
Fonts, HelpFile, MsgBox, TxtRead, WInDows,
PalObj, Grv16, DemoHlp;
Const
nS=8;
mS=13;
Sx:Integer = 50;
Sy:Integer = 40;
Sx1:Integer=20;
Sy1:Integer=20;
cmMemoViewChange = 1001;
CurrentElement:Byte=0;
IsResist:Boolean=True; {If True - resistOrs, Else - currents}
Type
TSheme=Array [1..nS,1..mS,1..2] Of Byte; {Массив сдержит схему}
TNodes=Array [1..nS*mS,1..2] Of Byte; {Массив содержит координаты всех
узловых элементов (i,j)}
TElems=Array [1..nS,1..mS] Of Real; {Содержит элементы значения}
TCurrents=Array [1..nS*mS] Of Real; {Токи}
TNNum=Array [1..nS*mS] Of Byte; {Номера узлов}
PEl=^TEl; {Элемент}
TEl=recOrd
Str,Col:Byte;{строка, столбец}
Typ:Byte;{тип}
Num:Byte;{номер}
Dir:Boolean;
End;
TBrunch=recOrd {Ветвь}
FromN,ToN:Byte;
ARes,AEDS:Real;
End;
TElAr=Array [1..2*mS*nS] Of TEl; {Элементы}
TBrunches=Array[1..mS*nS] Of TBrunch; {Ветви}
TEquals=Array[1..mS*nS Div 2,1..mS*nS Div 2] Of Real; {Уравнения}
PToolBar = ^TToolBar;
TToolBar = Object(TView)
ConstructOr Init(Var R: TRect);
Procedure Draw; Virtual;
Procedure HAndleEvent(Var Event:TEvent); Virtual; {Реагирование на события}
End;
PMemoView = ^TMemoView;
TMemoView = Object(TView)
ConstructOr Init(Var Bounds: TRect);
Procedure HAndleEvent(Var Event: TEvent); Virtual;
Procedure Draw; Virtual;
End;
{П- указатель, Т - тип}
PShemeView = ^TShemeView;
TShemeView = Object(TView)
ConstructOr Init(Var R: TRect);
Procedure Draw; Virtual;
Procedure HAndleEvent(Var Event:TEvent); Virtual;
End;
PShemeWIn = ^TShemeWIn;
TShemeWIn = Object(TDialog)
ConstructOr Init(Var R:TRect);
Function ElMatter(IsEDS:Boolean):Real; {Окно ввода значений}
DestructOr Done; Virtual;
End;
Var
Sheme:TSheme;
Nodes:TNodes;
EDS,Res:TElems;
Currents:TCurrents; {Токи}
NCount,NoDecount,ECount,RCount:Integer;
{Реално узлов, Узловых эл-тов, Колво ЭДС и Кол-во Рез.}
Changed:Boolean;
Exist:Boolean;
SetPhase:Boolean;
NNum:TNNum;
Brunches:TBrunches;
{Ветви}
BrunchCount:Integer;
{Кол-во}
Equals:TEquals;
Function IntToStr(i:longInt):String;
Procedure ElNumbers(Var ASheme:TSheme);
Procedure InitSheme(Var ASheme:TSheme);
Implementation
Procedure InitSheme(Var ASheme:TSheme);
{Зануляет текущую схему. Вызывается при старте и команде ОЧИСТИТЬ}
Var i,j,k:Integer;
Begin
For i:=1 To nS Do
For j:=1 To mS Do
For k:=1 To 2 Do
Begin
ASheme[i,j,k]:=0;
EDS[i,j]:=0;
Res[i,j]:=0;
End;
End;
ConstructOr TMemoView.Init(Var Bounds: TRect);
Begin
TView.Init(Bounds);
EventMask:= EventMask Or evBroadCast;
Options := OfPreProcess;
End;
Procedure TMemoView.HAndleEvent(Var Event: TEvent);
Begin
Inherited HAndleEvent(Event);
With Event Do
If (What =evBroadCast)And(CommAnd=cmMemoViewChange)
Then DrawView
Else Exit;
ClearEvent(Event);
End;
Procedure TMemoView.Draw;
Var
R: TRect;
S: String;
Begin
SetColOr(7);
FillRect(1, 1, Pred(Size.X), Pred(Size.Y));
GeTextent(R);
With R Do DrawFrame(A, B, OfWhiteRight);
Str(MemAvail:6, S);
SetColOr(0);
WriteStr(5, 3, S + 'b');
End;
ConstructOr TToolBar.Init(Var R: TRect);
Begin
Inherited Init(R);
GrowMode:= GrowMode Or (gfGrowHiX+gfGrowHiY);
End;
Procedure TToolBar.Draw;
Var
i,j: Integer;
Procedure ElDraw(Ax,Ay:Integer; An:Byte);
Procedure _1(x,y:Integer);
Begin
plotlIne (x,y+Sy Div 2,x+Sx,y+Sy Div 2);
End;
Procedure _2(x,y:Integer);
Begin
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy);
End;
Procedure _9(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx,y+sy Div 2);
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy);
End;
{ Procedure _3(x,y:Integer);
Begin
PlotLIne (x,y+Sy Div 2,x+Sx Div 5,y+Sy Div 2);
PlotLIne (x+Sx*4 Div 5,y+Sy Div 2,x+Sx,y+Sy Div 2);
ThickCircle(x+Sx Div 2,y+Sy Div 2,sx*2 Div 6,1);
PlotLIne (x+Sx Div 4,y+Sy Div 2,x+Sx*3 Div 4,y+Sy Div 2);
PlotLIne (x+Sx*3 Div 4,y+Sy Div 2,x+Sx Div 2,y+Sy*13 Div 20);
PlotLIne (x+Sx*3 Div 4,y+Sy Div 2,x+Sx Div 2,y+Sy*7 Div 20);
End;
Procedure _4(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx Div 5,y+sy Div 2);
PlotLIne (x+sx*4 Div 5,y+sy Div 2,x+sx,y+sy Div 2);
ThickCircle(x+sx Div 2,y+sy Div 2,sx*2 Div 6,1);
PlotLIne (x+sx Div 4,y+sy Div 2,x+sx*3 Div 4,y+sy Div 2);
PlotLIne (x+sx Div 4,y+sy Div 2,x+sx Div 2,y+sy*13 Div 20);
PlotLIne (x+sx Div 4,y+sy Div 2,x+sx Div 2,y+sy*7 Div 20);
End;
Procedure _5(x,y:Integer);
Begin
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy*2 Div 10);
PlotLIne (x+sx Div 2,y+sy*8 Div 10,x+sx Div 2,y+sy);
ThickCircle(x+sx Div 2,y+sy Div 2,sx*2 Div 6,1);
PlotLIne (x+sx Div 2,y+sy Div 4,x+sx Div 2,y+sy*3 Div 4);
PlotLIne (x+sx Div 2,y+sy Div 4,x+sx*13 Div 20,y+sy Div 2);
PlotLIne (x+sx Div 2,y+sy Div 4,x+sx*7 Div 20,y+sy Div 2);
End;
Procedure _6(x,y:Integer);
Begin
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy*2 Div 10);
PlotLIne (x+sx Div 2,y+sy*8 Div 10,x+sx Div 2,y+sy);
ThickCircle(x+sx Div 2,y+sy Div 2,sx*2 Div 6,1);
PlotLIne (x+sx Div 2,y+sy Div 4,x+sx Div 2,y+sy*3 Div 4);
PlotLIne (x+sx Div 2,y+sy*3 Div 4,x+sx*13 Div 20,y+sy Div 2);
PlotLIne (x+sx Div 2,y+sy*3 Div 4,x+sx*7 Div 20,y+sy Div 2);
End;}
Procedure _3(x,y:Integer);
Begin
PlotLIne (x,y+Sy Div 2,x+Sx*2 Div 5,y+Sy Div 2);
PlotLIne (x+Sx*3 Div 5,y+Sy Div 2,x+Sx,y+Sy Div 2);
PlotLIne (x+Sx*3 Div 5,y+Sy Div 8,x+Sx*3 Div 5,y+Sy*7 Div 8);
PlotLIne (x+Sx*2 Div 5,y+Sy Div 3,x+Sx*2 Div 5,y+Sy*2 Div 3);
End;
Procedure _4(x,y:Integer);
Begin
PlotLIne (x,y+Sy Div 2,x+Sx*2 Div 5,y+Sy Div 2);
PlotLIne (x+Sx*3 Div 5,y+Sy Div 2,x+Sx,y+Sy Div 2);
PlotLIne (x+Sx*2 Div 5,y+Sy Div 8,x+Sx*2 Div 5,y+Sy*7 Div 8);
PlotLIne (x+Sx*3 Div 5,y+Sy Div 3,x+Sx*3 Div 5,y+Sy*2 Div 3);
End;
Procedure _5(x,y:Integer);
Begin
PlotLIne (x+Sx Div 2,y,x+Sx Div 2,y+Sy*2 Div 5);
PlotLIne (x+Sx Div 2,y+Sy*3 Div 5,x+Sx Div 2,y+Sy);
PlotLIne (x+Sx Div 8,y+Sy*2 Div 5,x+Sx*7 Div 8,y+Sy*2 Div 5);
PlotLIne (x+Sx Div 3,y+Sy*3 Div 5,x+Sx*2 Div 3,y+Sy*3 Div 5);
End;
Procedure _6(x,y:Integer);
Begin
PlotLIne (x+Sx Div 2,y,x+Sx Div 2,y+Sy*2 Div 5);
PlotLIne (x+Sx Div 2,y+Sy*3 Div 5,x+Sx Div 2,y+Sy);
PlotLIne (x+Sx Div 8,y+Sy*3 Div 5,x+Sx*7 Div 8,y+Sy*3 Div 5);
PlotLIne (x+Sx Div 3,y+Sy*2 Div 5,x+Sx*2 Div 3,y+Sy*2 Div 5);
End;
Procedure _7(x,y:Integer);
Begin
PlotLIne(x,y+Sy Div 2,x+sx Div 5,y+Sy Div 2);
PlotLIne(x+sx*4 Div 5,y+Sy Div 2,x+sx,y+Sy Div 2);
PlotLIne(x+sx Div 5,y+Sy*12 Div 20,x+sx*4 Div 5,y+Sy*12 Div 20);
PlotLIne(x+sx*4 Div 5,y+Sy*12 Div 20,x+sx*4 Div 5,y+Sy*8 Div 20);
PlotLIne(x+sx*4 Div 5,y+Sy*8 Div 20,x+sx Div 5,y+Sy*8 Div 20);
PlotLIne(x+sx Div 5,y+Sy*8 Div 20,x+sx Div 5,y+Sy*12 Div 20);
End;
Procedure _8(x,y:Integer);
Begin
PlotLIne(x+Sx Div 2,y,x+Sx Div 2,y+Sy Div 5);
PlotLIne(x+Sx Div 2,y+Sy*4 Div 5,x+Sx Div 2,y+Sy);
PlotLIne(x+Sx*12 Div 20,y+Sy Div 5,x+Sx*12 Div 20,y+Sy*4 Div 5);
PlotLIne(x+Sx*12 Div 20,y+Sy*4 Div 5,x+Sx*8 Div 20,y+Sy*4 Div 5);
PlotLIne(x+Sx*8 Div 20,y+Sy*4 Div 5,x+Sx*8 Div 20,y+Sy Div 5);
PlotLIne(x+Sx*8 Div 20,y+Sy Div 5,x+Sx*12 Div 20,y+Sy Div 5);
End;
Procedure _0(x,y:Integer);
Begin
End;
Procedure _10(x,y:Integer);
Begin
PlotLIne(x+sx,y+sy Div 2,x+sx Div 2,y+sy Div 2);
PlotLIne(x+sx Div 2,y+sy Div 2,x+sx Div 2,y+sy);
End;
Procedure _11(x,y:Integer);
Begin
PlotLIne(x,y+sy Div 2,x+sx Div 2,y+sy Div 2);
PlotLIne(x+sx Div 2,y+sy Div 2,x+sx Div 2,y+sy);
End;
Procedure _12(x,y:Integer);
Begin
PlotLIne(x+sx Div 2,y,x+sx Div 2,y+sy Div 2);
PlotLIne(x+sx Div 2,y+sy Div 2,x+sx,y+sy Div 2);
End;
Procedure _13(x,y:Integer);
Begin
PlotLIne(x+sx Div 2,y,x+sx Div 2,y+sy Div 2);
PlotLIne(x+sx Div 2,y+sy Div 2,x,y+sy Div 2);
End;
Procedure _14(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx,y+sy Div 2);
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy);
FillCircle(x+sx Div 2,y+sy Div 2,2);
End;
Procedure _15(x,y:Integer);
Begin
PlotLIne (x+sx Div 2,y+sy Div 2,x+sx,y+sy Div 2);
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy);
FillCircle(x+sx Div 2,y+sy Div 2,2);
End;
Procedure _16(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx Div 2,y+sy Div 2);
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy);
FillCircle(x+sx Div 2,y+sy Div 2,2);
End;
Procedure _17(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx,y+sy Div 2);
PlotLIne (x+sx Div 2,y+sy Div 2,x+sx Div 2,y+sy);
FillCircle(x+sx Div 2,y+sy Div 2,2);
End;
Procedure _18(x,y:Integer);
Begin
PlotLIne (x,y+sy Div 2,x+sx,y+sy Div 2);
PlotLIne (x+sx Div 2,y,x+sx Div 2,y+sy Div 2);
FillCircle(x+sx Div 2,y+sy Div 2,2);
End;
Begin
If An=CurrentElement
Then
SetColOr(2)
Else
SetColOr(10);
FillRect(Ax,Ay,Sx,Sy);
SetColOr(4);
Case An Of
1:_1(Ax,Ay); 2:_2(Ax,Ay); 3:_3(Ax,Ay); 4:_4(Ax,Ay); 5:_5(Ax,Ay); 6:_6(Ax,Ay); 7:_7(Ax,Ay); 8:_8(Ax,Ay);
9:_9(Ax,Ay); 10:_10(Ax,Ay); 11:_11(Ax,Ay); 12:_12(Ax,Ay);
13:_13(Ax,Ay); 14:_14(Ax,Ay); 15:_15(Ax,Ay); 16:_16(Ax,Ay);
17:_17(Ax,Ay); 18:_18(Ax,Ay);
Else _0(Ax,Ay);
End;
End;
Begin
With Size Do
Begin
Sx:=x Div 3 - 2; Sy:=y Div 7 - 2;
End;
SetColOr(9);
FillRect(0,0,Size.X,(Sy+2)*6+CurrentFont^.Height+2);
SetColOr(4);
WriteStr((Size.X-14*CurrentFont^.Width) Div 2, 0, 'Меню элементов');
For i:=1 To 6 Do
For j:=1 To 3 Do
ElDraw((j-1)*(Sx+2),(i-1)*(Sy+2)+CurrentFont^.Height+2,(i-1)*3+j);
If CurrentElement=0
Then
SetColOr(2)
Else
SetColOr(10);
FillRect(0,(Sy+2)*6+CurrentFont^.Height+2,Size.X,Size.Y);
SetColOr(15);
WriteStr((Size.X-12*CurrentFont^.Width) Div 2,((Sy+2)*6+
CurrentFont^.Height Div 2 +2 + Size.Y) Div 2, 'Пустое место');
End;
Procedure TToolBar.HAndleEvent;
Var x,y:Integer;
Begin
Inherited HAndleEvent(Event);
If (Event.What=evMouseDown) And (Event.Buttons=mbLeftButton)
Then
Begin
x:=(Event.Where.X-CurrentFont^.Width-2) Div Sx;
y:=(Event.Where.Y-CurrentFont^.Height-2) Div Sy-1;
CurrentElement:=y*3+x+1;
If Event.Where.Y>Sy*7+CurrentFont^.Height+2
Then CurrentElement:=0;
DrawView;
ClearEvent(Event);
End;
End;
ConstructOr TShemeView.Init(Var R: TRect);
Begin
Inherited Init(R);
Font:=@Font8x8;
GrowMode:= GrowMode Or (gfGrowHiX+gfGrowHiY);
End;
Procedure TShemeView.Draw;
Const
Special:Integer=2;
Var
i,j: Integer;
c:Byte;
Procedure ElDraw(Ax,Ay:Integer; An,l:Byte);
Procedure _1(x,y:Integer);
Begin
plotlIne (x,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2);
End;
Procedure _2(x,y:Integer);
Begin
PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1);
End;
Procedure _9(x,y:Integer);
Begin
PlotLIne (x,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2);
PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1);
End;
{ Procedure _3(x,y:Integer);
Begin
PlotLIne (x,y+Sy1 Div 2,x+Sx1 Div 5+Special,y+Sy1 Div 2);
PlotLIne (x+Sx1*4 Div 5+Special,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2);
ThickCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,Sx1*2 Div 6,1);
PlotLIne (x+Sx1 Div 4+Special,y+Sy1 Div 2,x+Sx1*3 Div 4+Special,y+Sy1 Div 2);
PlotLIne (x+Sx1*3 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*12 Div 20);
PlotLIne (x+Sx1*3 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*8 Div 20);