Прозрачный компонент

При выводе прозрачного окна, окна или элементы управления, расположенные под ним, также видны. При перемещении невидимого окна, при условии, что оно не скрывается/выводится вновь, оно сохраняет "снимок" графической области, которая была расположена под ним в момент вывода (а именно: окна или видимые компоненты).

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

{ Начните с нового проекта.
Разместите на форме 4 кнопки и 1 компонент CheckBox. Создайте обработчик события OnClick как показано ниже
Во время выполнения программы, если вы нажимаете на Button3, щелчок по Button1 будет перехватываться InvWin; если вы нажимаете на Button4, щелчок по Button2 будет перехватываться InvWin. Поскольку "невидимое" окно первоначально представляет собой простой дескриптор, элемент управления, расположенный под ним, должен быть перерисован. Из-за этого существует проблема мерцания, происходящая по сценарию как, будто вы щелкнули по Button3 и Button4. При щелчке на CheckBox1, InvWin.Invisible устанавливается в True. Это позволяет окну не перерисовываться. Поскольку окно у нас теперь истинно невидимое, то для устранения мерцания мы целенаправленно посылаем необходимым окнам сообщение WM_SETREDRAW. }

unit Invwin1;
interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs,StdCtrls;
type TInvWin = Class ( TWinControl ) Private fOnControl : TControl; fInvisible : Boolean;
Procedure WMPaint ( Var Message : TWMPaint ); message WM_PAINT; Protected Procedure CreateParams ( Var Params : TCreateParams ); override; Procedure MouseDown ( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); override;
Procedure SetOnControl ( Value : TControl ); virtual; Public Constructor Create ( aOwner : TComponent );
Property OnControl : TControl Read fOnControl Write SetOnControl; Property Invisible : Boolean Read fInvisible Write fInvisible; End;
TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; CheckBox1: TCheckBox; procedure FormCreate(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); private { Private declarations } public { Public declarations } InvWin : TInvWin; end;
var Form1: TForm1;
implementation
{$R *.DFM}
Constructor TInvWin.Create ( aOwner : TComponent ); Begin Inherited Create ( aOwner );
ControlStyle := ControlStyle + [csOpaque]; End;
Procedure TInvWin.CreateParams ( Var Params : TCreateParams ); Begin Inherited CreateParams ( Params );
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT; End;
Procedure TInvWin.WMPaint ( Var Message : TWMPaint ); Var DC : THandle; PS : TPaintStruct; Begin If Not Invisible Then Begin If Message.DC = 0 Then DC := BeginPaint ( Handle, PS ) Else DC := Message.DC;
PatBlt ( DC, 0, 0, 5, 5, BLACKNESS ); PatBlt ( DC, Width - 6, 0, 5, 5, BLACKNESS ); PatBlt ( DC, 0, Height - 6, 5, 5, BLACKNESS ); PatBlt ( DC, Width - 6, Height - 6, 5, 5, BLACKNESS );
If Message.DC = 0 Then EndPaint ( Handle, PS ); End; End;
Procedure TInvWin.MouseDown ( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); Begin ShowMessage ( 'MouseDown над невидимым окном' ); End;
Procedure TInvWin.SetOnControl ( Value : TControl ); Var Rect : TRect; Begin If Value <> fOnControl Then Begin { Используйте только WM_SETREDRAW, если окно полностью невидимо } If Invisible And ( Parent <> Nil ) Then Parent.Perform ( WM_SETREDRAW, 0, 0 );
If fOnControl <> Nil Then Visible := False;
If Value <> Nil Then Begin Rect := Value.BoundsRect; InflateRect ( Rect, 2, 2 ); BoundsRect := Rect; End; fOnControl := Value;
If fOnControl <> Nil Then Visible := True;
{ Используйте только WM_SETREDRAW, если окно полностью невидимо } If Invisible And ( Parent <> Nil ) Then Parent.Perform (WM_SETREDRAW, 1, 0 ); End; End;

procedure TForm1.FormCreate(Sender: TObject); begin InvWin := TInvWin.Create ( Self ); InvWin.Visible := False; InvWin.Parent := Self; end;
procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage ( 'MouseClick над Button1' ); end;
procedure TForm1.Button2Click(Sender: TObject); begin ShowMessage ( 'MouseClick над Button2' ); end;
procedure TForm1.Button3Click(Sender: TObject); begin InvWin.OnControl := Button1; end;
procedure TForm1.Button4Click(Sender: TObject); begin InvWin.OnControl := Button2; end;
procedure TForm1.CheckBox1Click(Sender: TObject); begin InvWin.OnControl := Nil; InvWin.Invisible := CheckBox1.Checked; end;
end.

Robert Wittig [000749]

Содержание раздела