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