1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
unit ColorTxt;
{
TColoredText is a descendent of TStaticText designed to allow the writing
of colored text when color monitors are used. With a monochrome or BW
monitor, TColoredText acts the same as TStaticText.
TColoredText is used in exactly the same way as TStaticText except that
the constructor has an extra Byte parameter specifying the attribute
desired. (Do not use a 0 attribute, black on black).
}
{$i platform.inc}
{$ifdef PPC_FPC}
{$H-}
{$else}
{$F+,O+,E+,N+}
{$endif}
{$X+,R-,I-,Q-,V-}
{$ifndef OS_UNIX}
{$S-}
{$endif}
interface
uses
objects, drivers, views, dialogs, app, fvconsts;
type
PColoredText = ^TColoredText;
TColoredText = object(TStaticText)
Attr : Byte;
constructor Init(var Bounds: TRect; const AText: String; Attribute : Byte);
constructor Load(var S: TStream);
function GetTheColor : byte; virtual;
procedure Draw; virtual;
procedure Store(var S: TStream);
end;
const
RColoredText: TStreamRec = (
ObjType: idColoredText;
VmtLink: Ofs(TypeOf(TColoredText)^);
Load: @TColoredText.Load;
Store: @TColoredText.Store
);
implementation
constructor TColoredText.Init(var Bounds: TRect; const AText: String;
Attribute : Byte);
begin
TStaticText.Init(Bounds, AText);
Attr := Attribute;
end;
constructor TColoredText.Load(var S: TStream);
begin
TStaticText.Load(S);
S.Read(Attr, Sizeof(Attr));
end;
procedure TColoredText.Store(var S: TStream);
begin
TStaticText.Store(S);
S.Write(Attr, Sizeof(Attr));
end;
function TColoredText.GetTheColor : byte;
begin
if AppPalette = apColor then
GetTheColor := Attr
else
GetTheColor := GetColor(1);
end;
procedure TColoredText.Draw;
var
Color: Byte;
Center: Boolean;
I, J, L, P, Y: Sw_Integer;
B: TDrawBuffer;
S: String;
begin
Color := GetTheColor;
GetText(S);
L := Length(S);
P := 1;
Y := 0;
Center := False;
while Y < Size.Y do
begin
MoveChar(B, ' ', Color, Size.X);
if P <= L then
begin
if S[P] = #3 then
begin
Center := True;
Inc(P);
end;
I := P;
repeat
J := P;
while (P <= L) and (S[P] = ' ') do Inc(P);
while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do Inc(P);
until (P > L) or (P >= I + Size.X) or (S[P] = #13);
if P > I + Size.X then
if J > I then P := J else P := I + Size.X;
if Center then J := (Size.X - P + I) div 2 else J := 0;
MoveBuf(B[J], S[I], Color, P - I);
while (P <= L) and (S[P] = ' ') do Inc(P);
if (P <= L) and (S[P] = #13) then
begin
Center := False;
Inc(P);
if (P <= L) and (S[P] = #10) then Inc(P);
end;
end;
WriteLine(0, Y, Size.X, 1, B);
Inc(Y);
end;
end;
end.
|
