2010-01-25 08:59:44 -05:00
{
This file is part of the Mufasa Macro Library ( MML)
Copyright ( c) 2 0 0 9 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/ or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
( at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not , see < http: //www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
WindowSelector for the Mufasa Macro Library
}
unit windowselector;
{$mode objfpc} {$H+}
interface
uses
Classes, SysUtils,
{$IFDEF MSWINDOWS} os_windows, {$ENDIF}
2010-03-09 12:12:44 -05:00
{$IFDEF LINUX} os_linux, ctypes, {$ENDIF}
2010-01-25 08:59:44 -05:00
controls,
graphics,
forms,
2010-03-07 16:18:52 -05:00
extctrls,
2010-03-12 12:13:09 -05:00
{$IFNDEF MSWINDOWS} x, xlib, xatom,
2010-01-25 08:59:44 -05:00
{$ELSE}
2010-03-12 12:13:09 -05:00
windows,
2010-01-25 08:59:44 -05:00
{$ENDIF}
2010-03-12 12:13:09 -05:00
mufasabase
2010-01-25 08:59:44 -05:00
;
type
TMWindowSelector = class( TObject)
constructor Create( manager: TIOManager) ;
destructor Destroy; override ;
function Drag: TNativeWindow;
public
LastPick: TNativeWindow;
haspicked: boolean ;
manager: TIOManager;
end ;
implementation
constructor TMWindowSelector. Create( manager: TIOManager) ;
begin
inherited create;
haspicked: = false ;
self. manager : = manager;
end ;
destructor TMWindowSelector. Destroy;
begin
inherited ;
end ;
{$IFDEF LINUX}
function TMWindowSelector. Drag: TNativeWindow;
var
Tempwindow : x. TWindow;
root : x. TWindow;
subwindow : x. TWindow;
x_root, y_root : cint;
xmask : cuint;
x, y : cint;
2010-02-23 12:17:50 -05:00
//Old_Handler : TXErrorHandler;
2010-01-25 08:59:44 -05:00
window_opacity: TAtom;
opacity_75: culong;
opacity_100: culong;
begin
2010-02-23 12:17:50 -05:00
//Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
2010-01-25 08:59:44 -05:00
Result : = 0 ;
window_opacity: = XInternAtom( manager. display, PChar( '_NET_WM_WINDOW_OPACITY' ) , False ) ;
opacity_75 : = cuint( $ffffffff * 0.75 ) ;
opacity_100 : = cuint( $ffffffff ) ;
repeat
// get pointer pos + current window we are at.
XQueryPointer( manager. display, manager. desktop, @ root,
@ Tempwindow, @ x_root, @ y_root,
@ x, @ y, @ xmask) ;
subwindow: = Tempwindow;
while subwindow < > 0 do
begin
Tempwindow : = subwindow;
XQueryPointer( manager. display, Tempwindow, @ root,
@ subwindow, @ x_root, @ y_root,
@ x, @ y, @ xmask) ;
end ;
if Result < > Tempwindow then
begin
2010-03-07 10:57:10 -05:00
mDebugLn( 'Making ' + inttostr( tempwindow) + ' transparent' ) ;
2010-01-25 08:59:44 -05:00
XChangeProperty( manager. display, tempwindow, window_opacity, XA_CARDINAL, 3 2 , PropModeReplace, @ opacity_75, 1 ) ;
2010-03-07 10:57:10 -05:00
mDebugLn( 'Resetting ' + inttostr( Result ) ) ;
2010-01-25 08:59:44 -05:00
if result < > 0 then
XChangeProperty( manager. display, Result , window_opacity, XA_CARDINAL, 3 2 , PropModeReplace, @ opacity_100, 1 ) ;
2010-03-07 10:57:10 -05:00
mDebugLn( 'Changing Window from: ' + Inttostr( result ) + ' to: ' + IntToStr( Tempwindow) ) ;
2010-01-25 08:59:44 -05:00
// XChangeProperty(Window.XDisplay, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_50, 1);
Result : = Tempwindow;
LastPick: = TempWindow;
haspicked: = true ;
end ;
XFlush( manager. display) ;
Sleep( 1 6 ) ;
//if we are selecting for a long time, we must still process other messages
Application. ProcessMessages;
until ( xmask and Button1Mask) = 0 ;
XChangeProperty( manager. display, Result , window_opacity, XA_CARDINAL, 3 2 , PropModeReplace, @ opacity_100, 1 ) ;
XFlush( manager. display) ;
2010-02-23 12:17:50 -05:00
//XSetErrorHandler(Old_handler);
2010-01-25 08:59:44 -05:00
end ;
{$ELSE}
function TMWindowSelector. Drag: TNativeWindow;
var
TargetRect: TRect;
2010-03-07 16:18:52 -05:00
Region : HRGN;
2010-01-25 08:59:44 -05:00
Cursor : TCursor;
TempHandle : Hwnd;
Handle : Hwnd;
2010-03-07 16:18:52 -05:00
DragForm : TForm;
EdgeForm : TForm;
Style : DWord;
2010-03-09 12:12:44 -05:00
W, H: integer ;
2010-03-07 16:18:52 -05:00
const
EdgeSize = 4 ;
WindowCol = clred;
2010-01-25 08:59:44 -05:00
begin ;
Cursor: = Screen. Cursor;
Screen. Cursor: = crCross;
TempHandle : = GetDesktopWindow;
2010-03-07 16:18:52 -05:00
EdgeForm : = TForm. Create( nil ) ;
EdgeForm. Color: = WindowCol;
EdgeForm. BorderStyle: = bsNone;
EdgeForm. Show;
DragForm : = TForm. Create( nil ) ;
DragForm. Color: = WindowCol;
DragForm. BorderStyle: = bsNone;
DragForm. Show;
Style : = GetWindowLong( DragForm. Handle, GWL_EXSTYLE) ;
SetWindowLong( DragForm. Handle, GWL_EXSTYLE, Style or WS_EX_LAYERED or WS_EX_TRANSPARENT) ;
SetLayeredWindowAttributes( DragForm. Handle, 0 , 1 0 0 , LWA_ALPHA) ;
2010-01-25 08:59:44 -05:00
while GetAsyncKeyState( VK_LBUTTON) < > 0 do
begin ;
Handle: = WindowFromPoint( Mouse. CursorPos) ;
2010-03-09 12:12:44 -05:00
if ( Handle < > TempHandle) and ( Handle < > EdgeForm. Handle) then
2010-01-25 08:59:44 -05:00
begin ;
2010-03-07 16:18:52 -05:00
GetWindowRect( Handle, TargetRect) ;
W : = TargetRect. Right - TargetRect. Left+ 1 ;
H : = TargetRect. Bottom - TargetRect. Top+ 1 ;
DragForm. SetBounds( TargetRect. Left, TargetRect. top, W, H) ; //Draw the transparent form
SetWindowRgn( EdgeForm. Handle, 0 , false ) ; //Delete the old region
Region : = CreateRectRgn( 0 , 0 , w- 1 , h- 1 ) ; //Create a full region, of the whole form
CombineRgn( Region, Region, CreateRectRgn( EdgeSize, EdgeSize, w- 1 - ( edgesize) , h- 1 - ( edgesize) ) , RGN_XOR) ; //Combine a the 2 regions (of the full form and one without the edges)
SetWindowRgn( edgeform. Handle, Region, true ) ; //Set the only-edge-region!
2010-03-07 16:22:02 -05:00
EdgeForm. SetBounds( TargetRect. Left, TargetRect. top, W, H) ; //Move the form etc..
2010-01-25 08:59:44 -05:00
TempHandle : = Handle;
end ;
Application. ProcessMessages;
2010-03-07 16:22:02 -05:00
Sleep( 3 0 ) ;
2010-01-25 08:59:44 -05:00
end ;
Result : = TempHandle;
LastPick: = TempHandle;
haspicked: = true ;
Screen. Cursor: = cursor;
2010-03-07 16:18:52 -05:00
DragForm. Hide;
DragForm. Free;
EdgeForm. Hide;
EdgeForm. Free;
2010-01-25 08:59:44 -05:00
end ;
{$ENDIF}
end .