Прозрачная форма, не реагирующая на мышь
Материал из DRKB
Прозрачная форма, не реагирующая на мышь[править | править код]
unit transpar_frm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
// это просто кнопки на форме - для демонстрации
protected
procedure RebuildWindowRgn;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1 : TForm1;
implementation
{$R *.DFM}
{ Прозрачная форма }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
// StayOnTop в принципе можно убрать
FormStyle := fsStayOnTop;
// убираем скроллбары, чтобы не мешались
// при изменении размеров формы
HorzScrollBar.Visible := False;
VertScrollBar.Visible := False;
// строим новый регион
RebuildWindowRgn;
end;
procedure TForm1.Resize;
begin
inherited;
// строим новый регион
RebuildWindowRgn;
end;
procedure TForm1.RebuildWindowRgn;
var
FullRgn, Rgn: THandle;
ClientX, ClientY, I: Integer;
begin
// определяем относительные координаты клиентской части
ClientX := (Width - ClientWidth) div 2;
ClientY := Height - ClientHeight - ClientX;
// создаем регион для всей формы
FullRgn := CreateRectRgn(0, 0, Width, Height);
// создаем регион для клиентской части формы
// и вычитаем его из FullRgn
Rgn := CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY + ClientHeight);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
// теперь добавляем к FullRgn регионы каждого контрольного элемента
for I := 0 to ControlCount - 1 do
with Controls[I] do
begin
Rgn := CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +
Width, ClientY + Top + Height);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
end;
// устанавливаем новый регион окна
SetWindowRgn(Handle, FullRgn, True);
end;
end.
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 00452
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
protected
procedure CreateParams (var Params: TCreateParams); override;
end;
var
Form1: TForm1;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0, Byte(196), 2);
end;
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams (Params);
Params.ExStyle := Params.ExStyle or
WS_EX_TRANSPARENT;
end;
Author: Smike
Source: Взято из http://forum.sources.ru
ID: 00453
Вместо перекрытия CreateParams(): Сделать "прозрачным" для мышки:
setWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);
Сделать обратно нормальным:
setWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_TRANSPARENT);
Author: Vitalik
Source: Взято из http://forum.sources.ru
ID: 00454
Еще одно хорошее решение. Его преимущество в том, что работать оно будет на всех системах, включая Win9x.
procedure TForm1.HandleMessage(var Msg: tagMSG; var Handled: Boolean);
var
P: TPoint;
S, R: HRGN;
begin
inherited;
case Msg.message of
WM_MOUSEFIRST..WM_MOUSELAST:
begin
P.X := ScreenToClient(Msg.pt).X + ClientOrigin.X - Left;
P.Y := ScreenToClient(Msg.pt).Y + ClientOrigin.Y - Top;
R := CreateRectRgn(P.X, P.Y, P.X+1, P.Y+1);
S := CreateRectRgn(0, 0, Width, Height);
CombineRgn(S, S, R, RGN_XOR);
SetWindowRgn(Handle, S, True);
SendMessage(WindowFromPoint(Msg.pt), Msg.message, Msg.wParam, Msg.lParam);
DeleteObject(R);
DeleteObject(S);
Handled := True;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := HandleMessage;
end;
Source: Взято из http://forum.sources.ru
ID: 00455