谁能教我做透明控件??? 200分全给!(200分)

W

www

Unregistered / Unconfirmed
GUEST, unregistred user!
想做一个透明的控件,是带焦点的,比如button, 是透明的,但也可以有焦点,用键盘也可以操作. 网上找的都是基于TGraphiccontrol的,不能有焦点.
我要的是基于TWinControl或TCustomControl的.
 
这么难吗? 大家怎么不帮忙呀?
 
可以用TShape嗎?
牠的pen-->Mode屬性可以設透明
 
自已写一个三
 
真是好笑,大家就这么回答问题吗?
 
难道,还要给你把代码写出来
其实你写控件时,从TCustomControl继承,
重写一个Paint函数,或添加一个WM_NCPAINT消息,并写一个函数
 
我也建议用TSHAPE
 
唉,现在的人呀.
 
unit QTMRichEdit;
interface
uses
SysUtils, Classes, Controls, StdCtrls, ComCtrls,Windows,Messages;
const
TMWM__SpecialInvalidate = WM_USER + 2222;
type
TTMRichEdit = class(TRichEdit)
private
{ Private declarations }
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 CNCTLCOLORMSGBOX(var Message:TWMCTLCOLORMSGBOX);
message CN_CTLCOLORMSGBOX;
procedure CNCTLCOLORSTATIC(var Message:TWMCTLCOLORSTATIC);
message CN_CTLCOLORSTATIC;
procedure WMKeyDown(var Message: TWMKeyDown);
message WM_KEYDOWN;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);
message WM_ERASEBKGND;
procedure WMMove(var Message: TMessage);
message WM_MOVE;
procedure CMMouseEnter(var Message: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage);
message CM_MOUSELEAVE;
//procedure WMMouseMove (Var Message: TWMMouseMove);
Message WM_MouseMove;
procedure WMLButtonDown(Var Message: TWMLButtonDown);
Message WM_LButtonDown;
procedure WMKillFocus(Var Message: TWMKillFocus);
Message WM_KillFocus;
procedure WMMOUSEWHEELl(var Message:TMessage);message WM_MOUSEWHEEL;

protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams);
override;
procedure CreateWnd;override;
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
published
{ Published declarations }
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TTMRichEdit]);
end;

{ TTMRichEdit }
procedure TTMRichEdit.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTMRichEdit.CMMouseLeave(var Message: TMessage);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTMRichEdit.CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);
begin
with Messagedo
begin
SetBkMode(ChildDC,Windows.TRANSPARENT);
Result:=GetStockObject(HOLLOW_BRUSH)
//Result:=NullBrush;
end
end;

procedure TTMRichEdit.CNCTLCOLORMSGBOX(var Message: TWMCTLCOLORMSGBOX);
begin
Message.Result:=-1;
end;

procedure TTMRichEdit.CNCTLCOLORSTATIC(var Message: TWMCTLCOLORSTATIC);
begin
Message.Result:=-1;
end;

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

procedure TTMRichEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Paramsdo
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 TTMRichEdit.CreateWnd;
begin
inherited CreateWnd;
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);
end;

procedure TTMRichEdit.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;
Message.Result:=1;
end;

procedure TTMRichEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
//Update;
Message.Result := 1;
end;

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

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

procedure TTMRichEdit.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;

procedure TTMRichEdit.WMLButtonDown(var Message: TWMLButtonDown);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTMRichEdit.WMMOUSEWHEELl(var Message: TMessage);
begin
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
if Message.Result = 0 then
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
Update;
end;

procedure TTMRichEdit.WMMove(var Message: TMessage);
begin
inherited;
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

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

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

end.
 
Memo的
unit QTMMemo;
interface
uses
Windows, Messages, Controls, StdCtrls, Classes;
const
TMWM__SpecialInvalidate = WM_USER + 1111;

type
TTMMemo = class(TMemo)
private
{ Private declarations }
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;
procedure WMMove(var Message: TMessage);
message WM_MOVE;
procedure CMMouseEnter(var Message: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage);
message CM_MOUSELEAVE;
procedure WMLButtonDown (Var Message: TWMLButtonDown);
Message WM_LButtonDown;
procedure WMKillFocus (Var Message: TWMKillFocus);
Message WM_KillFocus;
procedure CNCTLCOLORMSGBOX(var Message:TWMCTLCOLORMSGBOX);
message CN_CTLCOLORMSGBOX;
procedure CNCTLCOLORSTATIC(var Message:TWMCTLCOLORSTATIC);
message CN_CTLCOLORSTATIC;

protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams);
override;
procedure CreateWnd;override;
proceduredo
Exit;
override;
proceduredo
Enter;
override;
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
published
{ Published declarations }
//property TransParent:Boolean read FTransparent write SetTransparent default True ;
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TTMMemo]);
end;

{ TTMMemo }
procedure TTMMemo.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTMMemo.CMMouseLeave(var Message: TMessage);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

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

procedure TTMMemo.CNCTLCOLORMSGBOX(var Message: TWMCTLCOLORMSGBOX);
begin
Message.Result:=-1;
end;

procedure TTMMemo.CNCTLCOLORSTATIC(var Message: TWMCTLCOLORSTATIC);
begin
Message.Result:=-1;
end;

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

procedure TTMMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Paramsdo
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 TTMMemo.CreateWnd;
begin
inherited CreateWnd;
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);
end;

procedure TTMMemo.DoEnter;
var exstyle,stdstyle:longint;
begin
inherited;
StdStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
exStyle:= StdStyle and not WS_EX_TRANSPARENT;
Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
invalidate;
end;

procedure TTMMemo.DoExit;
begin
inherited;
SetCursor(0);
RecreateWnd;
end;

procedure TTMMemo.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 TTMMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;

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

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

procedure TTMMemo.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;

procedure TTMMemo.WMLButtonDown(var Message: TWMLButtonDown);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

{procedure TTMMemo.WMMouseMove(var Message: TWMMouseMove);
begin
inherited;
if not (csDesigning in ComponentState) then
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
}
procedure TTMMemo.WMMove(var Message: TMessage);
begin
inherited;
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

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

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

end.
 

Similar threads

回复
0
查看
854
不得闲
D
回复
0
查看
538
DelphiTeacher的专栏
D
顶部