Dismiss Notice

REGISTRATION IS AFTER ADMIN ACTIVATION

DONATIONS WITH PAYPAL CLICK TO BUTTON

6 MONTHS VIP - 20$; 1 YEAR VIP - 30$; 2 YEARS VIP - 50$; GOLD USER FOR LIFE VIP - 150$

DONATIONS WITH Bitcoin Address:3NRs3CK3fhXifrNYxHEZKpETDd9vNLMsMD

Dismiss Notice
The registration is approved by the Administrator. It takes about 1 day to approve your registration
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 Administrator 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

Laws
Our website, law, laws, copyright and aims to be respectful of individual rights. Our site, as defined in the law of 5651 serves as a provider of space. According to the law, contrary to the law of site management has no obligation to monitor content. Therefore, our site has adopted the principle of fit and remove. Works are subject to copyright laws and is shared in a manner that violated their legal rights, or professional associations, rights holders who, adsdelphi@gmail.com I can reach us at e-mail address. Complaints considered to be infringing on the examination of the content will be removed from our site.
Donate Help To Us and Be VIP
DONATIONS WITH PAYPAL CLICK TO BUTTON
6 MONTHS VIP - 20$; 1 YEAR VIP - 30$; 2 YEARS VIP - 50$; GOLD USER FOR LIFE VIP - 150$
Social Block