delphi TRichEdit Установить цвет фона без пробелов - PullRequest
Новая
       9

delphi TRichEdit Установить цвет фона без пробелов

1 голос
/ 15 января 2010

Я нашел этот код в сети. Это помещает цвет фона к выделенным текстам на Trichedit: 

uses
 RichEdit;

procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
  Format: CHARFORMAT2;
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;

// Example: Set clYellow background color for the selected text.
procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetSelBgColor(RichEdit1, clYellow);
end;

Однако мне нужно исключить пробелы. Кто-нибудь может мне помочь? Любая идея будет полезна? Моя идея состоит в том, чтобы выбрать все пробелы и затем отформатировать их, но тогда я не знаю, как их выбрать. Кстати, я пользуюсь delphi 2009.

1 Ответ

3 голосов
/ 15 января 2010

@ junmats, с помощью этого кода вы можете выбрать любое слово в элементе управления richedit.

протестировано в Delphi 2010 и Windows 7 

uses
  RichEdit;

procedure SetWordBackGroundColor(RichEdit : TRichEdit; aWord : String;AColor: TColor);
var
  Format: CHARFORMAT2;
  Index : Integer;
  Len   : Integer;
begin
          FillChar(Format, SizeOf(Format), 0);
          Format.cbSize := SizeOf(Format);
          Format.dwMask := CFM_BACKCOLOR;
          Format.crBackColor := AColor;

          Index := 0;
          Len := Length(RichEdit.Lines.Text) ;
          Index := RichEdit.FindText(aWord, Index, Len, []);

          while Index <> -1 do
          begin
                RichEdit.SelStart  := Index;
                RichEdit.SelLength := Length(aWord) ;
                RichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
                Index := RichEdit.FindText(aWord,Index + Length(aWord),Len, []) ;
          end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
          SetWordBackGroundColor(RichEdit1,' ',clYellow);// will mark all spaces
end;

если вы хотите выделить все слова, кроме пробелов, вы можете сделать что-то вроде этого 

Procedure GetListofWords(Text : String; var ListofWords : TStringList);
var
  DummyStr  : String;
  FoundWord : String;
begin
  DummyStr := Text;
  FoundWord := '';
  if (Length(Text) = 0) then exit;

  while (Pos(' ', DummyStr) > 0) do
  begin
    FoundWord := Copy(DummyStr, 1, Pos(' ', DummyStr) - 1);
    ListofWords.Add(FoundWord);
    DummyStr := Copy(DummyStr, Pos(' ', DummyStr) + 1,  Length(DummyStr) - Length(FoundWord) + 1);
  end;

  if (Length(DummyStr) > 0) then
    ListofWords.Add(DummyStr);

end;



procedure TForm1.Button1Click(Sender: TObject);
var
ListofWords : TStringList;
i           : integer;
begin
          ListofWords:=TStringList.Create;
          try
           GetListofWords(RichEdit1.Lines.Text,ListofWords);
           if ListofWords.Count>0 then
            for i:=0  to ListofWords.Count - 1 do
             SetWordBackGroundColor(RichEdit1,ListofWords[i],clYellow);
          finally
          ListofWords.Clear;
          ListofWords.Free;
          end;
end;
...