VPF::Подсветка строки в RichEdit - Форум программистов

estra

Дата 6.8.2013, 09:04 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 13.10.2008

Репутация: нет
Всего: нет

Подскажите, как реализовать подсветку целой строки подобно тому, как это делает, например, редактор кода Delphi?

Присоединённый файл ( Кол-во скачиваний: 21 )

line.jpg 37,32 Kb

Poseidon

Дата 6.8.2013, 17:21 (ссылка)

(нет голосов)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133

У Delphi там, судя по всему, не RichEdit, а TEditControl. Какой-то, видимо, внутренний класс.

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

estra

Дата 7.8.2013, 08:21 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 13.10.2008

Репутация: нет
Всего: нет

Цитата(Poseidon @ 6.8.2013, 17:21

)

У Delphi там, судя по всему, не RichEdit, а TEditControl. Какой-то, видимо, внутренний класс.

Это понятно, я просто в пример привел. Хотелось реализовать аналогичное в RichEdit

kroiksm

Дата 8.8.2013, 16:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 10.1.2009

Репутация: 1
Всего: 1

Может это решение подойдет: Highlight line in RichEdit

Akella

Дата 9.8.2013, 11:02 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

estra, покажи, как делал, что именно не получается?

estra

Дата 15.8.2013, 17:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 13.10.2008

Репутация: нет
Всего: нет

kroiksm,

не подойдет, этот пример меняет цвет фона текста, но не закрашивает всю строку...

Akella,

вот тут все мои эксперименты...

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit;

type
  TRichEdit = class( ComCtrls.TRichEdit )
  private
    FirstLen: Integer;
    LastLen: Integer;
    CurrentLen, CurOld: Integer;

    NeedUpdate: Boolean;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMVMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;

    function GetFirstVisibleLine: integer;
    function GetLastVisibleLine: integer;
    function GetCurrentLine: integer;
    procedure GetLinesInfo;
  public
    Canvas: TCanvas;
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TRichEdit }

constructor TRichEdit.Create(AOwner: TComponent);
begin
   inherited;
   Canvas := TControlCanvas.Create;
   TControlCanvas( Canvas ).Control := Self;
   NeedUpdate := True;
end;

destructor TRichEdit.Destroy;
begin
   Canvas.Free;
   inherited;
end;

procedure TRichEdit.WMChar(var Message: TWMChar);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

procedure TRichEdit.WMHScroll(var Message: TWMHScroll);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

procedure TRichEdit.WMKeyDown(var Message: TWMKeyDown);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

procedure TRichEdit.WMKeyUp(var Message: TWMKeyUp);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

procedure TRichEdit.WMPaint(var Message: TWMPaint);
begin
   inherited;
   if NeedUpdate then
   begin
      Invalidate;
      NeedUpdate := False;
   end;
   //Canvas.MoveTo( 10, 10 );
   //Canvas.LineTo( 50, 50 );
   //if ( CurrentLen >= FirstLen ) and ( CurrentLen <= LastLen ) then
   begin
      if CurOld <> CurrentLen then
         Invalidate;
      Canvas.Brush.Color := clYellow;
      Canvas.FillRect( Rect( 0, CurrentLen * 13, Width-6, CurrentLen * 13 + 18 ) );
      Canvas.TextOut( 1, CurrentLen * 13+1, Lines[CurrentLen] );
   end;
   Form1.Caption := Format( '%d  %d  %d', [FirstLen, CurrentLen, LastLen] );
end;

procedure TRichEdit.WMVMouseWheel(var Message: TWMMouseWheel);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

procedure TRichEdit.WMVScroll(var Message: TWMVScroll);
begin
   inherited;
   GetLinesInfo;
   NeedUpdate := True;
end;

function TRichEdit.GetCurrentLine: integer;
begin
   Result := Perform( EM_EXLINEFROMCHAR, 0, SelStart + SelLength );
end;

function TRichEdit.GetFirstVisibleLine: integer;
begin
   Result := Perform( EM_GETFIRSTVISIBLELINE, 0, 0 );
end;

function TRichEdit.GetLastVisibleLine: integer;
const
  EM_EXLINEFROMCHAR = WM_USER + 54;
var
  r: TRect;
  i: integer;
begin
   Perform( EM_GETRECT, 0, Longint( @r ) );
   r.Left := r.Left + 1;
   r.Top  := r.Bottom - 2;
   i := Perform( EM_CHARFROMPOS, 0, Integer( @r.topleft ) );
   Result := Perform( EM_EXLINEFROMCHAR, 0, i );
end;

procedure TRichEdit.GetLinesInfo;
begin
   FirstLen := GetFirstVisibleLine;
   LastLen := GetLastVisibleLine;
   CurOld := CurrentLen;
   CurrentLen := GetCurrentLine;
end;

end.

Akella

Дата 15.8.2013, 22:24 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

А SelStart/SelLength не подходит?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »