program RS232; uses App, Objects, Menus, Drivers, Views, MsgBox, StdDlg, Memory, DOS; type TDialog = object (TApplication) Procedure InitStatusLine; Virtual; Procedure InitMenuBar; Virtual; Procedure HandleEvent(var Event: TEvent); Virtual; Procedure FileOpen; Procedure FileSave; Procedure ChangeDir; Procedure DOSCall; Procedure BeginPer; Procedure PerParam; end; const cm0 = 200; cm1 = 201; cm2 = 202; {-------------} Procedure TDialog.InitMenuBar; var R: TRect; begin GetExtent(R); R.B.Y := succ(R.A.Y); MenuBar := New(PMenuBar, Init(R, NewMenu( NewSubMenu('~F~/ Файл', hcNoContext, NewMenu( NewItem( '~1/ Открыть~','F3',kbF3,cmOpen,hcNoContext, NewItem( '~2/ Закрыть~','F2',kbF2,cmSave,hcNoContext, NewItem( '~3/ Сменить диск~','',0,cmChangeDir,hcNoContext, NewLine( NewItem( '~4/ Вызов ДОС~','',kbF4,cm0,hcNoContext, NewItem( '~5/ Выход~','Alt-X',kbAltX,cmQuit,hcNoContext, NIL))))) ) ), NewSubMenu('~P~/ Передача', hcNoContext, NewMenu( NewItem( '~1/ Начать~','',0,cm1,hcNoContext, NewLine( NewItem( '~2/ Параметры~','',0,cm2,hcNoContext, NIL))) ), NIL) )))) end; {-------------} Procedure TDialog.InitStatusLine; var R: TRect; begin GetExtent(R); R.A.Y := pred(R.B.Y); StatusLine := New(PStatusLine, Init(R, NewStatusDef(0, $FFFF, NewStatusKey('~Alt-X~ Выход из программы', kbAltX, cmQuit, NIL), NIL) )); end; {-------------} Procedure TDialog.HandleEvent(var Event: TEvent); begin Inherited HandleEvent(Event); if Event.What = evCommand then case Event.Command of cmOpen : FileOpen; cmSave : FileSave; cmChangeDir : ChangeDir; cm0 : DOSCall; cm1 : BeginPer; cm2 : perParam; else exit end; ClearEvent(Event) end; {-------------} Procedure TDialog.FileOpen; begin MessageBox('Открыть Файл',NIL,0) end; {-------------} Procedure TDialog.FileSave; begin MessageBox('Закрыть Файл',NIL,0) end; {-------------} Procedure TDialog.ChangeDir; begin MessageBox('Сменить каталог',NIL,0) end; {-------------} Procedure TDialog.DOSCall; const txt = ' Для возврата введите Exit'; begin DoneEvents; DoneVideo; DoneMemory; SetMemTop(HeapPtr); Writeln(txt); SwapVectors; Exec(GetEnv('COMSPEC'),''); SwapVectors; SetMemTop(HeapEnd); InitMemory; InitVideo; Initevents; InitSysError; Redraw; end; {-------------} Procedure TDialog.BeginPer; begin MessageBox('Начать передачу информации',NIL,0) end; {-------------} Procedure TDialog.PerParam; var Fi:file of integer; Skor, Bits, Parity:integer; nom, osh:integer; begin nom:=1; Assign(Fi,'d:\tp7\1.dat'); reset(Fi); while not EOF(Fi) and (nom<=6) MessageBox('Настройки параметров',NIL,0) end; {-------------} var N:TDialog; begin N.Init; N.Run; N.Done; end.