procedure TForm1.FormCreate(Sender: TObject);
begin
oldproc:=RichEdit1.WindowProc;
RichEdit1.WindowProc:=form1.ClassWndProc;
SetWindowLong(RichEdit1.Handle, GWL_EXSTYLE, GetWindowLong(RichEdit1.Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);
end;
procedure Tform1.ClassWndProc(var Msg: TMessage);
begin
if msg.Msg= WM_ERASEBKGND then
msg. result:=1 else
if (msg.Msg = CN_CTLCOLORMSGBOX )or(msg.Msg = CN_CTLCOLORSTATIC ) then
begin
bb:=null;
msg. result :=bb
end else
oldproc(msg)
end;
destructor TTransMemo.Destroy;
begin
inherited Destroy;
end;
procedure TTransMemo.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
FAlignText := Value;
RecreateWnd;
Invalidate;
end;
end;
procedure TTransMemo.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;
procedure TTransMemo.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 TTransMemo.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;
procedure TTransMemo.WMNCPaint(var Message: TMessage);
begin
inherited;
end;
procedure TTransMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;
procedure TTransMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;
procedure TTransMemo.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;
procedure TTransMemo.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;
procedure TTransMemo.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;
procedure TTransMemo.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 TTransMemo.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 TTransMemo.Change;
begin
RepaintWindow;
inherited Change;
end;
procedure TTransMemo.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;