|
#1
|
|||
|
|||
прозрачная TPanel
Всем доброго времени суток!
Написал компонент TTransparentPanel, который рисует фон под собой, как это рекомендовано здесь Вот код компонента: Код:
unit TransparentPanels; interface uses SysUtils, Classes, Controls, ExtCtrls, Windows, Graphics, Messages, Forms; type TTransparentPanel = class(TPanel) protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; end; procedure Register; implementation procedure CopyParentImage(Control: TControl; Dest: TCanvas); var I, Count, X, Y, SaveIndex: Integer; DC: HDC; R, SelfR, CtlR: TRect; begin if (Control = nil) or (Control.Parent = nil) then Exit; Count := Control.Parent.ControlCount; DC := Dest.Handle; {$IFDEF WIN32} with Control.Parent do ControlState := ControlState + [csPaintCopy]; try {$ENDIF} with Control do begin SelfR := Bounds(Left, Top, Width, Height); X := -Left; Y := -Top; end; SaveIndex := SaveDC(DC); try SetViewportOrgEx(DC, X, Y, nil); IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight); with TWinControl(Control.Parent) do begin Perform(WM_ERASEBKGND, DC, 0); Perform(WM_PAINT, DC, 0); end; finally RestoreDC(DC, SaveIndex); end; for I := 0 to Count - 1 do begin if Control.Parent.Controls[i] = Control then Break else if Control.Parent.Controls[i] <> nil then begin with TGraphicControl(Control.Parent.Controls[i]) do begin CtlR := Bounds(Left, Top, Width, Height); if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin {$IFDEF WIN32} ControlState := ControlState + [csPaintCopy]; {$ENDIF} SaveIndex := SaveDC(DC); try SetViewportOrgEx(DC, Left + X, Top + Y, nil); IntersectClipRect(DC, 0, 0, Width, Height); Perform(WM_PAINT, DC, 0); finally RestoreDC(DC, SaveIndex); {$IFDEF WIN32} ControlState := ControlState - [csPaintCopy]; {$ENDIF} end; end; end end; end; {$IFDEF WIN32} finally with Control.Parent do ControlState := ControlState - [csPaintCopy]; end; {$ENDIF} end; procedure Register; begin RegisterComponents('Prsicom', [TTransparentPanel]); end; constructor TTransparentPanel.Create(AOwner: TComponent); begin inherited; Ctl3D := false; BorderStyle := bsNone; end; procedure TTransparentPanel.Paint; begin end; procedure TTransparentPanel.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin CopyParentImage(Self, Self.Canvas); end; end. Всё работает. Но если на эту панель положить, например, кнопку TButton, то она отрисовывается как-то странно: при щелчке мышью в дизайнере она пропадает. Тоже самое и для других контролов и наследников от TGraphicControl. В run-time же видно, что отрисовка идёт без очищения фона (если положить на панель png-картинку с прозрачностью, то панель при каждой отрисовке будет становится всё непрозрачнее). В чём может быть проблема? |
#2
|
||||
|
||||
А если поставить обычную панель + XPManifest?
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |
#3
|
|||
|
|||
Цитата:
|
#4
|
||||
|
||||
Может я не так понял "прозрачная"...
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |