怎么样才能使 richedit 透明? 100 分

Question

如题

Answer 1

下面的代码是我抄来的.它实现了 memo 的透明效果 直接把 Tmemo 换成 Trichedit 也能透明
可惜的是不能显示文本.不知道那位大侠能帮帮小弟.不胜感激.
  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;// 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;

Answer 2

转一个文章,可能对你有帮助核心API函数就是SetLayeredWindowAttributes，以下的控件
代码是让你的窗口实现淡入淡出效果而设计，通过编程时动态改变AlphaValue值，您就
可以看到效果了。unit TranForm; {DragonPC 2001.2.21 }interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;typeTTranForm = class(TComponent)privateFAlphaValue : integer ;FHandle : HWND ;procedure SetFAlphaValue(Alpha:integer) ;protectedprocedure UpdateDisplay ;publicconstructor Create(AOwner: TComponent); override;publishedproperty AlphaValue : integer read FAlphaValue write SetFAlphaValue ;end;procedure Register;function SetLayeredWindowAttributes(Handle : HWND; COLORKEY : COLORREF; Alpha : BYTE; Flags : DWORD) :Boolean;stdcall; external 'USER32.DLL';implementationprocedure Register;beginRegisterComponents('Standard', [TTranForm]);end;{ TTranForm }procedure TTranForm.SetFAlphaValue(Alpha: integer);beginif (Alpha >= 0) and (Alpha < 256) then beginFAlphaValue := Alpha ;UpdateDisplay() ;end elseShowMessage('请输入0~255之间的值！') ;end;procedure TTranForm.UpdateDisplay;beginif not (csDesigning in ComponentState) thenSetLayeredWindowAttributes(FHandle, 0, FAlphaValue, 2);
end;constructor TTranForm.Create(AOwner: TComponent);begininherited;FAlphaValue := 255 ;FHandle := TForm(Owner).Handle ;if not (csDesigning in ComponentState) thenSetWindowLong(FHandle,GWL_EXSTYLE, GetWindowLong(FHandle, GWL_EXSTYLE )or $80000 );{我屏蔽了设计期的显示效果，如果你愿意可以改改，建议设计时最好不要看到效果}end;end.**************constWS_EX_LAYERED = $80000;AC_SRC_OVER = $0;AC_SRC_ALPHA = $1;AC_SRC_NO_PREMULT_ALPHA = $1;AC_SRC_NO_ALPHA = $2;AC_DST_NO_PREMULT_ALPHA = $10;AC_DST_NO_ALPHA = $20;LWA_COLORKEY = $1;LWA_ALPHA = $2;ULW_COLORKEY = $1ULW_ALPHA = $2ULW_OPAQUE = $4//新增加的常量定义function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明　procedure TForm1.FormCreate(Sender: TObject);var l:longint;beginl:=getWindowLong(Handle, GWL_EXSTYLE);l := l Or WS_EX_LAYERED;SetWindowLong (handle, GWL_EXSTYLE, l);SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);//第二个参数是指定透明颜色//第二个参数为0则使用第四个参数设置alpha值，从0到255，end;

Answer 3

谢谢你 pankun(剑神一笑).但它似乎只对窗口有效.不能用在 richedit上啊.

Answer 4

转贴---------------------------------------
type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    RichEdit1: TRichEdit;
    procedure ClassWndProc(var Msg: TMessage);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public    { Public declarations }
  end;var  Form1: TForm1;
  wproc: pointer;
  oldproc:TWndMethod;
  bb:hBrush ;
implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  oldproc:=RichEdit1.WindowProc;
  RichEdit1.WindowProc:=form1.ClassWndProc;
  SetWindowLong(RichEdit1.Handle, GWL_EXSTYLE, GetWindowLong(RichEdit1.Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);
end;
procedure Tform1.ClassWndProc(var Msg: TMessage);
begin
if msg.Msg= WM_ERASEBKGND  then
   msg. result:=1     else   
   if (msg.Msg =  CN_CTLCOLORMSGBOX )or(msg.Msg = CN_CTLCOLORSTATIC ) then
       begin
       bb:=null;
       msg. result :=bb
       end else
      oldproc(msg)
end;