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
FAlignText: TAlignment;
FTransparent: Boolean;
FPainting: Boolean;
procedure SetAlignText(Value: TAlignment);
procedure SetTransparent(Value: Boolean);
protected
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
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
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;
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);
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.