Реферат: Языки и технологии программирования

}

приложение 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);

        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.