透明的TMEMO？100分

[codingfans]

我按照一篇相关文章处理透明的TMEMO，但总是不成功，方法是从TMEMO生成一个子类，谁能给我说明一下具体步骤？

[masterdelphi]

对TWinControl类的控件, 要实现透明只要完成以下
四步基本上就成了.
1.在Create中设定ControlStyle :=
ControlStyle - [csOpaque];)
2. override 它的CreateParams方法, exstyle 里加上WS_EX_TRANSPARENT.
3. 修改它的parent的window style, 去掉WS_CLIPCHILDREN.

inherited CreateParams(Params);
with Params do
begin
{ 完全重画 }
Style := Style and not WS_CLIPCHILDREN;
Style := Style and not WS_CLIPSIBLINGS;
{ 增加透明 }
ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;


4. 截获WM_ERASEBKGND, 什么都不做直接返回1.(不搽除背景）
一般有上面3步能成. 有些控件比如TPanel, 在它的paint中用了fillrect, 所以要实现透明的话还要override 它的paint方法， 自己画.
按钮透明需要进一步处理.
createparams里加上style := style or BS_OWNERDRAW;
然后在WM_DRAWITEM中自己画吧

[codingfans]

谢谢，但我根据这个还是不会

[floattofool]

up

[johnsonrao]

透明的TPanel
type
TPanelBorder = set of (pbInnerRaised, pbInnerSunk, pbOuterRaised, pbOuterSunk);
TTrPanel = class(TCustomPanel)
private
FTransparentRate : Integer; // 透明度

FBkGnd : TBitmap; // 背景buffer

procedure SetTransparentRate(value: Integer);

procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;

protected
procedure BuildBkgnd; virtual; // 生成半透明的背景
procedure SetParent(AParent : TWinControl); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; // resize or move
procedure Invalidate; override;
procedure InvalidateA; virtual;
published
property TransparentRate: Integer read FTransparentRate write SetTransparentRate;
property ......
........ // 可以抄TPanel里面的
end;

procedure Register;

implimentation
procedure Register;
begin
RegisterComponent('Samples', [TTrPanel]);
end;

procedure TTrPanel.SetTransparentRate(value: Integer);
begin
if (value <0) or (value > 100) then exit;
if value <> FTransparentRate then
begin
FTransparentRate := value;
Invalidate;
end;
end;

procedure TTrPanel.WMEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := 1;
end;

procedure TTrPanel.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if (AParent <> nil) and AParent.HandleAllocated
and (GetWindowLong(AParent.Handle, GWL_STYLE) and WS_CLIPCHILDREN <> 0)
then
SetWindowLong(AParent.Handle, GWL_STYLE,
GetWindowLong(AParent.Handle, GWL_STYLE)
and not WS_CLIPCHILDREN);
end;

procedure TTrPanel.CreateParams(.....);
begin
inherited CreateParams(Params);
params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TTrPanel.Paint;
begin
if not assigned(FBkgnd) then
BuildBkgnd;
bitblt(Canvas.handle, 0, 0, width, height, FBkgnd.Canvas.Handle, 0, 0, SRCCOPY);
........
........ // 画边框, 画caption等, 就不写了.
end;
type
T24Color = record
b, g, r: Byte;
end;
P24Color := ^T24Color;

procedure TTrPanel.BuildBkgnd;
var
p, p1: P24Color;
C : LongInt;
i, j: Integer;
begin
FBkgnd := TBitmap.Create;
FBkgnd.PixelFormat := pf24Bit;
FBkgnd.Width := Width;
FBkgnd.Height := Height;
if ftransparentrate > 0 then
begin
BitBlt(FBkgnd.Canvas.handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
if ftransparentrate < 100 then // 部分透明
begin
c := ColorToRGB(Color);
// 注意: ColorToRGB得到的颜色r, b位置与
// scanline中颜色顺序正好相反.
p1 := @c;
for i := 0 to FBkgnd.Height - 1 do
begin
p := FBkgnd.Scanline[i];
for j := 0 to FBkgnd.Width - 1 do
begin
p^.r := (p^.r * ftransparentrate + p1^.b * (100-ftransparentrate)) div 100;
p^.g := (p^.g * ftransparentrate + p1^.g * (100-ftransparentrate)) div 100;
p^.b := (p^.b * ftransparentrate + p1^.r * (100-ftransparentrate)) div 100;
p := pointer(integer(p)+3);
end;
end;
end;
end
else begin // 不透明
c := CreateSolidBrush(ColorToRGB(color));
FillRect(fFBkgnd.canvas.handle, c);
deleteobject(c);
end;
controlstyle := controlstyle + [csOpaque]; // 背景没有变化时的重画不会出现闪烁
end;

Constructor TTrPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fbkgnd := nil;
fTransparentRate := 0;
end;

Destructor TTrPanel.Destroy;
begin
if assigned(fbkgnd) then
fbkgnd.free;
inherited;
end;

procedure TTrPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if ftransparentrate > 0 then // 移动时能获得正确的背景
invalidate;
inherited;
end;

procedure TTrPanel.Invalidate; // 刷新时重新计算背景
begin
if assigned(fbkgnd) then
begin
fbkgnd.free;
fbkgnd := nil;
controlstyle := constrolstyle - [csOpaque];
end;
inherited;
end;

procedure TTrPanel.InvalidateA; // 刷新时不重新计算背景(可以加快显示速度)
begin
inherited Invalidate;
end;

end.

参照着写吧!

[amna]

gz