ymax=getmaxy();
cleardevice();//очисткаэкрана
setcolor( MaxColors - 2 );//установка текущего цвета //белым
setviewport( 0, 0, xmax, ymax, 1 );//открыть окно во //весь экран
height = textheight( "H" );//установить начальную высоту //текста
settextjustify( CENTER_TEXT, TOP_TEXT );
outtextxy( xmax/2, 2, header );
setviewport( 0, height+4, xmax, ymax-(height+4), 1 );
DrawBorder();
setviewport( 1, height+5, xmax-1, ymax-(height+5), 1 );
}
//
//функция создания строки статуса в нижней части экрана
//
void StatusLine( char *msg )
{
int height;
xmax=getmaxx();
ymax=getmaxy();
setviewport( 0, 0, xmax, ymax, 1 ); //открытьокново //весьэкран
setcolor( MaxColors - 1 ); //установка текущего цвета //черным
settextjustify( CENTER_TEXT, TOP_TEXT );
setlinestyle( SOLID_LINE, 0, NORM_WIDTH );
setfillstyle( EMPTY_FILL, 0 );
height = textheight( "H" );//установкатекущейвысоты //текста
bar( 0, ymax-(height+4), xmax, ymax );
rectangle( 0, ymax-(height+4), xmax, ymax );
outtextxy( xmax/2, ymax-(height+2), msg );
setviewport( 1, height+5, xmax-1, ymax-(height+5), 1 );
}
//
//функция, образующая границу графического окна
//
void DrawBorder(void)
{
// struct viewporttype vp;
setcolor( MaxColors - 1 );//установка текущего цвета //белым
setlinestyle( SOLID_LINE, 0, NORM_WIDTH );
// getviewsettings( &vp );
rectangle( 0, 0, getmaxx(), getmaxy() );
}
приложение 3
Program Notebook;
{программа обслуживает файлы данных "записной книжки".}
Uses App, Objects, Menus, Drivers, Views, StdDlg, DOS, Memory, Dialogs;
type
{объект TWorkWin создает рамочное окно с полосами прокрутки для
управления встроенным в него объектом TInterrior}
PWorkWin =^TWorkWin;
TWorkWin = object (TWindow)
Constructor Init(Bounds: Trect);
end;
{Объект TDlgWin создает диалоговое окно для выбора режима работы}
PDlgWin =^TDlgWin;
TDlgWin = object (TDialog)
Procedure HandleEvent (var Event: TEvent); Virtual;
end;
{Следующий объект обуславливает внутреннюю часть рамочного окна TWorkWin. Он
создает прокручиваемое окно с записями из архивного файла и с помощью диало-
гового окна TDlgWin управляет работой с этими записями}
PInterior =^Tinterior;
Tinterior = object (TScroller)
PS: PStringCollection;
Location: Word;
Constructor Init (var Bounds: TRect; HS, VS: PScrollBar);
Procedure Draw; Virtual;
Procedure ReadFile;
Destructor Done; Virtual;
Procedure HandleEvent (var Event: TEvent); Virtual;
end;
{объект-программа ТNotebook поддерживает работу с меню и строкой стстуса}
TNotebook = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent (var Event: TEvent); virtual;
procedure FileSave;
procedure ChangeDir;
procedure DOSCall;
procedure FileOpen;
procedure Work;
end;
const
{Команды для обработчиков событий:}
cmChDir = 202;{сменить каталог}
cmWork = 203;{обработать данные}
cmDOS = 204;{временно выйти в дос}
cmCan = 205;{команда завершения работы}
cmDelete = 206;{уничтожить текущую запись}
cmSearch = 207;{искать нужную запись}
cmEdit = 208;{редактировать запись}
cmAdd = 209;{добавить запись}
{ножество временно недоступных команд:}
WinCom1: TCommandSet = [cmSave, cmWork];
WinCom2: TCommandSet = [cmOpen];
LName=25; {длинаполя NAME}
LPhone=11; {---------- PHONE}
LAddr=40; {---------- ADDR}
LLIne=LName+LPhone+LAddr; {длинастроки}
type
DataType = record {типданныхвфайле}
Name : string [LName]; {имя}
Phone: string [LPhone];{телефон}
Addr : string [LAddr]; {адрес}
end;
var
DataFile: file of DataType; {файловаяпеременная}
OpFileF : Boolean; {флаготкрытогофайла}
{---------------------------------------------
реализацияобъекта TWorkWin
----------------------------------------------}
constructor TWorkWin.Init(Bounds: Trect);
{созданиеокнаданных}
var
HS, VS: PScrollBar; {полосы-указатели}
Interior: PInterior; {указатель на управляемое текстовое окно}
begin
TWindow.Init(Bounds,'',0); {создание нового окна с рамкой}
GetClipRect(Bounds); {получение в BOUNDS кординаты минимальной перерисо-
вываемой части окна}
Bounds.Grow(-1,-1); {установка размеров окна с текстом}
{Включение стандартных по размеру и положению полос-уаказателей:}
VS:= StandardScrollBar(sbVertical+sbHandleKeyBoard);
HS:= StandardScrollBar(sbHorizontal+sbHandleKeyBoard);
{созданиетекстовогоокна:}
Interior :=New(Pinterior,Init(Bounds, HS, VS));
Insert(Interior) {включение его в основное окно}
end; {TWrkWin.Init}
{--------------------}
procedure TDlgWin.HandleEvent;
begin
inherited HandleEvent (Event);
if Event.What=evCommand then
EndModal(Event.Command)
end;
{--------------------}
procedure TNotebook.FileOpen;
{открывает файл данных}
var
PF: PFileDialog; {диалоговое окно выбора файла}
Control: Word;
s: PathStr;
begin
{создание экземпляра динамического объекта:}
New(PF, Init('*.dat','Выберите нужный файл:','Имя файла',fdOpenButton,0));
{с помощью следующего оператора окно выводится на экран и результат работы
пользователя с ним помещается в переменную Control:}
Control :=DeskTop^.ExecView(PF);
{анализ результата запроса:}
case Control of
StdDlg.cmFileOpen,cmOk:
begin {польов. указал имя файла:}
PF^.GetFileName(s); {s содержит имя файла}
Assign(DataFile,s);
{$I-}
Reset(DataFile);
if IOResult <> 0 then
Rewrite(Datafile);
OpFileF := IOResult=0;
{$I+}
if OpFileF then
begin
DisableCommands(WinCom2);
EnableCommands(WinCom1);
Work {переход к работе}
end
end;
end; {caseControl}
Dispose(PF, Done) {уничтожение экземпляра}
end; {FileOpen}
{---------------------------}
procedure TNotebook.FileSave;
{закрываетфайлданных}
begin
Close(DataFile);
OpFileF :=False;
EnableCommands(WinCom2); {разрешениеоткрытьфайл}
DisableCommands(WinCom1) {запрещение работы и сохранение}
end; {TNotebook.FileSave}
{--------------------------}
procedure TNotebook.ChangeDir;
{изменяет текущий каталог}
var
PD: PChDirDialog; {диалоговое окно смены каталога диска}
Control: Word;
begin
New(PD, Init(cdNormal,0)); {созданиедиалоговогоокна}
Control :=DeskTop^.ExecView(PD); {использованиеокна}
ChDir(PD^.DirInput^.Data^); {установка нового каталога}
Dispose(PD, Done) {удаление окна из кучи}
end; {TNotebook.ChangeDir}
{-------------------------}
procedure TNotebook.DOSCall;
{временный выход в дос}
const
txt='Для возврата введите EXIT в ответ'+
'на приглашение ДОС...';
begin
DoneEvents; {закрыть обработчик событий}
DoneVideo; {закрыть монитор экрана}
DoneMemory; {закрыть монитор памяти}
SetMemTop(HeapPtr); {освободить кучу}
writeln('Введите EXIT для возврата'); {выдать сообщение о выходе}
SwapVectors; {установить стандартные векторы}
{передать упр. ком. процессору дос}
Exec(GetEnv('COMSPEC'),'');
{возврат из дос}
SwapVectors; {восстановить векторы}
SetMemTop(HeapEnd); {восстановить кучу}
InitMemory; {открыть монитор памяти}
InitVideo; {открыть монитор экрана}
InitEvents; {открыть обработчик событий}
InitSysError; {открыть обработчик ошибок}
Redraw {восстановить вид экрана}
end; {DOSCall}
{------------------------------}
constructor TInterior.Init;
{создает окно скроллера}
begin
TScroller.Init(Bounds, HS, VS);
ReadFile;
GrowMode :=gfGrowHiX+gfGrowHiY;
SetLimit(LLine, PS^.Count)
end;
{-----------------------}
destructor TInterior.Done;
begin
Dispose(PS,Done);
inherited Done
end;
{--------------------------}
procedure TInterior.ReadFile;
{читает содержимое файла данных в массив LINES}
var
k: Integer;
s: String;
Data: DataType;
f: text;
begin
PS:= New(PStringCollection, Init(100,10));
seek(DataFile,0);
while not (EOF(DataFile) or LowMemory) do
begin
Read(DataFile, data);
with data do
begin
s:= Name;
while Length(s) < Lname do
s:= s+' ';
s:= s+Phone;
while Length(s) < LName+LPhone do
s:= s+' ';
s:= s+Addr
end;
if s<>'' then PS^.Insert(NewStr(S))
end;
Location:= 0;
end; {ReadFile}
{----------------------------}
procedure Tinterior.Draw;
{выводит данные в окно просмотра}
var
n, {текущая строка экрана}
k: integer; {текущая строка массива}
B: TDrawBuffer;
Color: Byte;
p: PString;
begin
if Delta.Y>Location then
Location:= Delta.Y;
if Location>Delta.Y+pred(Size.Y) then
Location:= Delta.Y+pred(Size.Y);
for n:= 0 to pred(Size.Y) do
{Size.Y- кол-во строк окна}
begin
k:= Delta.Y+n;
if k=Location then
Color:= GetColor(2)
else
Color:= GetColor(1);
MoveChar(B,' ',Color,Size.X);
if k<pred(PS^.Count) then
begin
p:= PS^.At(k);
MoveStr(B, Copy(p^,Delta.X+1,Size.X),Color);
end;
writeline(0,N,Size.X,1,B)
end
end; {TInterior.Draw}
{-----------------------------}
Function Control: Word;
{получает команду из основного диал. окна}
const
x=1;
L=12;
DX=13;
But: array [0..4] of string [13]= {надписинакнопках}
('~1~ Выход ','~2~ Убрать ','~3~ Искать ','~4~ Изменить ','~5~ Добавить ');
Txt: array [0..3] of string [52] = (
{справочныйтекст}
'Убрать - удалить запись, выделенную цветом',
'Искать - искать запись, начинающуюся с нужных букв',
'Изменить - изменить поле (поля) выделенной записи',
'Добавить - добавить новую запись');
var
R: TRect;
D: PDlgWin;
k: Integer;
begin
R.Assign(7,6,74,15);
D:=New(PDlgWin,Init(R, 'Выберите продолжение:'));
with D^ do
begin
for k:=0 to 3 do {вставляемпоясняющийтекст}
begin
R.Assign(1,1+k,65,2+k);
Insert(New(PStaticTEXT,Init(R,#3+Txt[k])))
end;
for k:=0 to 4 do {вставляемкнопки:}
begin
R.Assign(X+k*DX,6,X+k*DX+L,8);
Insert(New(PButton,
Init(R,But[k],cmCan+k,bfNormal)))
end;
SelectNext(False); {активизируемпервуюкнопку}
end;
Control:=DeskTop^.ExecView(D); {выполняемдиалог}
end;{Conrol}
{------------}
Procedure TInterior.HandleEvent;
Procedure DeleteItem;
{удаляетуказанныйв Location эл-тданных}
var
D: Integer;
PStr: PString;
s: String;
Data: DataType;
begin
PStr:=PS^.At(Location); {получаемтекущуюзапись}
s:=copy(PStr^,1,LName);
seek(DataFile,0);
D:=-1; {D-номер записи в файле}
repeat {цикл поиска по освпадению поля Name:}
inc(D);
read(DataFile,Data);
with Data do while Length(Name)<LName do
Name:=Name+' '
until Data.Name=s;
seek(DataFile,pred(FileSize(DataFile)));
read(DataFile,Data); {читает последнюю запись}
seek(DataFile,D);
write(DataFile,Data); {помещаетеенаместоудаляемой}
seek(DataFile,pred(FileSize(DataFile)));
truncate(DataFile); {удаляет последнюю запись}
with PS^ do D:=IndexOf(At(Location));
PS^.AtFree(D); {удаляет строку из коллекции}
Draw {обновляет окно}
end;{DeleteItem}
{----------------------}
procedure AddItem(Edit: Boolean);
{добавляет новый или редактирует элемент данных}
const
y=1;
dy=2;
L=LName+LPhone+LAddr;
var
Data: DataType;
R: TRect;
InWin: PDialog;
BName,BPhone,BAddr:PInputLine;
Control: Word;
OldCount: Word;
s: String;
p: PString;
begin
Seek(DataFile,FileSize(DataFile)); {добавяетзаписивконецфайла}
repeat {циклвводазаписей}
if Edit then {готовитзаголовок}
s:='Редактирование'
else
begin
Str(FileSize(DataFile)+1,s);
while Length(s)<3 do
s:='0'+s;
s:='Вводится запись N'+s
end;
FillChar(Data,SizeOf(Data),' '); {заполняет поля пробелами}
R.Assign(15,5,65,16);
InWin:=New(PDialog, Init(R, s)); {создаетокно}
with InWin^ do
begin {формируемокно:}
R.Assign(2,y+1,2+LName,y+2);
BName:=New(PInputline, Init(R,LName));
Insert(BName); {полеимени}
R.Assign(2,y,2+LName,y+1);
Insert(New(PLabel,
Init(R, 'Имя',BName)));
R.Assign(2,y+dy+1,2+LPhone,y+dy+2);
BPhone:=New(PInputLine,
Init(R,LPhone));
Insert(BPhone); {полетелеф.}
R.Assign(2,y+dy,2+LPhone,y+dy+1);
Insert(New(PLabel, Init(R, 'Телефон',BPhone)));
R.Assign(2,y+2*dy+1,2+LAddr,y+2*dy+2);
BAddr:=New(PInputLIne, Init(R,LAddr));
Insert(BAddr); {полеадреса}
R.Assign(2,y+2*dy,2+LAddr,y+2*dy+1);
Insert(New(PLabel, Init(R, 'Адрес',BAddr)));
{вставляемдвекомаедныекнопки}
R.Assign(2,y+3*dy+1,12,y+3*dy+3);
Insert(New(PButton, Init(R, 'Ввести',cmOK,bfDefault)));
R.Assign(2+20,y+3*dy+1,12+20,y+3*dy+3);