Edit Transparente - Delphi

unit UMyEditTransparent;

interface

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


type
  TTranspaEdit = class(TEdit)
  private
    { Private declarations }
    FPictureFond   : TPicture;
    FPictureFondVisible : boolean;
    FAlignText      : TAlignment;
    FTransparent    : Boolean;
    FPainting       : Boolean;
    procedure SetPictureFond(Value: TPicture);
    procedure SetAlignText(Value: TAlignment);
    procedure SetTransparent(Value: Boolean);

  protected
    { Protected declarations }
    procedure RepaintWindow;
    procedure Change; override;
    procedure SetParent(AParent: TWinControl); override;
    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;
    procedure PaintParent(ACanvas: TCanvas);
  public
    { Public declarations }
    procedure   CreateParams(var Params: TCreateParams);override;
    constructor Create(AOwner: TComponent); override;
    procedure   SetPictureFondVisible(Value: boolean);
    destructor  Destroy; override;
  published
    { Published declarations }
    property Align;
    property AlignText   : TAlignment read FAlignText   write SetAlignText   default taLeftJustify;
    property Transparent : Boolean    read FTransparent write SetTransparent default False;
    property Picture     : TPicture   read FPictureFond write SetPictureFond;
    property PictureVisible: boolean  read FPictureFondVisible write SetPictureFondVisible default False;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('My Componentes', [TTranspaEdit]);
end;

type

TParentControl = class(TWinControl);

const

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

constructor TTranspaEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
    FPictureFond := TPicture.Create;
    FAlignText   := taLeftJustify;
    FTransparent := false;
    FPainting    := false;
    Invalidate;
end;

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

procedure TTranspaEdit.SetPictureFond(Value : TPicture);
begin
  if FPictureFond <> Value then
  begin FPictureFond.Assign(Value);
    FTransparent       :=True;
    FPictureFondVisible:=True;
    Invalidate;
  end;
end;

procedure TTranspaEdit.SetPictureFondVisible(Value: Boolean);
begin
  if FPictureFondVisible <> Value then
  begin
    FPictureFondVisible := Value;
    Invalidate;
  end;
end;

destructor TTranspaEdit.Destroy;
begin
  FPictureFond.Free;
  inherited Destroy;
end;

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

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

procedure TTranspaEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
  DC: hDC;
  canvas : TCanvas;
  oldBrush : TBrush;
begin
if FTransparent and not(csDesigning in componentstate) then
begin
if Not FPictureFondVisible then
  begin
      canvas := TCanvas.create;
      try canvas.handle := message.dc;
          PaintParent(Canvas);
      finally
          canvas.free;
      end;
  end
  else if FPictureFondVisible Then
  begin
        DC:=message.dc;
        SetBkMode(DC, 1); //SetBkMode(DC, 1 = TRANSPARENT);
        Canvas := TCanvas.Create;
        try
            oldbrush := Canvas.Brush;
            canvas.handle := dc;
            Canvas.Font.Color  := Self.Font.Color;
            Canvas.Brush.Style := bsClear ;
            Canvas.draw(0,0,FPictureFond.Bitmap);
            Canvas.Brush := oldbrush;
        finally
            Canvas.Free;
        end;
  end;
  end else
  begin
        try
            canvas := TCanvas.create;
            canvas.handle := message.dc;
            canvas.brush.color := Color;
            canvas.brush.style := bsSolid;
            canvas.fillrect(clientrect);
        finally
            canvas.free;
        end;
  end;
end;


procedure TTranspaEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
   if FTransparent then
   begin
    Brush.Bitmap:=FPictureFond.Bitmap;
    if not FPainting then RepaintWindow;
   end;
end;



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

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

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

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

procedure TTranspaEdit.WMSize(var Message: TWMSize);
var
  r : TRect;
begin
inherited;
  r := ClientRect;
  InvalidateRect(handle,@r,false);
end;

procedure TTranspaEdit.WMMove(var Message: TWMMove);
var
  r : TRect;
begin
  inherited;
    Invalidate;
    r := ClientRect;
    InvalidateRect(handle,@r,false);
end;

procedure TTranspaEdit.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] + BorderWidth,
            BorderRec[BorderStyle] + BorderWidth, ClientWidth,
            ClientHeight, DC, 1, 1, SRCCOPY);
    SelectObject(DC, Bitmap);
    DeleteDC(DC);
    ReleaseDC(Handle, GetDC(Handle));
    DeleteObject(TmpBitmap);
    ShowCaret(Handle);
    FPainting := false;
  end;
end;

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

procedure TTranspaEdit.PaintParent(ACanvas: TCanvas);
var
  I, Count, X, Y, SaveIndex: integer;
  DC: cardinal;
  R, SelfR, CtlR: TRect;
  Control : TControl;
begin
    Control := Self;

    if Control.Parent = nil then Exit;
    Count := Control.Parent.ControlCount;
    DC := ACanvas.Handle;
    SelfR := Bounds(Control.Left, Control.Top, Control.Width, Control.Height);
    X := -Control.Left; Y := -Control.Top;
    // Copy parent control image
    SaveIndex := SaveDC(DC);
    SetViewportOrgEx(DC, X, Y, nil);
    IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
    TParentControl(Control.Parent).Perform(WM_ERASEBKGND,DC,0);
    TParentControl(Control.Parent).PaintWindow(DC);
    RestoreDC(DC, SaveIndex);

    //Copy images of graphic controls
    for I := 0 to Count - 1 do
    begin if (Control.Parent.Controls[i] <> nil) then
          begin if Control.Parent.Controls[i] = Control then break;
                with Control.Parent.Controls[i] do
                begin CtlR := Bounds(Left, Top, Width, Height);
                      if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then
                      begin SaveIndex := SaveDC(DC);
                            SetViewportOrgEx(DC, Left + X, Top + Y, nil);
                            IntersectClipRect(DC, 0, 0, Width, Height);
                            Perform(WM_ERASEBKGND,DC,0);
                            Perform(WM_PAINT, integer(DC), 0);
                            RestoreDC(DC, SaveIndex);
                      end;
                end;
          end;
    end;

end;

end.