※※※【100分求 透明Memo 控件】※※※在线等候，不见不散！！！

Question

※※※【100分求 透明Memo 控件】※※※

Answer 1

我写了90％了，就差一点，处理WndProc不好，所以Memo中凡是写了字的地方都是白色不透明，郁闷，在线等待高手～！！！我的贴出来，高手过目：unit TransMemo;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls;type
  TTransMemo = class(TMemo)
  private
        FTransparent : Boolean;
        procedure SetTransparent(Value: Boolean);
        procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    { Private declarations }
  protected
        procedure CreateParams(var Params: TCreateParams); override;
        procedure SetParent(AParent: TWinControl); override;
        procedure WndProc(var Message: TMessage); override;
    { Protected declarations }
  public
    { Public declarations }
  published
        property Transparent: Boolean read FTransparent write SetTransparent;
    { Published declarations }
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Standard', [TTransMemo]);
end;procedure TTransMemo.SetTransparent(Value: Boolean);
begin
    if ftransparent <> value then
    begin
        ftransparent := value;
    if value then
        controlstyle := controlstyle - [csOpaque]
    else
        controlstyle := controlstyle + [csOpaque];
    invalidate;
    end;
end;procedure TTransMemo.WMEraseBkgnd(var Msg: TMessage);
//var
//    br: HBRUSH;
begin
    if ftransparent then
        msg.result := 1
    else
        inherited;
end;procedure TTransMemo.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(Params);
    params.exstyle := params.exstyle or WS_EX_TRANSPARENT;    brush.Style := bsClear;
end;procedure TTransMemo.SetParent(AParent: TWinControl);
begin
    inherited SetParent(AParent);
    if (aparent <> nil) and aparent.HandleAllocated
        and (GetWindowLong(aparent.Handle, GWL_STYLE) or WS_CLIPCHILDREN <> 0) then
     SetWindowLong(aparent.handle, GWL_STYLE, GetWindowLong(aparent.Handle, GWL_STYLE)
        and not WS_CLIPCHILDREN);
end;procedure TTransMemo.WndProc(var Message: TMessage);
var
  NullBrush: HBRUSH;
begin
  case Message.Msg of
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
      begin
        NullBrush := GetStockObject(NULL_BRUSH);
        Message.Result := NullBrush;
//      Message.Result :=0;   //这个地方需要改！！
      end
  else
    inherited WndProc(Message);
  end;end; 
end.

Answer 2

看看这个吧，很好用的。
unit TranComp;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;type
  TCtrl = class(TWinControl);  
  // Transparent Memo
  TTransMemo = class(TMemo)
  private
    FAlignText: TAlignment;
    FTransparent: Boolean;
    FPainting: Boolean;
    procedure SetAlignText(Value: TAlignment);
    procedure SetTransparent(Value: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
    procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  protected
    procedure RepaintWindow;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Change; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
  end;procedure Register;implementationconst
 BorderRec: array[TBorderStyle] of Integer = (1, -1);procedure Register;
begin
  RegisterComponents('Transparent Components', [TTransMemo]);
end;function GetScreenClient(Control: TControl): TPoint;
var
 p: TPoint;
begin
 p := Control.ClientOrigin;
 ScreenToClient(Control.Parent.Handle, p);
 Result := p;
end;// Transparent Memo
constructor TTransMemo.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAlignText := taLeftJustify;
 FTransparent := false;
 FPainting := false;
end;destructor TTransMemo.Destroy;
begin
 inherited Destroy;
end;procedure TTransMemo.SetAlignText(Value: TAlignment);
begin
 if FAlignText <> Value then
 begin
  FAlignText := Value;
  RecreateWnd;
  Invalidate;
 end;
end;procedure TTransMemo.SetTransparent(Value: Boolean);
begin
 if FTransparent <> Value then
 begin
  FTransparent := Value;
  Invalidate;
 end;
end;procedure TTransMemo.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
 DC: hDC;
 i: integer;
 p: TPoint;
begin
 if FTransparent then
 begin
  if Assigned(Parent) then
  begin
   DC := Message.DC;
   i := SaveDC(DC);
   p := GetScreenClient(self);
   p.x := -p.x;
   p.y := -p.y;
   MoveWindowOrg(DC, p.x, p.y);
   SendMessage(Parent.Handle, $0014, DC, 0);
   TCtrl(Parent).PaintControls(DC, nil);
   RestoreDC(DC, i);
  end;
 end else inherited;
end;procedure TTransMemo.WMPaint(var Message: TWMPaint);
begin
 inherited;
 if FTransparent then
 if not FPainting then
 RepaintWindow;
end;procedure TTransMemo.WMNCPaint(var Message: TMessage);
begin
 inherited;
end;procedure TTransMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;procedure TTransMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;procedure TTransMemo.CMParentColorChanged(var Message: TMessage);
begin
 inherited;
 if FTransparent then
 Invalidate;
end;procedure TTransMemo.WMSize(var Message: TWMSize);
begin
 inherited;
 Invalidate;
end;procedure TTransMemo.WMMove(var Message: TWMMove);
begin
 inherited;
 Invalidate;
end;procedure TTransMemo.RepaintWindow;
var
 DC: hDC;
 TmpBitmap, Bitmap: hBitmap;
begin
 if FTransparent then
 begin
  FPainting := true;
  HideCaret(Handle);
  DC := CreateCompatibleDC(GetDC(Handle));
  TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
  Bitmap := SelectObject(DC, TmpBitmap);
  PaintTo(DC, 0, 0);
  BitBlt(GetDC(Handle), BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);
  SelectObject(DC, Bitmap);
  DeleteDC(DC);
  ReleaseDC(Handle, GetDC(Handle));
  DeleteObject(TmpBitmap);
  ShowCaret(Handle);
  FPainting := false;
 end;
end;procedure TTransMemo.CreateParams(var Params: TCreateParams);
const
 Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
 inherited CreateParams(Params);
 Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];
end;procedure TTransMemo.Change;
begin
 RepaintWindow;
 inherited Change;
end;procedure TTransMemo.SetParent(AParent: TWinControl);
begin
 inherited SetParent(AParent);
end;end.