Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

лабораторные на Pasca (Кудрявцев)l

.pdf
Скачиваний:
32
Добавлен:
18.03.2015
Размер:
1.63 Mб
Скачать

Интерьер

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) выведет

276

Лабораторная работа № 25

 

 

Я В ам пиш

Со всеми внесенными изменениями Ваша программа должна при- нять вид:

program TFirst4;

uses App,Objects,Menus,Drivers,Views; const

FileToRead='e:\tp6\tutor\urok.txt'; {здесь должен быть к путь Вашему файлу} MaxLines = 100;

cmNewWin=199;

cmFileOpen=200; winCount: Integer=0;

type TMyApp=Object(TApplication) procedure InitStatusLine; virtual; procedure InitMenuBar; virtual; procedure NewWindow; virtual;

procedure HandleEvent(var Event: TEvent); virtual; end;

type PDemoWindow=^TDemoWindow; TDemoWindow=object(TWindow)

constructor Init(Bounds: TRect; WinTitle: string; WindowNo: Integer);

end; type

PInterior=^Tinterior;

TInterior=object(TView)

constructor Init(var Bounds: TRect); procedure Draw; virtual;

end; var

MyApp: TMyApp; S: string; LineCount: Integer;

Lines: array[0..MaxLines - 1] of PString; constructor TInterior.Init(var Bounds: TRect);

Интерьер

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

280

Лабораторная работа № 25

 

 

begin

case Event.Command of cmNewWin: NewWindow; cmTile:

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

ReadFile;

MyApp.Init;

MyApp.Run;

MyApp.Done;

END.

Задания для самостоятельнойработы

1.Меняя состояния окон, наблюдайте за изменениями их интерьера.

2.Поэкспериментируйте с процедурами пересылки текста в буфер и вы- вода из него, меняя их параметры.

3.Поэкспериментируйте с цветами окон и выводимого текста, добиваясь наилучшего соотношения цветов.

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;

282

Лабораторная работа № 26

 

 

Options := Options or ofFramed;

SetLimit(128, LineCount); {горизонтальная и вертикальная границы скроллинга} end;

Соответственно, метод Draw для объекта TInterior и конструктор Init для TDemoWindow будутвыглядеть так:

procedure TInterior.Draw; var

Color: Byte;

I,Y: Integer;

B: TDrawBuffer; begin

Color := GetColor(1);

for Y := 0 to Size.Y - 1 do begin

MoveChar(B, ' ', Color, Size.X); i := Delta.Y + Y;

if (I < LineCount) and (Lines[I] <> nil) then

MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color); 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); GetExtent(Bounds);

Bounds.Grow(-1,-1);

MakeInterior(Bounds);

end;

Теперь осталось лишь написать процедуру MakeInterior:

procedure TDemoWindow.MakeInterior(Bounds: TRect); var

HScrollBar, VScrollBar: PScrollBar; Interior: PInterior;

R: TRect; begin

VScrollBar := StandardScrollBar(sbVertical + sbHandleKeyboard); HScrollBar := StandardScrollBar(sbHorizontal + sbHandleKeyboard);