TComponent 如何随着其父组件的移动而呈现或移动?

问题描述 投票:0回答:1

我需要一个透明组件。所以我决定创建一个从 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 但我失去了透明度

我尝试使用 WMMove。但没有成功。看:

delphi
1个回答
2
投票

您没有设置

FBackGround.Parent
,因此
FBackGround
有一个自由浮动窗口,与您的
FParent
窗口无关。要解决这个问题,您必须:

  • 设置

    FBackGround.Parent := FParent
    ,但请注意,如果您的应用程序清单
    声称与 Windows 8 兼容,您将在 Windows 7 及更早版本以及 Windows 8+ 上失去 AlphaBlend 功能。

  • 钩住

    FParent
    来跟踪其运动,以便您可以相应地移动
    FBackGround

© www.soinside.com 2019 - 2024. All rights reserved.