Edit透明在WIN XP下有问题!高手请进来看一下!分不够可再加!

[cherrylin]

制作了一个透明的Edit控件,主要是用API函数,但是很奇怪的问题出现,在WIN98和WIN200下都可以透明,在WIN XP下却不可以完全透明,有文字出现的地方不透明的!真纳闷啊!

哪位高手能不能帮我看看呢,或者有别的更好的方法,可以帮我解决一下吗,非常感谢!

我的控件代码如下:
unit EditPro;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics,Dialogs;

const
TWM_Invalidate = WM_USER+1;

type
TEditPro = class(TEdit)
private
FAlignment: TAlignment; //水平对齐
FTransparent: Boolean; //透明
procedure SetAlignment(Value: TAlignment);
procedure TInvalidate(var Message: TMessage); message TWM_Invalidate;
procedure CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMMove(var Message: TMessage); message WM_MOVE;
{ Private declarations }
protected
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DoExit; override;
procedure DoEnter; override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
procedure Invalidate; override;
{ Public declarations }
published
property Alignment: TAlignment Read FAlignment Write SetAlignment Default taLeftJustify; //水平对齐属性
{ Published declarations }
end;

procedure Register;

implementation

constructor TEditPro.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
Width := 70;
Height := 25;
FTransparent := True;
end;

procedure TEditPro.CreateWnd;
begin
inherited CreateWnd;
if FTransparent then
begin
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
end;
end;

procedure TEditPro.SetAlignment(Value: TAlignment);
begin
if Value <> FAlignment then
begin
FAlignment := Value;
RecreateWnd;
end;
end;

procedure TEditPro.TInvalidate(var Message:TMessage);
var
r: TRect;
begin
if (Parent <> nil) and FTransparent then
begin
r := ClientRect;
r.TopLeft := Parent.ScreenToClient(ClientToScreen(r.TopLeft));
r.BottomRight := Parent.ScreenToClient(ClientToScreen(r.BottomRight));
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end;
end;

procedure TEditPro.CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);
begin
if FTransparent then
with Message do
begin
SetBkMode(ChildDC, Windows.TRANSPARENT);
Result := GetStockObject(HOLLOW_BRUSH)
end
else
inherited;
end;

procedure TEditPro.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin
if FTransparent then
PostMessage(Handle, TWM_Invalidate, 0, 0)
else
inherited;
end;

procedure TEditPro.WMMove(var message: TMessage);
begin
inherited;
if FTransparent then
SendMessage(Handle, TWM_Invalidate, 0, 0)
else
Invalidate;
end;

procedure TEditPro.CreateParams(var Params: TCreateParams);
const
Alignments: array[TAlignment] of word = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or Alignments[FAlignment];
ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;
end;

procedure TEditPro.DoExit;
begin
inherited;
FTransparent := True;
SetCursor(0);
RecreateWnd;
end;

procedure TEditPro.DoEnter;
var
exstyle, stdstyle: LongInt;
begin
inherited;
FTransparent := False;
StdStyle:= Windows.GetWindowLong(Parent.handle, GWL_EXSTYLE);
exStyle:= StdStyle and not WS_EX_TRANSPARENT;
Windows.SetWindowLong(Parent.handle, GWL_EXSTYLE, exStyle);
invalidate;
end;

procedure TEditPro.Invalidate;
begin
if FTransparent then
SendMessage(Handle, TWM_Invalidate, 0, 0)
else
inherited;
end;

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

end.

[野草飞雪]

我也是XP，D6，EDIT透明在计算机上有相同的问题，不知道怎么解决？

[cherrylin]

版主都去哪了,问题这么多都没来回答一下!
急死人啦!

[miky]

没XP,帮不了你，帮你顶吧

[野草飞雪]

在XP上试过aiirii(ari-爱的眼睛) 的方法，是可行的！

[cherrylin]

难道真没人知道吗,没人做过Edit透明吗?
高手都到哪去了!

[aiirii]

我回復了几次, 都提交不了! csdn 還是有問題!!

XP 多個個屬性, 你要設置, 我所知道的就是這樣

Style := Style or Alignments[FAlignment];
ExStyle := ExStyle or WS_EX_TRANSPARENT;

[cherrylin]

aiirii大哥：

我用上面同样的方法使memo透明，在WIN XP下是可以完全透明的，如果是XP属性设置问题的话，照理说，memo也无法透明啊？

是否有谁知道如何使memo实现垂直对齐，在这个贴子中！
http://community.csdn.net/Expert/topic/3070/3070589.xml?temp=.7679865

[aiirii]

參考這個, 我試了下, 如不用XpMan之類實現XP效果, 是沒問題的
unit TranComp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;

type
TCtrl = class(TWinControl);

TTransEdit = class(TEdit)
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
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;

[aiirii]

implementation

const
BorderRec: array[TBorderStyle] of Integer = (1, -1);

procedure Register;
begin
RegisterComponents('Samples', [TTransEdit, TTransMemo]);
end;

function GetScreenClient(Control: TControl): TPoint;
var
p: TPoint;
begin
p := Control.ClientOrigin;
ScreenToClient(Control.Parent.Handle, p);
Result := p;
end;

constructor TTransEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignText := taLeftJustify;
FTransparent := false;
FPainting := false;
end;

destructor TTransEdit.Destroy;
begin
inherited Destroy;
end;

procedure TTransEdit.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
FAlignText := Value;
RecreateWnd;
Invalidate;
end;
end;

procedure TTransEdit.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;

procedure TTransEdit.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 TTransEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;

procedure TTransEdit.WMNCPaint(var Message: TMessage);
begin
inherited;
end;

procedure TTransEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TTransEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

[aiirii]

procedure TTransEdit.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;

procedure TTransEdit.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TTransEdit.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;

procedure TTransEdit.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 TTransEdit.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 TTransEdit.Change;
begin
RepaintWindow;
inherited Change;
end;

procedure TTransEdit.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;

// Transparent Memo

constructor TTransMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignText := taLeftJustify;
FTransparent := false;
FPainting := false;
end;

[aiirii]

Transparent Memo
我就不貼了!!!