|
|
Приложени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.
|
|
|
