1

我有组件（TPanel 的后代），我在其中实现了 Transparency 和 BrushStyle（使用 TImage）属性。

当我在表单上有一个这种类型的组件时，一切都好。当我在表单上添加更多这种类型的组件时，只会绘制第一个可见组件。当表单被移动并且第一个组件位于其他窗口或桌面外部时，下一个组件被绘制。

unit TransparentPanel;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, stdctrls;

type
  TTransparentPanel = class(TPanel)
  private
    FTransparent: Boolean;
    FBrushStyle: TBrushStyle;
    FImage: TImage;

    procedure SetTransparent(const Value: Boolean);
    procedure SetBrushStyle(const Value: TBrushStyle);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Transparent: Boolean read FTransparent write SetTransparent default
      True;
    property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle default
      bsBDiagonal;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TransparentPanel', [TTransparentPanel]);
end;

constructor TTransparentPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTransparent := True;
  FBrushStyle := bsBDiagonal;

  FImage := TImage.Create(Self);
  FImage.Align := alClient;
  FImage.Parent := Self;
  FImage.Transparent := FTransparent;
end;

procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if ((not (csDesigning in ComponentState)) and FTransparent) then
    Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

destructor TTransparentPanel.Destroy;
begin
  if Assigned(FImage) then
    FreeAndNil(FImage);

  inherited Destroy;
end;

procedure TTransparentPanel.Paint;
var
  XBitMap,
    BitmapBrush: TBitmap;
  XOldDC: HDC;
  XRect: TRect;
  ParentCanvas: TCanvas;
begin
  {This panel will be transparent only in Run Time}
  if (csDesigning in ComponentState) or (not FTransparent) or (FBrushStyle in [bsClear, bsSolid]) then
    inherited Paint
  else
  begin
    XRect := ClientRect;
    XOldDC := Canvas.Handle;
    XBitMap := TBitmap.Create;
    BitmapBrush := TBitmap.Create;
    try
      XBitMap.Height := Height;
      XBitMap.Width := Width;
      Canvas.Handle := XBitMap.Canvas.Handle;
      inherited Paint;
      RedrawWindow(Parent.Handle, @XRect, 0,
        RDW_ERASE or RDW_INVALIDATE or
        RDW_NOCHILDREN or RDW_UPDATENOW);

      BitmapBrush.Width := FImage.Width;
      BitmapBrush.Height := FImage.Height;

      BitmapBrush.Canvas.Brush.Color := clBlack;
      BitmapBrush.Canvas.Brush.Style := FBrushStyle;
      SetBkColor(BitmapBrush.Canvas.Handle, clWhite);
      BitmapBrush.Canvas.FillRect(BitmapBrush.Canvas.ClipRect);

      FImage.Canvas.Draw(0, 0, BitmapBrush);
    finally
      Canvas.Handle := XOldDC;
      Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
      XBitMap.Free;
      BitmapBrush.Free;
    end;
  end;
end;

procedure TTransparentPanel.SetBrushStyle(const Value: TBrushStyle);
begin
  if (FBrushStyle <> Value) then
  begin
    FBrushStyle := Value;
    Invalidate;
  end
end;

procedure TTransparentPanel.SetTransparent(const Value: Boolean);
begin
  if (FTransparent <> Value) then
  begin
    FTransparent := Value;
    FImage.Transparent := Value;
    Invalidate;
  end;
end;

end.

怎么了？

4

4 回答 4

5

好的，一些提示：

  • 只绘制了一个组件，因为在绘制过程中控件的客户区再次失效，因此您创建了无限的WM_PAINT消息流，而第二个组件永远不会被绘制。正如你所描述的，直到第一个变得不可见。您可以从 CPU 负载中看到这一点，表单上的一个组件使用我系统上一个内核的 100%（Delphi 2007，在运行时创建的组件）。

  • 您应该尝试删除您绘制的位图，并改用 DoubleBuffered 属性。

  • FImage 实际用于什么？

  • 如果根据透明属性的值修改创建参数，则需要在属性更改时重新创建窗口句柄。

  • 也许您可以完全摆脱该组件，而改用 TPaintBox ？只要您不自己绘制背景，它就是透明的。但是我无法从您的代码中看出您真正想要实现的目标，所以很难说。

于 2009-05-11T18:06:11.607 回答
4

我认为你想要一个可以包含其他控件的控件——就像TPanel可以做的那样——以及一个可以显示它下面的窗口内容的控件——就像在设置它的属性TImage时可以做的那样。Transparent您似乎误以为如果将一个控件放在另一个控件之上，您将获得两者的结合行为。这就是问题所在。

你应该做的第一件事是摆脱TImage控制。这只会让事情变得比他们需要的更复杂。当需要在面板上绘制画笔图案时，直接在面板上绘制即​​可。

接下来，实现ws_ex_Transparent窗口样式控制是否先绘制窗口的兄弟姐妹。这并没有说明窗口的父级是否被重新绘制。如果您的面板的父级ws_ClipChildren设置了样式，那么它不会在您的面板应该在的位置下方绘制自己。如果面板控件的父级设置了样式集，它看起来会对您有所帮助ws_ex_Composited，但作为组件编写者，您无法控制控件的父级。

TImage能够显示为透明，因为它不是窗口控件。它没有窗口句柄，因此有关绘画和剪辑的操作系统规则不适用于它。从 Windows 的角度来看，TImage根本不存在。我们在 Delphi 世界中所认为的TImage绘画本身实际上是父窗口，它遵循一个单独的子程序来绘制父窗口的某个区域。正因为如此，TImage绘画代码不能简单地在父区域的某些区域上绘画。

如果我这样做，我会问自己带有画笔图案的控件是否真的需要成为容器控件。我可以改用一个普通TImage的画笔重复画笔图案吗？其他控件仍然可以在其之上，但它们不会被视为模式控件的子控件。

于 2009-05-11T18:08:20.603 回答
0

如果您希望面板是透明的，您需要做的就是覆盖 Paint 并且什么都不做（例如，或者绘制透明图像），并且还要捕获 WM_ERASEBKGND 消息并且在这里什么也不做。这样可以确保面板根本不会自行涂漆。

还要确保从 ControlStyle 中排除 csOpaque 标志，以便父级知道它应该在面板下方绘制自己。

顺便说一句，您在 Paint 中拥有的东西绝对是可怕的（我的意思是 RedrawWindow 的东西）。摆脱它。WS_EX_TRANSPARENT 仅适用于顶层窗口，不适用于控件。

于 2009-05-14T10:04:37.620 回答
0

尝试查看Graphics32 库：它非常擅长绘制东西，并且与位图和透明度配合得很好

于 2009-05-13T10:57:43.067 回答