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


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 (http://msdn.microsoft.com/en-us/library/aa932345.aspx) 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í:
Windows.SetBkMode(Message.ChildDC, 1);



Saludos.

[kotai]

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

Saludos.