лабораторные на Pasca (Кудрявцев)l
.pdfИнтерьер |
273 |
|
|
begin DeskTop^.GetExtent(R); DeskTop^.Tile(R);
end;
cmCascade: begin
DeskTop^.GetExtent(R);
DeskTop^.Cascade(R); end
else Exit; end;
ClearEvent(Event);
end;
end; BEGIN
MyApp.Init;
MyApp.Run;
MyApp.Done;
END.
Выбранный нами способ записи в окно выглядит слишком прими- тивно и вряд ли может быть полезен на практике. Очевидно, что
гораздо эффективнее записывать нужную для вывода информацию в файл, а уж затем помещать ее в окно. Поэтому напишем процеду- ру чтения информации из файла. Она может выглядеть так:
procedure ReadFile; var F: Text;
S: String; begin LineCount := 0;
Assign(F,FileToRead);
Reset(F);
while not Eof(F) and (LineCount < MaxLines) do begin
Readln(F, S); Lines[LineCount] := NewStr(S); Inc(LineCount);
end;
Close(F);
end;
274 |
Лабораторная работа № 25 |
|
|
Эта процедура считывает информацию из файла F и помещает ее в
строковый массив Lines: array[0..MaxLines - 1] of PString. Переменная
LineCount типа integer является счетчиком строк, а постоянная MaxLines задает максимальное значение числа строк в массиве. По- нятно, что эти величины должны быть добавлены в раздел описа- ния данных Вашей программы (как станет ясным из дальнейшего, это глобальные величины). Кроме того, в раздел описания констант нужно добавить и путь к файлу, из которого будет читаться инфор- мация, то есть задать значение строковой постоянной FileToRead. В качестве этого файла можно просто использовать файл, в котором хранится код Вашей программы. Например, если Ваша программа записана на диске С: в каталоге tp6 под именем MyFirst3.pas, то объявление константы будет иметь вид: FileToRead='с:\tp6\ MyFirst3.pas'. Однако, для того, чтобы не возникало ощущения, что Вы наблюдаете через окно редактор Турбо Паскаля, лучше написать
с его помощью любой текст и сохранить его под любым именем с расширением txt. Не забудьтедобавить вызов ReadFile в код основ- ной программы (перед MyApp.Init).
Поскольку Вы занимаете под хранение информации, считанной из файла, определенную память, то после использования этой инфор- мации память необходимо освободить. Для этого напишем проце- дуру DoneFile (в этом тоже проявляется один из принципов Turbo Vision – все, что было открыто, нужно закрыть!):
procedure DoneFile; var
I: Integer; begin
for I := 0 to LineCount - 1 do
if Lines[I] <> nil then DisposeStr(Lines[i]); end;
Осталось изменить код процедуры Draw:
procedure TInterior.Draw; var Y: Integer;
begin
for Y := 0 to Size.Y - 1 do begin
WriteStr(0, Y, Lines[Y]^, $06); end;
end;
Интерьер |
275 |
|
|
Запустив после внесенных изменений программу, Вы увидите, что на тех местах, где должны быть пустые строки, появляются лишние символы. Это произошло потому, что мы нарушили принцип, со- гласно которому метод Draw должен покрывать всю площадь, за которую отвечает использующий его видимый элемент. Поэтому еще раз изменим процедуру Draw, помещая считываемые из файла строки не в массив, а в буфер (буфер в Turbo Vision – это тип TDraw-
Buffer=array[0..MaxViewWidth] и постоянная MaxViewWidth равна 132
символам). Новый Draw будетиметь вид:
procedure TInterior.Draw; var
Color: Byte;
Y:Integer;
B:TDrawBuffer; begin
Color := GetColor(6);
for Y := 0 to Size.Y - 1 do begin
MoveChar(B, ' ', Color, Size.X);
if (Y < LineCount) and (Lines[Y] <> nil) then
MoveStr(B, Copy(Lines[Y]^, 1, Size.X), Color); {и копирует строку в буфер} WriteLine(0, Y, Size.X, 1, B); {выводит содержимое буфера} end;
end;
Запустив программу, Вы увидите, что теперь все работает нормаль- но – стые места заполнены пробелами, как и должно быть. Для пе- ресылки текста в буфер были использованы две глобальные проце- дуры: MoveChar – для пересылки символов и MoveStr – для пере- сылки строк. Кроме них могут использоваться MoveСStr – для пере- сылки управляющих символов и управляющих строк (с «~» для элементов меню и статуса) и MoveBuf – для пересылки буфера в бу- фер.
Для вывода содержимого буфера имеются две процедуры. WriteLine(X, Y, W, H, Buf) выводит содержимое буфера Buf в строку длиной в W символов, начиная с позиции X, Y. Если параметр H больше единицы, буфер повторяется H раз. WriteBuf(X, Y, W, H, Buf) также выводит содержимое буфера, но W и H задают ширину и вы- соту вывода. Так, если в буфере – «Я Вам пишу», то процедура
WriteBuf(0, 0, 3, 3, Buf) выведет
Интерьер |
277 |
|
|
begin TView.Init(Bounds);
GRowMode:=gfGrowHiX+gfGrowHiY;
end;
procedure ReadFile; var F: Text;
S: String; begin LineCount := 0;
Assign(F,FileToRead);
Reset(F);
while not Eof(F) and (LineCount < MaxLines) do begin
Readln(F, S); Lines[LineCount] := NewStr(S); Inc(LineCount);
end;
Close(F);
end;
procedure DoneFile; var
I: Integer; begin
for I := 0 to LineCount - 1 do
if Lines[I] <> nil then DisposeStr(Lines[i]); end;
procedure TInterior.Draw; var
Color: Byte;
Y:Integer;
B:TDrawBuffer; begin
Color := GetColor(6);
for Y := 0 to Size.Y - 1 do begin
MoveChar(B, ' ', Color, Size.X);
if (Y < LineCount) and (Lines[Y] <> nil) then MoveStr(B, Copy(Lines[Y]^, 1, Size.X), Color);
278 |
Лабораторная работа № 25 |
|
|
WriteLine(0, Y, Size.X, 1, B); end;
end;
constructor TDemoWindow.Init(Bounds: TRect; WinTitle: string; WindowNo: Integer);
var S: string[3]; Interior: PInterior;
begin Str(WindowNo, S);
TWindow.Init(Bounds, WinTitle+' '+S, wnNoNumber); GetClipRect(Bounds);
Bounds.Grow(-1,-1); Interior:=New(PInterior, Init(Bounds)); Insert(Interior);
end;
procedure TMyApp.InitStatusLine; var R:TRect;
begin GetExtent(R); R.A.Y:=R.B.Y-1;
StatusLine:=New(PStatusLine,Init(R, NewStatusDef(0,$FFFF, NewStatusKey('~Alt-X~Exit',kbAltX,cmQuit, NewStatusKey('~F4~New',kbF4,cmNewWin, NewStatusKey('~Alt-F3~Close',kbAltF3,cmClose, NewStatusKey('~F10~Menu',kbF10,cmMenu,
nil)))),
nil)))
end;
procedure TMyApp.InitMenuBar; var R:TRect;
begin GetExtent(R); R.B.Y:=R.A.Y+1;
MenuBar:=New(PMenuBar,Init(R,NewMenu(
NewSubMenu('~F~ile',hcNoContext,NewMenu(
NewItem('~O~pen','F3',kbF3,cmFileOpen,
hcNoContext,
Интерьер |
279 |
|
|
NewItem('~N~ew','F4',kbF4,cmNewWin,
hcNoContext,
NewLine( NewItem('E~x~it','Alt-X',kbAltX,cmQuit,
hcNoContext,
nil))))),
NewSubMenu('~W~indow',hcNoContext,NewMenu(
NewItem('~N~ext','F6',kbF6,cmNext,
hcNoContext,
NewItem('~Z~oom','F5',kbF5,cmZoom,
hcNoContext, NewItem('~S~ize/Move','Ctr-F5',kbCtrlF5,cmResize,
hcNoContext,
NewItem('~T~ile','',0,cmTile,
hcNoContext,
NewItem('~C~ascade','',0,cmCascade,
hcNoContext,
nil)))))),
nil)))))
end;
procedure TMyApp.NewWindow; var
Window: PDemoWindow; R: TRect;
begin Inc(WinCount); R.Assign(0,0,30,7);
R.Move(Random(58),Random(16)); Window:=New(PDemoWindow, Init(R,'Demo Window ', WinCount)); Window^.Options:=Window^.Options+ofTileable; DeskTop^.Insert(Window);
end;
procedure TMyApp.HandleEvent(var Event: TEvent); var
R: TRect; begin
TApplication.HandleEvent(Event); if Event.What=evCommand then
281
Лабораторная работа № 26
СКРОЛЛИНГ
Созданный нами в предыдущей работе интерьер обладает тем не- достатком, что позволяет просмотреть лишь несколько первых строк открываемого файла. Поэтому удобнее использовать в каче- стве интерьера другой видимый объект – TScroller. Этот объект по- зволяет добавить к нему полосы скроллинга, так что TInterior стано- вится окном, скользящим по текстовому файлу. Для этого нам при- дется изменить объявление TInterior:
type PInterior=^TInterior;
TInterior=object(TScroller)
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
procedure Draw; virtual; end;
Вы видите, что теперь TInterior объявляется как объект TScroller, при инициализации которого задаются занимаемая им область (пере- менная Bounds типа TRect) и полосы вертикальной и горизонталь-
ной прокрутки (AHScrollBar, AVScrollBar).
Кроме того, удобно изменить и объект TDemoWindow, добавив в не- го метод MakeInterior, с тем, чтобы отделить эту процедуру от меха- низма открытия окна:
type PDemoWindow=^TDemoWindow; TDemoWindow=object(TWindow)
constructor Init(Bounds: TRect; WinTitle: string; WindowNo: Integer);
procedure MakeInterior(Bounds: TRect); end;
Понятно, что должно измениться и правило инициализации объекта
TInterior:
constructor TInterior.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
begin
TScroller.Init(Bounds, AHScrollBar, AVScrollBar); GrowMode := gfGrowHiX + gfGrowHiY;