Информатика на пять О нас
 Добавить в избранное
5byte.ru
 Теория
 8 класс
 9 класс
 10 класс
 11 класс
Задания
 8 класс
 9 класс
 10 класс
 11 класс
Книги
Тесты
ЕГЭ
Turbo Pascal 7
 Описание
 Задачи
HTML
Рефераты

Приложениe Г

Пример использования ООП

  {* * * * Модуль с объектами экранного редактора * * * *}
unit Edit;

  {* * * Интерфейс модуля * * *}
interface
const Len = 80;           {размер элемента строки}
      BackS = 8;          {код клавиши Backspace}
      Ent = 13;           {код клавиши Enter}
      Esc = 27;           {код клавиши Esc}
type
   tEkran = array[1..25, 1..80, 1..2] of Char;
                          {тип-массив видеопамяти}
   tStringLen = string[Len];        {тип-элемент строки}
var
   S: tEkran absolute $B800:$0000;
                          {видеопамять текстового режима}
   Ch: Char;              {вводимый символ}

  {* * Объект связи в структуре * *}
type
  pConnection = ^tConnection;
  tConnection = object           {предок последующих объектов}
    PredElem: Pointer;
                  {указатель на предыдущий элемент структуры}
    NextElem: Pointer;
                  {указатель на следующий элемент структуры}
    procedure PutPredElem(PredEl: Pointer);
                    {задание указателя на предыдущий элемент}
    procedure PutNextElem(NextEl: Pointer);
                    {задание указателя на следующий элемент}
    function GetPredElem: Pointer;
                    {получение указателя на предыдущий элемент}
    function GetNextElem: Pointer;
                    {получение указателя на следующий элемент}
  end;

  {* * Объект - структура * *}
type
  pStrucrure = ^tStructure;
  tStructure = object(tConnection)   {потомок типа tConnection}
    FirstElem: Pointer;         {указатель на первый элемент}
    LastElem: Pointer;          {указатель на последний элемент}
    constructor Init;           {фиктивная подпрограмма}
    procedure PutFirstElem(FirstEl: Pointer);
                    {задание указателя на первый элемент}
    procedure PutLastElem(LastEl: Pointer);
                    {задание указателя на последний элемент}
    function GetFirstElem: Pointer;
                    {получение указателя на первый элемент}
    function GetLastElem: Pointer;
                    {получение указателя на последний элемент}
    function InitElem: Pointer; virtual;
                    {инициализация элемента}
    procedure DispElem(PointDel: Pointer); virtual;
                    {удаление элемента из динамической памяти}
    procedure PutConnection(FirstPoint, SecondPoint:Pointer);                     {установление связи между элементами}
    procedure NewEKPointPredEl, PointNextEl: Pointer);
                    {включение нового элемента}
    procedure DelEKPointDel: Pointer);
                    {удаление элемента}
  end;

  {* * Объект - элемент строки * *}
pElLine = ^tElLine;
tElLine = object(tConnection)     {потомок типа tConnection}
  Info: tStringLen;               {строка текста}
  constructor Init;               {конструктор объекта}
  procedure PutSymb(Ch: Char; NomlnEl: Byte; var OldSym: Char); {размещение символа Ch в элементе строки в позиции NomlnEl; в OldSym - последний удаленный из строки символ}
  function GetSymb(NomInEl: Byte): Char;
          {получение символа из позиции NomlnEl}
  procedure PutString(Str: tStringLen; BegNom: Byte);
          {размещение строки Str, начиная с позиции BegNom}
  function GetString(BegNom: Byte): tStringLen;
          {получение части строки, начиная с позиции BegNom}
end;

  {* * Объект - строка * *}
pLine = ^tLine;
tLine = object(tStructure)        {потомок типа tStructure}
  constructor Init;               {конструктор объекта}
  destructor Done;                {деструктор объекта}
  function InitElem: Pointer; virtual;
                                  {инициализация элемента}
  procedure DispElem(PointDel: Pointer); virtual;
                  {удаление элемента из динамической памяти}
  procedure GetPointElLineAndNomlnEKNom: Word; var PointElLine: PElLine; var NomlnEl: Byte; NewLine: Boolean);
{Получение указателя PointElLine на элемент строки, в котором находится символ с абсолютным номером Nom,
и номер позиции этого символа NomlnEl в элементе строки; если NewLine = True, при отсутствии требуемого элемента строки он создается}
  procedure PutSymb(Nom: Word);
     {размещение символа Ch в строке с абсолютным номером Nom позиции в строке}
  function GetSymb(Nom: Word): Char;
          {получение символа с абсолютным номером Nom позиции в строке}
  procedure LastNotBlank(var PointElLine: PElLine; var NomAbs: Word; var NomlnEl: Byte);
{получение указателя PointElLine на элемент строки, в котором находится последний символ, не являющийся пробелом,
абсолютного номера NomAbs этого символа в строке и номера позици этого символа NomlnEl в элементе строки}
end;

  {* * Объект - текст * *}
type
  pText = ^tText;
  tText = object(tStructure)       {потомок типа tStructure}
    Xabs,Yabs: Word;
      {абсолютные координаты текущего символа в тексте}
    SmX,SmY: Word;
      {координаты начала экрана в тексте (отсчет от нуля)}
    CurrentPointLine: pLine;
      {указатель на текущую строку текста (соответствует Yabs)}
    OnlyLine,FullEkran: Boolean;
      {признак необходимости вывода на экран текущей строки или всего текста}
    constructor Init;               {конструктор объекта}
    destructor Done;                {деструктор объекта}
    function InitElem: Pointer; virtual;
                                    {инициализация строки}
    procedure DispElem(PointDel: Pointer); virtual;
      {удаление строки из динамической памяти}
    procedure PutX(X: Word);
      {задание координат X - абсолютной и смещения начала экрана, если Х=0, координата не меняется}
    procedure PutY(Y: Word);
      {задание координат Y - абсолютной и смещения начала экрана, если Y=0 или больше максимального числа, координата не меняется}
    procedure IncX;                 {увеличение координат X на 1}
    procedure DecX;
      {уменьшение координат X на 1, если Xabs=0, координата не меняется}
    procedure IncY;
      {увеличение координат Y на 1 и получение следующего текущего указателя на строку, если след. строки нет, координата не меняется}
    procedure DecY;
      {уменьшение координат Y на 1 и получение предыдущего текущего указателя на строку, если Yabs=0, координата не меняется}
    function GetX: Word;            {получение координаты Xabs}
    function GetY: Word;            {получение координаты Yabs}
    function GetPointLine(Y: Word): pLine;
      {получение указателя на строку с координатой Y}
    procedure PutSymb;
             {помещение символа в текст с текущими координатами}
    function GetSymb: Char;         {получение символа с текущими координатами}
    procedure PutEkran;         {вывод текста на экран}
    PutCursor;                  {вывод курсора на экран}
end;

  {* * Объект - выполнение операции * *}
type
  pOperation = ^tOperation;
  tOperation = object             {предок последующих объектов}
    constructor Init;
    procedure PutNewSymb;         {обработка введенного символа}
    procedure Ins; virtual;       {размещение символа в тексте}
  end;

  {* * Объект - Размещение символа с кодом больше 30 * *}
  pInsertSymbol = ^tInsertSymbol;
  tInsertSymbol = object(tOperation)
                                  {потомок типа tOperation}
    Symb: Char;                   {размещаемый символ}
    Constructor Init;             {конструктор объекта}
    Procedure Ins; virtual;       {размещение символа}
  end;

  {* * Объекты - перемещение курсора на одну позицию **}
  pInsertUp = ^tInsertUp;
  tInsertUp = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;       {перемещение курсора вверх}
  end;
  pInsertDn = ^tInsertDn;
  tInsertDn = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;       {перемещение курсора вниз}
  end;
  pInsertLeft = ^tInsertLeft;
  tInsertLeft = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;       {перемещение курсора влево}
  end;
  pInsertRight = ^tInsertRight;
  tInsertRight = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;       {перемещение курсора вправо}
  end;

  {* * Объект - обработка клавиши Enter * *}
  pInsertEnter = ^tInsertEnter;
  tInsertEnter = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;       {формирование новой строки}
  end;

  {** Объект -обработка клавиши Backspace **}
  pInsertBackSpace = ^tInsertBackSpace;
  tInsertBackSpace = object(tOperation)
    constructor Init;             {конструктор объекта}
    procedure Ins; virtual;      {удаление символа или объединение двух строк}
  end;
var
  PointText: pText;        {указатель создаваемого текста}
  Symbol: pInsertSymbol;   {указатель на объект - размещение символа}
  Up: pInsertUp;          {указатель на объект - курсор вверх}
  Dn: pInsertDn;          {указатель на объект - курсор вниз}
  Left: pInsertLeft;      {указатель на объект - курсор влево}
  Right: pInsertRignt;    {указатель на объект - курсор вправо}
  Enter: pInsertEnter;    {указатель на объект - обработка клавиши Enter}
  Backspace: pInsertBackSpace;    {указатель на объект - обработка клавиши Backspace}
  StringOfBlanks: tStringLen;     {строка пробелов}

  {* * * Исполнительная часть модуля * * *}
implementation
uses Crt;

  {* * Подпрограммы tConnection * *}
procedure tConnection.PutPredElem(PredEl: Pointer);
begin
  PredElem := PredEl
end;
procedure tConnection.PutNextElem(NextEl: Pointer);
begin
  NextElem := NextEl
end;
function tConnection.GetPredElem: Pointer;
begin
  GetPredElem := PredElem
end;
function tConnection.GetNextElem: Pointer;
begin
  GetNextElem := NextElem
end;

  {* * Подпрограммы tStructure * *}
constructor tStructure.Init;
begin                              {фиктивная подпрограмма}
end;
procedure tStructure.PutFirstElem(FirstEl: Pointer);
begin
  FirstElem := FirstEl
end;
procedure tStructure.PutLastElem(LastEl: Pointer);
begin
  LastElem := LastEl
end;
function tStructure.GetFirstElem: Pointer;
begin
  GetFirstElem := FirstElem
end;
function tStructure.GetLastElem: Pointer;
begin
  GetLastElem := LastElem
end;
function tStructure.InitElem: Pointer;
begin                              {фиктивная подпрограмма}
end;
procedure tStructure.DispElem(PointDel: Pointer);
begin                              {фиктивная подпрограмма}
end;
procedure tStructure.PutConnection(FirstPoint, SecondPoint:Pointer);
begin
  if FirstPointonil then      {первый элемент существует - связь со вторым}
    pLine(FirstPoint)^.PutNextElem(SecondPoint)
  else                        {нет - второй элемент - начальный}
    PutFirstElem(SecondPoint);
  if SecondPoint <>nil then   {второй элемент существует - связь с первым}
    pLine(SecondPoint)^.PutPredElem(FirstPoint)
  else                        {нет - первый элемент - конечный}
    PutLastElem(FirstPoint);
end ;
procedure tStructure.NewEl(PointPredEl, PointNextEl: Pointer);
var NewPoint: Pointer;
begin
  NewPoint := InitElem;        {новый элемент}
  PutConnection(PointPredEl, NewPoint);
                               {связь с предыдущим элементом}
  PutConnection(NewPoint, PointNextEl);
                               {связь со следующим элементом}
end;
procedure tStructure.DelEl(PointDel: Pointer);
var Point: pLine;
begin
  Point := PointDel;
  PutConnection(Point^.GetPredElem, Point^.GetNextElem);
                  {установление связей минуя удаляемый элемент}
  DispElem(PointDel)            {удаление элемента}
end;

{** Подпрограммы tElLine **)
constructor tElLine.Init;
begin
  Info := StringOfBlanks;        {заполнение строки пробелами}
end;
procedure tElLine.PutSymb(Ch: Char; NomInEl: Byte; var OldSym: Char);
begin
  if (NomInEl > 0) and (NomInEl <= Len) then
                                  {допустимый номер символа}
    begin
      OldSym := Info[Len];        {сохранение последнего символа}
      Insert(Ch, Info, NomInEl)   {размещение символа}
    end
end;
function tElLine.GetSymb(NomInEl: Byte): Char;
begin
  if (NomInEl > 0) and (NomInEl <= Len) then
                                  {допустимый номер символа}
     GetSymb := Info[NomInEl]
  else                            {нет - помещение пробела}
     GetSymb := ' '
end;
procedure tElLine.PutString(Str: tStringLen; BegNom: Byte);
begin
  Insert(Str, Info, BegNom)       {размещение строки}
end;
function tElLine:GetString(BegNom: Byte): tStringLen;
begin
  GetString := Copy(Info.BegNom,Len)    {получение части строки}
end;

  {* * Подпрограммы tLine * *}
constructor tLine.Init;
begin
  NewEl(nil, nil)              {задание связей первого элемента}
end;
destructor tLine.Done;
var P1 ,P2: pElLine;
begin
  P1 : = GetFirstElem;         {указатель на первый элемент}
  While P1 <> nil do           {пока есть очередной элемент . . .}
    begin
      Р2 := P1^.GetNextElem;   {указатель на следующий элемент}
      Dispose(P1);             {удаление элемента строки}
      Р1 := Р2
    end
end;
function tLine.InitElem;
begin
  InitElem : = New(pElLine, Init);  {создание нового элемента строки}
end;
procedure tLine.DispElem(PointDel: Pointer);
begin
  Dispose(pElLine(PointDel));       {удаление элемента строки}
end;
procedure tLine.GetPointElLineAndNomInEl(Norn: Word;
                    var PointElLine: PElLine;
                    var NomInEl: Byte; NewLine: Boolean);
begin
  PointElLine := GetFirstElem;      {первый элемент строки}
  while (Nom > Len) do              {если номер символа больше размера строки...}
    begin
      if NewLine and (PointElLine^.GetNextElem=nil) then
  {если нет следующего элемента, а его следует создать...}
         NewEl(PointElLine, nil);
  {создание нового элемента}
      if PointElLine <> nil then
  {если нет следующего элемента...}
         PointElLine := PointElLine^.GetNextElem;
  {указатель на следующий элемент}
      Nom := Nom-Len
  {уменьшение порядкового номера символа на размер элемента строки}
    end;
  if NewLine and (PointElLine = nil) then
{если нет следующего элемента, а его следует создать...}
     NewEl(GetLastElem, nil);        {создание нового элемента}
  if PointElLine <> nil then         {если есть элемент строки...}
     NomInEl := Nom                  {получение номера}
  else
     NomInEl := 0                    {иначе номер равен нулю}
end;
procedure tLine.PutSymb(Nom: Word);
var PointElLine: pElLine;
    OldSym: Char;
    NomInEl: Byte;
    NewPointElLine: pElLine;
begin
  GetPointElLineAndNomInEl(Nom, PointElLine, NomInEl, True);
    {получение указателя на элемент строки и номера позиции символа}
  PointElLine^.PutSymb(Ch, NomInEl, OldSym);
    {размещение символа в элементе строки}
  while (OldSym <> ' ') or (PointElLine^.GetNextElem <> nil)
  do
    {пока последний символ не пробел или есть следующий элемент строки...}
    begin
      if PointElLine^.GetNextElem = nil then
  {если нет следующего элемента строки...}
      NewEl(PointElLine, nil);
  {создать его}
      PointElLine := PointElLine^.GetNextElem;
  {следующий элемент}
      PointElLine^.PutSymb(OldSym, 1, OldSym)
  {последний символ - в первую позицию}
    end
end;
function tLine.GetSymb(Nom: Word): Char;
var PointElLine: pElLine;
    NomInEl: Byte;
begin
  GetPointElLineAndNomInEl(Nom, PointElLine, NomInEl, False);
{получение указателя на элемент строки и номера позиции символа}
  if PointElLine <> nil then             {если есть символ...}
     GetSymb := PointElLine^.GetSymb(NomInEl)
  else
     GetSymb := ' '                      {иначе - пробел}
end;
procedure tLine.LastNotBlank(var PointElLine: PElLine;
var NomAbs: Word; var NomInEl: Byte);
var Point: pElLine;
     TekNom: Word;
     i: Byte;
begin
  Point := GetFirstElem;      {указатель на первый элемент строки}
  NomAbs := 0;
  TekNom := 0;
  repeat
    for i := 1 to Len do
      begin
        Inc(TekNom);
        if Point^.GetSymb(i) <> ' ' then
           NomAbs : = TekNom   {очередной символ - не пробел}
      end;
    Point : = Point^.GetNextElem
  until Point = nil;           {пока есть очередной элемент}
  GetPointElLineAndNomInEl(NomAbs, PointElLine, NomInEl, False);
end;

{* * Подпрограммы tText * *}
constructor tText.Init;
begin
  NewEl(nil, nil);                  {задание связей первой строки}
  Xabs := 1;                        {абсолютные координаты}
  Yabs := 1;                        {курсора}
  SmX := 0;                         {смещение начала экрана}
  SmY := 0;
  CurrentPointLine:=GetFirstElem;   {текущий указатель}
  OnlyLine := False;                {признаки вывода на экран}
  FullEkran := False;
  New(Symbol, Init);                {объект - размещение символа}
  New(Up, Init);                    {объект - курсор вверх}
  New(Dn, Init);                    {объект - курсор вниз}
  New(Left, Init);                  {объект - курсор влево}
  New(Right, Init);                 {объект - курсор вправо}
  New(Enter, Init);                 {объект - обработка Enter}
  New(BackSpace, Init);             {объект - обработка Backspace}
end;
destructor tText.Done;
var P1, P2: pLine;
begin
  P1 := GetFirstElem;               {указатель на первую строку}
  while P1 <> nil do
    begin
      P2 : = P1^.GetNextElem;               {следующая строка}
      Dispose(P1, Done);               {удаление строки}
      P1 := P2
    end;
  Dispose(Symbol);        {удаление объекта - размещение символа}
  Dispose(Up);             {удаление объекта - курсор вверх}
  Dispose(Dn);             {удаление объекта - курсор вниз}
  Dispose(Left);           {удаление объекта - курсор влево}
  Dispose(Right);          {удаление объекта - курсор вправо}
  Dispose(Enter);          {удаление объекта - обработка Enter}
  Dispose(BackSpace);    {удаление объекта - обработка Backspace}
end;
function tText.InitElem: Pointer;
begin
  InitElem := New(pLine,Init)
end;
procedure tText.DispElem(PointDel: Pointer);
begin
  Dispose(pLine(PointDel) ,Done)
end;
procedure tText.PutX(X: Word);
begin
  if X <> 0 then
    begin
      Xabs := X;
      if SmX >= Xabs then
        begin
          SmX := Xabs - 1;
          FullEkran := True
        end
      else if SmX + 80 < Xabs then
        begin
          SmX := Xabs - 80;
          FullEkran := True
        end
    end
end;
procedure tText.PutY(Y: Word);
var P: pLine;
begin
  if Y <> 0 then
    begin
      P : = GetPointLine(Y);
      if P <> nil then
        begin
          Yabs := Y;
          if SmY > = Yabs then
            begin
              SmY := Yabs - 1;
              FullEkran := True
            end
          else if SmY + 25 < Yabs then
            begin
              SmY := Yabs - 25;
              FullEkran : = True
            end;
          CurrentPointLine := P
        end
    end
end;
procedure tText.IncX;
begin
  Inc(Xabs);
  if SmX + 80 < Xabs then
    begin
      SmX := Xabs - 80;
      FullEkran := True
    end
end;
procedure tText.DecX;
begin
  if Xabs > 1 then
    begin
      Dec(Xabs);
      if SmX >= Xabs then
        begin
          SmX : = Xabs - 1;
          FullEkran := True
        end
    end
end;
procedure tText.IncY;
begin
  if CurrentPointLine^ .NextElem <> nil then
    begin
      Inc(Yabs);
      if SmY + 25 < Yabs then
        begin
          SmY := Yabs - 25;
          FullEkran := True
        end;
      CurrentPointLine := CurrentPointLine^.NextElem
    end
end;
procedure tText.DecY;
begin
  if Yabs > 1 then
    begin
      Dec(Yabs);
      if SmY >= Yabs then
        begin
          SmY := Yabs - 1;
          FullEkran := True
        end;
      CurrentPointLine : = CurrentPointLine^.PredElem
    end
end;
function tText.GetX: Word;
begin
  GetX := Xabs
end;
function tText.GetY: Word;
begin
  GetY := Yabs
end;
function tText.GetPointLine(Y: Word): pLine;
var PointLine: pLine;
    i: Word;
begin
  PointLine : = GetFirstElem;      {указатель на первую строку}
  for i := 2 to Y do
    if PointLine <> nil then       {если есть текущая строка...}
       PointLine := PointLine^.GetNextElem;
                                   {взять следующую строку}
  GetPointLine : = PointLine
end;
procedure tText.PutSymb;
begin
  CurrentPointLine^.PutSymb(Xabs)
end;
function tText.GetSymb: Char;
begin
  GetSymb : = CurrentPointLine^.GetSymb(Xabs)
end;
procedure tText.PutEkran;
var PointLine: pLine;
    i, j: Byte;
    XRez, YRez: Word;
    XSmRez, YSmRez: Word;
begin
  XRez : = Xabs; YRez := Yabs;
  XSmRez := SmX; YSmRez := SmY;
  if FullEkran then              {если выводить весь экран...}
    begin
      PutY(SmY +1);
      for i := 1 to 25 do
        begin
          PutX(SmX + 1);
          if CurrentPointLine <> nil then
                                 {есть очередная строка}
            begin
              for j := 1 to 80 do
                begin
                  S[i, j, 1] := GetSymb;
                  IncX
                end;
              CurrentPointLine := CurrentPointLine^.NextElem
            end
          else                  {нет строки - поместить пробелы}
            for j := 1 to 80 do
              begin
                S[i, j, 1] := ' ';
                IncX
              end;
          SmX : = XSmRez;
        end;
      FullEkran : = False;          {сбросить признак вывода}
      SmY := YSmRez;
      PutX(XRez);
      PutY(YRez)
    end
  else if OnlyLine then             {если выводить одну строку}
    begin
      PutX(SmX + 1) ;
      for j := 1 to 80 do
        begin
          S[Yabs - SmY, j, 1] := GetSymb;
          IncX
        end;
      OnlyLine := False;
      SmX := XSmRez;
      PutX(XRez)
    end
end;
procedure tText.PutCursor;
begin
  GotoXY(Xabs - SmX, Yabs - SmY);
end;

{* * Подпрограммы tOperatin * *}
constructor tOperation.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tOperation.Ins;
begin
end;
procedure tOperation.PutNewSymb;
begin
  Ins;
  with PointText^ do
    begin
      PutEkran;
      PutCursor
    end
end;

{** Подпрограммы tInsertSymbol **}
constructor tInsertSymbol.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertSymbol.Ins;
var PointLine: pLine;
begin
  with PointText^ do
    begin
      PutSymb;                   {размещение символа}
      IncX;                      {сдвиг курсора вправо}
      if not FullEkran then      {если выводится не весь экран...}
         OnlyLine : = True       {выводится одна строка}
    end
end ;

{* * Подпрограммы перемещения курсора * *}
constructor tlnsertUp.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertUp.Ins;
begin
  with PointText^ do
      DecY
end;
constructor tInsertDn.Init;
begin                               {фиктивная подпрограмма}
end;

procedure tInsertDn.Ins;
begin
  with PointText^ do
      IncY
end;
constructor tInsertLeft.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertLeft.Ins;
begin
  with PointText^ do
      DecX
end;
constructor tInsertRight. Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertRight.Ins;
begin
  with PointText^ do
      IncX
end;

{** Подпрограммы tlnsertEnter **}
constructor tInsertEnter.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertEnter.Ins;
var PointElLine: pElLine;
     NomAbs: Word;
     NomlnEl: Byte;
     NewPoint: pLine;
     Point: pElLine;
     PointOldElLine: pelLine;
begin
 with PointText^ do
  begin
   CurrentPointLine^.LastNotBlank(PointElLine, NomAbs, NomInEl);
    {координаты последнего символа строки, не являющегося пробелом}
   CurrentPointLine^.GetPointElLineAndNomInEl(GetX, PointElLine, NomInEl, False);
    {внутренние координаты курсора}
   if GetX = 1 then        {если начало строки...}
    begin
     NewEl(CurrentPointLine^.GetPredElem, CurrentPointLine);
      {новая строка перед текущей}
     CurrentPointLine := CurrentPointLine^.GetPredElem
    end
   else           {иначе...}
    begin
     NewEl(CurrentPointLine, CurrentPointLine^.GetNextElem);
      {новая строка после текущей}
     if (NomInEl <> 0) and (GetX < = NomAbs) then
      {если символ существует и не является заключительным пробелом...}
      begin
       NewPoint := CurrentPointLine^.GetNextElem;
        {следующая строка}
       NewPoint^ . PutLastElem(CurrentPointLine^ . GetLastElem);
        {указатель на последний элемент -из предыдущей строки}
       if NomInEl = 1 then
        {если начало элемента строки...}
        begin
         Dispose(NewPoint^.FirstElem);
          {удаление строки из нового объекта}
         CurrentPointLine^.PutConnection(PointElLine^.GetPredElem, nil);
         NewPoint^.PutConnection(nil, PointElLine)
          {помещение остатка предыдущей строки в следующую строку}
        end
       else           {иначе...}
        begin
         Point : = NewPoint^.GetFirstElem;
          {первый элемент новой строки}
         PointOldElLine := PointElLine^.GetNextElem;
          {удаляемая часть текущей строки}
         CurrentPointLine^.PutConnection( PointElLine, nil);
          {оформление конца текущей строки}
         NewPoint^.PutConnection(Point, PointOldElLine);
          {добавление остатка текущей строки к новой строке}
         Point^.PutString(PointElLine^.GetString(NomInEl), 1);
          {добавление конца последнего элемента в конец первого новой строки}
         PointElLine^.PutString(StringOfBlanks, NomInEl);
          {пробелы в конец последнего элемента};
         while Point^.GetNextElem <> nil do
          {пока есть следующий элемент...}
          begin
           PointOldElLine := Point^.GetNextElem;
            {следующий элемент}
           Point^.PutString(PointOldElLine^.GetString(l), Len - NomlnEl + 2);
            {начало следующего элемента - в конец предыдущего}
           Point : = PointOldElLine;
            {следующий элемент}
           Point^.PutString( Point^.GetString(NomInEl), 1);
            {конец элемента - в начало}
          end;
         Point^.PutString(StringOfBlanks, Len - NomInEl + 2) ;
          {пробелы в конец последнего элемента}
        end
       end
      end;
     PutX(1);
     IncY;                      {новые координаты}
     FullEkran : = True         {обновить весь экран}
    end
end;

{* * Подпрограммы tInsertBackSpace * *}
constructor tInsertBackSpace.Init;
begin                               {фиктивная подпрограмма}
end;
procedure tInsertBackSpace.Ins;
var PointElLine: pElLine;
     PointNextElLine: pElLine;
     NomInEl: Byte;
     NewPoint,OldPoint: pLine;
     NomAbs: Word;
     Point,Point1: pElLine;
     Ch: Char;
begin
 with PointText^ do
 if (GetX <> 1) or (GetY <> 1) then
  {если не начало текста...}
  begin
   CurrentPointLine^ .GetPointElLineAndNomInEl(GetX, PointElLine, NomInEl, False);
    {внутренние координаты курсора}
   if NomInEl = 0 then      {если нет символа...}
      DecX      {сдвиг курсора влево}
   else
    if GetX <> 1 then       {если не начало строки...}
     begin
      if NomInEl =1 then
       {если начало элемента...}
       begin
        PointElLine : = PointElLine^.GetPredElem;
         {указатель на предыдущий элемент}
        NomInEl := Len + 1
         {корректировка номера элемента в строке}
       end;
      PointElLine^.PutString(PointElLine^. GetString(NomlnEl), NomlnEl - 1);
       {удаление текущего символа}
      PointNextElLine := PointElLine^.GetNextElem; {следующий элемент строки}
      while PointNextElLine <> nil do
       {пока есть следующий элемент...}
       begin
        PointElLine^.PutSymb(PointNextElLine^. GetSymb(l), Len, Ch);
         {первый символ следующего элемента - в конец предыдущего}
        PointElLine := PointNextElLine;
         {следующий элемент строки}
        PointNextElLine := PointNextElLine^.GetNextElem;
         {следующий элемент строки}
        PointElLine^.PutString(PointElLine^. GetString(2), 1);
         {сдвиг новой строки на символ влево}
        end;
       PointElLine^.PutSymb(' ', Len, Ch);
        {пробел в последнюю позицию последнего элемента}
        DecX;     {задание новых координат}
        if not FullEkran then
         {если не выводить весь экран...}
          OnlyLine := True
         {то выводить текущую строку}
       end
      else      {начало строки - объединение строк}
       begin
        NewPoint := CurrentPointLine^.GetPredElem;
         {предыдущая строка}
        OldPoint := CurrentPointLine^.GetNextElem;
         {последующая строка}
        PointNextElLine:= PointElLine;
         {последующий элемент строки}
        NewPoint^.LastNotBlankCPointElLine, NomAbs, NomInEl);
         {последний символ предыдущей строки, не являющийся пробелом}
        NewPoint^.PutLastElem(CurrentPointLine^. GetLastElem);
         {конец предыдущей строки - конец текущей строки}
        PutConnection(NewPoint, OldPoint);
         {связь предыдущей строки с последующей минуя текущую}
        Point := PointElLine^.GetNextElem;
         {следующий элемент текущей строки}
        while Point <> nil do {пока есть следующий элемент...}
         begin
          Point1 := Point^.GetNextElem;
           {следующий элемент}
          Dispose(Point);
           {удаление элемента}
          Point := Point1
           {следующий элемент}
         end;
        PutConnection(PointElLine, PointNextElLine);
         {связь элементов предыдущей строки с элементами текущей}
        Dispose(CurrentPointLine);
         {удаление текущей строки}
        if NomInEl <> Len then
         {если присоединение не к концу предыдущего элемента...}
         while PointElLine^.GetNextElem <> nil do {пока есть следующий элемент...}
          begin
           PointNextElLine := PointElLine^.GetNextElem; PointElLine^.PutString(PointNextElLine^.GetStringC1),NomlnEl + 1);
            {начало следующего элемента - в конец текущего элемента}
           PointNextElLine^.PutString(PointNextElLine^.GetString(Len - NomInEl + 1), 1);
            {конец следующей строки - в ее начало}
           PointElLine := PointNextElLine
            {следующий элемент }
          end;
         PointElLine^.PutString(StringOfBlanks,NomlnEl + 1);
          {пробелы в конец последнего элемента}
         PutX(NomAbs +1);
         PutY(GetY - 1);
         FullEkran := True
       end
    end
end;

{* * Секция инициализации * *}
var i: Byte;
begin
  for i := 1 to Len do
     StringOfBlanks[i] := ' ';
  StringOfBlanks[0] := Chr(Len);
  New(PointText, Init);                  {создание объекта}
end.

{* * * * Файл с основной программой * * * *}
uses Crt,Edit;
begin
  TextBackGround(Blue);          {цвет фона}
  TextColor(White);              {цвет символов}
  ClrScr;                        {очистка экрана}
  GotoXY(l,l);                   {курсор в начало координат}
    repeat
      Ch := ReadKey;             {чтение символа}
      if Ch = Chr(0) then        {сложный код клавиши}
        begin
          Ch := ReadKey;         {вторая половина кода}
          case Ord(Ch) of
            72: Up^.PutNewSymb;           {клавиша Up}
            80: Dn^.PutNewSymb;           {клавиша Dn}
            75: Left^.PutNewSymb;         {клавиша Left}
            77: Right^.PutNewSymb         {клавиша Right}
          end
        end
      else if Ch > Chr(31) then
        Symbol^.PutNewSymb          {размещение символа}
      else if Ch = Chr(Ent) then
        Enter^.PutNewSymb           {клавиша Enter}
      else if Ch = Chr(BackS) then
        Backspace^.PutNewSymb       {клавиша Backspace}
    until Ch = Chr(Esc);            {пока не нажата клавиша Esc}
    Dispose(PointText, Done);       {удаление объекта}
    TextBackGround(DarkGray);       {цвет фона}
    TextColor(LightGray);           {цвет символов}
    ClrScr                          {очистка экрана}
end.




 У Вас есть материал пишите нам
 
    Copyright © 2008    
Rambler's Top100