Таблица на free vision

uses App;
var
 Table: TApplication;
begin
 Table.Init; 
 Table.Run;
 Table.Done;
end.

{$X+} { расширенный синтаксис включить }
{$IFNDEF Ver60}
{$T-} { проверку типов выключить }
{$ENDIF}
unit Tables;
interface
 
uses App, Objects, Drivers, Views, Dialogs, Strings;
 
Const CSheet=#6#7#8#9#10;       {Палитра для объекта TSheet}
      CCellPointer=#11#12#13#14;{-"-для объекта TCellPointer}
{      CTableWindow=CBlueWindow+}
      cmLeaveCell=255;
      cmMovePointer=254;
      cmEditCell=253;
Const EnterReaction:(erGoRight,erGoDown,erNextLine)=erGoDown;
Type
     PTable = ^TTable;
     PGroupedScroller = ^TGroupedScroller;
     PSheet = ^TSheet;
     PCellPointer = ^TCellPointer;
     TTable = object(TGroup)
                Delta:TPoint;
                Sheet:PSheet;
                HTitle,
                VTitle:PGroupedScroller;
                CellPointer:PCellPointer;
                HScrollBar:PScrollBar;
                VScrollBar:PScrollBar;
                Constructor Init(var Bounds:TRect;ASheet:PSheet;
                                 AHTitle,AVTitle:PGroupedScroller;
                                 AHScrollBar,AVScrollBar:PScrollBar);
                Constructor Load(var S:TStream);
                Procedure Store(var S:TStream);
                Procedure SetState(AState:Word;Enable:Boolean);virtual;
                {Скрывает/показывает ScrollBar'ы при необходимости}
 
                Procedure HandleEvent(Var Event:TEvent);virtual;
                {Перемещает Указатель в соответствии с событиями от
                 полос прокрутки}
 
                Procedure Awaken; virtual;
 
                procedure UpDate;
                { Вызывается, если значения в таблице были изменены }
 
                procedure Print(var F       : text;        { файл }
                       Width, Height,         { ширина/высота страницы }
                       Left, Top , Bottom     { отступ слева/сверху/снизу }
                                            : integer);
                { Печатает текущую таблицу }
              end;
 
     {Отличается от TScroller только тем, что не пытается показывать/скрывать
      ScrollBarы при изменении состояния}
     TGroupedScroller = object(TScroller)
                          Procedure SetState(AState:Word;Enable:Boolean);virtual;
                          function Print(i, Start, Finish : integer) : PChar; virtual;
                          function GetHeight:integer;virtual;
                        end;
 
     TCellJust=(cjLeft,cjCenter,cjRight);
     TCellProt=(cpNormal,{Ячейку можно редактировать внутри курсора}
                cpComplex,{Ячейку можно редактировать, но то, что следует
                           редактировать не совпадает с тем, что видно на
                           экране}
                cpProtected);{Ячейку вообще нельзя изменять}
 
     TSheet = object(TGroupedScroller)
                {TScroller.Delta хранит первую ячейку на экране}
 
                CurCell:TPoint;{Смещение Текущей ячейки относительно Delta}
                LastColumn:Integer;{Последняя ячейка на экране}
                Constructor Load(var S:TStream);
                Procedure Store(var S:TStream);
                Constructor Init(ALimitX,ALimitY:Integer);
                                                {Размеры таблицы}
                Procedure Draw;virtual;
                Procedure HandleEvent(var Event:TEvent);virtual;
                {Обрабатывает события от мыши и в случае если оно
                 произошло, вырабатывает сообщение cmLeaveCell}
 
                Function GetCurrentWidth:Integer;
                {Возвращает ширину текущей колонки}
 
                Function GetX(Column:Integer):Integer;
                {Возвращает абсолютную позицию текущей колонки в таблице}
 
                Function GetCurrentX:Integer;
                Function GetCurrentY:Integer;
                {Возвращает экранные координаты текущей ячейки в координатах
                 владельца}
 
                Function CurrentX:Integer;
                Function CurrentY:integer;
                {Положение текущей ячейки в таблице}
 
                {Абстрактные методы, которые следует переопределить
                 при создании конкретного объекта}
                Function GetWidth(Column:Integer):Integer;Virtual;
                {Возвращает ширину указанной колонки 0-based }
 
                Function GetValue(X,Y:Integer):String;Virtual;
                {Возвращает строковое представление указанной ячейки}
 
                Function GetFormula(X,Y:Integer):String;virtual;
                {Возвращает редактируемое представление ячейки с классом
                 защиты cpComplex}
 
                Function GetProtection(X,Y:Integer):TCellProt;virtual;
                {Возвращает класс защиты ячейки}
 
                Function CellJust(X,y:Integer):TCellJust;virtual;
                {Возвращает тип выравнивания значения в ячейке}
 
                Function ChangeValue(X,Y:Integer;value:String):Boolean;virtual;
                {Изменяет содержимое указанной ячейки или возвращает False,
                 если значение недопустимое.Для ячеек класса cpComplex на
                 входе то, что выдает GetFormula}
 
                Function CellColor(X,Y:Integer):Byte;virtual;
                {Выдает экранные цвета для вывода данной ячейки
                 (для TView.WriteStr) Используется в Draw}
 
                function GetColumn(Poz : integer) : integer;
                { Функция, которая получает позицию в абсолютных
                  координатах, а возвращает номер столбца. }
 
                function SetColumn(Col : integer) : integer;
                { Возвращает абсолютную позицию последнего символа
                  колонки по номеру колонки. }
 
                function Print(i, Start, Finish : integer) : PChar; virtual;
                { печатает i-ую строку таблицы начиная с позиции Start,
                  кончая позицией Finish }
 
              end;
       PCharArray=^TCharArray;
       TCharArray=Array[0..65521] of char;
       {Заголовок таблицы по умолчанию. рисует необходимый кусок из
        текстового буфера размером Width*Height (прямоугольник с левым
        верхним углом Sheet^.GetX(Sheet^.CurCell.X),Sheet^.CurCell.Y и
        размерами Size.X ,Size.Y}
       PHeader = ^THeader;
       THeader = object(TGroupedScroller)
                   Text:PCharArray;
 
                   Constructor Init(Width,Height:Integer; AText:PCharArray);
                   Constructor Load(var S:TStream);
                   Destructor Done;virtual;
                   Procedure Store(var S:TStream);
                   Procedure Draw;virtual;
                   function Print(i, Start, Finish : integer) : PChar; virtual;
                 end;
     {Табличный курсор - строка ввода}
      TCellPointer = object(TInputLine)
                      Changed:Boolean;
                      Protection:TCellProt;
                      Procedure HandleEvent(var Event:TEvent);virtual;
                      Function GetHelpCtx:Word;virtual;
                      {обрабатывает ^S,^D как стрелки}
                      Function Valid(Command:Word):Boolean;virtual;
                      Procedure NewCell(TblX,TblY,ScrX,ScrY,W:Integer);
                      {Переход на другую ячейку}
                      Function GetPalette:PPalette;virtual;
                     end;
Const RCellPointer : TStreamRec=(ObjType:1001;
                                VMTLink:ofs(TypeOf(TCellPointer)^);
                                Load:@TCellPointer.Load;
                                Store:@TCellPointer.Store);
Const RHeader : TStreamRec=(ObjType:1002;
                                VMTLink:ofs(TypeOf(THeader)^);
                                Load:@THeader.Load;
                                Store:@THeader.Store);
 
Const RTable : TStreamRec=(ObjType:1003;
                                VMTLink:ofs(TypeOf(TTable)^);
                                Load:@TTable.Load;
                                Store:@TTable.Store);
 
implementation
{******************* TGroupedScroller *******************************}
Procedure TGroupedScroller.SetState(AState:Word;Enable:Boolean);
begin
 TView.SetState(AState,Enable);
end;
function TGroupedScroller.GetHeight:integer;
begin
 GetHeight:=Limit.Y;
end;
function TGroupedScroller.Print(i, Start, Finish : integer) : PChar;
begin
 
end;
{********************* TTable **************************************}
 
Constructor TTable.Init(var Bounds:TRect;ASheet:PSheet;AHTitle,AVTitle:PGroupedScroller;
                           AhScrollBar,AVScrollBar:PScrollbar);
var R:TRect;
 
begin
 TGroup.Init(Bounds);
 Options:=Options and not ofBuffered;
  GrowMode:=gfGrowHiX+gfGrowHiY;
 EventMask:=EventMask or evMouse;
 if AHTitle<>nil then
 begin
  HTitle:=AHTitle;
  HTitle^.HScrollBar:=AHScrollBar;
  HTitle^.GrowMode:=gfGrowHiX;
  Insert(HTitle);
 end;
 if AVTitle<>nil then
 begin
  VTitle:=AVTitle;
  VTitle^.GrowMode:=gfGrowHiY;
  Insert(VTitle);
  VTitle^.VScrollBar:=AVScrollBar;
 end;
 Sheet:=ASheet;
 Sheet^.HScrollBar:=AHScrollBar;
 Sheet^.VScrollBar:=AVScrollBar;
 Sheet^.Options:=Sheet^.Options or ofPostProcess;
 Insert(Sheet);
 if HTitle<>nil then R.A.y:=hTitle^.Limit.y else R.A.Y:=0;
 if VTitle<>nil then R.A.x:=VTitle^.Limit.X else R.A.X:=0;
 R.B:=Size;
 Sheet^.ChangeBounds(R);
 With Sheet^ do
  VScrollBar^.SetParams(0,0,Limit.Y-Size.Y,Size.Y,1);
 R.B.X:=R.A.X;
 R.A.X:=0;
 if VTitle<>nil then
  Vtitle^.ChangeBounds(R);
 R.A.X:=R.B.X;
 R.B.X:=Size.X;
 R.B.Y:=R.A.Y;
 R.A.Y:=0;
 HTitle^.ChangeBounds(R);
 R.B.X:=R.A.X;
 R.A.X:=0;
 Insert(New(PView,Init(R)));
 HScrollBar:=AHScrollBar;
 VScrollBar:=AVscrollBar;
 Sheet^.GrowMode:=gfGrowHiX+gfGrowHiY;
 
 R.Assign(0,0,SHeet^.GetWidth(0),1);
 CellPointer:=New(PCellPointer,Init(R,255));
 CellPointer^.EventMask:=CellPointer^.EventMask or evMouse;
 CellPointer^.Options:=CellPointer^.Options or ofPostProcess;
 CellPointer^.EventMask:=CellPointer^.EventMask or evBroadCast;
 Insert(CellPointer);
 CellPointer^.GrowMode:=0;
  CellPointer^.NewCell(0,0,Sheet^.Origin.X,Sheet^.Origin.Y,Sheet^.GetWidth(0));
end;
Constructor TTable.Load(var S:TStream);
begin
 TGroup.Load(S);
 GetPeerViewPtr(S,HScrollBar);
 GetPeerViewPtr(S,VScrollBar);
 GetSubViewPtr(S,Sheet);
 GetSubViewPtr(S,CellPointer);
 GetSubViewPtr(S,VTitle);
 GetSubViewPtr(S,HTitle);
end;
Procedure TTable.AWaken;
begin
 TGroup.Awaken;
 VTitle^.VScrollBar:=VScrollBar;
 HTitle^.HScrollBar:=HScrollBar;
 Sheet^.VScrollBar:=VScrollBar;
 Sheet^.HScrollBar:=HScrollBar;
  CellPointer^.NewCell(0,0,Sheet^.Origin.X,Sheet^.Origin.Y,Sheet^.GetWidth(0));
end;
Procedure TTable.Store(var S:TStream);
begin
 TGroup.Store(S);
 PutPeerViewPtr(S,HScrollBar);
 PutPeerViewPtr(S,VScrollBar);
 PutSubViewPtr(S,Sheet);
 PutSubViewPtr(S,CellPointer);
 PutSubViewPtr(S,VTitle);
 PutSubViewPtr(S,HTitle);
end;
 
procedure TTable.SetState(AState: Word; Enable: Boolean);
 
procedure ShowSBar(SBar: PScrollBar);
begin
  if (SBar <> nil) then
    if GetState(sfActive + sfSelected) then
    begin
      SBar^.Show;
      CellPointer^.Show;
    end
    else begin
      SBar^.Hide;
      CellPointer^.Hide;
    end;
end;
 
begin
  TGroup.SetState(AState, Enable);
  if AState and (sfActive + sfSelected) <> 0 then
  begin
    ShowSBar(HScrollBar);
    ShowSBar(VScrollBar);
  end;
end;
Procedure TTable.HandleEvent(Var Event:TEvent);
{Перемещает Указатель в соответствии с событиями от
полос прокрутки}
var
  D : PDialog;
  R : TRect;
  I : PInputLine;
begin
  if (Event.What=evKeyDown) then
   if Event.KeyCode=kbTab then Event.KeyCode:=kbRight
   else if Event.KeyCode=kbShiftTab then Event.KeyCode:=kbLeft else
   if Event.KeyCode=kbEnter then
    case EnterReaction of
    erGoRight:Event.KeyCode:=kbRight;
    erGoDown:Event.KeyCode:=kbDown;
    erNextLine:begin
               end;
    end;
  if (Event.What=evBroadcast)and(Event.Command=cmScrollBarChanged)and
  not (Event.InfoPtr=HScrollBar)and not (Event.InfoPtr=VScrollBar)
   then exit;
 
 
  TGroup.HandleEvent(Event);
end;
 
procedure TTable.UpDate;
begin
  with Sheet^ do
    CellPointer^.NewCell(CurrentX,CurrentY,GetCurrentX,GetCurrentY,GetCurrentWidth);
 
  ReDraw;
end;
{ --------------------------------------------------------------------- }
procedure TTable.Print(var F       : text;        { файл }
                       Width,                 { ширина страницы }
                       Height,                { высота страницы }
                       Left,                  { отступ слева }
                       Top,                   { отступ сверху }
                       Bottom  : integer);    { отступ снизу }
 
const
  HeightHHeader   = 3;        { то, что сверху (маленькое) }
  WidthVHeader    = 6;        { то, что сбоку (маленькое) }
 
var
  SWidth, EWidth,                   { нач. и кон.  ширина и }
  SHeight, EHeight : integer;       { высота печатаемого куска }
  I                : integer;
  tmpHead          : PChar;
  R                : TRect;
  D                : PWindow;
  ZZ:              integer;
begin
  R.Assign(0,0,28,5);
  New(D, Init(R, 'Wait!', wnNoNumber));
  D^.Options:=D^.Options or ofCentered;
  D^.Flags:=0;
  D^.Palette:=wpGrayWindow;
  R.Assign(1,2,27,3);
  D^.Insert(New(PStaticText, Init(R, ' Подождите! Идет печать...')));
  DeskTop^.Insert(D);
 
  SWidth:=0;
  EWidth:=0;
  SHeight:=0;
  EHeight:=0;
  repeat
    if Height=0 then
      EHeight:=Sheet^.GetHeight
    else if SHeight=0 then { Первая страница }
           if (Height-Top-Bottom-HeightHHeader-
               HTitle^.GetHeight<Sheet^.GetHeight)
           then
             EHeight:=Height-Top-Bottom-HeightHHeader-HTitle^.GetHeight
           else
             EHeight:=Sheet^.GetHeight
         else { Не первая страница }
           if (EHeight+Height-Top-Bottom-HeightHHeader<Sheet^.GetHeight)
           then
             EHeight:=EHeight+Height-Top-Bottom-HeightHHeader
           else
             EHeight:=Sheet^.GetHeight;
 
    if Width=0 then
      EWidth:=Sheet^.SetColumn(Sheet^.Limit.X)
    else if SWidth=0 then { Первый столбец }
           if (Width-Left-WidthVHeader-
               VTitle^.Limit.X-1<Sheet^.SetColumn(Sheet^.Limit.X))
           then
             EWidth:=Sheet^.SetColumn(Sheet^.GetColumn(Width-Left-WidthVHeader-
             VTitle^.Limit.X-1)-1)
           else
             EWidth:=Sheet^.SetColumn(Sheet^.Limit.X)
         else { Не первый столбец }
           if (EWidth+Width-Left-
               WidthVHeader<Sheet^.Setcolumn(Sheet^.Limit.X))
           then
             EWidth:=Sheet^.SetColumn(Sheet^.GetColumn(EWidth+Width-Left-WidthVHeader)-1)
           else
             EWidth:=Sheet^.SetColumn(Sheet^.Limit.X);
 
    { Печатать страницу }
    if SHeight=0 then { Если это первая страница, то печатать шапку }
      for i:=1 to HTitle^.GetHeight do
      begin
        tmpHead:=HTitle^.Print(i, SWidth, EWidth-1);
        if SWidth=0 then write(F, ' ':VTitle^.Limit.X+WidthVHeader)
                    else write(F, ' ':WidthVHeader);
        writeln(F, tmpHead);
        if tmpHead<>Nil then
                          StrDispose(tmpHead);
      end;
 
    { маленькая шапка }
    tmpHead:=Sheet^.Print(-2, SWidth, EWidth);
    if SWidth=0 then write(F, ' ':VTitle^.Limit.X+WidthVHeader)
                else write(F, ' ':WidthVHeader);
    writeln(F, tmpHead);
    if tmpHead<>Nil then FreeMem(tmpHead, EWidth-SWidth+2);
 
    tmpHead:=Sheet^.Print(-1, SWidth, EWidth);
    if SWidth=0 then write(F, ' ':VTitle^.Limit.X+WidthVHeader)
                else write(F, ' ':WidthVHeader);
    writeln(F, tmpHead);
    if tmpHead<>Nil then FreeMem(tmpHead, EWidth-SWidth+2);
 
    tmpHead:=Sheet^.Print(-2, SWidth, EWidth);
    if SWidth=0 then write(F, ' ':VTitle^.Limit.X+WidthVHeader)
                else write(F, ' ':WidthVHeader);
    writeln(F, tmpHead);
    if tmpHead<>Nil then FreeMem(tmpHead, EWidth-SWidth+2);
    { закончили с маленькой шапкой }
 
    for i:=SHeight+1 to EHeight do
    begin
      if SWidth=0 then { Если это первый столбец }
      begin
        tmpHead:=VTitle^.Print(i, SWidth, VTitle^.Limit.X-1);
        write(F, tmpHead);
        ZZ:=StrLen(TmpHead);
        if tmpHead<>Nil then
             StrDispose(tmpHead);
      end;
 
      if i<10 then write(F, '│ 0',i,' │')
              else write(F, '│ ',i,' │');
 
      tmpHead:=Sheet^.Print(i, SWidth, EWidth);
      writeln(F, tmpHead);
      if tmpHead<>Nil then
                   StrDispose(tmpHead);
    end;
    SHeight:=EHeight;
    SWidth:=EWidth;
    writeln(F, #12);
 
    { Напечатан ли последний столбец данной страницы }
    if EWidth=Sheet^.SetColumn(Sheet^.Limit.X) then SWidth:=0;
 
    if EHeight=Sheet^.GetHeight then SHeight:=0;
 
  { Напечатан последний столбец последней страницы? }
  until (EHeight>=Sheet^.GetHeight) and
        (EWidth>=Sheet^.SetColumn(Sheet^.Limit.X));
  { Если нет, то: -> на начало }
 
  DeskTop^.Delete(D);
  Dispose(D, Done);
end;
{ --------------------------------------------------------------------- }
 
{***************** TCellPointer ***************************************}
Procedure TCellPointer.HandleEvent(var Event:TEvent);
begin
 
  if Event.What=evKeyDown then
  Case Event.KeyCode of
  kbLeft,kbRight,kbHome,kbEnd:exit;
  kbAltS+ord(^S):Event.KeyCode:=kbLeft;
  kbAltA+ord(^A):Event.KeyCode:=kbHome;
  kbAltD+ord(^D):Event.KeyCode:=kbRight;
  kbAltF+ord(^F):Event.KeyCode:=kbEnd;
  kbEsc:begin
     With PTable(Owner)^.Sheet^ Do
      NewCell(CurrentX,CurrentY,GetCurrentX,GetCurrentY,GetCurrentWidth);
     ClearEvent(Event);
     Changed:=False;
         exit;
        end;
  kbDel:case Protection of
       cpNormal:Changed:=True;
       cpComplex:begin
                  With PTable(Owner)^.Sheet^ do
                    ChangeValue(CurrentX,CurrentY,'');
                  ClearEvent(Event);
                  exit
                 end;
       cpProtected:ClearEvent(Event)
     end;
  else
 
   if (Event.CharCode<>#0)then
   if (Protection>cpNormal)
    then begin ClearEvent(Event);exit end else Changed:=True;
  end;
  if Event.What and evMouse<>0 then
   begin
    PTable(Owner)^.Sheet^.HandleEvent(Event);
    exit;
  end;
  TInputLine.HandleEvent(Event);
 
  if (Event.What=evBroadCast) then
    if (Event.Command=cmLeaveCell)or(Event.Command=cmScrollBarChanged) then
    begin
      if not Valid(cmLeaveCell) then
        ClearEvent(Event)
    end else
      if Event.Command=cmMovePointer then
      begin
        With PTable(Owner)^.Sheet^ Do
          NewCell(CurrentX,CurrentY,GetCurrentX,GetCurrentY,GetCurrentWidth);
        ClearEvent(Event);
      end;
end;
{обрабатывает ^S,^D как стрелки}
Function TCellPointer.Valid(Command:Word):Boolean;
begin
 if (Command=cmLeaveCell)and(Protection=cpNormal) then
  Valid:=not Changed or PTable(Owner)^.Sheet^.ChangeValue(PTable(Owner)^.Sheet^.CurrentX,
     PTable(Owner)^.Sheet^.CurrentY,Data^)
 else Valid:=TInputLine.Valid(Command);
end;
Function TCellPointer.GetHelpCtx:word;
begin
 GetHelpCtx:=PTable(Owner)^.Sheet^.HelpCtx;
end;
Procedure TCellPointer.NewCell(TblX,TblY,ScrX,ScrY,W:Integer);
{Переход на другую ячейку}
var S:String;X,Y:Integer;
begin
 
  GrowTo(W,1);
 With PTable(Owner)^.Sheet^ do
 begin
  S:=GetValue(TblX,TblY);
  Protection:=GetProtection(TblX,TblY);
  Changed:=False;
 end;
 SetData(S);
 MoveTo(ScrX,ScrY);
end;
Function TCellPointer.GetPalette:PPalette;
const P:String[Length(CCellPointer)]=CCellPointer;
begin
 GetPalette:=@P;
end;
{************************** THeader ************************************}
Constructor THeader.Init(Width,Height:Integer;AText:PCharArray);
var Bounds:TRect;
begin
 Bounds.Assign(0,0,1,1);
 TScroller.Init(Bounds,nil,nil);
 Limit.X:=Width;
 Limit.Y:=Height;
 Text:=AText;
end;
Constructor THeader.Load(var S:TStream);
begin
 TView.Load(S);
 S.Read(Delta,SizeOf(Delta));
 S.Read(Limit,SizeOf(Limit));
 GetMem(Text,Limit.X*Limit.Y);
 S.Read(Text^,Limit.X*Limit.Y);
end;
Procedure THeader.Store(var S:TStream);
begin
 TView.Store(S);
 S.Write(Delta,SizeOf(Delta));
 S.Write(Limit,SizeOf(Limit));
 S.Write(Text^,Limit.X*Limit.Y);
end;
 
Destructor THeader.Done;
begin
 if Text<>NIL then FreeMem(Text,Limit.X*Limit.Y);
 TScroller.Done;
end;
Procedure THeader.Draw;
var Start,Last:Integer;i:Integer;S:String;
begin
 I:=PTable(Owner)^.Sheet^.GetX(Delta.X);
 Start:=Delta.Y*Limit.X+i;
 if Limit.X-i>Size.X then Last:=Size.X else Last:=Limit.X-i;
 FillChar(S[1],Size.X,' ');
 For i:=0 to Pred(Size.Y) Do
 begin
  S[0]:=Chr(Size.X);
  FillChar(S[1],Size.X,' ');
  if Start<Limit.x*Limit.Y then
  Move(Text^[Start],S[1],Last);
  WriteStr(0,i,S,1);
  Inc(Start,Limit.X);
 end;
end;
 
{ ---------------------------------------------------------
 
  Процедура THeader.Print(i, Start, Finish), где i - номер строки
  заголовка, который надо вывести, а SWidth и EWidth - начальная и
  конечная позиция. Процедура возвращает строку, точнее i-ую строку
  верхнего (или не верхнего) хедера, причем не полную, а только начиная
  с SWidth позиции и кончая EWidth позицией.
}
function THeader.Print(i, Start, Finish : integer) : PChar;
var
  Result : PChar;
begin
  if Start>=Finish then Print:=Nil
  else
  begin
    GetMem(Result, Finish-Start+2);
    Move(Text^[(i-1)*Limit.X+Start], Result^, Finish-Start+1);
    Result[Finish-Start+1]:=#0;
    Print:=Result;
  end;
end;
{ --------------------------------------------------------- }
 
{*********************** TSheet ************************************}
Constructor TSheet.Init(ALimitX,ALimitY:Integer);
var Bounds:TRect;
begin
 Bounds.Assign(0,0,1,1);
 TScroller.Init(Bounds,nil,nil);
 Limit.X:=ALimitX;
 Limit.Y:=AlimitY;
 Options:=Options and ofPostProcess;
 GrowMode:=gfGrowHiX+gfGrowHiY;
end;
Function TSheet.GetWidth(Column:Integer):Integer;
{Возвращает ширину указанной колонки}
begin
 GetWidth:=9;
end;
Function TSheet.GetCurrentWidth:Integer;
{Возвращает ширину текущей колонки}
begin
 GetCurrentWidth:=GetWidth(CurrentX);
end;
Function TSheet.GetX(Column:Integer):Integer;
{Возвращает абсолютную позицию текущей колонки в таблице}
var W:Word;I:Integer;
begin
 W:=0;
 for i:=0 to Pred(Column) do
  W:=W+GetWidth(i);
 GetX:=W;
end;
Function TSheet.GetCurrentX:Integer;
{Возвращает экранные координаты текущей ячейки в координатах
владельца}
var W:Word;I:Integer;
begin
  W:=0;
  For i:=Delta.X to Pred(CurrentX) do
   W:=W+GetWidth(i);
  GetCurrentX:=W+Origin.X;
end;
Function TSheet.GetFormula(X,Y:Integer):String;
{Возвращает редактируемое представление ячейки с классом
защиты cpComplex}
begin
 GetFormula:=GetValue(X,Y);
end;
Function TSheet.GetProtection(X,Y:Integer):TCellProt;
{Возвращает класс защиты ячейки}
begin
 GetProtection:=cpNormal;
end;
Function TSheet.GetCurrentY:Integer;
{Возвращает экранные координаты текущей ячейки в координатах
владельца}
begin
  GetCurrentY:=CurCell.Y+Origin.Y;
end;
Function TSheet.CurrentX:Integer;
{Положение текущей ячейки в таблице}
begin
 CurrentX:=Delta.X+CurCell.X;
end;
Function TSheet.CurrentY:integer;
{Положение текущей ячейки в таблице}
begin
 CurrentY:=Delta.Y+CurCell.Y;
end;
Function TSheet.GetValue(X,Y:Integer):String;
{Возвращает строковое представление указанной ячейки}
begin
 GetValue:='';
end;
Function TSheet.CellJust(X,y:Integer):TCellJust;
{Возвращает тип выравнивания значения в ячейке}
begin
 CellJust := cjRight;
end;
{ ------------------------------------------------ }
Function TSheet.ChangeValue(X,Y:Integer;value:String):Boolean;
{Изменяет содержимое указанной ячейки или возвращает False,
если значение недопустимое}
begin
 ChangeValue:=True;
end;
{ ------------------------------------------------ }
Procedure TSheet.Draw;
var i,j,x,w:integer;S,Cell:String;
    just:TCellJust;
begin
  S[0]:=chr(Size.X);
  For j:=0 to Pred(Size.Y) do
   begin
    FillChar(S[1],Size.X, ' ');
    X:=1;
    if j>=Limit.Y then WriteStr(0,j,S,1) else
    begin
     i:=Delta.X;
    While (X<=Size.X)and(I<Limit.X) do
     begin
      Cell:=GetValue(i,j+Delta.Y);
      W:=GetWidth(i);
      Just:=CellJust(i,j+Delta.Y);
    { if Cell<>'' then}
       begin
        if (Length(Cell)>W)and(Just<>cjLeft) then
          Cell:=Copy(Cell,1,W);
        While Length(Cell)<W do
         Case Just of
         cjLeft:Cell:=Cell+' ';
         cjCenter:Cell:=' '+Cell+' ';
         cjRight:Cell:=' '+Cell;
         end;
        if Size.X-X-W+1>0 then
        FillChar(Cell[W+1],Size.X-X-W+1,' ');
 
        WriteStr(X-1,J,Cell,CellColor(i,J+Delta.Y));
      end;
     X:=X+W;
     inc(i);
    end;
    if X<=Size.X then
      WriteChar(X-1,J,' ',1,Size.X-X+1);
   end;
    {WriteStr(0,j,S,1);}
   end;
   if X<=Size.X then LastColumn:=i else
   LastColumn:=i-2;
   HScrollBar^.SetParams(Delta.X,0,Limit.X-1,LastColumn-Delta.X,1);
end;
{ ------------------------------------------------- }
Procedure TSheet.HandleEvent(var Event:TEvent);
{Обрабатывает события от мыши и стрелки и в случае если оно
произошло, вырабатывает сообщение cmLeaveCell}
 
  var MousePoint:TPoint;I:Integer;
  { ------------------------------------ }
  Procedure MovePointer(X,Y:Integer);
  begin
   Event.What:=evBroadCast;
   Event.Command:=cmLeaveCell;
   TPoint(Event.InfoPtr).X:=X;
   TPoint(Event.InfoPtr).Y:=Y;
   PutEvent(Event);
  end;
  { ------------------------------------ }
  Procedure ChangeCellPointer;
  begin
   Message(Owner,evBroadCast,cmMovePointer,nil);
  end;
  { ------------------------------------ }
begin
 TScroller.HandleEvent(Event);
 
 if Event.What=evKeyDown then
 begin
  case Event.KeyCode of
    { Стрелки - если курсор не на краю таблицы, то он перемещается,
      иначе событие передается ScrollBar'ам }
    kbLeft  : if CurCell.X>0 then
                MovePointer(CurCell.X-1,CurCell.Y)
              else exit;
 
    kbRight : if CurCell.X+Delta.X<Pred(Limit.X) then
                if Delta.X+CurCell.X<LastColumn-1 then
                  MovePointer(CurCell.X+1,CurCell.Y)
                else exit;
 
    kbUp    : if CurCell.Y>0 then
                MovePointer(CurCell.X,CurCell.Y-1)
              else exit;
 
    kbDown  : if CurCell.Y+Delta.Y<Pred(Limit.Y) then
                if CurCell.Y<Pred(Size.Y) then
                  MovePointer(CurCell.X,CurCell.Y+1)
                else exit;
    else exit;
  end; { case }
  ClearEvent(Event);
 end
 else if Event.What=evMouseDown then
 begin
  MakeLocal(Event.Where,MousePoint);
  MousePoint.X:=MousePoint.X+GetX(Delta.X);
  i:=Delta.X;
  While GetX(I+1)< MousePoint.X do inc(i);
  if (CurCell.X=I-Delta.X)and(MousePoint.Y=CurCell.Y) then Exit;
  MovePointer(i-Delta.X,MousePoint.Y);
  ClearEvent(Event);
 end else
 if (Event.What=evBroadCast)
  Then
  if (Event.Command=cmLeaveCell) then
  begin
   CurCell.X:=TPoint(Event.InfoPtr).X;
   CurCell.Y:=TPoint(Event.InfoPtr).Y;
   ChangeCellPointer;
   ClearEvent(Event);
  end else
  if Event.Command=cmScrollBarChanged then
  begin
   if Delta.X+CurCell.X>Limit.X-1 then
   CurCell.X:=Limit.X-Delta.X-1;
    ChangeCellPointer;
  end;
end;
{ ---------------------------------------------------- }
Function TSheet.CellColor(X,Y:Integer):Byte;
begin
 CellColor:=1;
end;
Constructor TSheet.Load(var S:TStream);
begin
 TView.Load(S);
 S.Read(Delta,SizeOf(Delta));
 S.Read(Limit,SizeOf(Limit));
 S.Read(CurCell,SizeOf(CurCell));
 S.Read(LastColumn,SizeOf(LastColumn));
end;
Procedure TSheet.Store(var S:TStream);
begin
 TView.Store(S);
 S.Write(Delta,SizeOf(Delta));
 S.Write(Limit,SizeOf(Limit));
 S.Write(CurCell,SizeOf(CurCell));
 S.Write(LastColumn,SizeOf(LastColumn));
end;
{ -------------------------------------------------------------------- }
function TSheet.GetColumn(Poz : integer) : integer;
var
  Result : integer;
begin
  Result:=0;
  while Poz>=0 do
  begin
    Poz:=Poz-GetWidth(Result);
    inc(Result);
  end;
  GetColumn:=Result;
end;
{ -------------------------------------------------------------------- }
function TSheet.SetColumn(Col : integer) : integer;
var
  Result, i : integer;
begin
  Result:=0;
  for i:=1 to Col do
    Result:=Result+GetWidth(i-1);
  SetColumn:=Result;
end;
{ -------------------------------------------------------------------- }
function TSheet.Print(i, Start, Finish : integer) : PChar;
var
  Result : PChar;
  tmpasc : array [0..255] of char;
  j,k    : integer;
  lim    : integer;
  SCol, FCol : integer;
  tmpStr : string;
  Just   : TCellJust;
  tmpInt : integer;
 
begin
  if Start>=Finish then Print:=Nil
  else
  begin
    if MaxAvail<Finish-Start+2 then Print:=Nil
    else
    begin
      GetMem(Result, Finish-Start+2);
      Result[0]:=#0;
      SCol:=GetColumn(Start)-1;
      FCol:=GetColumn(Finish)-1;
 
      for j:=SCol to FCol-1 do
      begin
        tmpInt:=GetWidth(j);
        tmpStr:='';
 
        case i of
          -1 : tmpStr:=long2str(j+1);
          -2 : for k:=1 to tmpInt do
                 tmpStr:=tmpStr+'─';
          else tmpStr:=Trim(GetValue(j,i-1));
        end; { case }
 
        if i=-1 then Just:=cjCenter
                else Just:=CellJust(j,i);
 
        while length(tmpStr)<tmpInt do
          case Just of
            cjLeft   : tmpStr:=tmpStr+' ';
            cjCenter : tmpStr:=' '+tmpStr+' ';
            cjRight  : tmpStr:=' '+tmpStr;
          end;
 
        if length(tmpStr)>tmpInt then
          tmpStr:=Copy(tmpStr,1,tmpInt); { урезать до нормы }
 
        if i=-1 then tmpStr[length(tmpStr)]:='│';
        if i=-2 then tmpStr[length(tmpStr)]:='┼';
                                         { заменить последний символ }
        Result:=StrCat(Result, StrPCopy(tmpasc, tmpStr));
      end;
      Print:=Result;
    end;
  end;
end;
{ -------------------------------------------------------------------- }
 
end.

function long2str(L:LongInt):string;
var serv : string;
begin
  str(L, serv);
  long2str := serv;
end;
 
function Trim(const S: string): string;
var
  i,j : longint;
begin
  i:=1;
  while (i<length(s)) and (s[i]=' ') do
   inc(i);
  j:=length(s);
  while (j>0) and (s[j]=' ') do
   dec(j);
  Trim:=Copy(S,i,j-i+1);
end;

type
   TMyPoint = record
      X : SmallInt;
      Y : SmallInt;
   end;

procedure 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^.QetFileName(s) ; {s содержит имя файла}
    {Открыть файл}
   end;
 end; {case Control} 
 Dispose (PF, Done) {Уничтожаем экземпляр} 
end; {FileOpen}

uses StdDlg;

uses ..., app, fvconsts, stddlg;
 
procedure FileOpen; {Открывает файл данных} 
var
 PF: PFileDialog; {Диалоговое окно выбора файла} 
 Control: Word; 
 s: PathStr; 
begin
 {Создаем экземпляр динамического объекта:} 
 New(PF, Init('*.dat','Выберите нужный файл:','Имя файла',fdOpenButton,0)); 
 {С помощью следующего оператора окно выводится на экран и результат работы пользователя с ним помещается в переменную Control:} 
 Control := DeskTop^.ExecView(PF); 
 {Анализируем результат запроса:} 
 case Control of 
  cmFileOpen, cmOk: // Это описано в FVconsts, а не в StdDlg
   begin {Пользователь указал имя файла:}
    PF^.GetFileName(s) ; {s содержит имя файла}
    {Открыть файл}
   end;
 end; {case Control} 
 Dispose (PF, Done) {Уничтожаем экземпляр} 
end; {FileOpen}

procedure TNotebook.ChangeDir;
{Изменяет текущий каталог} 
var
 PD: PChDirDialog; {Диалоговое окно смены каталога/диска}
 Control: Word; 
begin
 New(PD, Init(cdNormal,0));{Создаем диалоговое окно}
 Control := DeskTop^.ExecView(PD);{Используем окно}
 ChDir(PD^.Dirlnput^.Data^);{Устанавливаем новый каталог}
 Dispose(PD, Done){Удаляем окно из кучи}
end; {TNotebook.ChangeDir}

procedure TNotebook.ChangeDir;
{Изменяет текущий каталог} 
var
 PD: PChDirDialog; {Диалоговое окно смены каталога/диска}
 Control: Word; 
 s : string;
begin
 New(PD, Init(cdNormal,0));{Создаем диалоговое окно}
 Control := DeskTop^.ExecView(PD);{Используем окно}
 s := PD^.Dirlnput^.Data^;
 ChDir(s);{Устанавливаем новый каталог}
 Dispose(PD, Done){Удаляем окно из кучи}
end; {TNotebook.ChangeDir}

...
begin
 ...
 ChDir(PD^.Dirinput^.Data^); {Устанавливаем новый каталог}
 ...

program HelpS;
{Программа обслуживает файлы данных "справочной системы"}
uses App, Objects, Menus, Drivers, Views, StdDlg, FVconsts, DOS, Memory, Dialogs;
const
 {Команды для обработчиков событий}
 cmWork = 203; {Обработать данные}
 cmDOS = 204; {Временно выйти в ДОС}
 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;
 
type
 PWorkWin = ^TWorkWin; 
 TWorkWin = object (TWindow) 
 Constructor Init(Bounds: TRect); 
end;
 
type
 PInterior = ^TInterior;
 TInterior = object (TScroller)
 Location: Word;
 PS: PStringCollection;
 constructor Init(var Bounds: TRect; HS,VS: PScrollBar);
 procedure Draw; virtual;
 procedure ReadFile;
 destructor Done; virtual;
 procedure HandleEvent(var Event: TEvent); virtual; 
end;
 
type
{Объект-программа TNotebook поддерживает работу с меню и строкой статуса} 
 TNotebook = object (TApplication)  {Создаем объект-потомок от TApplication} 
 procedure InitStatusLine; virtual;  {Перекрываем старый метод InitStatusLine новым} 
 procedure InitMenuBar; virtual; 
 procedure HandleEvent(var Event: TEvent); virtual;
 procedure FileSave;
 procedure ChangeDir;
 procedure DOSCall;
 procedure FileOpen;
 procedure Work; 
end;
 
var
 HelpSystem: TNotebook;
 DataFile: file of DataType; {Файловая переменная} 
 OpFileF: Boolean; {Флаг открытого файла}
// NLines: Word; {Истинная длина массива строк} 
 
destructor TInterior.Done; 
begin
 Dispose(PS, Done); {Удаляем коллекцию} 
 inherited Done {Выполняем стандартный деструктор} 
end;
 
Procedure TInterior.HandleEvent(var Event: TEvent); 
{Обработчик событий для окна данных} 
var
 R: TPoint; 
begin
 Inherited HandleEvent(Event);
 case Event.What of
  evMouseDown: {Реакция на щелчок мышью} 
              begin
               MakeLocal(MouseWhere, R);{Получаем в R локальные координаты указателя мыши}
               Location := Delta.Y+R.Y; 
               Draw; 
              end;
 evKeyDown: {Реакция на клавиши + -} 
 case Event.KeyCode of
  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 TInterior.ReadFile;
{Читает содержимое файла данных в массив Lines}
var
 k: Integer;
 s: String;
 Data: DataType;
 f: text;
begin
 PS := New(PStringCollection, Init(100,10)); 
 s := copy(ParamStr(0),1,pos('.',ParamStr(0)))+'pas'; 
 Assign(f,s);
 Reset (f); {Открыть файл с текстом программы} 
 while not (EOF(f) or LowMemory) do begin
  readln(f,s);
  if s <> ' ' then PS^.Insert(NewStr(s)) 
 end;
 Close(f); 
 exit;
 Seek(DataFile,0);
 while not (EOF(DataFile) or LowMemory) do 
 begin
  read(DataFile, data); 
  with data do begin
  end;
  if s<>''then PS^.Insert(NewStr(s)) 
 end;
 Location:=0;
end; {ReadFile}
 
Constructor TInterior.Init(var Bounds: TRect; HS,VS: PScrollBar); 
{Создает окно для данных}
begin
 inherited Init(Bounds, HS, VS);
 ReadFile;
 GrowMode := gfGrowHiX + gfGrowHiY;
 SetLimit(LLine, PS^.Count) 
end; {TInterior.Init}
 
Procedure TInterior.Draw; 
{Выводит данные в окно просмотра} 
var
 n,k:Integer;
 B: TDrawBuffer;
 p: PString; 
 Color: Byte; 
 
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 begin
  k := Delta.Y+n; 
  if k=Location then
   Color := GetColor(2) 
  else
   Color := GetColor(1);
 end 
end; {TInterior.Draw}
 
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 TNotebook.InitMenuBar; 
{Создание верхнего меню}
var
 R: TRect; 
begin
 GetExtent(R);
 R.B.Y := succ(R.A.Y) ; {R - координаты, строки меню} 
 MenuBar := New(PMenuBar, Init(R, NewMenu ( {Создаем меню}
 {Первый элемент нового меню представляет собой подменю (меню второго уровня) . Создаем его}
 NewSubMenu( '~F~/ File', hcNoContext, 
 {Описываем элемент главного меню} 
 NewMenu( {Создаем подменю} 
 NewItem( '~1~/ Open ', 'F3' , kbF3,cmOpen, hcNoContext, 
 NewItem( '~2~/ Close ', 'F2', kbF2, cmSave,hcNoContext, 
 NewItem( '~3~/ Change disk' , ' ' , 0, cmChangeDir,hcNoContext, 
 NewLine ( {Строка-разделитель} 
 NewItem('~4~/ Call DOS' , ' ' , 0, cmDOSShell, hcNoContext, 
 NewItem('~5~/ Exit' , 'Alt-X' , kbAltX, cmQuit, hcNoContext,
 NIL) ))))) {Нет других элементов подменю} ),
 {Создаем второй элемент главного меню} 
 NewItem( '~W~/ Work', ' ', kbF4, cmWork, hcNoContext, 
 NIL) {Нет других элементов главного меню} )))) 
end; {TNotebook. InitMenuBar}
 
procedure TNotebook.InitStatusLine; {Описание нового метода,
 с помощью которого создается строка статуса}
var
 R: TRect; {Границы строки статуса} 
begin
 GetExtent(R); {Получаем в R координаты всего экрана} 
 R.A.Y := pred(R.B.Y); {Помещаем в R координаты строки статуса}
 {Создаем строку статуса} 
 StatusLine := New(PStatusLine, Init(R, 
 {Определяем один вариант строки статуса} 
 NewStatusDef(0, $FFFF, {Устанавливаем для этого варианта
 максимальный диапазон контекстной справочной службы}
 {Определяем единственную клавишу Alt-X} 
 NewStatusKey('~Alt-X~ Exit' , kbAltX, cmQuit,
 NewStatusKey('~F2~ Close', kbF2, cmSave,
 NewStatusKey('~F3~ Open', kbF3,cmOpen,
 NewStatusKey('~F4~ Work', kbF4,cmWork, 
 NewStatusKey('~F10~ Menu', kbF10,cmMenu,
 {Нет других клавиш} NIL))))),
 {Нет других строк статуса} NIL) ));
 DisableCommands(WinCom1) {Запрещаем недоступные команды} 
end; {TNotebook. InitStatusLine}
 
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 
  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);
    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; 
 s: string;
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
end; {DOSCall}
 
procedure TNotebook.Work;
{Работа с данными}
var
 R: TRect;
 PW: PWorkWin; 
begin
 R.Assign(0,0,80,23) ;
 PW := New(PWorkWin, Init(R));
 DeskTop^.Insert(PW) 
end; {Work}
 
procedure TNotebook.HandleEvent(var Event: TEvent); 
{Обработчик событий программы} 
begin {TNotebook.HandleEvent} 
 inherited 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}
 
begin
 HelpSystem.Init;
 HelpSystem.Run;
 HelpSystem.Done;
end.

procedure TNotebook.Work;
{Работа с данными}
var
 R: TRect;
 PW: PWorkWin; 
begin
 R.Assign(0,0,80,23) ;
 PW := New(PWorkWin, Init(R));
 DeskTop^.Insert(PW) 
end; {Work}

 s := copy(ParamStr(0),1,pos('.',ParamStr(0)))+'pas';