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.
|
|
)