Компонент Delphi не окрашен

Question

У меня есть компонент (потомок TPanel), где я реализовал свойства прозрачности и 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.

Что случилось?

Answer 1

ОК, несколько советов:

• Рисуется только один компонент, потому что во время рисования клиентская область элемента управления снова становится недействительной, поэтому вы создаете бесконечный поток сообщений WM_PAINT, а второй компонент никогда не рисуется. Пока первый не станет невидимым, как вы описываете. Это видно по загрузке ЦП, когда один из ваших компонентов в форме использует 100% одного ядра в моей системе (Delphi 2007, компонент, созданный во время выполнения).

• Вам следует попытаться удалить растровое изображение, в которое вы рисуете, и использовать вместо этого свойство DoubleBuffered.

• Для чего на самом деле используется FImage?

• Если вы изменяете параметры создания в зависимости от значения свойства Transparent, вам необходимо заново создать дескриптор окна при изменении свойства.

• Может быть, вы можете полностью избавиться от компонента и использовать вместо него TPaintBox? Он прозрачен, если вы сами не рисуете фон. Но я не могу сказать из вашего кода, чего вы на самом деле хотите достичь, поэтому сложно сказать.

Answer 2

Я думаю, что вы хотите элемент управления, который может содержать другие элементы управления, такие как TPanel может сделать - и элемент управления, который может отображать содержимое окна под ним - как TImage может сделать, когда его Transparent свойство установлено. Похоже, у вас сложилось ошибочное впечатление, что если вы поместите один элемент управления поверх другого, вы получите поведение обоих вместе. Вот что не так.

Первое, что вы должны сделать, это избавиться от TImage контроль. Это только делает вещи более сложными, чем они должны быть. Когда вам нужно нарисовать рисунок кисти на панели, нарисуйте его прямо на панели.

Затем осознайте, что ws_ex_Transparent Стиль окна определяет, будут ли окрашены первые элементы окна. Это ничего не говорит о том, перерисовывается ли родитель окна. Если родитель вашей панели имеет ws_ClipChildren набор стилей, тогда он не будет краситься под тем местом, где ваша панель предположительно находится. Похоже, это поможет вам, если бы родитель вашего элемента управления панели имел ws_ex_Composited набор стилей, но как автор компонентов, вы не получаете контроль над родителями элементов управления.

TImage может выглядеть прозрачным, потому что это не оконный элемент управления. У него нет дескриптора окна, поэтому правила ОС для рисования и отсечения не применяются к нему. С точки зрения Windows, TImage не существует вообще То, что мы в мире Delphi воспринимаем как TImage На самом деле рисование - это родительское окно, которое откладывается до отдельной подпрограммы для рисования определенной области родительского окна. Из-за этого TImage код рисования может просто не закрасить часть родительской области.

Если бы я делал это, я бы спросил себя, действительно ли элемент управления с шаблоном кисти должен быть контейнерным элементом управления. Могу ли я вместо этого просто использовать обычный TImage с повторяющимся рисунком кисти? Другие элементы управления все еще могут быть поверх него, но они не будут считаться дочерними элементами элемента управления шаблоном.

Answer 3

Попробуйте взглянуть на библиотеку Graphics32: она очень хорошо рисует и прекрасно работает с растровыми изображениями и прозрачностью

Answer 4

Если вы хотите, чтобы панель была прозрачной, все, что вам нужно сделать, это переопределить Paint и ничего не делать (или нарисовать прозрачное изображение, например), а также перехватить сообщение WM_ERASEBKGND и здесь также ничего не делать. Это гарантирует, что панель не красит себя вообще.

Не забудьте также исключить флаг csOpaque из ControlStyle, чтобы родитель знал, что он должен нарисовать себя под панелью.

Кстати, то, что у вас есть в Paint, абсолютно ужасно (я имею в виду RedrawWindow). Избавиться от этого. И WS_EX_TRANSPARENT предназначен только для окон верхнего уровня, а не для элементов управления.