delphi TEdit透明
unit tansEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls,Types;
type
TCtrl = class(TWinControl);
TRDTransEdit = 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 CNCTLCOLORMSGBOX(var Message: TWMCtlColorStatic); message CN_CTLCOLORMSGBOX;
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;
procedure WndProc(var Msg: TMessage);override;
published
property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
property Transparent: Boolean read FTransparent write SetTransparent default false;
end;
procedure Register;
implementation
const
BorderRec: array[TBorderStyle] of Integer = (1, -1);
procedure Register;
begin
RegisterComponents('OurComponent', [TRDTransEdit]);
end;
function GetScreenClient(Control: TControl): TPoint;
var
p: TPoint;
begin
p := Control.ClientOrigin;
ScreenToClient(Control.Parent.Handle, p);
Result := p;
end;
constructor TRDTransEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlignText := taLeftJustify;
FTransparent := false;
FPainting := false;
end;
destructor TRDTransEdit.Destroy;
begin
inherited Destroy;
end;
procedure TRDTransEdit.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
FAlignText := Value;
RecreateWnd;
Invalidate;
end;
end;
procedure TRDTransEdit.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;
procedure DoTransparent(ADC: HDC; AWinControl: TWinControl);
var
nSaveIndex: HDC;
pt: TPoint;
xParent: TWinControl;
xControl: TControl;
I: Integer;
procedure _DoTransparent_Helper(_DC: HDC; _WinCtrl: TWinControl);
var
_xSaveIndex: HDC;
_xSubSaveIndex: HDC;
_I: Integer;
_SubCtrl: TControl;
begin
if (_WinCtrl = nil) or (_DC = 0) then begin
Exit;
end;
// 非设计时并且不可见
if (not (csDesigning in _WinCtrl.ComponentState)) and (not _WinCtrl.Visible) then begin
Exit;
end;
// 设计时, 但是设计不可见
if (csDesigning in _WinCtrl.ComponentState)
and ((csDesignerHide in _WinCtrl.ControlState)
or (csNoDesignVisible in _WinCtrl.ControlStyle)) then begin
Exit;
end;
if not Windows.RectVisible(_DC, Types.Rect(_WinCtrl.Left, _WinCtrl.Top,
_WinCtrl.Left + _WinCtrl.Width,
_WinCtrl.Top + _WinCtrl.Height)) then begin
Exit;
end;
_xSaveIndex := Windows.SaveDC(_DC);
try
// _WinCtrl.ControlState := _WinCtrl.ControlState + [csPaintCopy];
MoveWindowOrg(_DC, _WinCtrl.Left, _WinCtrl.Top);
Windows.IntersectClipRect(_DC, 0, 0, _WinCtrl.Width, _WinCtrl.Height);
_WinCtrl.Perform( WM_ERASEBKGND, Integer(_DC), Integer(_DC) );
_WinCtrl.Perform( wm_PrintClient, Integer(_DC), prf_Client );
_WinCtrl.Perform( WM_PAINT, Integer(_DC), 0 );
for _I := 0 to _WinCtrl.ControlCount - 1 do begin
_SubCtrl := _WinCtrl.Controls[_i];
if _SubCtrl is TWinControl then begin
_xSubSaveIndex := Windows.SaveDC(_DC);
try
_DoTransparent_Helper(_DC, TWinControl(_SubCtrl));
finally
Windows.RestoreDC(_DC, _xSubSaveIndex);
end;
end;
end;
finally
Windows.RestoreDC(_DC, _xSaveIndex);
_WinCtrl.ControlState := _WinCtrl.ControlState - [csPaintCopy];
end;
end;
begin
if (AWinControl = nil) or (AWinControl.Parent = nil) or (ADC = 0) then begin
Exit;
end;
xParent := AWinControl.Parent;
nSaveIndex := Windows.SaveDC( ADC );
try try
Windows.GetViewportOrgEx(ADC, pt);
Windows.SetViewportOrgEx(ADC, pt.X - AWinControl.Left, pt.Y - AWinControl.Top, nil);
Windows.IntersectClipRect( ADC, 0, 0, AWinControl.Parent.ClientWidth,
AWinControl.Parent.ClientHeight);
if xParent.DockSite and AWinControl.UseDockManager
and (xParent.DockManager <> nil) then begin
xParent.DockManager.PaintSite(ADC);
end;
if xParent.ControlCount = 0 then begin
Exit;
end;
xParent.Perform( WM_ERASEBKGND, Integer(ADC), Integer(ADC));
xParent.Perform( wm_PrintClient, Integer(ADC), prf_Client );
// xParent.Perform( WM_PAINT, Integer(ADC), 0 );
for I := 0 to xParent.ControlCount - 1 do begin
xControl := xParent.Controls[i];
// TGraphicControl
if xControl is TWinControl then begin
if xControl = AWinControl then begin
Break;
end;
_DoTransparent_Helper(ADC, TWinControl(xControl));
end;
end;
except
end;
finally
Windows.RestoreDC( ADC, nSaveIndex );
end;
end;
procedure TRDTransEdit.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;
DoTransparent(Message.DC,Self);
Message.Result := 1;
end
else
inherited;
end;
procedure TRDTransEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;
procedure TRDTransEdit.WMNCPaint(var Message: TMessage);
begin
inherited;
end;
procedure TRDTransEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then begin
SetBkMode(Message.ChildDC, 1);
Message.Result:= GetStockObject(NULL_BRUSH);
end;
end;
procedure TRDTransEdit.CNCTLCOLORMSGBOX(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then begin
SetBkMode(Message.ChildDC, 1);
Message.Result:= GetStockObject(NULL_BRUSH);
end;
end;
procedure TRDTransEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then begin
SetBkMode(Message.ChildDC, 1);
Message.Result:= GetStockObject(NULL_BRUSH);
end;
end;
procedure TRDTransEdit.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;
procedure TRDTransEdit.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;
procedure TRDTransEdit.WndProc(var Msg: TMessage);
begin
inherited WndProc(Msg);
case Msg.Msg of
CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:begin
Msg.Result:= GetStockObject(NULL_BRUSH);
end;
end;
end;
procedure TRDTransEdit.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;
procedure TRDTransEdit.RepaintWindow;
var
DC,rDC: hDC;
TmpBitmap, Bitmap: hBitmap;
begin
if FTransparent then
begin
FPainting := true;
HideCaret(Handle);
rDC := GetDC(Handle);
DC := CreateCompatibleDC(rDC);
TmpBitmap := CreateCompatibleBitmap(rDC, Succ(ClientWidth), Succ(ClientHeight));
Bitmap := SelectObject(DC, TmpBitmap);
PaintTo(DC, 0, 0);
BitBlt(rDC, BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1,
SRCCOPY);
SelectObject(DC, Bitmap);
DeleteDC(DC);
ReleaseDC(Handle, rDC);
DeleteObject(TmpBitmap);
ShowCaret(Handle);
FPainting := false;
end;
end;
procedure TRDTransEdit.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];
if self.FTransparent then begin
Params.Style := Params.Style or WS_EX_TRANSPARENT;
end;
end;
procedure TRDTransEdit.Change;
begin
RepaintWindow;
inherited Change;
end;
procedure TRDTransEdit.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;
end.