Hola amigos, esperando que hayan pasado una feliz Navidad desearles un venturoso 2007, mis mayores augurios para que se cumplan todos sus deseos.
Hoy recurriendo nuevamente a vuestra ayuda, no estoy muy compenetrado con la Programación de Componentes (aclaro), y por ahí me recomendaron el Componente de abajo que transparenta un Panel.
He probado el componente, dentro del mismo he incluido una TIMage con la propiedad transparente=true, y funciona bien; pero ocurre algo extraño, he ubicado al componente TMyPanel (incluido la TImage transparente) encima de otros objetos (TButtons, TEDits, etc) y ya sea en tiempo de diseño (cuando arrastro el componente a otra posición) o ya sea en tiempo de ejecución cuando arrastro con:
Código Delphi
[-]
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; begin
ReleaseCapture;
MyPanel1.perform(WM_SysCommand, SC_DragMove, 0);
end;
El componente TMyPanel captura toda el área donde estaba transparente (encima de otros objetos) y al arrastre como dije en tiempo de diseño o ejecución, arrastra y dibuja esa area también.
¿A que se debe todo ello? ¿Cómo solucionar este componente al arrastre del mouse y dibuje cada instante transparente? Código Delphi
[-]
unit CustomPanel1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls;
type
TMyPanel = class(TCustomPanel)
private
FTransparent: Boolean;
procedure SetTransparent(const Value: Boolean);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure PutCaption(ACanvas: TCanvas); dynamic;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
public
constructor Create(AOwner: TComponent); override;
published
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Caption;
property Font;
property Alignment;
property OnClick;
property Enabled;
property FullRepaint;
property Color;
property ParentColor;
property OnCanResize;
property OnConstrainedResize;
property OnContextPopup;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
procedure Register;
implementation
const
_Transparent = TRANSPARENT;
procedure TMyPanel.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
Msg.Result := 1;
end;
procedure TMyPanel.PutCaption(ACanvas: TCanvas);
const
_Alignment: array [TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
RectTxt: TRect;
Flags: Longint;
begin
with ACanvas do
begin
if Caption <> '' then
begin
ACanvas.Font := Self.Font;
SetBkMode(Handle, _Transparent);
Font := Self.Font;
RectTxt := GetClientRect;
InflateRect(RectTxt, -BorderWidth, -BorderWidth);
Flags := DT_EXPANDTABS or _Alignment[Alignment];
Flags := DrawTextBiDiModeFlags(Flags);
DrawText(ACanvas.Handle, PChar(Caption), -1, RectTxt, Flags or DT_CALCRECT);
OffsetRect(RectTxt,0, -RectTxt.Top+(Height-(RectTxt.Bottom-RectTxt.Top)) div 2);
case Alignment of
taRightJustify:
OffsetRect(RectTxt, - RectTxt.Left +
(Width - (RectTxt.Right - RectTxt.Left) - BorderWidth - 0), 0);
taCenter:
OffsetRect(RectTxt, -RectTxt.Left +
(Width - (RectTxt.Right - RectTxt.Left)) div 2, 0);
end;
if not Enabled then
Font.Color := clGrayText;
if Transparent then
SetBkMode(ACanvas.Handle, _Transparent);
DrawText(ACanvas.Handle, PChar(Caption), -1, RectTxt, Flags);
end;
end;
end;
procedure TMyPanel.Paint;
begin
PutCaption(Canvas);
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTransparent := True;
end;
procedure TMyPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if Transparent then
begin
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
ControlStyle := ControlStyle - [csOpaque];
end
else
begin
Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT;
ControlStyle := ControlStyle + [csOpaque];
end;
end;
procedure TMyPanel.SetTransparent(const Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
RecreateWnd;
end;
end;
procedure Register;
begin
RegisterComponents('David', [TMyPanel]);
end;
end.
¿A que se debe que captura esa área? ¿Cómo solucionar este componente al arrastre del mouse y dibuje cada instante transparente?