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]);