Tedit transparente

[kotai]

Hola.

He pasado de Delphi 2006 a Delphi XE3 y unos componentes que usaba para pintar los TEdit transparentes (solo se ve la letra, no el fondo) han dejado de funcionar, creo que porque en los delphis XE un funciona la función: SetBkMode()

Os dejo el código fuente del componente para ver si alguien sabe como cambiar el SetBkMode() o como hacer que funcione en Delphi XE3

Código Delphi [-]
unit TranComp;

interface

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

type
  TCtrl = class(TWinControl);
  TParentControl = class(TWinControl);
  TOnMouseEvent = procedure( Msg: TWMMouse ) of object;



   TTransEdit = class(TEdit)
   private
     { Private declarations }
     FAlignText: TAlignment;
     FTransparent: Boolean;
     FPainting: Boolean;
     procedure SetAlignText(Value: TAlignment);
     procedure SetTransparent(Value: Boolean);
   protected
     { Protected declarations }
     procedure RepaintWindow;
     procedure CreateParams(var Params: TCreateParams); override;
     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 }
     constructor Create(AOwner: TComponent); override;
     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;

   end;



implementation

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


constructor TTransEdit.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FAlignText := taLeftJustify;
   FTransparent := false;
   FPainting := false;
 end;

 destructor TTransEdit.Destroy;
 begin
   inherited Destroy;
 end;

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


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

 procedure TTransEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
 var
   DC: hDC;
   i: integer;
   p: TPoint;
   canvas : TCanvas;
 begin
   if FTransparent and not(csDesigning in componentstate) then
   begin
     canvas := TCanvas.create;
     try
       canvas.handle := message.dc;
       PaintParent(Canvas);
     finally
       canvas.free;
     end;
   end
   else
   begin
     canvas := TCanvas.create;
     try
       canvas.handle := message.dc;
       canvas.brush.color := Color;
       canvas.brush.style := bsSolid;
       canvas.fillrect(clientrect);
     finally
       canvas.free;
     end;
   end;
 end;

 procedure TTransEdit.WMPaint(var Message: TWMPaint);
 begin
   inherited;
   if FTransparent then
     if not FPainting then RepaintWindow;
 end;

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

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

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

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

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


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

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

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

 procedure TTransEdit.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.

Gracias.

[[escafandra]]

No puedo probar en delphi XE3. SetBkMode debería funcionar porque es una API de windows... A no ser que en delphi XE3 exita una función del mismo nombre perteneciente a la clase TEdit o antecesoras. Para forzar llamar a la API debes hacerlo así:

Código Delphi [-]
Windows.SetBkMode(Message.ChildDC, 1);

Saludos.

[kotai]

Gracias.
Lo he probado pero nado siguen sin hacerse el fondo del TEdit transparente.

Saludos.