Контроль за динамической памятью

Как правило, объекты в Turbo Vision размещаются в куче. Это отвечает специфике диалоговых программ: на этапе разработки программист обычно не может учесть все возможные действия пользователя программы. Чтобы не накладывать неестественные ограничения на те или иные ее возможности, не следует злоупотреблять статическими определениями объектов, так как в этом случае программа не сможет гибко учитывать специфические требования пользователя.

В правильно разработанной программе контроль за доступной динамической памятью должен осуществляться перед каждым обращением к New, в противном случае нехватка памяти может вызвать аварийный останов программы и все подготовленные пользователем данные и промежуточные результаты будут безвозвратно потеряны.

В Turbo Vision имеются средства, упрощающие этот контроль: глобальная функция LowMemory будет возвращать True, если размер свободного участка кучи стал слишком мал (по умолчанию меньше 4 Кбайт). Таким образом, вместо того, чтобы контролировать кучу перед каждым обращением к New, можно обратиться к функции LowMemory перед началом размещения динамического объекта или сразу после того, как объект размещен в куче. Если LowMemory возвращает True, дальнейшая работа с

кучей возможна только после ее очистки. Резервный участок кучи длиной в 4 Кбайт называется пулом надежности. Предполагается, что его размеры достаточны для размещения любого объекта Turbo Vision, поэтому обычно контроль с помощью LowMemory осуществляется сразу после процедуры динамического размещения нового видимого элемента.

В следующем примере создается простое диалоговое окно:

Uses Memory,...;{Функция LowMemory определена в модуле Memory}

.....

R.Assign(20,3,60,10);

D := New(Dialog, Init(R, 'Диалоговое окно')); 

with D do 

begin

R.Assign(2,2,32,3);

Insert(New(PStaticText, Init(R, 'Сообщение-вопрос'))); 

R.Assign(5,5,14,7);

Insert(New(PButton, Init(R, '~Y~es (Да)', cmYes))); 

RAssign(16,5,25,7);

Insert(New(PButton, Init(R, ' ~N~o (Нет)', cmNO))) 

end;

if LowMemory then 

begin

Dispose(D,Done); {Нет памяти: удаляем распределение} 

OutOfMemory; {Сообщаем об этом} 

DoIt := False {Признак ошибки} 

end 

else

Dolt := DeskTop.ExecView(D)=cmYes;

Если Вы используете вызов LowMemory сразу после динамического размещения объекта, то в ходе самого размещения не должен произойти аварийный останов, связанный с нехваткой памяти. Таким образом, размер пула надежности должен быть достаточным для размещения всего объекта. Переменная LowMemSize задает размер пула надежности в параграфах (участках, длиной по 16 байт). По умолчанию она имеет значение 4096 div 16 = 256, т.е. размер пула надежности составляет 4 Кбайт.

На практике вместо прямого обращения к LowMemory чаще используется вызов метода TProgram.ValidView (P: Pointer): Pointer. Этот метод получает в качестве параметра обращения указатель Р на динамический объект и осуществляет следующие действия:

если Р = NIL, метод возвращает NIL; если LowMemory = True, метод освобождает память, связанную с Р, вызывает метод TProgram.OutOfMemory и возвращает NIL; если обращение к методу TView. Valid (cm Valid) дает False (см. ниже), объект Р удаляется из кучи и метод ValidView возвращает NIL; в противном случае считается, что размещение осуществлено успешно, и метод возвращает значение указателя Р.

Метод TProgram.ValidView осуществляет стандартные действия по контролю надежности использования кучи. Обычно его используют перед тем, как поместить новый видимый элемент в группу, например:

DeskTop.Insert(ValidView(New(TMyWindow, Init(...))));

Заметим, что нехватка памяти вызывает обращение к виртуальному методу OutOfMemory, предназначенному для выдачи сообщения о ненормальной ситуации. По умолчанию этот метод ничего не делает и просто возвращает управление вызывающей программе. Вы должны перекрыть его, если хотите сообщить пользователю о возникшей проблеме.

В ряде случаев может оказаться полезной глобальная функция Function MemAlloc (Size: Word): Pointer, которая осуществляет те же действия, что и New или GetMem, но в отличие от них не распределяет пул надежности. Функция возвращает указатель на выделенную область кучи или NIL, если в куче нет свободного блока нужного размера. Аналогичные действия осуществляет функция MemAllocSeg, отличающаяся от MemAlloc только тем, что выделяет память, выровненную на границу параграфа (на границу сегмента).

 

Обработка ошибок инициации и модальных состояний

Каждый видимый элемент наследует виртуальный метод TView.Valid (Command: Word): Boolean. С помощью этого метода решаются две задачи: если параметр обращения Command = cmValid = О, метод должен проверить правильность инициации объекта и выдать True, если инициация прошла успешно; при обращении с параметром Command о cmValid метод возвращает True только тогда, когда модальное состояние диалогового элемента можно завершить командой Command. По умолчанию метод Valid возвращает True. Вы должны перекрыть этот метод, если хотите автоматизировать контроль за инициацией объекта и/или за завершением работы модального элемента.

Поскольку метод Valid автоматически вызывается из метода ValidView, в нем нет необходимости контролировать правильность использования кучи - это делает ValidView. С другой стороны, в методе Valid можно проверить другие условия правильного функционирования объекта. Например, если в объекте используется дисковый файл, можно проверить существование этого файла.

Типичный метод Valid имеет такой вид:

Function TMyView. Valid (Command: Word): Boolean; 

begin

Valid := True;

{Проверяем корректность инициации:} 

if Command = cmValid then 

if not Correctlylnit then 

begin

ReportErrorlnit; {Сообщяем о некорректной инициации} 

Valid := False 

end 

else

{Проверяем корректность завершения:} 

else if Command <> EnableCommand then

begin 

ReportErrorEnd {Сообщяем о некорректном выходе}

Valid := False 

end 

end;

В этом фрагменте предполагается, что результат проверки правильности создания элемента возвращается в логической переменной Correctlylnit, проверка корректности завершения работы модального элемента осуществляется сравнением команды завершения с ожидаемой командой EnableCommand, а сообщения об обнаруженных отклонениях от нормы выдаются процедурами ReportErrorInit и ReportErrorEnd. Заметим, что сообщения об ошибках инициации, не связанных с динамическим распределением объекта в куче, реализуются в методе Valid, в то время как сообщения об ошибках кучи - в методе ValidView.

Если видимый элемент - модальный, метод Valid перекрывается также для того, чтобы сообщить вызывающей программе о том, будет ли корректным в данном контексте завершение модального состояния командой Command или нет. Таким способом можно, например, перехватить выход из окна редактора в случае, если в нем остался несохраненный в файле текст. Разумеется, в подобной ситуации программа может не только выдать сообщение пользователю, но и предпринять необходимые действия для корректного завершения работы модального элемента. Метод Valid автоматически вызывается методом Execute модального элемента перед завершением работы.

Перекрытие методов Valid особенно полезно на этапе создания сложных программ: автоматический вызов проверки состояния используемого видимого элемента и выдача исчерпывающей диагностики могут дать неоценимую помощь программисту. Если Вы перекрываете методы Valid, Вы можете программировать, не заботясь о многочисленных проверках - методы сделают это за Вас.

 

Отладка программ

Если Вы пытались отлаживать какую-либо программу в Turbo Vision, Вы наверняка убедились, что трассировка (пошаговое прослеживание логики работы) таких программ весьма неэффективна. Вызвано это двумя обстоятельствами. Во-первых, значительная часть библиотеки Turbo Vision скрыта от Вас: библиотека поставляется в TPU-файлах, прослеживание работы которых невозможно. Во-вторых, в Turbo Vision используется принцип отделения логики создания видимых элементов от логики обработки связанных с ними событий: как только видимый элемент активизируется вызовом Execute, начинает работать его метод HandleEvent, который может породить целую цепочку непрослеживаемых трассировкой действий программы.

Ключом к решению проблемы отладки программ в Turbo Vision является расстановка точек контроля в наследуемых методах HandleEvent. Если программа не хочет открывать диалоговое окно или не реагирует на нажимаемую кнопку, следует прежде всего убедиться в том, что Ваши действия действительно порождают нужное событие.

Может случиться, что установленная контрольная точка не будет реагировать вообще или, наоборот, будет активизироваться слишком часто. Если точка не активизируется, это означает, что Ваш обработчик событий просто «не видит» событие. В этом случае необходимо убедиться в том, что поле EventMask видимого объекта содержит маску, позволяющую ему реагировать на событие нужного вида. Другой причиной «исчезновения» события может быть его перехват (и обработка) другим видимым элементом. Это может быть вызвано различными обстоятельствами. Например, Вы могли ошибочно связать две разные команды с одной константой или используете команду, которую использует также другой видимый элемент. Кроме того, обычно в наследуемых методах HandleEvent вызывается обработчик событий объекта-родителя, который может «украсть» событие у Вашего обработчика. В таких ситуациях бывает достаточно сделать вызов родительского метода после того, как событие будет обработано Вами.

Если контрольная точка активизируется слишком часто, значит Вы установили ее неправильно. Например, если Вы установили эту точку внутри метода TGroup.Execute, точка будет непрерывно активизироваться, т.к. значительная часть времени работы программы тратится на ожидание события. Если Вам все-таки требуется установить контрольную точку именно в этом месте, сделайте ее условной, чтобы она не реагировала на пустые или ненужные события.

Иногда запущенная программа «зависает», т.е. перестает реагировать на любые действия пользователя. Такие ошибки отлаживать труднее всего. Если программа «зависла», попытайтесь прежде всего локализовать то место, в котором это происходит. Для этого обычно используется расстановка контрольных точек в подозрительных местах программы. Следует помнить, что в Turbo Vision «зависания» связаны в основном с тремя видами ошибок:

освобождается динамический объект, который входил в состав ранее освобожденной динамической группы; читаются данные из потока в ошибочно зарегистрированный объект (объект имеет неуникальный регистрационный номер); элемент коллекции ошибочно трактуется как элемент другого типа. Ошибки первого вида встречаются наиболее часто. Например, прогон следующего невинного на первый взгляд варианта программы приводит к зависанию:

Uses Objects,Views; 

var

G1, G2: PGroup;

R: TRect; 

begin

R.Assign(10,5,70,20) ;

Gl := New(PGroup, Init(R));

R.Grow(-10, -3) ;

G2 := New(PGroup, Init(R));

G1.Insert(G2);

Dispose(G1, Done);

Dispose(G2, Done) {Здесь программа "зависнет"!} 

end.

Заметим, что перестановка операторов Dispose местами приводит к корректному варианту, т.к. метод G1.Done умеет контролировать освобождение своего подэлемента G2 и не освобождает его вторично. Во всех случаях оператор Dispose (G2, Done) излишен: освобождение группы вызывает автоматическое освобождение всех ее подэ-лементов.

Поскольку динамическая память используется в Turbo Vision очень интенсивно, полезно предусмотреть в отладочном варианте программы визуализацию ее размера. Для этого можно использовать такой объект THeapView:

Unit HeapView;

Interface

Uses Dialogs,Objects;

type

PHeapView = THeapView;

THeapView = object(TStaticText) 

Constructor Init(var R: TRect); 

Procedure Update;

end;

Implementation 

Constructor THeapView.Init; 

var

S: String; 

begin

Str(MemAvail,S);

Inherited lnit(R,#3+S) 

end;

Procedure THeapView.Update; 

var

S: String; 

begin

Str(MemAvail,S);

DisposeStr(Text);

Text := NewStr(#3+S);

Draw 

end; 

end.

Например, в следующей программе показан способ включения контрольного окна, создаваемого в этом объекте, в верхний правый угол экрана:

Uses Objects,Views,App, HeapView; 

var

H: PHeapView;{Окно для MemAvail}

W: PWindow; 

G: PGroup; 

R: TRect; 

P: TApplication;{Стандартная программа} 

begin 

P.Init;

R.Assign(70,0,80,1);{Верхний правый угол}

New(H, Init(R));{Создаем окно контроля} 

P.Insert(H);{Помещаем его на экран}

ReadLn; {Пауза - показываем начальный размер кучи}

R.Assign(10,5,70,20);

W := New(PWindow,Init(R,'',0)); {Создаем окно}

R.Assign(5,3,55,12);

G := New(PGroup, Init(R));

W.Insert(G); {Вставляем в окно группу}

DeskTop.Insert(W); {Выводим на экран}

Н.Update; {Обновляем окно контроля}

ReadLn; {Пауза - размер кучи перед освобождением}

Dispose(W, Done); {Освобождаем окно и группу}

НА.Update; {Обновляем окно контроля} 

ReadLn; {Пауза - размер после освобождения} 

Р.Done 

end.

Для получения текущего значения общего размера кучи используется вызов метода THeapView.Update в нужных местах программы. Вы можете автоматизировать обновление окна контроля, если включите вызов Update в перекрываемый метод TProgramIdle. В следующем варианте показан способ отображения MemAvail в фоновом режиме. Кроме того, в программе иллюстрируется возможное использование функции MessageBox.

{$Х+} {Используется расширенный синтаксис вызова функции MessageBox} 

Uses Objects,Views,App,HeapView,MsgBox; 

type

MyApp = object (TApplication) 

Procedure Idle; Virtual;

end; 

var

H: PHeapView; 

Procedure MyApp.Idle; 

begin

H^.Update 

end; 

var

W: PWindow;

G: PGroup;

R: TRect;

P: MyApp; 

begin

P.Init;

R.Assign(70,0,80,1);

New(H,Init(R));

P.Insert(H);

MessageBox(#3'Размер кучи до размещения',NIL,0);

R.Assign(10,5,70,20) ;

W := New(PWindow, Init(R,'',0));

R.Assign(5,3,55,12) ;

G := New(PGroup, Init(R));

WA.lnsert(G);

DeskTop.Insert(W);

MessageBox(#3'Размер кучи после размещения', NIL,0);

Dispose(W, Done);

MessageBox(#3'Размер кучи после освобождения', NIL,0);

Р.Done 

end.

Константа #3 вставляется в начало строки сообщения в том случае, когда требуется центрировать эту строку (расположить ее симметрично относительно границ окна сообщения).

 

Использование оверлея

Модули Turbo Vision разработаны с учетом возможного использования их в оверлейных программах. Все они могут быть оверлейными за исключением модуля Drivers, который содержит процедуры обработки прерываний и другой системный интерфейс низкого уровня.

При разработке оверлейных программ старайтесь спроектировать логические последовательности вызовов тех или иных модулей так, чтобы по возможности уменьшить свопинг (динамический обмен оверлеев). Поскольку программы Turbo Vision рассчитаны на интенсивное использование диалога с пользователем, размещайте (если это возможно) все процедуры, связанные с некоторой точкой диалога, в том же модуле, в котором создается и исполняется соответствующий модальный элемент. Например, используемые в программе диалоговые окна, как правило, порождаются от TDialog, а диалоговые элементы этих окон - от TInputLine и TListViewer. Если Вы поместите все три порожденных типа в один модуль, Ваша программа будет исполняться быстрее, так как взаимосвязанные вызовы объектов не будут приводить к свопингу оверлеев.

Заметим, что размеры всех основных оверлейных модулей - Арр, Objects, Views, Menus приблизительно одинаковы и составляют около 50 Кбайт. С учетом Ваших собственных объектов, обеспечивающих интенсивное взаимодействие с пользователем и порожденных от TWindow или TDialog, типичный размер оверлейного буфера составит не менее 64 КБайт. Если Вы хотите минимизировать потери времени на свопинг и в то же время создать достаточно компактную программу, Вам придется поэкспериментировать с размером оверлейного буфера и/или испытательной зоны. Вы можете также возложить на пользователя Вашей программы ответственность за выбор размера оверлейного буфера, предусмотрев соответствующий параметр в строке вызова программы.

В следующем примере показан возможный способ инициации оверлея.

{$F+,0+,S-}

{$М 8192,65536,655360}

Uses Overlay, Drivers, Memory, Objects, Views, Menus, 

Dialogs,istList, StdDlg, App; 

{Объявляем оверлейные модули:} 

{$0 App } 

{$O Dialogs } 

{$0 HistList } 

{$0 Memory } 

{$0 Menus } 

{$0 Objects } 

{$0 StdDlg } 

{$O Views } 

const

OvrBufDisk=96*1024;{Размер буфера без EMS-памяти}

OvrBufEMS=72*1024;{Размер буфера при использовании EMS-памяти}

type

ТМуАрр = object (TApplication) 

Constructor Init; Destructor Done; Virtual;

.....

end; {TMyApp}

Procedure InitOverlays; 

var

FileName: String [79] ; 

begin

FileName := ParamStr(0); 

Ovrlnit(FileName) ; 

if OvrResult <> 0 then 

begin

PrintStr('Невозможно открыть оверлейный файл ', FileName); 

Halt; 

end;

OvrinitEMS; 

if OvrResult = 0 then OvrSetBuf(OvrBufEMS) 

else 

begin

OvrSetBuf(OvrBufDisk) ; 

OvrSetRetry(OvrBufDisk div 2); 

end

end; {InitOverlays} 

Constructor TMyApp.Init; 

begin

InitOverlays; 

TApplication.Init;

.....

.....

end; {TMyApp.Init} 

Destructor TMyApp.Done; 

begin

.....

.....

TApplication.Done; 

end; {TMyApp.Done} 

var

MyApp: TMyApp; 

begin

MyApp.Init;

MyApp.Run;

MyApp. Done; 

end.

В этой программе используется механизм размещения оверлеев в исполняемом EXE-файле. Для этого после компиляции программы используйте команду ДОС

copy/b MyProg.exe+MyProg.ovr MyProg.exe

Чтобы определить маршрут поиска EXE-файла, в процедуре InitOverlays проверяется параметр вызова с номером 0. Заметим, что в этот параметр автоматически помещается маршрут доступа к загруженной программе только в том случае, когда Ваш ПК работает под управлением MS-DOS версии 3.0 и выше.

Обратите внимание: размер оверлейного буфера можно сделать меньшим, если программа обнаружит доступную EMS-память, ведь в этом случае потери времени на свопинг будут минимальными. Разумеется, инициация оверлея осуществляется до обращения к TApplication.Init, т.к. модуль Арр, в котором находится этот метод, сделан в программе оверлейным.

 

Порядок вызова наследуемого метода

Большая часть объектов Turbo Vision спроектирована в расчете на их дальнейшее перекрытие в прикладных программах. Типичным примером такого рода объектов является TView, метод Draw которого создает на экране пустой прямоугольник и, следовательно, не может отображать никакой полезной информации. Поскольку все видимые элементы порождены от TView, Вам необходимо перекрыть метод Draw в собственном объекте-потомке. Более того, поскольку TView.Draw не делает никакой полезной работы, его не нужно вызывать в перекрытом методе. Однако полностью перекрываемые методы, подобные TView.Draw, скорее исключение из общего правила. Обычно в перекрытом методе вызывается соответствующий метод, наследуемый от родителя, т.к. в нем реализуются некоторые необходимые для потомка действия. В такого рода ситуациях важна последовательность вызова наследуемого метода: вызывать ли его до реализации специфичных действий или после? Ниже приводятся практические рекомендации на этот счет.

 

Конструктор

Вызывайте наследуемый Метод до реализации дополнительных действий:

Procedure MyObject.Init(.....); 

begin

{Вызов наследуемого конструктора Init} 

{Реализация дополнительных действий} 

end;

Такая последовательность необходима по той простой причине, что вызов наследуемого конструктора приводит к обнулению всех дополнительных полей объекта MyObject. Если, например, Вы используете следующий фрагмент программы:

type

MyObject = object (TWindow) 

Value: Word; 

Ok : Boolean; 

Constructor Init(var Bounds: TRect; ATitle: TTitleStr;

AValue: Word; AOk: Boolean); 

end;

Constructor MyObject.Init; 

begin

Inherited Init(Bounds, ATitle, wnNoNumber); 

Value := 16; 

Ok := True; 

end;

то дополнительные поля Value и Ok получат нужные значения 16 и True. Однако, если обращение TWindow.Init (Bounds, ATitle, wnNoNumber); поставить после оператора Ok := True, в них будут помещены значения 0 и False. Из этого правила существует одно исключение, связанное с загрузкой коллекции из потока конструктором Load. Дело в том, что в наследуемом методе TCollection.Load реализуется следующий цикл:

Constructor TCollection.Load (var S: TStream); 

begin

.....

for I := 0 to Count - 1 do

AtPut(I, GetItem(S)); 

end;

Если элементами коллекции являются произвольные наборы двоичных данных (не объекты), Вам потребуется перед чтением очередного элемента сначала получить из потока его длину. Следующий пример иллюстрирует сказанное.

type

PDataCollection = ATDataCollection; 

TDataCollection = object (TStringCollection)

ItemSize: Word;

Constructor Load(var S: TStream);

Function GetItem(var S: TStream): Pointer; Virtual;

.....

end;

Constructor TDataCollection.Load(var S: TStream); 

begin

S.Read(ItemSize, SizeOf(ItemSize));

Inherited Load(S); 

end;

Function TDataCollection.GetItem(var S: TStream): Pointer; 

var

Item: Pointer; 

begin

GetMem(Item, ItemSize);

S.Read(Item, ItemSize);

GetItem := Item; 

end;

В этом примере конструктор Load сначала загружает из потока поле ItemSize, содержащее длину читаемого элемента. Затем вызывается конструктор TCollection.Load, в котором осуществляется вызов GetItem. Новый GetItem использует поле ItemSize, чтобы определить размер читаемых данных, и резервирует нужный буфер в динамической памяти. Разумеется, запись полиморфных коллекций в поток должна происходить в том же порядке, т.е. сначала записывается длина очередного элемента, а уже потом - его данные.

 

Деструктор

Вызывайте наследуемый метод после реализации дополнительных действий:

Procedure MyObject.Done; 

begin

{Реализация дополнительных действий} 

{Вызов наследуемого деструктора Done} 

end;

Работа деструктора проходит в обратном порядке по отношению к конструктору. Вначале Вы должны освободить всю дополнительно распределенную динамическую память, а уже затем вызвать наследуемый деструктор, чтобы уничтожить весь объект.

 

Другие методы

Порядок вызова наследуемого метода зависит от конкретного алгоритма. В большинстве случаев наследуемый метод вызывается первым, но могут использоваться и другие последовательности. Особое значение имеет вызов наследуемого обработчика событий HandleEvent. В самом общем виде структура нового обработчика будет такой:

Procedure MyObject.HandleEvent(var Event: TEvent); 

begin

{Изменение наследуемых свойств} 

{Вызов наследуемого обработчика} 

{Добавление новых свойств} 

end;

Таким образом, вначале Вы должны запрограммировать те действия, которые изменяют стандартное поведение перекрытого обработчика, затем вызвать его и, наконец, осуществить новую обработку событий. Разумеется, любая из этих трех частей может отсутствовать. Например, стандартный обработчик TDialog.HandleEvent лишь расширяет свойства наследуемого метода TWindow.HandleEvent, добавляя в него обработку событий от клавиатуры и событий-команд:

Procedure TDialog.HandleEvent(var Event: TEvent); 

begin

Inherited HandleEvent(Event);

case Event.what of

evKeyDown:

.....

evCommand:

.....

end ; 

end;

Этот обработчик перехватывает все события от клавиатуры и мыши, в том числе и нажатие на клавишу Tab. Если Вы хотите обработать событие от клавиши Tab особым способом, Вы должны перехватить это событие до вызова стандартного обработчика. Например:

Procedure TNoTabsDialog.HandleEvent(var Event: TEvent);

begin

if (Event.What = evKeyDown) then 

if (Event.KeyCode = kbTab) or

(Event.KeyCode = kbShiftTab) then 

ClearEvent(Event); Inherited HandleEvent(Event); 

end;

 

Примеры программных реализаций

В этом разделе приводятся примеры программных реализаций некоторых типичных задач, решаемых с помощью Turbo Vision. Эти примеры не имеют сколько-нибудь серьезного прикладного назначения, они просто иллюстрируют возможные приемы программирования. Поскольку большинство видимых объектов используется в тесной взаимосвязи, примеры иллюстрируют программирование сразу нескольких объектов.

 

Строка статуса

В следующей программе создается строка статуса, содержание которой зависит от установленного контекста подсказки (определяется значением поля TProgram.HelpCtx). В зависимости от действий пользователя эта строка будет содержать текст

Esc Выход F1 Сменить контекст на 1 

Однажды в студеную, зимнюю пору

либо

ESC Выход F2 Сменить контекст на 0 

Я из лесу вышел. Был сильный мороз...

Переключение строки осуществляется клавишами F1 и F2, для выхода из программы используется клавиша Esc.

Uses Objects,App,Menus,Drivers,Views; 

type

PMyStatusLine = TMyStatusLine; 

TMyStatusLine = object (TStatusLine)

Function Hint(Cntx: Word): String; Virtual; 

end; 

MyApp = object (TApplication)

StatLine: PMyStatusLine; 

Constructor Init;

Procedure InitStatusLine; Virtual; 

Procedure HandleEvent(var Event: Tevent); Virtual; 

end; 

const

cmCntxl =200; 

cmCntx2 = 201;

{-----------------}

Constructor MyApp.Init ; 

begin

Inherited Init;

Insert (StatLine) {Использовать нестандартную строку статуса} 

end {MyApp .Init} ;

Procedure MyApp. Ini tstatusLine ;

{Инициация нестандартного поля MyApp. StatLine}

var

R: Trect; 

begin

GetExtent (R) ;

R.A.Y := pred(R.B.Y) ;

StatLine := New(PMyStatusLine, Init(R,

NewStatusDef (0, 0, {Первый вариант строки}

NewStatusKey ( ' ~Esc~ Выход1 , kbEsc, cmQuit,

NewStatusKey (' ~F1~ Сменить контекст на 1', kbF1 , cmCntxl , NIL) ) ,

NewStatusDef (1, 1, {Второй вариант строки}

NewStatusKey (' ~Esc~ Выход ', kbEsc, cmQuit,

NewStatusKey (' ~F2~ Сменить контекст на 0 ' , kbF2 , cmCntx2 , NIL)) ,

NIL) ) ) ) ; end {MyApp. Ini tstatusLine} ;

{--------------------}

Procedure MyApp. HandleEvent;

{Переключение контекста и обновление строки статуса} 

begin

Inherited HandleEvent (Event) ; 

case Event . Command of 

cmCntxl: HelpCtx := 1; 

cmCntx2: HelpCtx := 0; 

else

ClearEvent (Event) ; 

end;

if Event. What <> evNothing then 

begin

StatLine. Update; 

ClearEvent (Event) 

end 

end {MyApp . HandleEvent } ;

{---------------------}

Function TMyStatusLine. Hint (Cntx: Word):String;

{Переключение поля подсказки}

const

Prompt: array [0..1] of String =(

'Однажды в студеную, зимнюю пору',

'Я из лесу вышел. Был сильный мороз...');

begin

Hint : = Prompt [Cntx] 

end {TMyStatusLine.Hint} ;

{---------------------}

var

P : MyApp ; 

begin

P.Init;

P . Run ;

P . Done 

end .

 

Меню

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

Рис. 23.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.

 

Диалоговое окно

На рис.23.2 показан вид диалогового окна, которое создается и используется в рассматриваемом ниже примере.

Рис.23.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.

 

Окно с текстом

В следующей программе на экране создается несколько окон, содержащих один и тот же текст - текст программы (см. рис.23. 3).

Рис.23.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 обеспечивают стандартные функции скроллера для окна, создаваемого в приводимой даже программе. В частности, это окно (см. рис.23.4) управляется мышью, реагирует на клавиши смещения курсора, оно может изменять размеры и свое положение на экране, его можно «распахнуть» на весь экран.

Рис.23.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-указателя) на некоторых ПК мог бы привести к аварийному останову.

 

Просмотр списка файлов

Ниже приводится программа, в которой показано, как можно создать и использовать диалоговое окно для выбора файлов из любого каталога. В пример включены лишь минимальные средства, с помощью которых на экране формируется окно выбора файлов и окно с сообщением о конкретном выборе (см. рис.23. 5).

Для реализации просмотра списка файлов и выбора из этого списка нужного файла в Turbo Vision предусмотрен объект TListBox. Этот объект создает специальное окно скроллера, содержащее одну вертикальную полосу и указатель на текущий элемент. Имена файлов помещаются в коллекцию строк, указатель на которую передается объекту с помощью метода TListBox.NewList.

В программе используются две глобальные переменные, содержащие указатель на коллекцию L и номер выбранного элемента Foc. В объекте TApplication перекрываются методы Run и Done. Новый метод TMyApp.Run создает коллекцию и окно просмотра. Метод TMyApp.Done перед завершением работы программы формирует окно, в котором сообщается имя выбранного из списка файла. Заметим, что это имя помещается в переменную Foc в момент выхода из программы с помощью перекрываемого метода TListBox. Valid.

Рис. 23.5. Окно выбора файлов

{$Х+}

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.

 

---

---