|
|
|
Математическое моделирование физических задач на ЭВМ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 (jNil 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); End; Procedure _4(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 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*12 Div 20); PlotLIne (x+Sx1 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*8 Div 20); End; Procedure _5(x,y:Integer); Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*3 Div 10); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*7 Div 10,x+Sx1 Div 2+Special,y+Sy1); ThickCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,Sx1*2 Div 6,1); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1 Div 2+Special,y+Sy1*5 Div 8); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1*12 Div 20+Special,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1*8 Div 20+Special,y+Sy1 Div 2); End; Procedure _6(x,y:Integer); Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*3 Div 10); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*7 Div 10,x+Sx1 Div 2+Special,y+Sy1); ThickCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,Sx1*2 Div 6,1); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1 Div 2+Special,y+Sy1*5 Div 8); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*5 Div 8,x+Sx1*12 Div 20+Special,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*5 Div 8,x+Sx1*8 Div 20+Special,y+Sy1 Div 2); End;} Procedure _3(x,y:Integer); Begin PlotLIne (x,y+Sy1 Div 2,x+Sx1*2 Div 5+Special,y+Sy1 Div 2); PlotLIne (x+Sx1*3 Div 5+Special,y+Sy1 Div 2,x+Sx1+Special,y+Sy1 Div 2); PlotLIne (x+Sx1*3 Div 5+Special,y+Sy1 Div 8,x+Sx1*3 Div 5+Special,y+Sy1*7 Div 8); PlotLIne (x+Sx1*2 Div 5+Special,y+Sy1 Div 3,x+Sx1*2 Div 5+Special,y+Sy1*2 Div 3); End; Procedure _4(x,y:Integer); Begin PlotLIne (x,y+Sy1 Div 2,x+Sx1*2 Div 5+Special,y+Sy1 Div 2); PlotLIne (x+Sx1*3 Div 5+Special,y+Sy1 Div 2,x+Sx1+Special,y+Sy1 Div 2); PlotLIne (x+Sx1*2 Div 5+Special,y+Sy1 Div 8,x+Sx1*2 Div 5+Special,y+Sy1*7 Div 8); PlotLIne (x+Sx1*3 Div 5+Special,y+Sy1 Div 3,x+Sx1*3 Div 5+Special,y+Sy1*2 Div 3); End; Procedure _5(x,y:Integer); Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*2 Div 5); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 5,x+Sx1 Div 2+Special,y+Sy1); PlotLIne (x+Sx1 Div 8+Special,y+Sy1*2 Div 5,x+Sx1*7 Div 8+Special,y+Sy1*2 Div 5); PlotLIne (x+Sx1 Div 3+Special,y+Sy1*3 Div 5,x+Sx1*2 Div 3+Special,y+Sy1*3 Div 5); End; Procedure _6(x,y:Integer); Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*2 Div 5); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 5,x+Sx1 Div 2+Special,y+Sy1); PlotLIne (x+Sx1 Div 8+Special,y+Sy1*3 Div 5,x+Sx1*7 Div 8+Special,y+Sy1*3 Div 5); PlotLIne (x+Sx1 Div 3+Special,y+Sy1*2 Div 5,x+Sx1*2 Div 3+Special,y+Sy1*2 Div 5); End; Procedure _7(x,y:Integer); Begin If IsResist Then 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); PlotLIne(x+Sx1 Div 5+Special,y+Sy1*12 Div 20,x+Sx1*4 Div 5+Special,y+Sy1*12 Div 20); PlotLIne(x+Sx1*4 Div 5+Special,y+Sy1*12 Div 20,x+Sx1*4 Div 5+Special,y+Sy1*8 Div 20); PlotLIne(x+Sx1*4 Div 5+Special,y+Sy1*8 Div 20,x+Sx1 Div 5+Special,y+Sy1*8 Div 20); PlotLIne(x+Sx1 Div 5+Special,y+Sy1*8 Div 20,x+Sx1 Div 5+Special,y+Sy1*12 Div 20); End Else If Currents[Sheme[i,j,2]]>0 Then 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); 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); End Else 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); PlotLIne (x+Sx1 Div 4+Special,y+Sy1 Div 2,x+Sx1*3 Div 4+Special,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*12 Div 20); PlotLIne (x+Sx1 Div 4+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1*8 Div 20); End; End; Procedure _8(x,y:Integer); Begin If IsResist Then Begin PlotLIne(x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1 Div 5); PlotLIne(x+Sx1 Div 2+Special,y+Sy1*4 Div 5,x+Sx1 Div 2+Special,y+Sy1); PlotLIne(x+Sx1*12 Div 20+Special,y+Sy1 Div 5,x+Sx1*12 Div 20+Special,y+Sy1*4 Div 5); PlotLIne(x+Sx1*12 Div 20+Special,y+Sy1*4 Div 5,x+Sx1*8 Div 20+Special,y+Sy1*4 Div 5); PlotLIne(x+Sx1*8 Div 20+Special,y+Sy1*4 Div 5,x+Sx1*8 Div 20+Special,y+Sy1 Div 5); PlotLIne(x+Sx1*8 Div 20+Special,y+Sy1 Div 5,x+Sx1*12 Div 20+Special,y+Sy1 Div 5); End Else If Currents[Sheme[i,j,2]]>0 Then Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*3 Div 10); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*7 Div 10,x+Sx1 Div 2+Special,y+Sy1); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1 Div 2+Special,y+Sy1*5 Div 8); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1*12 Div 20+Special,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1*8 Div 20+Special,y+Sy1 Div 2); End Else Begin PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1*3 Div 10); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*7 Div 10,x+Sx1 Div 2+Special,y+Sy1); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*3 Div 8,x+Sx1 Div 2+Special,y+Sy1*5 Div 8); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*5 Div 8,x+Sx1*12 Div 20+Special,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y+Sy1*5 Div 8,x+Sx1*8 Div 20+Special,y+Sy1 Div 2); End; End; Procedure _0(x,y:Integer); Begin End; Procedure _10(x,y:Integer); Begin PlotLIne(x+Sx1,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1 Div 2); PlotLIne(x+Sx1 Div 2+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1); End; Procedure _11(x,y:Integer); Begin PlotLIne(x,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1 Div 2); PlotLIne(x+Sx1 Div 2+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1); End; Procedure _12(x,y:Integer); Begin PlotLIne(x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1 Div 2); PlotLIne(x+Sx1 Div 2+Special,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2); End; Procedure _13(x,y:Integer); Begin PlotLIne(x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1 Div 2); PlotLIne(x,y+Sy1 Div 2,x+Sx1 Div 2+Special+1,y+Sy1 Div 2); End; Procedure _14(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); FillCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,3); End; Procedure _15(x,y:Integer); Begin PlotLIne (x+Sx1 Div 2+Special,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1); FillCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,3); End; Procedure _16(x,y:Integer); Begin PlotLIne (x,y+Sy1 Div 2,x+Sx1 Div 2,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y,x+Sx1 Div 2+Special,y+Sy1); FillCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,3); End; Procedure _17(x,y:Integer); Begin PlotLIne (x,y+Sy1 Div 2,x+Sx1,y+Sy1 Div 2); PlotLIne (x+Sx1 Div 2+Special,y+Sy1 Div 2,x+Sx1 Div 2+Special,y+Sy1); FillCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,3); End; Procedure _18(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 Div 2); FillCircle(x+Sx1 Div 2+Special,y+Sy1 Div 2,3); End; Begin Special:=Sx1 Div 10; SetColOr(l); FillRect(Ax,Ay,Sx1,Sy1); 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 C:= GetColOr(6); {Определение цвета нормального текста} SetColOr(C shr 4); With Size Do Begin FillRect(0, 0, Size.X, Size.Y); Sx1:=x Div mS; Sy1:=y Div nS; For i:=1 To nS Do For j:=1 To mS Do Begin ElDraw((j-1)*Sx1+(x-Sx1*mS) Div 2 ,(i-1)*Sy1+(y-Sy1*nS) Div 2,Sheme[i,j,1],((i+j) mod 2)+14); Case Sheme[i,j,1]Of 3,4,5,6:WriteStr((j-1)*Sx1+(x-Sx1*mS) Div 2 ,(i-1)*Sy1+(y-Sy1*nS) Div 2,'E'+IntToStr(Sheme[i,j,2])); 7,8: If IsResist Then WriteStr((j-1)*Sx1+(x-Sx1*mS) Div 2 ,(i-1)*Sy1+(y- Sy1*nS) Div 2,'R'+IntToStr(Sheme[i,j,2])) Else WriteStr((j-1)*Sx1+(x-Sx1*mS) Div 2 ,(i-1)*Sy1+(y- Sy1*nS) Div 2,'I'+IntToStr(Sheme[i,j,2])); End; {Of Case} End; { RestOreFont;} End; End; Procedure TShemeView.HAndleEvent; Var x,y:Integer; Begin Inherited HAndleEvent(Event); If (Event.What=evMouseDown) And (Event.Buttons=mbLeftButton) Then Begin x:=(Event.Where.X-Sx1*3 Div 8-(Size.X-Sx1*mS) Div 2) Div Sx1-3; y:=(Event.Where.Y-(Size.Y-Sy1*nS) Div 2) Div Sy1; Case Sheme[y,x,1] Of 3..6: EDS[y,x]:=0; 7..8: Res[y,x]:=0; End; Sheme[y,x,1]:=CurrentElement; Changed:=True; ElNumbers(Sheme); DrawView; Case CurrentElement Of 3..6: EDS[y,x]:=PShemeWIn(Owner)^.ElMatter(True); 7..8: Res[y,x]:=PShemeWIn(Owner)^.ElMatter(False); End; ClearEvent(Event); End; End; Function IntToStr(I: LongInt): String; { Convert any Integer Type To a String } Var S: String[11]; Begin Str(I, S); IntToStr:= S; End; Procedure ElNumbers(Var ASheme:TSheme); {Нумерует элементы схемы (ЭДС, резисторы и узловые элементы для служебных целей).Вызывается когда схема готова} Var i,j:Integer; nE,nR,nN:Byte; Begin nE:=0;nR:=0;nN:=0; For j:=1 To mS Do For i:=1 To nS Do Case ASheme[i,j,1] Of 3,4,5,6: Begin {ЭДС} Inc(nE); ASheme[i,j,2]:=nE; End; 7,8: Begin {резистор} Inc(nR); ASheme[i,j,2]:=nR; End; 14..18: Begin Inc(nN); ASheme[i,j,2]:=nN; Nodes[nN,1]:=i; Nodes[nN,2]:=j; End; End; {Of Case} ECount:=nE; RCount:=nR; NoDecount:=nN; End; ConstructOr TShemeWIn.Init; Begin Inherited Init(R, 'Схема без имени'); SetPhase:=True; Exist:=True; Options:= Options Or OfCentered; DragMode:=0; Palette:= wpCyanWInDow; GeTextentWIn(R); R.B.X:=R.A.X+(R.B.X-R.A.X) Div 4; Insert(New(PToolBar, Init(R))); GeTextentWIn(R); R.A.X:=(R.B.X-R.A.X) Div 4; Insert(New(PShemeView, Init(R))); HelpCtx:= hcGraphic; End; Function TShemeWIn.ElMatter; Var R:TRect; M:Real; c:wOrd; i:Integer; D:PDialog; L:PInputLIne; s:String; Begin M:=0; GeTextentWIn(R); R.B.X:=R.A.X+(R.B.X-R.A.X) Div 4; Inc(R.A.Y,CurrentFont^.Height*5); Dec(R.B.Y,CurrentFont^.Height*10); If IsEDS Then s:='Напряжение' Else s:='Сопртивление'; D:=New(PDialog,Init(R,s)); Inc(R.A.Y,CurrentFont^.Height*3); Inc(R.A.X,CurrentFont^.Width*5); Dec(R.B.X,CurrentFont^.Width*5); R.B.Y:=R.A.Y+CurrentFont^.Height*1; L:=New(PInputLIne,Init(R,10)); If D<>Nil Then Begin D^.GeTextentWIn(R); Inc(R.A.Y,CurrentFont^.Height Div 2); Inc(R.A.X,CurrentFont^.Width); Dec(R.B.X,CurrentFont^.Width*4); R.B.Y:=R.A.Y+CurrentFont^.Height; L:=New(PInputLIne,Init(R,10)); R.A.X:=R.B.X+CurrentFont^.Width; R.B.X:=R.A.X+CurrentFont^.Width*3; If IsEDS Then s:='В' Else s:='Ом'; D^.Insert(New(PStaticText,Init(R,s))); D^.GeTextentWIn(R); R.Move(CurrentFont^.Width*2,CurrentFont^.Height*2); R.B.Y:=R.A.Y+CurrentFont^.Height; R.B.X:=R.A.X+CurrentFont^.Width*15; D^.Insert(New(PButton,Init(R,'O~k~',cmOk,bfDefault))); If L<>Nil Then D^.Insert(L); c:=DeskTop^.ExecView(D); If c<>cmCancel Then Begin If L<>Nil Then Begin L^.GetData(s); Dispose(L,Done); End; i:=0; val(s,M,i); End; If D<>Nil Then Dispose(D,Done); End; ElMatter:=M; End; DestructOr TShemeWIn.Done; Begin Inherited Done; Exist:=False; End; END. 3. Модуль вычисления токов ветвей Unit Applic1; {$F+,O+,X+,V-,R-,I-,S-} Interface Uses Crt, Objects, Drivers, Dialogs, Views, Menus, App, StdDlg, Fonts, HelpFile, MsgBox, TxtRead, WInDows, PalObj, Grv16, DemoHlp, Types2; Const cmAbout = 100; cmReCounte = 101; cmTxtWInDow = 102; cmDialog = 103; cmDemOfonts = 104; cmDemoPic = 105; cmWInWIn = 106; cmCur = 107; cmRes = 108; cmIdle = 6000; HelpName:String ='Sheme.hlp'; Var ValDel: LongInt; Ticks: WOrd absolute $40:$6C; { BIOS Timer ticks counter } Type TMyApp = Object(TApplication) MemoAvail: LongInt; {Свободная мем} ShemeWInDow: PShemeWIn; {Окно} ShemeName: String; {Имя схемы} ConstructOr Init; {Добавление нового } Procedure HAndleEvent(Var Event: TEvent); Virtual; Procedure InitMenuBar; Virtual; Procedure InitStatusLIne; Virtual; Procedure ReCounte; Virtual; Procedure About; Procedure HlpWInDow; Procedure NewSheme; Procedure OpenSheme; Procedure SaveSheme; Procedure SaveShemeAs; Procedure Idle; Virtual; {Обновление показ. памяти} End; Implementation ConstructOr TMyApp.Init; Var R: TRect; Begin Inherited Init; InitSheme(Sheme); ShemeName:=''; Changed:=False; StatusLIne^.GetBounds(R); R.A.X:= R.B.X - 65; Insert(New(PMemoView, Init(R))); MemoAvail:= MemAvail; ValDel:= Ticks; DeskTop^.GeTextent(R); ShemeWInDow:=New(PShemeWIn,Init(R)); DeskTop^.Insert(ShemeWInDow); DisableCommAnds([cmRes]); EnableCommAnds([cmCur]); End; Procedure TMyApp.Idle; Function IsTileable(P: PView): Boolean; Begin IsTileable:= (P^.Options And OfTileable) <> 0; End; Begin Inherited Idle; Message(@Self, evBroadCast, cmIdle, Nil); If MemoAvail <> MemAvail Then Begin Message(@Self, evBroadCast, cmMemoViewChange, Nil); MemoAvail:= MemAvail; End; If Desktop^.FirstThat(@IsTileable) <> Nil Then EnableCommAnds([cmTile, cmCascade]) Else DisableCommAnds([cmTile, cmCascade]); End; Procedure TMyApp.InitMenuBar; Var R: TRect; Begin GeTextent (R); R.B.Y:= R.A.Y + CurrentFont^.Height + 1; MenuBar:= New(PMenuBar, Init(R, NewMenu( NewItem('~Ё~', '', kbAltSpace, cmAbout, hcMenu10, NewSubMenu('~Ф~айл', hcMenu20, NewMenu( NewItem('~Н~овая схема', '', kbNoKey, cmNew, hcNoConText, NewItem('~Ч~итать схему с диска', 'F3', kbF3, cmOpen, hcNoConText, NewItem('~C~охранить схему', 'F2', kbF2, cmSave, hcNoConText, NewItem('Cохранить ~к~ак...', 'ShIft-F2', kbShIftF2, cmSaveAs, hcNoConText, NewLIne( NewItem('~В~ыход', 'Alt-X', kbAltX, cmQuit, hcNoConText, Nil))))))), NewSubMenu('~О~кно', hcMenu30, NewMenu( NewItem('~С~ледующее', 'F6', kbF6, cmNext, hcNoConText, NewItem('~П~редыдущее', 'F5', kbF5, cmPrev, hcNoConText, NewItem('~З~акрыть', 'AltF3', kbAltF3, cmClose, hcNoConText, Nil)))), Nil) ))))); MenuBar^.State:= MenuBar^.State Or sfActive; End; Procedure TMyApp.InitStatusLIne; Var R: TRect; Begin GeTextent(R); R.A.Y:= R.B.Y - 19; SetFont(@Font8x14); StatusLIne:= New(PStatusLIne, Init(R, NewStatusDef(0, $0FFF, NewStatusKey('', kbAltF3, cmClose, NewStatusKey('~F1~ Помощь', kbF1, cmHelp, NewStatusKey('', kbF10, cmMenu, NewStatusKey('~Alt-X~ Выход', kbAltX, cmQuit, NewStatusKey('~F7~Токи', kbF7, cmCur, NewStatusKey('~F8~Резисторы', kbF8, cmRes, NewStatusKey('~F9~ Обсчет', kbF9, cmReCounte, Nil))))))), NewStatusDef($1000, $1001, NewStatusKey('~Ctrl-'#24#25#26#27'~ Перемещение', kbNoKey, cmNo, NewStatusKey('~Shft-'#24#25#26#27'~ Размер', kbNoKey, cmNo, NewStatusKey('~'#17#217'~ Подтвердить', kbNoKey, cmNo, NewStatusKey('~Esc~ Отменить', kbNoKey, cmNo, Nil)))), NewStatusDef($FFFE, $FFFF, NewStatusKey('', kbAltF3, cmClose, NewStatusKey('~Tab~ След. индекс', kbTab, cmNextTopic, NewStatusKey('~ShIft-Tab~ Пред. индекс', kbShIftTab, cmPrevTopic, NewStatusKey('~Esc~ Закрыть', kbEsc, cmClose, Nil)))), Nil))) )); RestOreFont; End; Procedure TMyApp.HAndleEvent(Var Event: TEvent); Var R: TRect; P: PView; Control: WOrd; SavePalette: PaletteType; Begin Inherited HAndleEvent(Event); If Event.What = evCommAnd Then Begin Case Event.CommAnd Of cmNew : NewSheme; cmOpen : OpenSheme; cmSave : If ShemeName='' Then SaveShemeAs Else SaveSheme; cmSaveAs : SaveShemeAs; cmReCounte : ReCounte; cmAbout : About; cmHelp : HlpWInDow; cmCur : Begin IsResist:=False; DisableCommAnds([cmCur]); EnableCommAnds([cmRes]); ShemeWInDow^.DrawView; End; cmRes : Begin IsResist:=True; DisableCommAnds([cmRes]); EnableCommAnds([cmCur]); ShemeWInDow^.DrawView; End; Else Exit; End; ClearEvent(Event); End; End; Procedure TMyApp.OpenSheme; Var D: PFileDialog; FileName: String[79]; i,j:Integer; f:Text; c:wOrd; Begin If Not Exist Then NewSheme; D:= PFileDialog(ValidView(New(PFileDialog, Init('*.shm', 'Выбор файла', '~И~мя файла со схемой', fDopenButton, 100)))); If D <> Nil Then Begin c:=Desktop^.ExecView(D); If c <> cmCancel Then Begin D^.GetFileName(FileName); Assign(f,FileName); reset(f); For i:=1 To nS Do Begin For j:=1 To mS Do Read (f,Sheme[i,j,1]); Readln(f); End; For i:=1 To nS Do Begin For j:=1 To mS Do Read(f,EDS[i,j]); Readln(f); End; For i:=1 To nS Do Begin For j:=1 To mS Do Read(f,Res[i,j]); Readln(f); End; Close(f); ShemeName:=FileName; DisposeStr(ShemeWInDow^.Title); ShemeWInDow^.Title:=NewStr('Схема '+ShemeName); ElNumbers(Sheme); ShemeWInDow^.DrawView; End; Dispose(D, Done); End; End; Procedure TMyApp.SaveSheme; Var f:Text; i,j:Integer; Begin Assign (f,ShemeName); ReWrite (f); For i:=1 To nS Do Begin For j:=1 To mS Do Write(f,Sheme[i,j,1]:4); Writeln(f); End; For i:=1 To nS Do Begin For j:=1 To mS Do Write(f,EDS[i,j]:5:2,' '); Writeln(f); End; For i:=1 To nS Do Begin For j:=1 To mS Do Write(f,Res[i,j]:5:2,' '); Writeln(f); End; Close(f); End; Procedure TMyApp.SaveShemeAs; Var D: PFileDialog; FileName: String[79]; W: PWInDow; C:wOrd; Begin D:= New(PFileDialog, Init('*.SHM', 'Выбор файла', ShemeName, fDokButton, 100)); C:= Desktop^.ExecView(D); D^.GetFileName(ShemeName); Dispose(D, Done); If ShemeName='' Then exit; SaveSheme; ShemeWInDow^.Title:=NewStr('Схема '+ShemeName); ShemeWInDow^.DrawView; End; Procedure TMyApp.HlpWInDow; Var W: PWInDow; Begin W:= PWInDow(ValidView(New(PFileWInDow,Init(HelpName)))); W^.HelpCtx:= hcMenu30; If W <> Nil Then Desktop^.Insert(W); End; Procedure TMyApp.NewSheme; Var R:TRect; c:wOrd; Begin If Exist And Changed Then Begin R.Assign((Size.X-CurrentFont^.Width*50) Div 2,(Size.Y- CurrentFont^.Height*10) Div 2, (Size.X+CurrentFont^.Width*50) Div 2,(Size.Y+ CurrentFont^.Height*10) Div 2); c:=MessageBoxRect(R, 'В текущую схему внесены изменения с момента последнего '+ 'сохранения, которые будут потеряны. Хотите ли Вы сохранить текущую '+ 'схему?',Nil,mfYesNoCancel+mfConfirmation); Case c Of cmYes:If ShemeName<>'' Then SaveSheme Else SaveShemeAs; cmCancel:Exit; End; End; If Not Exist Then Begin DeskTop^.GeTextent(R); ShemeWInDow:=New(PShemeWIn,Init(R)); DeskTop^.Insert(ShemeWInDow);End; ShemeName:=''; DisposeStr(ShemeWInDow^.Title); ShemeWInDow^.Title:=NewStr('Схема без имени'); Changed:=False; InitSheme(Sheme); ShemeWInDow^.DrawView; End; Procedure TMyApp.About; Begin MessageBox('Обсчет разветвленных цепей. Ver.1.0.',Nil, mfInFormation+mfOkButton); End; Procedure TMyApp.ReCounte; Begin Abstract;{This method must be overriden} End; END. ----------------------- E1 R1 E2 R2 R4 R6 R5 E3 R3 E1 R1 E2 R2 R4 R6 ?????????? R5 E3 R3 |
|
|||||||||||||||||||||||||||||
 |
|||||||||||||||||||||||||||||||
|
|||||
Рефераты бесплатно, реферат бесплатно, рефераты на тему, сочинения, курсовые работы, реферат, доклады, рефераты, рефераты скачать, курсовые, дипломы, научные работы и многое другое. |
||
При использовании материалов - ссылка на сайт обязательна. |
||
