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

Question

У меня есть компонент (descendat of TPanel), где я реализовал свойства Transparency и BrushStyle (используя TImage).

Все это нормально, когда у меня есть один компонент этого типа на форме. Bun, когда я каламбур на форме больше компонентов этого типа, только первый видимый компонент окрашен. Когда форма перемещается и первый компонент находится под другим окном или внешним рабочим столом, следующий компонент окрашивается.

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

OK, несколько советов:

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

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

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

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

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

Answer 2

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

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

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

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

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

Answer 3

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

Answer 4

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

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

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