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

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

Что не так?


person Community    schedule 11.05.2009    source источник
comment
В вашем коде много проблем, но трудно вам помочь, не зная, что должен делать элемент управления. Не могли бы вы предоставить более подробную информацию?   -  person mghie    schedule 11.05.2009


Ответы (4)


Хорошо, несколько советов:

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

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

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

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

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

person mghie    schedule 11.05.2009

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

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

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

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

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

person Rob Kennedy    schedule 11.05.2009

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

person Olivier Pons    schedule 13.05.2009

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

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

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

person Frederik Slijkerman    schedule 14.05.2009