構造体 TCHARFORMAT2 を使いますので RichEdit2.0 以上
Windows98系の RichEdit1.0 では出来ません
98系の TCHARFORMAT では文字色ならば変えられます
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/
platform/commctls/richedit/richeditcontrols/aboutricheditcontrols.asp
Rich Edit version DLL
1.0 Riched32.dll
2.0 Riched20.dll
3.0 Riched20.dll
4.1 Msftedit.dll
The following list describes which versions of Rich Edit are included in which
releases of Microsoft WindowsR.
Windows XP SP1 Includes Rich Edit 4.1, Rich Edit 3.0, and a Rich Edit 1.0 emulator.
Windows XP Includes Rich Edit 3.0 with a Rich Edit 1.0 emulator.
Windows Me Includes Rich Edit 1.0 and 3.0.
Windows 2000 Includes Rich Edit 3.0 with a Rich Edit 1.0 emulator.
Windows NT 4.0 Includes Rich Edit 1.0 and 2.0.
Windows 98 Includes Rich Edit 1.0 and 2.0.
Windows 95 Includes only Rich Edit 1.0. However, Riched20.dll is compatible
with Windows 95 and may be installed by an application that requires it.
uses RichEdit;
var
Form1: TForm1;
fMarkColor : TColor;
implementation
{$R *.DFM}
procedure SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
Format: TCHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
with Format do
begin
cbSize := SizeOf(Format);
dwMask := CFM_BACKCOLOR;
crBackColor := AColor;
RichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
end;
end;
procedure ClearBgColor(RichEdit: TRichEdit);
var
Format: TCHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
with Format do begin
cbSize := SizeOf(Format);
dwMask := CFM_BACKCOLOR;
dwEffects := CFE_AUTOBACKCOLOR;
RichEdit.Perform(EM_SETCHARFORMAT, SCF_ALL, Longint(@Format));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fMarkColor := $00D2E1D5;
end;
procedure TForm1.MarkButtonClick(Sender: TObject);
var
fStartPos, fLength : Integer;
begin
if RichEdit1.SelLength <> 0 then
begin
fStartPos := RichEdit1.SelStart;
fLength := Length(RichEdit1.SelText);
//これがないとマーカーが増え続ける
ClearBgColor(RichEdit1);
SetSelBgColor(RichEdit1,fMarkColor);
RichEdit1.SelStart := fStartPos + fLength;
//これを入れないとマーカーに続けて書く場合色を引きづる
SetSelBgColor(RichEdit1, RichEdit1.Color);
end;
end;
//ここまでやれば完璧に近づくかも
procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = Word(VK_RIGHT) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_Left) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_UP) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_DOWN) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_PRIOR) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_NEXT) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_DELETE) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_BACK) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_HOME) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_END) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
if key = Word(VK_CONTROL) then
SetSelBgColor(RichEdit1, RichEdit1.Color);
end;
|