在画布上写字(50分)

请各位高手帮忙，请问如何做出在画布上写字象windows所带的画图程序一样，用鼠标在画布上一拖，出现一个矩形虚线框，可在其中写字，要求背景透明，写完后用鼠标点其它位置上则画在画布上。

pdc->textout()

我是要求可在上面编辑，不是直接在上面画，这个我知道了。就象windows画图程序一样

如何把delphi的memo或rechedit或text控件的背景变为透明，要是能答出这个也可以。

放一个TEDIT在上面好了

用透明编辑控件

什么透明编辑控件，TEDIT不能透明

const
TMWM__SpecialInvalidate = WM_USER + 1111;
sc_DragMove: Longint = $F012;

type
TTransparentMemo = class(TMemo)
private
FRectList: array [1..8] of TRect;
FPosList: array [1..8] of Integer;
FCanvas: TControlCanvas;
FBB:Boolean;
FMapText:String;
function GetCanvas:TControlCanvas;
procedure WmSize (var Msg: TWmSize);message wm_Size;
procedure WmLButtonDown (var Msg: TWmLButtonDown);message wm_LButtonDown;
procedure WmNcHitTest (var Msg: TWmNcHitTest);message wm_NcHitTest;
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 SizerEnter(Sender:TObject);
procedure SizerExit(Sender:TObject);
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 SetMapText(const Value: String);
procedure cmMousemove(var Msg:TWMMouseMove);message WM_MouseMove;
procedure Change(Sender:TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
property MapText:String read FMapText write SetMapText;
property Canvas:TControlCanvas read GetCanvas;
end;


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

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

procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
var
i:integer;
begin
with Message do
begin
SetBkMode(ChildDC,TRANSPARENT);
Result:=GetStockObject(HOLLOW_BRUSH);
if FBB then Exit;
Canvas.Brush.Color := clBlack;
Canvas.Pen.Width:=1;
Canvas.Pen.Color:=clRed;
Canvas.MoveTo(0,0);
Canvas.LineTo(Width,0);
Canvas.MoveTo(Width-1,0);
Canvas.LineTo(Width-1,Height);
Canvas.MoveTo(0,0);
Canvas.LineTo(0,Height);
Canvas.MoveTo(0,Height-1);
Canvas.LineTo(Width,Height-1);
for I := 1 to 8 do
Canvas.Rectangle (FRectList .Left, FRectList .Top,FRectList .Right, FRectList .Bottom);
end;
end;

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

procedure TTransparentMemo.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 TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);
begin
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;

procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
if SelText='' then
PostMessage(Handle,WM_KEYDOWN,0,0);
end;

constructor TTransparentMemo.Create(AOwner: TComponent);
begin
inherited;
FCanvas:=TControlCanvas.Create;
FCanvas.Control:=Self;
OnEnter:=SizerEnter;
OnExit:=SizerExit;
OnChange:=Change;
ControlStyle := [csCaptureMouse, csDesignInteractive, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csNoStdEvents];
FBB:=True;
BorderStyle:=bsNone;
FPosList [1] := htTopLeft;
FPosList [2] := htTop;
FPosList [3] := htTopRight;
FPosList [4] := htRight;
FPosList [5] := htBottomRight;
FPosList [6] := htBottom;
FPosList [7] := htBottomLeft;
FPosList [8] := htLeft;
end;

procedure TTransparentMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
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;

function TTransparentMemo.GetCanvas: TControlCanvas;
begin
Result:=FCanvas;
end;

procedure TTransparentMemo.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: Integer;
begin
Pt := Point (Msg.XPos, Msg.YPos);
Pt := ScreenToClient (Pt);
Msg.Result := 0;
for I := 1 to 8 do
if PtInRect (FRectList , Pt) then
Msg.Result := FPosList ;
if Msg.Result = 0 then
inherited;
end;

procedure TTransparentMemo.WmSize(var Msg: TWmSize);
begin
FRectList [1] := Rect (0, 0, 5, 5);
FRectList [2] := Rect (Width div 2 - 3, 0,Width div 2 + 2, 5);
FRectList [3] := Rect (Width - 5, 0, Width, 5);
FRectList [4] := Rect (Width - 5, Height div 2 - 3,Width, Height div 2 + 2);
FRectList [5] := Rect (Width - 5, Height - 5,Width, Height);
FRectList [6] := Rect (Width div 2 - 3, Height - 5,Width div 2 + 2, Height);
FRectList [7] := Rect (0, Height - 5, 5, Height);
FRectList [8] := Rect (0, Height div 2 - 3,5, Height div 2 + 2);
inherited;
end;

procedure TTransparentMemo.SizerEnter(Sender: TObject);
begin
FBB:=False;
PostMessage(Handle,WM_SIZE,0,0);
end;

procedure TTransparentMemo.SizerExit(Sender: TObject);
begin
if Text='' then
begin
Free;
Exit;
end;
FBB:=True;
if SelText<>'' then
PostMessage(Handle,WM_ERASEBKGND,0,0);
PostMessage(Handle,WM_SIZE,0,0);
end;

procedure TTransparentMemo.SetMapText(const Value: String);
begin
FMapText := Value;
Lines.Text:=Value;
end;

procedure TTransparentMemo.WmLButtonDown(var Msg: TWmLButtonDown);
begin
if (Msg.XPos<=2) or (Msg.YPos<=2) or ((Msg.XPos<=Width) and (Msg.XPos>=(Width-2))) or
((Msg.YPos<=Height) and (Msg.YPos>=(Height-2))) then
begin
Perform (wm_SysCommand, sc_DragMove, 0);
PostMessage(Handle,WM_Size,0,0);
end
else inherited;
end;

procedure TTransparentMemo.cmMousemove(var Msg: TWMMouseMove);
begin
if (Msg.XPos<=2) or (Msg.YPos<=2) or ((Msg.XPos<=Width) and (Msg.XPos>=(Width-2))) or
((Msg.YPos<=Height) and (Msg.YPos>=(Height-2))) then
Cursor:=crHandPoint
else Cursor:=crDefault;
end;

procedure TTransparentMemo.Change(Sender: TObject);
begin
FMapText:=Lines.Text;
end;

wangrui_2003谢谢，能不能留下QQ号或E-mail，我们交个朋友。[]

我的E-mail:sun_wangrui@163.com