1. This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn More.
  2. Donation with Paypal!!!

    Go to your paypal account and send directly donation to [email protected]

    1 month - 10 $ - Standart VIP

    6 months - 20 $- Standart VIP

    1 year - 30 $- Standart VIP

    2 years - 50 $- Standart VIP

    Gold member for life - 150 $- Standart VIP

    High Vip (Standart VIP include) group please send PM or email to [email protected] for info

    After Donation please send email to [email protected]

  3. Donation Ways 2020


    Paysend
  4. Telegram

  5. Delphifan Magazine
Dismiss Notice

Donation with Paypal!!!

Go to your paypal account and send directly donation to [email protected]

1 month - 10 $ - Standart VIP

6 months - 20 $- Standart VIP

1 year - 30 $- Standart VIP

2 years - 50 $- Standart VIP

Gold member for life - 150 $- Standart VIP

High Vip (Standart VIP include) group please send PM or email to [email protected] for info

After Donation please send email to [email protected]

Dismiss Notice
For open hidden message no need write thanks, thank etc. Enough is click to like button on right side of thread.

How to create a transparent TPanel

Discussion in 'Delphi Programming' started by AdminDF, Feb 1, 2014.

  1. AdminDF
    Online

    AdminDFAdminDF is a Verified Member Delphifan Staff Member DF Staff

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Problem/Question/Abstract:[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]How to create a transparent TPanel[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Answer:[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Solve 1:[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Particularly note the SetParent bit. It works even with movement. It should even work in Delphi 1, as it doesn't use the Win32 non-rectangular-window method for creating transparency. The code is simple so can be easily retro-fitted to any control that you wished were transparent. I put this together in ten minutes, so it needs proper testing to make sure it doesn't cause any problems, but here it is. Create one on a form, and drag it about over some edits, combo boxes etc. (and TImages and you'll get major flicker).[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]type[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  TTransparentPanel = class(TPanel)[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  private[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure SetParent(AParent: TWinControl); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_EraseBkGnd;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  protected[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure CreateParams(var Params: TCreateParams); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure Paint; override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  public[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    constructor Create(AOwner: TComponent); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure Invalidate; override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]constructor TTransparentPanel.Create(AOwner: TComponent);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited Create(AOwner);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  ControlStyle := ControlStyle - [csOpaque];[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.CreateParams(var Params: TCreateParams);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited CreateParams(Params);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.Paint;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Canvas.Brush.Style := bsClear;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Canvas.Rectangle(0, 0, Width, Height);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Canvas.TextOut(Width div 2, Height div 2, 'Transparent');[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  {Do Nothing}[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Message.Result := 1;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.SetParent(AParent: TWinControl);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited SetParent(AParent);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  {The trick needed to make it all work! I don't know if changing the parent's [/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]        style is a good idea, but it only removes the WS_CLIPCHILDREN style which shouldn't    cause any problems.}[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if Parent <> nil then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      (Parent.Handle, GWL_STYLE) and not WS_ClipChildren);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.Invalidate;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]var[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Rect: TRect;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Rect := BoundsRect;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if (Parent <> nil) and Parent.HandleAllocated then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    InvalidateRect(Parent.Handle, @Rect, True)[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited Invalidate;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]


    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Solve 2:[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]unit TransparentPanel;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]interface[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]uses[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]type[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  TTransparentPanel = class(TPanel)[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  private[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    { Private declarations }[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    FBackground: TBitmap;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  protected[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    { Protected declarations }[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure CaptureBackground;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure Paint; override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  public[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    { Public declarations }[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    property Canvas;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    constructor Create(aOwner: TComponent); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    destructor Destroy; override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  published[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    { Published declarations }[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure Register;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]implementation[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure Register;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  RegisterComponents('PBGoodies', [TTransparentPanel]);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.CaptureBackground;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]var[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  canvas: TCanvas;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  dc: HDC;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  sourcerect: TRect;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  FBackground := TBitmap.Create;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  with Fbackground do[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    width := clientwidth;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    height := clientheight;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  dc := CreateDC('DISPLAY', nil, nil, nil);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  try[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    canvas := TCanvas.Create;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    try[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.handle := dc;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    finally[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.handle := 0;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.free;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  finally[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    DeleteDC(dc);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]constructor TTransparentPanel.Create(aOwner: TComponent);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  ControlStyle := controlStyle - [csSetCaption];[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]destructor TTransparentPanel.Destroy;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  FBackground.free;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.Paint;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if csDesigning in ComponentState then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      {would need to draw frame and optional caption here do not call[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited, the control fills its client area if you do}[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if Visible and HandleAllocated and not (csDesigning in ComponentState) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Fbackground.Free;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Fbackground := nil;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Hide;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Parent.Update;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Show;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]var[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  canvas: TCanvas;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if csDesigning in ComponentState then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    if not Assigned(FBackground) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Capturebackground;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    canvas := TCanvas.create;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    try[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.handle := msg.DC;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.draw(0, 0, FBackground);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    finally[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.handle := 0;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      canvas.free;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    msg.result := 1;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end.[/font]


    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]Solve 3:[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]This panel will be transparent only at runtime.[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]{ ... }[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]type[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  TMyPopUpTransPanel = class(TPanel)[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  protected[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure WndProc(var Message: TMessage); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure CreateParams(var Params: TCreateParams); override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    procedure Paint; override;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  { ... }[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TMyPopUpTransPanel.CMHitTest(var Message: TCMHitTest);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  Message.Result := Windows.HTNOWHERE;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TMyPopUpTransPanel.WndProc(var Message: TMessage);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]var[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  XControl: TControl;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  XPos: TPoint;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if not (csDesigning in ComponentState) and ((Message.Msg >= WM_MOUSEFIRST)[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    and (Message.Msg <= WM_MOUSELAST)) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    XPos := ClientToScreen(POINT(TWMMouse(Message).XPos, TWMMouse(Message).YPos));[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    XControl := Parent.ControlAtPos(POINT(TWMMouse(Message).XPos +[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Left, TWMMouse(Message).YPos + Top), true, true);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    if Assigned(XControl) and (XControl is TWinControl) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      XPos := TWinControl(XControl).ScreenToClient(XPos);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      TWMMouse(Message).XPos := XPos.X;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      TWMMouse(Message).YPos := XPos.Y;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      PostMessage(TWinControl(XControl).Handle, Message.Msg,[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]                         Message.WParam, Message.LParam);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    end[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      XPos := Parent.ScreenToClient(XPos);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      TWMMouse(Message).XPos := XPos.X;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      TWMMouse(Message).YPos := XPos.Y;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      PostMessage(Parent.Handle, Message.Msg, Message.WParam, Message.LParam);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Message.Result := 0;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited WndProc(Message);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TMyPopUpTransPanel.CreateParams(var Params: TCreateParams);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  inherited CreateParams(Params);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if not (csDesigning in ComponentState) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]

    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]procedure TMyPopUpTransPanel.Paint;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]var[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  XBitMap: TBitMap;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  XOldDC: HDC;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  XRect: TRect;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  if (csDesigning in ComponentState) then[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    inherited Paint[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  else[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  begin[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    XRect := ClientRect;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    XOldDC := Canvas.Handle;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    XBitMap := TBitMap.Create;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    try[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      XBitMap.Height := Height;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      XBitMap.Width := Width;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Canvas.Handle := XBitMap.Canvas.Handle;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      inherited Paint;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      RedrawWindow(Parent.Handle, @XRect, 0, RDW_ERASE or RDW_INVALIDATE or[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]        RDW_NOCHILDREN or RDW_UPDATENOW);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    finally[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Canvas.Handle := XOldDC;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      Canvas.BrushCopy(XRect, XBitMap, XRect, Color);[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]      XBitMap.Free;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]    end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]  end;[/font]
    [font=Arial, Tahoma, Helvetica, FreeSans, sans-serif]end;[/font]
     

Share This Page