|
|
|
|
Delphi 1
Прозрачный компонент
При выводе прозрачного окна, окна или элементы управления, расположенные под ним, также видны. При перемещении невидимого окна, при условии, что оно не скрывается/выводится вновь, оно сохраняет "снимок" графической области, которая была расположена под ним в момент вывода (а именно: окна или видимые компоненты).
Взгляните на модуль, приведенный ниже, в нем предлагается решение проблемы невидимого окна.
|
{ Начните с нового проекта. Разместите на форме 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]
|
|
|
|
|