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