Реферат: Математическое моделирование физических задач на ЭВМ 
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.
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.
|
