лабораторные на Pasca (Кудрявцев)l
.pdfСкроллинг |
283 |
|
|
GetExtent(Bounds);
Bounds.Grow(-1,-1);
Interior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar)); Insert(Interior);
end;
Из записанных выше процедур видно, что вертикальная и горизон-
тальная полосы скроллинга инициализируются и вставляются в группу, а затем передаются в TScroller при его инициализации. Скроллер – это видимый элемент, спроектированный для отобра- жения части большого видимого элемента. Скроллер и его полосы прокрутки (скроллинга) объединяются для создания скользящего видимого элемента с незначительными усилиями. Все, что нам нужно сделать – это создать метод Draw, чтобы он отображал соот- ветствующую часть виртуального видимого элемента. Полосы скроллинга автоматически управляют значениями Delta.X (колонка, с которой начинается вывод) и Delta.Y (строка, с которой начинает- ся вывод) скроллера.
Мы должны перекрыть метод Draw в TScroller. Значения Delta изме- няются в соответствии с полосами скроллинга. Метод Draw вызы- вается каждый раз, когда изменяется Delta.
Если Вы правильно внесли все изменения в Вашу программу TFirst4, то она должна принять вид:
program TFirst5;
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)
284 |
Лабораторная работа № 26 |
|
|
constructor Init(Bounds: TRect; WinTitle: string; WindowNo: Integer);
procedure MakeInterior(Bounds: TRect); end;
type PInterior=^Tinterior;
TInterior=object(TScroller)
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
procedure Draw; virtual; end;
var
MyApp: TMyApp; S: string; LineCount: Integer;
Lines: array[0..MaxLines - 1] of PString;
constructor TInterior.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
begin
TScroller.Init(Bounds, AHScrollBar, AVScrollBar); GrowMode := gfGrowHiX + gfGrowHiY;
Options := Options or ofFramed; SetLimit(128, LineCount);
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
Скроллинг |
285 |
|
|
for I := 0 to LineCount - 1 do
if Lines[I] <> nil then DisposeStr(Lines[i]); end;
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); MakeInterior(Bounds);
end;
procedure TDemoWindow.MakeInterior(Bounds: TRect); var
HScrollBar, VScrollBar: PScrollBar; Interior: PInterior;
R: TRect; begin
VScrollBar := StandardScrollBar(sbVertical + sbHandleKeyboard); HScrollBar := StandardScrollBar(sbHorizontal + sbHandleKeyboard); GetExtent(Bounds);
Bounds.Grow(-1,-1);
Interior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar)); Insert(Interior);
end;
procedure TMyApp.InitStatusLine; var R:TRect;
286 |
Лабораторная работа № 26 |
|
|
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,
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;
Скроллинг |
287 |
|
|
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 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.
Попытаемся теперь продублировать интерьер и создадим окно с двумя видимыми элементами для текстового файла. Мышка или клавиша Tab автоматически выбирает один из двух интерьеров.
Скроллинг |
289 |
|
|
RInterior^.GrowMode := gfGrowHiX + gfGrowHiY; Insert(RInterior);
end;
Если Вы правильно внесли изменения в Вашу программу, то, от- крыв окно, Вы увидите в нем два интерьера, которые можно вы- брать (сделать активными) с помощью мышки или клавиши Tab. Однако, если Вы уменьшите размер окна, то заметите, что верти- кальная полоса скроллинга будет перекрыта левым интерьером, ес- ли правая сторона окна придвинута слишком близко к левой. Это можно предотвратить, перекрывая метод SizeLimits в TWindow (это виртуальный метод):
procedure TDemoWindow.SizeLimits(var Min,Max:TPoint); var R: TRect;
begin TWindow.SizeLimits(Min,Max); GetExtent(R);
Min.X:=R.B.X div 2; end;
Заметим, что Вы не вызываете SizeLimits, Вы просто перекрываете его, и он будет вызываться в соответствующее время. Это похоже на то, что Вы делали с методом Draw: Вы говорите видимому эле- менту, как его рисовать, но не когда. Turbo Vision уже знает, когда вызывать Draw. Это же применимо и к SizeLimits – Вы устанавли- ваете границы, а видимый элемент знает тот момент, когда необхо- димо проверить их.
После всех изменений Ваша программа должна принять следую- щий окончательный вид:
program TFirst5;
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;
290 |
Лабораторная работа № 26 |
|
|
procedure NewWindow; virtual;
procedure HandleEvent(var Event: TEvent); virtual; end;
type PInterior=^Tinterior;
TInterior=object(TScroller)
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
procedure Draw; virtual; end;
type PDemoWindow=^TDemoWindow; TDemoWindow=object(TWindow)
constructor Init(Bounds: TRect; WinTitle: string; WindowNo: Integer);
function MakeInterior(Bounds: TRect; Left: Boolean): PInterior; procedure SizeLimits(var Min,Max:TPoint);virtual;
end; var
MyApp: TMyApp; S: string; LineCount: Integer;
Lines: array[0..MaxLines - 1] of PString;
procedure TDemoWindow.SizeLimits(var Min,Max:TPoint); var R: TRect;
begin TWindow.SizeLimits(Min,Max); GetExtent(R);
Min.X:=R.B.X div 2; end;
constructor TInterior.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
begin
TScroller.Init(Bounds, AHScrollBar, AVScrollBar); Options := Options or ofFramed;
SetLimit(128, LineCount); end;
procedure ReadFile; var
F: Text;
S: String; begin
Скроллинг |
291 |
|
|
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;
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]; R: TRect;
RInterior, LInterior: PInterior; begin
Str(WindowNo, S);
292 |
Лабораторная работа № 26 |
|
|
TWindow.Init(Bounds, WinTitle+' '+S, wnNoNumber); GetExtent(Bounds);
R.Assign(Bounds.A.X, Bounds.A.Y, Bounds.B.X div 2 + 1, Bounds.B.Y); LInterior := MakeInterior(R, True);
LInterior^.GrowMode := gfGrowHiY; Insert(Linterior);
R.Assign(Bounds.B.X div 2, Bounds.A.Y, Bounds.B.X, Bounds.B.Y); RInterior := MakeInterior(R,False);
RInterior^.GrowMode := gfGrowHiX + gfGrowHiY; Insert(RInterior);
end;
function TDemoWindow.MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
var HScrollBar, VScrollBar: PScrollBar; R: TRect;
begin
R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1); VScrollBar := New(PScrollBar, Init(R));
VScrollBar^.Options := VScrollBar^.Options or ofPostProcess; if Left then VScrollBar^.GrowMode := gfGrowHiY; Insert(VScrollBar);
R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y); HScrollBar := New(PScrollBar, Init(R));
HScrollBar^.Options := HScrollBar^.Options or ofPostProcess; if Left then HScrollBar^.GrowMode := gfGrowHiY + gfGrowLoY; Insert(HScrollBar);
Bounds.Grow(-1,-1);
MakeInterior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar)); 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)))