«« Site Rescued »»

While the site is still going to move from its current host, a new site will now take its place. More Info.

The new site may have less content, but the core will now remain. And it will now play nicely with phones! Keep an eye on the DelphiDabbler Blog for news.

» Help

How to create a transparent TMemo

   
unit TrMemo;
 
{$R-}
 
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('cool!', [tTransparentMemo]);
end;
 
end.
Original resource: The Delphi Pool
Author: Unknown
Added: 2013-01-27
Last updated: 2013-01-27

« Return to contents »