Модуль с библиотекой элементов
Поможем в ✍️ написании учебной работы
Поможем с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой

 

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.

 



Дата: 2019-05-29, просмотров: 167.