Прозрачная форма, не реагирующая на мышь

Previous  Top  Next

    
 

 

 

Code:

unit transpar_frm;

{©Drkb v.3(2007): www.drkb.ru}

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.

 

 

Автор: Krid

Взято из http://forum.sources.ru

©Drkb::00452


 

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

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;

АвторSmike

Взято из http://forum.sources.ru

©Drkb::00453


Вместо перекрытия CreateParams():
Сделать "прозрачным" для мышки:

Code:

setWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);

 

Сделать обратно нормальным:

Code:

setWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_TRANSPARENT);

 
АвторVitalik

Взято из http://forum.sources.ru

©Drkb::00454


Еще одно хорошее решение. Его преимущество в том, что работать оно будет на всех системах, включая Win9x.
 

Code:

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;

 
Автор ответа - Scorpy
Взято из http://forum.sources.ru

©Drkb::00455