Меню


Стандартная программа содержит поле MenuBar типа ТМепиВаr. По умолчанию Метод TApplicatlon.InitMenuBar устанавливает это поле в NIL, что означает отказ от меню. Если Вы хотите использовать меню в Вашей программе, необходимо перекрыть этот метод. В следующем примере создается двухуровневое меню, показанное на   1.
Опцию «Подменю...» можно выбрать следующими способами:

  • нажатием клавиш F10 - <смещение указателя> - Enter;
  • командой Alt-S;
  • отметкой мышью.

Опции «Первый выбор» и «Второй выбор» можно выбрать клавишами F1 и F2 без развертывания подменю. После развертывания подменю можно использовать те же клавиши, а также использовать клавиши с цифрами 1 и 2, отметку мышью или смещение указателя к нужной опции и Enter. Опция «Третий выбор» доступна только после развертывания подменю. Выбор каждой из этих трех опций приводит к появлению на экране окна с сообщением. Кроме того, опция «Третий выбор» попеременно запреща-ет или разрешает действие команд cm1, cm2 и cmQuit.
{$X+}
Uses Objects,App,Menus,Drivers,Views,MsgBox; 
type
MyApp = object (TApplication) 
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(var Event: TEvent); Virtual; 
end;
const
cm1 = 201; 
cm2 = 202; 
cm3 = 203;
{----------------}
Procedure MyApp. InitMenuBar; 
var
R: TRect; 
begin
GetExtent (R) ;
R.B.Y := succ(R.A.Y) ;
MenuBar := New ( PMenuBar , Init(R,
NewMenu ( {Главная полоса меню}
NewSubMenu ( {Первый элемент главного меню}
' ~S~ Подменю. ..', hcNoContext,
NewMenu ( {Определить выпадающее подменю}
NewItem( '~1~ Первый выбор ' , ' F1 ' , kbF1, cm1, 0,
NewItem('~2~ Второй выбор' , ' F2 ' , kbF2, cm2, 0,
NewLine( {Определить разделяющую линию}
NewItem('~3~ Третий выбор' , ' ' , 0, cm3, 0,
NIL) ) ) ) ) ,
NewItem( {Второй элемент главного меню}
'-ESO Выход' , '~ESC~' , kbEsc,cmQuit, 0, NIL))))); end {MyApp. InitMenuBar} ;
{------------------}
Procedure MyApp . HandleEvent ; 
const
Flag: Boolean = True; 
cms = [cm1, cm2, cmQuit] ; 
begin
Inherited HandleEvent (Event) ; 
case Event . Command of
cm1: MessageBox (#3 'Первый выбор', NIL,0); 
cm2 : MessageBox (#3 'Второй выбор', NIL,0); 
cm3 : 
begin
MessageBox (#3' Третий выбор', NIL,0); 
if Flag then
DisableCommands (cms) 
else
EnableCommands (cms) ; 
Flag := not Flag 
end 
end 
end {MyApp .HandleEvent } ;
{------------------}
var
P: MyApp;
begin
P.Init; 
P.Run; 
P.Done 
end.
Диалоговое окно
На  2 показан вид диалогового окна, которое создается и используется в рассматриваемом ниже примере.
Если диалог завершен командой «Установить», на экране разворачивается окно, в котором сообщаются полученные из диалогового окна параметры - текст из строки ввода и настройка кнопок. Если диалог завершен командой «Не изменять», окно сообщений содержит строку
Команда 'Не изменять',
если диалог завершен по клавише Esc, на экран не выводится никаких сообщений.
Пример иллюстрирует использование строки ввода, зависимых и независимых кнопок и нестандартных команд.
Для задания начальных параметров и чтения параметров, установленных в результате диалога, используется поле TDialog.Data. Это поле содержит данные, используемые в ходе диалога, в виде записи, поля и тип которой строго соответствуют порядку и типу вставляемых в окно терминальных элементов. В нашем примере (см. текст программы) первым в окно вставляется статический текст, однако этот терминальный элемент не имеет параметров, которые можно было бы изменить в ходе диалога, поэтому в записи Data ему не отводится место. Второй по счету в окно вставляется строка ввода TInputLine. Этот объект характеризуется длиной L строки, указываемой вторым параметром обращения к TInputLine.Init, поэтому для него в Data выделяется поле, длинойL+1 байт. Каждому кластеру с кнопками выделяется поле WORD, что дает возможность задать в кластере до 16 независимых кнопок и до 65536 зависимых: каждая независимая кнопка связана с соответствующим разрядом 16-битного поля (первая кнопка - с младшим разрядом), а каждой зависимой кнопке соответствует свое число (первой кнопке соответствует число 0, второй - 1 и т.д.). Установка данных в поле TDialog.Data осуществляется методом TDialog.SetData, получить данные после диалога можно с помощью метода TDialog.GetData.
{$Х+}
Uses Objects , App , Drivers , Dialogs,Menus,Views,MsgBox ; 
type
MyApp = object (TApplication)
Procedure InitStatusLine; Virtual; 
Procedure HandleEvent (var Event: Tevent) ; Virtual; 
Procedure GetDialog; 
end;
PMyDialog = TMyDialog; 
TMyDialog = object (TDialog)
Procedure HandleEvent (var Event: Tevent); Virtual; 
end; 
const
cm0 = 200; 
cm1 = 201; 
cm2 = 202;
{-------------------}
Procedure MyApp.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,
NewStatusKey ( ' ~F1~ Вызов окна', kbF1,cm0, NIL)),
NIL) ) ) 
end {MyApp.InitStatusLine} ;
{-----------------}
Procedure MyApp.HandleEvent; 
{Обрабатывает нестандартную команду cm0} 
begin
Inherited HandleEvent (Event) ;
case Event . Command of 
cm0 : GetDialog
else
ClearEvent (Event)
end 
end {MyApp . HandleEvent} ;
{------------------}
Procedure MyApp.GetDialog;
{Создает и использует диалоговое окно} 
var
R: TRect; {Координаты элементов} 
D: PMyDialog; {Диалоговое окно} 
I: PInputLine; {Строка ввода} 
RB: PRadioButtons; {Зависимые кнопки} 
СВ: PCheckBoxes; {Независимые кнопки} 
s : String; {Для вывода сообщения} 
const
L = 120; {Длина строки ввода} 
type
TDialogData = record {Параметры диалогового окна} 
I_Data: String [L]; {Текст в строке ввода} 
CB_data: Word; {Независимые кнопки} 
RB_Data: Word {Зависимые кнопки} 
end; 
const
st: array [0..2] of String = ('Первое','Второе','Третье '); 
Data : TDialogData =( {Начальные параметры диалога} 
I_Data : 'Начальный текст';
CB_Data: 3; {1-я и 2-я кнопка} 
RB_Data: 2); {3-е продолжение} 
begin
R.Assign(5,3,75,18); {Координаты диалогов ого окна} 
D := New(PMyDialog,Init(R,'Пример диалогового окна')); 
with D do 
begin
R.Assign(1,1,69,3);
Insert(New(PStaticText, {Вставляем статический текст} 
Init(R,#3'Это статический текст'))); 
R.Assign(20,3,60,4) ; 
I := New(PInputLine, Init(R, L)); 
Insert (I); {Вставляем строку ввода} 
R.Assign(1,3,20,4);
Insert(New(PLabel, {Вставляем метку строки ввода} 
Init(R,'~l~ Строка ввода:',I)));
R.Assign(60,3,62,4);
Insert(New(PHistory, {Вставляем список ввода} 
Init(R,I,0))) ; 
R.Assign(10,6,30,9) ; 
CB := New (PCheckBoxes, Init(R, 
NewSItem('Первая кнопка', 
NewSItem('Вторая кнопка',
NewSItem('Третья кнопка', NIL)))));
Insert(CB); {Вставляем независимые кнопки} 
R.Assign(6,5,30,6);
Insert(New(PLabel, {Вставляем метку кнопок} 
Init(R,'~2~ Независимые кнопки',CB)));
R.Assign(40,6,63,9); 
RB := New(PRadioButtons, Init(R, 
NewSItem('Первое продолжение', 
NewSItem('Второе продолжение', 
NewSItem('Третье продолжение', NIL))))); 
Insert(RB); {Вставляем зависимые кнопки} 
R.Assign(36,5,63,6) ;
Insert(New(PLabel, {Вставляем метку кнопок} 
Init(R,'~3~ Зависимые кнопки',RB))); 
R.Assign(14,11,32,13) ;
Insert(New(PButton, {Вставляем кнопку "Установить"} 
Init(R,'~4~ Установить',cm1,bfNormal))); 
R.Assign(40,11,58,13);
Insert (New(PButton, {Вставляем кнопку "Не изменять"} 
Init(R,'~5~ He изменять',cm2,bfNormal))); 
SetData(Data) {Устанавливаем начальные значения} 
end;
{Помещаем окно на экран и получаем команду завершения} 
case DeskTop.ExecView(D) of 
cm1:
begin {Была команда "Установить":} 
D.GetData(Data); {Получаем новые значения} 
with Data do
begin {Готовим сообщение} 
s := #3'Параметры диалогового окна:'+
#13'Текст :'+I_Data+#13'Кнопки: '; 
if CB_Data and 1 <> 0 then
s := s+' Первая'; 
if CB_Data and 2 <> 0 then
s := s+' Вторая'; 
if CB_Data and 4 <> 0 then
s := s+' Третья';
s :=s+#13'Продолжение: '+st[RB_Data] 
end 
end ;
cm2: s := #3'Команда "Не изменять"'; 
else
s := ' ' ; 
end; {case} 
if s <> '' then
MessageBox(s,NIL,0) 
end {MyApp.GetDialog};
{--------------}
Procedure TMyDialog.HandleEvent; 
{Обрабатывает нестандартные команды cm1 и cm2} 
begin
Inherited HandleEvent(Event);
if Event.What = evCommand then 

case Event.Command of
cm1:EndModal (cm1);{Завершить с командой cm1}
cm2:EndModal (cm2){Завершить с командой cm2}
end;
ClearEvent (Event) {Очистить другие события} 
end {TMyDialog.HandleEvent} ;
{---------------}
var
P: MyApp; 
begin
P.Init;
P. Run;
P . Done
end.
Для использования нестандартных команд cm0, cm1 и cm2 перекрываются обработчики событий строки статуса и диалогового окна. Чтобы завершить диалог с выдачей нестандартной команды, в обработчике событий окна вызывается метод EndModal, в результате чего метод ExecView возвращает значение соответствующей команды. Заметим, что стандартная для Turbo Vision команда cmCancel (закрыть окно по клавише Esc) обрабатывается стандартным методом TDlalog.HandleEvent.
 
Окно с текстом
В следующей программе на экране создается несколько окон, содержащих один и тот же текст - текст программы (см.   3).
Каждое новое окно открывается с помощью клавиши Ins. Активное окно можно удалить клавишей Del или распахнуть на весь экран клавишей F5. С помощью мыши Вы можете перемещать активное окно по экрану и/или изменять его размеры.
Uses Objects,App,Views,Drivers,Menus; 
const
cmNewWin = 200;
cmDelWin = 201;
MaxLine = 22; {Количество текстовых строк} 
var
Lines: array [0.. MaxLine] of String [80]; 
type
MyApp = object (TApplication)
WinNo : Word;
Constructor Init;
Procedure InitStatusLine; Virtual;
Procedure HandleEvent (var Event: Tevent) ; Virtual;
Procedure NewWindow; 
end;
PInterior = Tinterior; 
TInterior = object (TView)
Constructor Init(R: TRect);
Procedure Draw; Virtual; 
end ;
{----------------}
Constructor MyApp. Init;
{Открывает и читает файл с текстом программы}
var
f: text;
s: String;
k: Integer; 
begin
Inherited Init;
WinNo := 0 ; {Готовим номер окна }
for К := 0 to MaxLine do
Lines [k] := ' ' ; {Готовим массив строк}
s := copy(ParamStr(0),1,pos ('.',ParamStr(0)))+'PAS';
{$I-}
Assign (f,s) ; 
Reset (f); 
if IOResult <> 0 then
exit; {Файл нельзя открыть} 
for k := 0 to MaxLine do
if not EOF(f) then ReadLn(f, Lines [k] ); 
Close(f) 
{$I+} 
end {MyApp.Init} ;
{----------------}
Procedure MyApp. 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,
NewStatusKey ( ' ~Ins~ Открыть новое' , kbIns, cmNewWin, 
NewStatusKey (' ~Del~ Удалить активное' , kbDel, cmClose, 
NewStatusKey (' ~F5~ Распахнуть ', kbF5, cmZoom, NIL)))), NIL))) 
end {MyApp. InitStatusLine} ;
{---------------------}
Procedure MyApp. HandleEvent;
{Обработка нестандартных команд cmNewWin, cmDelWin}
begin
Inherited HandleEvent (Event) ; 
case Event. Command of 
cmNewWin: 
begin
ClearEvent (Event) ; 
NewWindow; 
end ;
cmDelWin: Event . Command := cmClose; 
end;
ClearEvent(Event) 
end {MyApp.HandleEvent } ;
{-------------------}
Procedure MyApp.NewWindow ; 
{Открывает новое окно} 
var 
R: TRect;
W: PWindow; 
begin
Inc(WinNo); {Номер окна} 
{Задаем случайные размеры и положение окна : }
R. Assign (0, 0,24+Random(10) ,7+Random(5) ) ;
R. Move (Random ( 80 -R. В. X) ,Random(24-R.B.Y) ) ;
W := New (PWindow, Init (R, ' ' ,WinNo) ) ;
W^.GetClipRect (R) ; {Получаем в R границы окна}
R.Grow( - 1, -1) ; {Размер внутренней части окна} 
{Инициируем просмотр текста : }
W. Insert (New (PInterior, Init(R)));
DeskTop . insert (W) ; {Помещаем окно на экран} 
end {MyApp.NewWindow} ;
{-------------------}
Constructor TInterior.Init; 
{Инициация просмотра текста во внутренней части окна} 
begin 
Inherited Init (R) ;
GrowMode := gfGrowHiX+gfGrowHiY 
end {Tinterior.Init} ;
{-----------}
Procedure TInterior. Draw; 
{Вывод текста в окне} 
var
k: Integer; 
В: TDrawBuffer; 
begin
for k := 0 to pred(Size.Y) do 
begin
MoveChar(B,' ',GetColor(1),Size.X); 
MoveStr(B, copy(Lines[k],1,Size.X),GetColor(1)); 
WriteLine(0,k,Size.X,1,B) 
end
end {TInterior.Draw}; 
{-------------------}
var
P: MyApp; 
begin 
P.Init; 
P.Run; 
P.Done 
end.
В программе объявляется тип TInterior, предназначенный для создания изображения во внутренней части окон. Его метод Init определяет способ связи объекта TInterior со стандартным объектом TWindow: оператор
GrowMode := gfGrowHiX+gfGrowHiY
задает автоматическое изменение размеров объекта TInterior при изменении размеров окна так, чтобы вся внутренняя часть окна была всегда заполнена текстом. Метод TInterior.Draw заполняет внутреннюю часть окон текстовыми строками, которые в ходе выполнения конструктора TMyApp.Init предварительно считываются из файла с исходным текстом программы в глобальный массив Lines. Для вывода текста сначала с помощью метода MoveChar буферная переменная В типа TDrawBuffer заполняется пробелами, затем методом MoveStr в нее копируется нужный текст, а с помощью WriteLine содержимое переменной В помещается в видеопамять. Такая последовательность действий стандартна для вывода текстовых сообщений в Turbo Vision. Заметим, что функция GetColor (1) возвращает номер элемента палитры, связанный с обычным текстом; для выделения тестовых строк можно использовать вызов GetColor (2).
Окно со скроллером
Скроллером называется специальное окно, обеспечивающее просмотр (скроллинг) текста. Типичный скроллер - это окно редактора интегрированной среды системы Турбо Паскаля; его поведение Вам, очевидно, хорошо знакомо. Средства Turbo Vision обеспечивают стандартные функции скроллера для окна, создаваемого в приводимой даже программе. В частности, это окно (см.  4) управляется мышью, реагирует на клавиши смещения курсора, оно может изменять размеры и свое положение на экране, его можно «распахнуть» на весь экран.
Uses Objects,App,Drivers,Menus,Views; var
Lines: PCollection; {Коллекция для хранения текстовых строк}
type
ТМуАрр = object (TApplication)
Procedure Run; Virtual; 
end;
PInterior =TInterior;
TInterior = object (TScroller)
Constructor Init(R: TRect; SX,SY: PScrollBar);
Procedure Draw; Virtual; 
end;
Procedure TMyApp.Run;
{Читает строки из, текстового файла и обеспечивает их просмотр}
var
R: TRect;
W: PWindow;
s,name: String;
f: text; 
begin
{Получаем в NAME имя файла с текстом программы:}
name := copy(ParamStr(0),1,pos('.',Paramstr(0)))+'PAS';
{Создаем коллекцию текстовых строк:}
Lines := New(PCollection, Init(10,5));
assign(f,name);
{$I-}
reset (f);
{$I+}
if IOResult = 0 then
begin {Файл успешно открыт} 
with Lines do while not EOF(f) do
begin
ReadLn ( f , s ) ; 
Insert (NewStr (s) ) 
end;
Close (f) 
end 
else {Файл не был открыт}
Lines . Insert (NewStr (' Нет доступа к файлу '+name)); 
{Создаем окно со скроллером: } 
DeskTop.GetExtent (R) ;
W := New (PWindow, Init (R, 'Просмотр файла '+name,0)); 
with W do 
begin
GetClipRect(R) ; 
R.Grow(-1, -1) ;
Insert (New (PInterior , Init (R, StandardScrollBar ( 
sbHorizontal+ sbHandleKeyboard) , 
StandardScrollBar (sbvertical+sbHandleKeyboard) ) ) ) 
end ;
DeskTop . Insert (W) ; 
{Ждем действий пользователя:} 
Inherited Run end {TMyApp.Run} ;
{----------------}
Constructor TInterior.Init; 
{Создает окно скроллера} 
begin
Inherited Init (R, SX, SY) ;
GrowMode := gfGrowHiX+gfGrowHiY;
SetLimit(128, Lines .count- 1) 
end {TInterior.Init};
{----------------}
Procedure TInterior.Draw;
{Выводит на экран содержимое окна скроллера}
var
Y: Integer; 
В: TDrawBuffer; 
S: String; 
begin
for Y := 0 to pred(Size.Y) do 
begin
MoveChar(B,' ' ,GetColor (1) , Size.X) ; 
if (Y+Delta.Y < Lines. Count) and
(Lines. At (Y+Delta.Y) <> NIL) then 
begin
S := PString (Lines. At (Y+Delta.Y) ); 
MoveStr (В, copy (s, Delta. X+1, Length (s) -
Delta. X), GetColor(1) ) 
end;
WriteLine(0,Y,Size.X,1,B) 
end 
end {TInterior.Draw} ;
{----------}
var
P : TMyApp ; 
begin
P.Init;
P. Run;
P. Done 
end.
В программе перекрывается метод TApplication.Run. В потомке TMyApp этот метод вначале считывает текстовые строки из файла с текстом программы в коллекцию Lines и создает на экране окно со скроллером. После этого вызывается стандартный метод TApplication.Run.
Метод TInterior.Draw обеспечивает вывод нужных строк в окно скроллера. Для определения порядкового номера выводимых строк и их положения относительно границ скроллера используется поле TScroller.Delta. Обратите внимание: если в коллекцию помещается «пустая» строка, т.е. строка нулевой длины, глобальная функция NewStr возвращает значение NIL. В методе TInterior.Draw оператор
if (Y+Delta.Y < Lines. count) and 
(Lines.At(Y+Delta.Y) <> NIL) then ...
осуществляет проверку значения получаемого из коллекции указателя на NIL; если бы мы не предусмотрели эту проверку, прогон программы (использование NIL-указателя) на некоторых ПК мог бы привести к аварийному останову.
 
Просмотр списка файлов
Ниже приводится программа, в которой показано, как можно создать и использовать диалоговое окно для выбора файлов из любого каталога. В пример включены лишь минимальные средства, с помощью которых на экране формируется окно выбора файлов и окно с сообщением о конкретном выборе (см.   5).
Для реализации просмотра списка файлов и выбора из этого списка нужного файла в Turbo Vision предусмотрен объект TListBox. Этот объект создает специальное окно скроллера, содержащее одну вертикальную полосу и указатель на текущий элемент. Имена файлов помещаются в коллекцию строк, указатель на которую передается объекту с помощью метода TListBox.NewList.
В программе используются две глобальные переменные, содержащие указатель на коллекцию L и номер выбранного элемента Foc. В объекте TApplication перекрываются методы Run и Done. Новый метод TMyApp.Run создает коллекцию и окно просмотра. Метод TMyApp.Done перед завершением работы программы формирует окно, в котором сообщается имя выбранного из списка файла. Заметим, что это имя помещается в переменную Foc в момент выхода из программы с помощью перекрываемого метода TListBox. Valid.
{$Х+}
Uses DOS,Objects,App,Views,Dialogs,Drivers,MsgBox; 
var
L: PStringCollection; {Коллекция имен файлов} 
Foc: String; {Выбранный файл} 
type
ТМуАрр = object (TApplication) 
Procedure Run; Virtual; 
Destructor Done; Virtual; 
end ;

PMyListBox =^TMyListBox; 
TMyListBox = object (TListBox)
Function Valid(Command: Word): Boolean; Virtual; 
end ; 
{------------------}
Procedure TMyApp.Run; {Создает диалоговое окно с TListBox} 
var
R,RR: TRect; 
W: PDialog;
S: SearchRec;
B: PScrollBar; 
P: PListBox; 
begin {Создаем коллекцию имен файлов:}
L := New(PStringCollection, Init(50,10)); 
FindFirst('\games\fl9\*.*',Archive,S); 
While DosError = 0 do with S,L^ do 
begin
Insert(NewStr(Name)); 
FindNext(S) 
end;
{Создаем окно:} 
R.Assign (17, 4 ,63, 14 );
W := New(PDialog, Init (R, 'Текущий каталог:')); 
{Вставляем в окно TListBox:} 
with W do 
begin
RR.Assign(44,1,45,9) ;
В := New(PScrollBar, Init(RR));
Insert (B) ;
R.Assign (1, 1,44,9) ;
P:= New(PMyListBox, Init (R, 3 ,B) ) ;
P.NewList(L) ;
Insert (P) 
end ;
DeskTop . Insert (W) ; {Помещаем окно на экран} 
Inherited Run {Ждем команду Alt-X} 
end; {TMyApp.Run}
{-------------------}
Function TMyListBox. Valid;
{Помещает в Foc имя выбранного файла}
begin
Foc := PString(L.At (Focused));
Valid := True
end ; {TMyL stBox .Valid}
Destructor TMyApp.Done;
{Выводит имя выбранного файла} 
var
R: TRect;
begin
R.Assign(20, 15, 60,22) ;
MessageBoxRect(R,#3' Выбран файл '+Foc, NIL, $402);
Inherited Done 
end {TMyApp.Done};
{-----------------}
var
P: TMyApp; 
begin
P. Init;
P. Run;
P. Done 
end.
Окно TListBox управляется мышью и клавишами. В частности, клавишами смещения курсора можно выбрать нужный файл, клавишами PgUp, PgDn листать окно со списком. Работают также клавиши End, Home, Ctrl-PgUp, Ctrl-PgDn.
В момент обращения к методу TMyApp.Done вызывается функция TMyListBox. Valid, которая определяет номер вьщеленного файла (этот номер хранится в поле TListBox.Focused) и переписывает имя этого файла из коллекции в глобальную переменную Foc.

 

 
На главную | Содержание | < Назад....Вперёд >
С вопросами и предложениями можно обращаться по nicivas@bk.ru. 2013 г. Яндекс.Метрика