richedit,送分的小问题

Question

我想把richedit中选中的文字呈深蓝色，但不是改变字体颜色。就是记事本，word中的那种。是不是应该用selattributes？应该怎么改？

Answer 1

给你段代码不过好像效果不是很好，就当给你个思路好了：
{@_@真不好意思，摘录老外的，自己水平有限.....郁闷}unit Unit1;
interfaceuses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ComCtrls, ExtCtrls;type
 TForm1 = class(TForm)
   RichEdit1: TRichEdit;
    but_ChangeRed: TButton;
    but_Exit: TButton;
    but_Restore: TButton;
    Button1: TButton;
   procedure but_ExitClick(Sender: TObject);
   procedure but_ChangeRedClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure but_RestoreClick(Sender: TObject);
   procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
   RichCanvas: TCanvas;
   Reds: Boolean;
   Procedure RedSelect;
 public
   { Public declarations }
 end;var
 Form1: TForm1;implementation{$R *.DFM}procedure TForm1.but_ExitClick(Sender: TObject);
begin
Close;
end;procedure TForm1.RedSelect;
{this uses RichCanvas.TextOut to
redraw the selected Text with Red background}
const
EM_EXLINEFROMCHAR = WM_USER + 54;
var
SelString: String;
ClarPos: TPoint;
TH, BW, CharLoca, LineNum, LinePos, i: Integer;
begin
if RichEdit1.SelLength = 0 then Exit;
RichCanvas.Brush.Color := clred;
RichCanvas.Font := RichEdit1.Font;
SelString := RichEdit1.SelText;
ClarPos := RichEdit1.CaretPos;
{this RichEdit1.CaretPos is not a Pixel Point but a Line Nunber and Charater Point}{set ReadOnly to true so keboard input will not cause the RedSelect to be lost}
RichEdit1.ReadOnly := True;
{Reds is used to Refresh on MouseDown}
Reds := True;
CharLoca := RichEdit1.SelStart;
LinePos := 0;
TH := RichCanvas.TextHeight('D');
BW := RichEdit1.BorderWidth;
LineNum := SendMessage(RichEdit1.Handle,EM_EXLINEFROMCHAR,0,CharLoca);
for i := 0 to LineNum-1 do
begin
LinePos := LinePos+Length(RichEdit1.Lines[i]);
end;
{LineNum*2 is my Lazy way of dealing with the #10 and #13 lineBreak charaters}
LinePos := CharLoca - LinePos-(LineNum*2);
{I only made this to do a Max of 2 selected lines}
{test to see if the Selection goes more than one line}
if RichEdit1.SelLength > Length(RichEdit1.Lines[LineNum]) - LinePos then
begin
RichCanvas.TextOut(RichCanvas.TextWidth(Copy(RichEdit1.Lines[LineNum], 0, LinePos))+2, ((LineNum) * TH)+BW, Copy(SelString, 0, Length(RichEdit1.Lines[LineNum])- LinePos)+'  '{these 2 spaces cover the LineBreak Charaters});
RichCanvas.TextOut(BW, ((LineNum+1) * TH)+BW, Copy(RichEdit1.Lines[LineNum+1], 0,RichEdit1.SelLength-(Length(RichEdit1.Lines[LineNum])- (LinePos-2))));
end else
RichCanvas.TextOut(RichCanvas.TextWidth(Copy(RichEdit1.Lines[ClarPos.y], 0, ClarPos.x-RichEdit1.SelLength)), (ClarPos.y * TH)+BW, SelString);
end;procedure TForm1.but_ChangeRedClick(Sender: TObject);
{this button will place the RedSelect where you want it,
withOUT any text being selected by the user}
begin
Reds := True;
RichEdit1.SelLength := 0;
RichEdit1.Refresh;
{you will have to place the location with TextWidth and TextHeight}
RichCanvas.TextOut(RichCanvas.TextWidth('Rich')+RichEdit1.BorderWidth, ({LineNumber}0 * RichCanvas.TextHeight('D'))+RichEdit1.BorderWidth, 'Edit');
end;procedure TForm1.FormCreate(Sender: TObject);
begin
{you need to get the RichEdit1 HDC to a delphi compatible Canvas}
RichCanvas := TCanvas.Create;
RichCanvas.Handle := GetDC(RichEdit1.Handle);
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Free Canvas
RichCanvas.Free;
end;procedure TForm1.but_RestoreClick(Sender: TObject);
{this button restores the RichEdit to be Writable again}
begin
RichEdit1.ReadOnly := False;
{Remove all Selections is not really nessary}
RichEdit1.SelLength := 0;
Reds := False;
{Refresh removes any RedSelect}
RichEdit1.Refresh;
RichEdit1.SetFocus;
end;procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if Reds then
RichEdit1.Refresh;
RedSelect;
end;end.