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

В следующей программе на экране создается несколько окон, содержащих один и тот же текст - текст программы (см. рис.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).