Математическое моделирование физических задач на ЭВМ

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

Страницы: 1, 2, 3, 4