透明TMemo-文本在未选中时似乎保持选中状态

Question

I was hoping for some help with regards to a transparent TMemo control in Delphi 7. I found some code online that works well, to an extent, the refresh rate is a bit rubbish but I can live with that. The main problem is that unselected text can look as if it's actually selected.

Here's where all the text is selected using SelectAll();

Here's where no text is actually selected, but has been previously, note the floating line suggesting typing will happen after the 'p' in Improvement.

And finally an image just showing the difference.

What I find quite odd is that if I hit an arrow key for example, the false highlighting disappears, but when using the mouse it does not.

The code for this custom TMemo is as follows:

unit TrMemo;

interface

uses
 Messages, Controls, StdCtrls, classes;

const TMWM__SpecialInvalidate=WM_USER+1111;

type
  TTransparentMemo = class(TMemo)
  private
   procedure SpecialInvalidate(var Message:TMessage); message TMWM__SpecialInvalidate;
   procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
   procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
   procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
   procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
   procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
   procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
   procedure CreateParams(var Params: TCreateParams); override;
  public
   constructor Create(AOwner: TComponent); override;
  end;

procedure Register;

implementation

uses Windows;

{ TTransparentMemo }

procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll);
begin
 inherited;
 PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll);
begin
 SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
 inherited;
 PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
 with Message do
 begin
  SetBkMode(ChildDC,TRANSPARENT);
  Result:=GetStockObject(HOLLOW_BRUSH)
 end
end;

procedure TTransparentMemo.WMSetText(var Message:TWMSetText);
begin
 inherited;
 if not (csDesigning in ComponentState) then PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;

procedure TTransparentMemo.SpecialInvalidate(var Message:TMessage);
var
 r:TRect;
begin
 if (Parent <> nil) then
 begin
  r:=ClientRect;
  r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft));
  r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight));
  InvalidateRect(Parent.Handle,@r,true);
  RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE);
 end;
end;

procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);
begin
 SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
 inherited;
 PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
 Message.Result:=1
end;

constructor TTransparentMemo.Create(AOwner: TComponent);
begin
 inherited;
 ControlStyle:=[csCaptureMouse, csDesignInteractive, csClickEvents,  csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csNoStdEvents];
end;

procedure TTransparentMemo.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do
 begin
  ExStyle:=ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE
   and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not
   WS_EX_CLIENTEDGE;
 end;
end;

procedure Register;
begin
 RegisterComponents('Samples', [tTransparentMemo]);
end;

end.

Any tips/hints/answers would be greatly appreciated! Cheers in advance!

Answer 1

This isn't a complete fix, but you could, for example, do something like

protected
  procedure Click; override;

procedure TTransparentMemo.Click;
begin
  PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
  inherited;
end;

And so on. Perhaps there's a better place to do this. Have a look in your VCL source (StdCtrls.pas) and you might find something in TCustomEdit or TCustomMemo which would be better options to override.