Program Notebook;
{Программа обслуживает файлы данных "записной книжки"}
Uses App, Objects, Menus, Drivers, Views, StdDlg, DOS, Memory, Dialogs;
type

  {Объект TWorkWin создает рамочное окно с полосами скроллинга
   для управления встроенным в него объектом TInterior}
  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;

  {Объект-программа TNotebook поддерживает работу с меню
  и строкой статуса}
  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; {TWorkWin.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);
  {Aнализируем результат запрoса:}
  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; {case Control}
  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(txt); 		{Сообщить о выходе}
  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; {Control}
{-----------------}
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) 	{Активизируем первую кнопку}
      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('А')+ord(s[k])-ord('а'))
  else if s[k] in ['р'..'я'] then
    s[k] := chr(ord('Р')+ord(s[k])-ord('р'));
  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) or
	(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(	{Первый элемент}
  		'~1~/ Открыть','F3',kbF3,cmOpen,hcNoContext,
  		NewItem(	{Второй элемент}
  		'~2~/ Закрыть','F2',kbF2,cmSave,hcNoContext,
  		NewItem(	{Третий элемент}
  		'~3~/ Сменить диск','',0,cmChangeDir,hcNoContext,
  		NewLine(	{Строка-разделитель}
  		NewItem('~4~/ Вызов ДОС','',0,cmDOSShell,hcNoContext,
  		NewItem('~5~/ Конец работы','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.

