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

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

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

Автор: Robert Wittig

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

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

{  Начните с нового проекта.

Разместите на форме 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.