Псевдографика - это рисование линий (только горизонтальных и вертикальных) в текстовой моде посредством специальных символов. Во времена DOS эта возможность выглядела крайне привлекательно. Символы псевдографики размещаются во второй половине кодов ASCII, причем в в некоторых национальных кодировках они конфликтуют с буквами национального алфавита, что нехорошо. В кодировке 866 (которая в основном и использовалась в DOS) с этим все в порядке, и есть возможность и рисовать рамочки и таблицы, и писать по-русски.
Основная особенность, которая делает всю эту кухню сложной для "ручного" применения - это сопряжение линий на поворотах и пересечениях (что делается подставлением на пересечение специального символа). Линии бывают одинарные и двойные - это добваляет шарму, но немало усложняет ситуацию. Код, в котором вручную набраны рамки (скажем, на титульном листе) выглядит крайне громоздко и непритязательно. А слегка подправить текст в рамке - занятие не для слабонервных.. )) В предствленном модуле эта задача решена - линии сопрягаются между собой автоматически.
Символы псевдографики в кодировке http://pascalnet.ru/866 простираются от 176 до 222 номера:
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
176: ░ ▒ ▓ │ ┤ ╡ ╢ ╖ ╕ ╣ ║ ╗ ╝ ╜ ╛ ┐ └
192: └ ┴ ┬ ├ ─ ┼ ╞ ╟ ╚ ╔ ╩ ╦ ╠ ═ ╬ ╧ ╨
208: ╨ ╤ ╥ ╙ ╘ ╒ ╓ ╫ ╪ ┘ ┌ █ ▄ ▌ ▐ ▀ р
varПри внимательном взгляде на этот набор символов вы обнаружите, что он обладает как некоторой полнотой, так и ограничениями. Например, во всей полноте представлены символы перехода с одинарной на двойную линию при поворотах. Но при этом совершенно отсутствуют переходы на прямых участках (даже на пересечениях - и это совершенно оправдано, если вникнуть.
i,j: integer;
begin
Write(' ');
for i:=0 to 16 do Write(i:3);
WriteLn;
WriteLn;
for i:=11 to 13 do begin
Write(i*16:4,': ');
for j:=0 to 16 do Write(Chr(i*16+j),' ');
WriteLn;
WriteLn
end
end.
╔═════════════════════════════════════════════════════════╕
║ │
║ ╔═══════════════╦════════╤════════╗ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
╒══════╬═══════════╗ ║ ║ │ ║ │
│ ║ ║ ║ ║ │ ║ │
│ ║ ║ ║ ║ │ ║ │
│ ║ ┌────────╫──*┬┬┬┬┬┬┬┬┬┬┬┬┬┬┬╫┬┬┬┬┬┬┬┬┼──────┬─╫───┐ ══╡
│ ║ │ ║ ╙───────────┼┴┴┴╫┴┴┴┴┴┴┴┴┘ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ └────────╫──────────────┼──╥╫───────────┬───┘ ║ │ │
│ ║ ║ │ ║╣ │ ║ │ │
│ *╤╤╤╤╤╤╤╤╤╤╤*══════════════╪══╬╬═══════════╪═════╬═══╪════╛
└──────────────────╜ │ ║╣ │ ║ │
│ ║*┬┬┬┬┬┬┬┬┬┬┬┼╥╥╥╥╥╢ │
╘══*────────────*═════════╛
uses
TxGraph;
const
n= 8;
var
i: integer;
begin
for i:=1 to n do begin
TxRectangle(
Random(80)+1,Random(25)+1,Random(80)+1,Random(25)+1,
Random(2)+1,Random(2)+1,Random(2)+1,Random(2)+1
);
// TxDump
end
end.
╔═════════════════════════════════════════════════════════╕
║ │
║ ╔═══════════════╔═════════════════╗ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
║ ║ ║ │ ║ │
╒══════║═══════════╗ ║ ║ │ ║ │
│ ║ ║ ║ ║ │ ║ │
│ ║ ║ ║ ║ │ ║ │
│ ║ ┌───────────────────────────────────────────┐─║───┐ ══│
│ ║ │ ║ ╙───────────────║────────┘ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ │ ║ │ ║ │ ║ │ │
│ ║ └───────────────────────────────────────────┘ ║ │ │
│ ║ ║ │ ║║ │ ║ │ │
│ ╚═════════════════════════════║║═══════════│═════║════════╛
└──────────────────╜ │ ║║ │ ║ │
│ ║╙─────────────────╜ │
╘══╙────────────┘═════════╛
{ рисование в текстовой моде символами псевдографики
drawing with pseudo-graphic characters in text mode
by Lapp
forum.pascalnet.ru, FAQ
v.1.0 }
unit TxGraph;
interface
procedure TxHorLine(x1,x2,y,w: integer);
procedure TxVerLine(y1,y2,x,w: integer);
procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
procedure TxDump;
implementation
uses
CRT;
const
mx= 300;
my= 200;
TxGrEl: array [
0..2, // r
0..2, // u
0..2, // l
0..2 // d
] of char = (
( // r=0
( // u=0
(' ','│','║'), // l=0
('─','┐','╖'), // l=1
('═','╕','╗') // l=2
),
( // u=1
('│','│','*'), // l=0
('┘','┤','*'), // l=1
('╛','╡','*') // l=2
),
( // u=2
('║','*','║'), // l=0
('╜','*','╢'), // l=1
('╝','*','╣') // l=2
)
),
( // r=1
( // u=0
('─','┌','╓'), // l=0
('─','┬','╥'), // l=1
('*','*','*') // l=2
),
( // u=1
('└','├','*'), // l=0
('┴','┼','*'), // l=1
('*','*','*') // l=2
),
( // u=2
('╙','*','╟'), // l=0
('╨','*','╫'), // l=1
('*','*','*') // l=2
)
),
( // r=2
( // u=0
('═','╒','╔'), // l=0
('*','*','*'), // l=1
('═','╤','╦') // l=2
),
( // u=1
('╘','╞','*'), // l=0
('*','*','*'), // l=1
('╧','╪','*') // l=2
),
( // u=2
('╚','*','╠'), // l=0
('*','*','*'), // l=1
('╩','*','╬') // l=2
)
)
);
var
TxGrA: array [0..mx,0..my] of byte;
procedure Order(var a,b: integer);
begin
if a<=b then exit;
a:= a xor b;
b:= a xor b;
a:= a xor b
end;
procedure TxHorLine(x1,x2,y,w: integer);
var
i: integer;
begin
Order(x1,x2);
for i:=x1 to x2 do TxGrA[i,y]:= w;
for i:=x1 to x2 do begin
GoToXY(i,y);
Write(TxGrEl[TxGrA[i+1,y],TxGrA[i,y-1],TxGrA[i-1,y],TxGrA[i,y+1]])
end
end;
procedure TxVerLine(y1,y2,x,w: integer);
var
i: integer;
begin
Order(y1,y2);
for i:=y1 to y2 do TxGrA[x,i]:= w;
for i:=y1 to y2 do begin
GoToXY(x,i);
Write(TxGrEl[TxGrA[x+1,i],TxGrA[x,i-1],TxGrA[x-1,i],TxGrA[x,i+1]])
end
end;
procedure TxDump;
begin
FillChar(TxGrA,SizeOf(TxGrA),0)
end;
procedure TxRectangle(x1,y1,x2,y2,wr,wu,wl,wd: integer);
begin
Order(x1,x2);
Order(y1,y2);
TxVerLine(y1,y2,x2,wr);
TxHorLine(x1,x2,y1,wu);
TxVerLine(y1,y2,x1,wl);
TxHorLine(x1,x2,y2,wd)
end;
begin
TxDump
end.
Вариант кода, доработанный IUnknown с целью убрать ложку дегтя (unit CRT). Он, по идее, должен быть системонезависимым (не проверялось пока) и при этом все же компилиться под TP/BP!! (дань традиции, видимо)).