TEdit,TMemo背景透明

Thecomponentbelowworksperfectly,exceptforthefollowingproblem:

1)Savesthecomponentbelowinafile"trancomp.pas".

Then,installthiscomponentinDelphi;

2)Later,openDelphiandcreateanewproject;

3)AddsaTImageandaTTransMemototheform;

4)Opensanyimageinthe"PICTURE"propertyofTIMAGE.AdjustthesizeofTIMAGEsothatTTransMEMOstaysonTIMAGE;

5)Changesthe"TRANSPARENT"propertyofTTransMemofor"TRUE".Alsochangethe"SCROLLBARS"propertyfor"Vertical".

6)Now,executestheprojectandtrytoslidethescrollbar(Up/Down).Seethatthebackgroundimage"shakes"whenthetextisrolledupwardordown.

Please,couldanybodyrepairthisprobleminthecomponentsothatitworkscorrectly?

------------------STARTOFCOMPONENT----------------------

unitTranComp;

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;

procedureSetAlignText(Value:TAlignment);

procedureSetTransparent(Value:Boolean);

procedureWMPaint(varMessage:TWMPaint);messageWM_PAINT;

procedureWMNCPaint(varMessage:TMessage);messageWM_NCPAINT;

procedureWMEraseBkGnd(varMessage:TWMEraseBkGnd);messageWM_ERASEBKGND;

procedureCNCtlColorEdit(varMessage:TWMCtlColorEdit);messageCN_CTLCOLOREDIT;

procedureCNCtlColorStatic(varMessage:TWMCtlColorStatic);messageCN_CTLCOLORSTATIC;

procedureCMParentColorChanged(varMessage:TMessage);messageCM_PARENTCOLORCHANGED;

procedureWMSize(varMessage:TWMSize);messageWM_SIZE;

procedureWMMove(varMessage:TWMMove);messageWM_MOVE;

protected

procedureRepaintWindow;

procedureCreateParams(varParams:TCreateParams);override;

procedureChange;override;

procedureSetParent(AParent:TWinControl);override;

public

constructorCreate(AOwner:TComponent);override;

destructorDestroy;override;

published

propertyAlignText:TAlignmentreadFAlignTextwriteSetAlignTextdefaulttaLeftJustify;

propertyTransparent:BooleanreadFTransparentwriteSetTransparentdefaultfalse;end;

//TransparentMemo

TTransMemo=class(TMemo)

private

FAlignText:TAlignment;

FTransparent:Boolean;

FPainting:Boolean;

procedureSetAlignText(Value:TAlignment);

procedureSetTransparent(Value:Boolean);

procedureWMPaint(varMessage:TWMPaint);messageWM_PAINT;

procedureWMNCPaint(varMessage:TMessage);messageWM_NCPAINT;

procedureWMEraseBkGnd(varMessage:TWMEraseBkGnd);messageWM_ERASEBKGND;

procedureCNCtlColorEdit(varMessage:TWMCtlColorEdit);messageCN_CTLCOLOREDIT;

procedureCNCtlColorStatic(varMessage:TWMCtlColorStatic);messageCN_CTLCOLORSTATIC;

procedureCMParentColorChanged(varMessage:TMessage);messageCM_PARENTCOLORCHANGED;

procedureWMSize(varMessage:TWMSize);messageWM_SIZE;

procedureWMMove(varMessage:TWMMove);messageWM_MOVE;

protected

procedureRepaintWindow;

procedureCreateParams(varParams:TCreateParams);override;

procedureChange;override;

procedureSetParent(AParent:TWinControl);override;

public

constructorCreate(AOwner:TComponent);override;

destructorDestroy;override;

published

propertyAlignText:TAlignmentreadFAlignTextwriteSetAlignTextdefaulttaLeftJustify;

propertyTransparent:BooleanreadFTransparentwriteSetTransparentdefaultfalse;end;

procedureRegister;

implementation

const

BorderRec:array[TBorderStyle]ofInteger=(1,-1);

procedureRegister;

begin

RegisterComponents('TransparentComponents',[TTransEdit,TTransMemo]);end;

functionGetScreenClient(Control:TControl):TPoint;

var

p:TPoint;

begin

p:=Control.ClientOrigin;

ScreenToClient(Control.Parent.Handle,p);

Result:=p;end;

constructorTTransEdit.Create(AOwner:TComponent);

begin

inheritedCreate(AOwner);

FAlignText:=taLeftJustify;

FTransparent:=false;

FPainting:=false;end;

destructorTTransEdit.Destroy;

begin

inheritedDestroy;end;

procedureTTransEdit.SetAlignText(Value:TAlignment);

begin

ifFAlignText<>Valuethen

begin

FAlignText:=Value;

RecreateWnd;

Invalidate;end;end;

procedureTTransEdit.SetTransparent(Value:Boolean);

begin

ifFTransparent<>Valuethen

begin

FTransparent:=Value;

Invalidate;end;end;

procedureTTransEdit.WMEraseBkGnd(varMessage:TWMEraseBkGnd);

var

DC:hDC;

i:integer;

p:TPoint;

begin

ifFTransparentthen

begin

ifAssigned(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;

endelseinherited;end;

procedureTTransEdit.WMPaint(varMessage:TWMPaint);

begin

inherited;

ifFTransparentthen

ifnotFPaintingthen

RepaintWindow;end;

procedureTTransEdit.WMNCPaint(varMessage:TMessage);

begin

inherited;end;

procedureTTransEdit.CNCtlColorEdit(varMessage:TWMCtlColorEdit);

begin

inherited;

ifFTransparentthen

SetBkMode(Message.ChildDC,1);end;

procedureTTransEdit.CNCtlColorStatic(varMessage:TWMCtlColorStatic);

begin

inherited;

ifFTransparentthen

SetBkMode(Message.ChildDC,1);end;

procedureTTransEdit.CMParentColorChanged(varMessage:TMessage);

begin

inherited;

ifFTransparentthen

Invalidate;end;

procedureTTransEdit.WMSize(varMessage:TWMSize);

begin

inherited;

Invalidate;end;

procedureTTransEdit.WMMove(varMessage:TWMMove);

begin

inherited;

Invalidate;end;

procedureTTransEdit.RepaintWindow;

var

DC:hDC;

TmpBitmap,Bitmap:hBitmap;

begin

ifFTransparentthen

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;

procedureTTransEdit.CreateParams(varParams:TCreateParams);

const

Alignments:array[TAlignment]ofDWord=(ES_LEFT,ES_RIGHT,ES_CENTER);

begin

inheritedCreateParams(Params);

Params.Style:=Params.StyleorES_MULTILINEorAlignments[FAlignText];end;

procedureTTransEdit.Change;

begin

RepaintWindow;

inheritedChange;end;

procedureTTransEdit.SetParent(AParent:TWinControl);

begin

inheritedSetParent(AParent);end;

//TransparentMemo

constructorTTransMemo.Create(AOwner:TComponent);

begin

inheritedCreate(AOwner);

FAlignText:=taLeftJustify;

FTransparent:=false;

FPainting:=false;end;

destructorTTransMemo.Destroy;

begin

inheritedDestroy;end;

procedureTTransMemo.SetAlignText(Value:TAlignment);

begin

ifFAlignText<>Valuethen

begin

FAlignText:=Value;

RecreateWnd;

Invalidate;end;end;

procedureTTransMemo.SetTransparent(Value:Boolean);

begin

ifFTransparent<>Valuethen

begin

FTransparent:=Value;

Invalidate;end;end;

procedureTTransMemo.WMEraseBkGnd(varMessage:TWMEraseBkGnd);

var

DC:hDC;

i:integer;

p:TPoint;

begin

ifFTransparentthen

begin

ifAssigned(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;

endelseinherited;end;

procedureTTransMemo.WMPaint(varMessage:TWMPaint);

begin

inherited;

ifFTransparentthen

ifnotFPaintingthen

RepaintWindow;end;

procedureTTransMemo.WMNCPaint(varMessage:TMessage);

begin

inherited;end;

procedureTTransMemo.CNCtlColorEdit(varMessage:TWMCtlColorEdit);

begin

inherited;

ifFTransparentthen

SetBkMode(Message.ChildDC,1);end;

procedureTTransMemo.CNCtlColorStatic(varMessage:TWMCtlColorStatic);

begin

inherited;

ifFTransparentthen

SetBkMode(Message.ChildDC,1);end;

procedureTTransMemo.CMParentColorChanged(varMessage:TMessage);

begin

inherited;

ifFTransparentthen

Invalidate;end;

procedureTTransMemo.WMSize(varMessage:TWMSize);

begin

inherited;

Invalidate;end;

procedureTTransMemo.WMMove(varMessage:TWMMove);

begin

inherited;

Invalidate;end;

procedureTTransMemo.RepaintWindow;

var

DC:hDC;

TmpBitmap,Bitmap:hBitmap;

begin

ifFTransparentthen

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;

procedureTTransMemo.CreateParams(varParams:TCreateParams);

const

Alignments:array[TAlignment]ofDWord=(ES_LEFT,ES_RIGHT,ES_CENTER);

begin

inheritedCreateParams(Params);

Params.Style:=Params.StyleorES_MULTILINEorAlignments[FAlignText];end;

procedureTTransMemo.Change;

begin

RepaintWindow;

inheritedChange;end;

procedureTTransMemo.SetParent(AParent:TWinControl);

begin

inheritedSetParent(AParent);end;

end.

下面的代码如果memo已有内容，回到已有内容中间处修改，旧的文本笔画会和新的文本笔画混合。文本笔画背景未完全檫除。效果不好

TEdit,TMemo背景透明

type

TForm1
=class(TForm)

private

{Privatedeclarations}

FBitmap:TBitmap;

FBrush:HBRUSH;

Edit1:TEdit;

Memo1:TMemo;

Image2:TImage;//背景图片

protected

procedureWndProc(varMessage:TMessage);override;

end;

procedureTForm1.FormCreate(Sender:TObject);

begin

FBitmap:=TBitmap.Create;
FBitmap.SetSize(Memo1.Width,Memo1.Height);
FBitMap.Canvas.CopyRect(

types.Rect(0,0,FBitmap.Width,FBitmap.Height),

Image2.Canvas,

types.Rect(memo1.Left,memo1.Top,memo1.Left+Memo1.Width,memo1.Top+Memo1.Height));

FBrush:=CreateSolidBrush(FBitmap.Handle);

SetWindowLong(Edit1.Handle,GWL_EXSTYLE,GetWindowLong(Edit1.Handle,GWL_EXSTYLE)
orWS_EX_TRANSPARENT);

SetWindowLong(Memo1.Handle,GWL_EXSTYLE,GetWindowLong(Memo1.Handle,GWL_EXSTYLE)
orWS_EX_TRANSPARENT);

end;

procedureTForm1.FormPaint(Sender:TObject);

begin

Canvas.Brush.Handle:=FBrush;

Canvas.Rectangle(0,0,width,height);end;

procedureTForm1.WndProc(varMessage:TMessage);

begin

inherited;

caseMessage.Msgof

WM_CTLCOLOREDIT,WM_CTLCOLORSTATIC:

SetBkMode(Message.WParam,TRANSPARENT);

Message.Result:=FBrush;//GetStockObject(NULL_BRUSH);end;end;