uses RichEdit;
procedure TFrmRTFTest.Button1Click(Sender: TObject);
type
// Indizes gem. http://msdn.microsoft.com/en-us/library/bb787942%28VS.85%29.aspx
TIndexColor = (Black, Blue, Cyan, Green, Magenta, Red, Yellow, White,
DarkBlue, DarkCyan, DarkGreen, DarkMagenta, DarkRed, DarkYellow, DarkGray,
LightGray);
function IdxColorToString(AColor: TIndexColor):
string;
begin
case AColor
of
Black:
Result := '
Black';
Blue:
Result := '
Blue';
Cyan:
Result := '
Cyan';
Green:
Result := '
Green';
Magenta:
Result := '
Magenta';
Red:
Result := '
Red';
Yellow:
Result := '
Yellow';
White:
Result := '
White';
DarkBlue:
Result := '
DarkBlue';
DarkCyan:
Result := '
DarkCyan';
DarkGreen:
Result := '
DarkGreen';
DarkMagenta:
Result := '
DarkMagenta';
DarkRed:
Result := '
DarkRed';
DarkYellow:
Result := '
DarkYellow';
DarkGray:
Result := '
DarkGray';
LightGray:
Result := '
LightGray';
end;
end;
const
InitialOffset = $0801;
// darunter passiert nichts
TestFile = '
C:\test\Test.rtf';
var
i: TIndexColor;
fmt: TParaFormat2;
OldStart: integer;
begin
RichEdit1.Lines.BeginUpdate;
try
RichEdit1.Clear;
ZeroMemory(@fmt, SizeOf(fmt));
fmt.cbSize := SizeOf(fmt);
fmt.dwMask := PFM_SHADING;
// anscheinend völlig egal, aber wir setzen den Wert einfach mal
fmt.wShadingWeight := 100;
for i := Low(TIndexColor)
to High(TIndexColor)
do
begin
OldStart := RichEdit1.SelStart;
RichEdit1.Lines.Add(IdxColorToString(i));
RichEdit1.SelStart := OldStart;
RichEdit1.SelLength := RichEdit1.GetTextLen;
// die "Blockgröße" scheint bei 2048 zu liegen
fmt.wShadingStyle := InitialOffset + Ord(i)
shl 11;
SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, lParam(@fmt));
RichEdit1.SelLength := 0;
RichEdit1.SelStart := RichEdit1.GetTextLen;
end;
RichEdit1.Lines.SaveToFile(TestFile);
ShowMessage('
Fertig');
finally
RichEdit1.Lines.EndUpdate;
end;
end;