Marking







構造体 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;









Back