Советы по Delphi
         

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


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

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

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

unit Invwin1;
interface
usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs,StdCtrls;
typeTInvWin = Class ( TWinControl )PrivatefOnControl : TControl;fInvisible : Boolean;
Procedure WMPaint ( Var Message : TWMPaint ); message WM_PAINT;ProtectedProcedure CreateParams ( Var Params : TCreateParams ); override;Procedure MouseDown ( Button : TMouseButton; Shift : TShiftState;X, Y : Integer ); override;
Procedure SetOnControl ( Value : TControl ); virtual;PublicConstructor 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;
varForm1: TForm1;
implementation
{$R *.DFM}
Constructor TInvWin.Create ( aOwner : TComponent );BeginInherited Create ( aOwner );
ControlStyle := ControlStyle + [csOpaque];End;
Procedure TInvWin.CreateParams ( Var Params : TCreateParams );BeginInherited CreateParams ( Params );
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;End;
Procedure TInvWin.WMPaint ( Var Message : TWMPaint );VarDC : THandle;PS : TPaintStruct;BeginIf Not Invisible ThenBeginIf Message.DC = 0Then 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 = 0Then EndPaint ( Handle, PS );End;End;
Procedure TInvWin.MouseDown ( Button : TMouseButton; Shift : TShiftState; X, Y: Integer );BeginShowMessage ( 'MouseDown над невидимым окном' );End;
Procedure TInvWin.SetOnControl ( Value : TControl );VarRect : TRect;BeginIf Value <> fOnControl ThenBegin{ Используйте только WM_SETREDRAW, если окно полностью невидимо }If Invisible And ( Parent <> Nil ) Then Parent.Perform ( WM_SETREDRAW, 0, 0 );
If fOnControl <> Nil Then Visible := False;
If Value <> Nil ThenBeginRect := 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);beginInvWin := TInvWin.Create ( Self );InvWin.Visible := False;InvWin.Parent := Self;end;
procedure TForm1.Button1Click(Sender: TObject);beginShowMessage ( 'MouseClick над Button1' );end;
procedure TForm1.Button2Click(Sender: TObject);beginShowMessage ( 'MouseClick над Button2' );end;
procedure TForm1.Button3Click(Sender: TObject);beginInvWin.OnControl := Button1;end;
procedure TForm1.Button4Click(Sender: TObject);beginInvWin.OnControl := Button2;end;
procedure TForm1.CheckBox1Click(Sender: TObject);beginInvWin.OnControl := Nil;InvWin.Invisible := CheckBox1.Checked;end;
end.

Robert Wittig [000749]



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