我需要一个透明组件。所以我决定创建一个从 TComponent 继承的类,在其中使用 TForm AlphaBlend。我获得了透明度,但是当移动或重新渲染我的父窗体时,我的组件不会移动。怎么解决?
unit Transparent;
interface
uses
Winapi.Windows,
System.Classes,
System.SysUtils,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.Graphics,
System.Math,
Winapi.Messages;
type
TTransparent = class(TComponent)
private
FParent : TWinControl;
FBackGround : TForm;
procedure CreateContainer;
public
procedure Show(aParent : TWinControl);
procedure Close;
end;
procedure Register;
implementation
{ TTransparent }
procedure Register;
begin
RegisterComponents('Custom', [TTransparent]);
end;
procedure TTransparent.Close;
begin
FreeAndNil(FBackGround);
end;
procedure TTransparent.CreateContainer;
var
vParentOrigin: TPoint;
begin
if FParent = nil then
FParent := Application.MainForm;
FBackGround := TForm.Create(nil);
FBackGround.AlphaBlend := True;
FBackGround.AlphaBlendValue := 200;
FBackGround.BorderStyle := bsNone;
FBackGround.Color := clBlack;
vParentOrigin := FParent.ClientOrigin;
SetWindowPos(
FBackGround.Handle,
HWND_TOP,
vParentOrigin.X,
vParentOrigin.Y,
FParent.ClientWidth - 1,
FParent.ClientHeight,
SWP_SHOWWINDOW
);
end;
procedure TTransparent.Show(aParent: TWinControl);
begin
FParent := aParent;
CreateContainer
end;
end.
object Form5: TForm5
Left = 0
Top = 0
Caption = 'Form5'
ClientHeight = 302
ClientWidth = 418
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 160
Top = 240
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Transparent1: TTransparent
Left = 320
Top = 32
end
end
unit Principal;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Transparent, Vcl.StdCtrls;
type
TForm5 = class(TForm)
Button1: TButton;
Transparent1: TTransparent;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
procedure TForm5.Button1Click(Sender: TObject);
begin
Transparent1.Show(Self);
end;
end.
我已经使用了 TFormComponent.Parent := TFormPai 但我失去了透明度
您没有设置
FBackGround.Parent
,因此 FBackGround
有一个自由浮动窗口,与您的 FParent
窗口无关。要解决这个问题,您必须:
设置
FBackGround.Parent := FParent
,但请注意,如果您的应用程序清单不声称与 Windows 8 兼容,您将在 Windows 7 及更早版本以及 Windows 8+ 上失去
AlphaBlend
功能。
钩住
FParent
来跟踪其运动,以便您可以相应地移动 FBackGround
。