1

TransparencyプロパティとBrushStyle（TImageを使用）プロパティを実装したコンポーネント（TPanelの子孫）があります。

フォームにこのタイプのコンポーネントが1つあれば、問題ありません。このタイプのコンポーネントをフォームに追加すると、最初に表示されるコンポーネントのみがペイントされます。フォームが移動され、最初のコンポーネントが他のウィンドウの下またはデスクトップの外側にある場合、次のコンポーネントがペイントされます。

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

0

Graphics32ライブラリを見てみてください。これは、描画に非常に優れており、ビットマップと透明度でうまく機能します。

于 2009-05-13T10:57:43.067 に答える
0

パネルを透明にしたい場合は、Paint をオーバーライドして何もしない (または透明な画像をペイントするなど) だけでよく、WM_ERASEBKGND メッセージをキャッチしてここでも何もしません。これにより、パネル自体がまったくペイントされなくなります。

また、ControlStyle から csOpaque フラグを必ず除外してください。これにより、親はパネルの下に自分自身をペイントする必要があることがわかります。

ちなみに、ペイントにあるものは絶対にひどいものです (つまり、RedrawWindow のことです)。それを取り除く。また、WS_EX_TRANSPARENT は、コントロールではなく、トップレベル ウィンドウのみを対象としています。

于 2009-05-14T10:04:37.620 に答える