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

Question

У меня есть компонент (потомок 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.

Что не так?

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

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

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

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

Answer 4

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