Реферат: Языки и технологии программирования
гового окна 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);
Insert(New(PButton, Init(R, 'Выход',cmCancel,bfNormal)));
SelectNext(False) {Активизируем 1-ую кнопку}
end; {конец формирования окна}
if Edit then with Data do
begin {готовим начальный текст}
p:=PS^.At(Location);{читает данные из записи}
s:=p^;
Name:=copy(s,1,LName);
Phone:=copy(s,succ(LName),LPhone);
Addr:=copy(s,succ(LName+LPhone),LAddr);
InWin^.SetData(Data) {вставляет текст в поля ввода}
end;
Control:=DeskTop^.ExecView(InWin); {выполняем диалог}
if Control=cmOK then with Data do
begin
if Edit then
DeleteItem; {удаляет старую запись}
Name:=BName^.Data^;
Phone:=BPhone^.Data^;
Addr:=BAddr^.Data^;
s[0]:=chr(L);
FillChar(s[1],L,' ');
move(Name[1],s[1],Length(Name));
move(Phone[1],s[succ(LName)],Length(Phone));
move(Addr[1],s[succ(LName+LPhone)],Length(Addr));
OldCount:=PS^.Count; {прежнее кол-во записей}
PS^.Insert(NewStr(s)); {добавляет в коллекцию}
{проверяем добавление}
if OldCount<>PS^.Count then
write(DataFile,Data) {да - добавляем в файл}
end
until Edit or (Control=cmCancel);
Draw
end; {AddItem}
{--------------------}
procedure SearchItem;
{ищет нужный элемент }
function UpString(s: String): string;
{преобразует строку в верхний регистр}
var
k: Integer;
begin
for k:=1 to Length(s) do
if s[k] in ['a'..'z'] then
s[k]:=chr(ord('A')+ord(s[k])-ord('a'))
else if s[k] in ['а'..'п'] then
s[k]:=chr(ord('A')+ord(s[k])-ord('a'))
else if s[k] in ['р'..'я'] then
s[k]:=chr(ord('P')+ord(s[k])-ord('p'));
UpString:=s
end; {UpString}
var
InWin: PDialog;
R: TRect;
s: String;
p: PInputLine;
k: Word;
begin {SearchItem}
R.Assign(15,8,65,16);
InWin:=New(PDialog,
Init(R,'Поиск записи:'));
with InWin^ do
begin
R.Assign(2,2,47,3);
p:=New(PInputLine,Init(R,50));
Insert(p);
R.Assign(1,1,40,2);
Insert(New(PLabel, Init(R, 'Введите образец поиска:',p)));
R.Assign(10,5,20,7);
Insert(New(PButton,Init(R,'Ввести',cmOK,bfDefault)));
R.Assign(25,5,35,7);
Insert(New(PButton,Init(R,'Выход',cmCancel,bfNormal)));
SelectNext(False)
end;
if DeskTop^.ExecView(InWin)=cmCancel then
exit;
s:=p^.Data^;
Location:=0;
while (UpString(s)>=UpString(PString(PS^.At(Location))^))
and (Location<pred(PS^.Count)) do
inc(Location);
if (Location<Delta.Y+pred(Size.Y)) then
ScrollTo(Delta.X,Location)
else
Draw
end; {SearchItem}
{------------------------}
var
R: TPoint;
label Cls;
begin
TScroller.HandleEvent(Event);
case Event.What of
evCommand:
case Event.Command of
cmClose:
begin
Cls:
case Control of {получить команду из основного диалогового окна}
cmCan,
cmCancel: EndModal(cmCancel);
cmEdit: AddItem(True);
cmDelete: DeleteItem;
cmSearch: SearchItem;
cmAdd: AddItem(False);
end
end;
cmZoom: exit;
end;
evMouseDown: {реакция на щелчок мыши}
begin
MakeLocal(MouseWhere, R); {получение в R локальные
координаты мыши}
Location:=Delta.Y+R.Y;
Draw
end;
evKeyDown: {реакция на клавиши + -}
case Event.KeyCode of
kbEsc: goto Cls;
kbGrayMinus: if Location<Delta.Y then
begin
dec(Location);
Draw
end;
kbGrayPlus: if Location<Delta.Y+pred(Size.Y) then
begin
inc (Location);
Draw
end;
end
end
end; {TInterior.HandleEvent}
{------------------------}
procedure Tnotebook.Work;
{работа с данными}
var
R: TRect;
PW: PWorkWin;
Control: Word;
begin
R.Assign(0,0,80,23);
PW:=New(PWorkWin, Init(R));
Control:=DeskTop^.ExecView(PW);
Dispose(PW,Done)
end;
{------------------------}
procedure TNotebook.HandleEvent(var Event: TEvent);
{обработчик событий программы}
begin {TNotebook.HandleEvent}
TApplication.HandleEvent(Event); {обработка станд. команд cmQuit и cmMenu}
if Event.What=evCommand then
case Event.Command of
{обработка новых команд}
cmOpen: FileOpen; {открыть файл}
cmSave: FileSave; {закрыть файл}
cmChangeDir: ChangeDir; {сменить диск}
cmDOSShell: DOSCall; {временный выход в дос}
cmWork: Work; {Обработать данные}
else
exit {не обрабатывать другие команды}
end;
ClearEvent(Event) {очистить событие после обработки}
end; {TNotebook.HandleEvent}
{--------------------------------}
procedure TNotebook.InitMenuBar;
{соэдание верхнего меню}
var
R: TRect;
begin
GetExtent(R);
R.B.Y:=succ(R.A.Y); {R - координаты строки меню}
MenuBar:=New(PMenuBar, Init(R,
NewMenu( {создание меню}
{первый эл-т нового меню представляет собой
подменю. Создаем его}
NewSubMenu('~F~ Файл', hcNoContext,
{описываем элемент главного меню}
NewMenu( {создание подменю}
NewItem( {первый эл-т}
'~~ Открыть','F3',kbF3,cmOpen,hcNoContext,
NewItem( {второй эл-т}
'~~ Закрыть','F2',kbF2,cmSave,hcNoContext,
NewItem( {третий эл-т}
'~~ Сменить диск','',0,cmChangeDir,hcNoContext,
NewLine( {строка-разделитель}
NewItem('~~ Вызов ДОС','',0,cmDOSShell,hcNoContext,
NewItem('~~ Конец работы','Alt-X',kbAltX,cmQuit,hcNoContext,
NIL)))))) {нет других элементов подменю}
),
{создаем второй элемент главного меню}
NewItem('~W~ Работа','',kbF4,cmWork,hcNoContext,
NIL) {нет др. эл-тов гл. меню}
))))
end; {TNotebook.InitMenuBar}
{----------------------------}
procedure TNotebook.InitStatusLine;
{формирует строку статуса}
var
R:TRect; {границы строки статуса}
begin
GetExtent(R); {получаем в R координаты всего экрана}
R.A.Y:=pred(R.B.Y);
StatusLine:=New(PStatusLine,
Init(R, {создает строку статуса}
NewStatusDef(0, $FFFF, {устанавливает макс. диап. кон-
текстной справочной службы}
NewStatusKey('~Alt-X~ Выход',kbAltX,cmQuit,
NewStatusKey('~F2~ Закрыть',kbF2,cmSave,
NewStatusKey('~F3~ Открыть',kbF3,cmOpen,
NewStatusKey('~F4~ Работа',kbF4,cmWork,
NewStatusKey('~F10~ Меню',kbF10,cmMenu,
NIL))))), {нет других клавиш}
NIL) {нет др. определений}
));
DisableCommands(WinCom1) {запрещает недоступные команды}
end; {TNotebook.InitStatusLine}
{-----------------}
var
Nbook: TNotebook;
begin
Nbook.Init;
Nbook.Run;
Nbook.Done
end.
