Well, I have got close but I am not sure how to make the Drawn rectangle
transparent or how to dispose of the DC after I am through.. Any help would
be greatly appreciated.
----------------------------------------------------------------
#!perl -w
# Left-Click on the target image, and drag
use warnings;
use strict;
use Win32::GUI;
use Win32::API;
use Win32::GUI::BitmapInline();
my $mw = Win32::GUI::Window->new(
-name => "MainWindow",
-title => "Win32::GUI Spy++",
-pos => [100,100],
-size => [100,100],
);
my $cursor = get_cursor();
$mw->AddLabel(
-name => "Target",
-icon => $cursor,
-notify => 1,
-onMouseDown => \&mouseDown,
-onMouseUp => \&mouseUp,
-onMouseMove => \&mouseMove,
);
$mw->Show();
Win32::GUI::Dialog();
exit(0);
###########################
###########################
sub mouseDown{
my $label = shift;
Win32::GUI::SetCursor($cursor);
$label->SetCapture();
return;
}
################
sub mouseUp{
my $label = shift;
$label->ReleaseCapture();
return;
}
#################
sub mouseMove{
my ($label, $x, $y) = @_; # x,y in client co-ordinates
return unless Win32::GUI::GetCapture();
Win32::GUI::SetCursor($cursor);
my $hwnd=getWindowXY($x,$y);
my $class=getWindowClass($hwnd) || '';
my $text=getWindowText($hwnd) || '';
$text=substr($text,0,30) if length($text) > 30;
my $exe=getWindowExe($hwnd) || '';
my ($left,$top,$right,$bottom)=getWindowRect($hwnd);
my $hdc=getWindowDC(getDesktopWindow());
my $ok=drawRectangle($hdc,$left,$top,$right,$bottom);
#print qq|$hwnd\ ($x,$y) [$exe] {$class} "$text"\n|;
return;
}
###############
sub getWindowDC{
#usage: my $hwnd=getWindowDC($hwnd);
#info: returns the handle of a device context for the specified window.
my $hwnd=shift || return;
my $GetWindowDC = new Win32::API("user32", "GetWindowDC", ['N'], 'N') ||
return $^E;
my $hdc=$GetWindowDC->Call($hwnd);
return $hdc;
}
###############
sub getDesktopWindow{
#usage: my $hwnd=getWindowDC($hwnd);
#info: returns the handle of a device context for the specified window.
my $GetDesktopWindow = new Win32::API("user32", "GetDesktopWindow", [],
'N') || return $^E;
my $hwnd=$GetDesktopWindow->Call();
return $hwnd;
}
###############
sub drawRectangle{
#usage: my $ok=drawRectangle($hdc,$left,$top,$right,$bottom);
#info: returns the handle of a device context for the specified window.
my $hdc=shift || return;
my $left=shift || 0;
my $top=shift || 0;
my $right=shift || 0;
my $bottom=shift || 0;
my $Rectangle = new Win32::API("gdi32", "Rectangle",
['N','I','I','I','I'], 'N') || return $^E;
my $ok=$Rectangle->Call($hdc,$left,$top,$right,$bottom);
return $hdc;
}
###############
sub getWindowXY{
#usage: my $hwnd=getWindowXY($x,$y);
#info: returns the window handle of window at x,y
my $x=shift || return;
my $y=shift || return;
my $WindowFromPoint = new Win32::API("user32", "WindowFromPoint",
['N','N'], 'N') || return $^E;
my $POINT = pack("LL", $x, $y);
return $WindowFromPoint->Call($x,$y);
}
###############
sub getWindowClass{
my $hwnd = shift || return;
my $GetClassName = new Win32::API("user32", "GetClassName", ['N', 'P',
'N'], 'N') || return $^E;
my $name = " " x 1024;
my $nameLen = 1024;
my $result = $GetClassName->Call($hwnd, $name, $nameLen);
if($result){return substr($name, 0, $result);}
}
###############
sub getWindowExe {
#GetModuleFileName
my $hwnd = shift || return;
my $GetModuleFileName = new Win32::API("kernel32", "GetModuleFileName",
['N', 'P', 'N'], 'N') || return "unable to create new API";
my $name = " " x 1024;
my $Len = 1024;
my $result = $GetModuleFileName->Call($hwnd, $name, $Len);
if($result) {return substr($name, 0, $result);}
return "unknown";
}
###############
sub getWindowRect {
my $hwnd = shift || return;
my $GetWindowRect = new Win32::API("user32", "GetWindowRect", ['N', 'P'],
'N') || return $^E;
my $RECT = pack("iiii", 0, 0);
$GetWindowRect->Call($hwnd, $RECT);
return wantarray ? unpack("iiii", $RECT) : $RECT;
}
###############
sub getWindowText{
my $hwnd = shift || return;
my $GetWindowText = new Win32::API("user32", "GetWindowText", ['N', 'P',
'N'], 'N') || return $^E;
my $title = " " x 1024;
my $titleLen = 1024;
my $result = $GetWindowText->Call($hwnd, $title, $titleLen);
my $text=substr($title, 0, $result);
if($text){return $text;}
#if no result send a WM_GetText message to the window
my $WmSendMessage = new Win32::API("user32", "SendMessageA",
['N','N','N','P'],'N') || return $^E;
my $WM_GETTEXT=13;
my $txt = " " x 2048;
my $textLen = 2048;
$result = $WmSendMessage->Call($hwnd,$WM_GETTEXT, $textLen, $txt);
$text= substr($txt, 0, $result);
return $text;
}
#####################
sub get_cursor{
return Win32::GUI::BitmapInline->newCursor( q(
AAACAAEAICAAAA8AEAAwAQAAFgAAACgAAAAgAAAAQAAAAAEAAQAAAAAAAAEAAAAAAAAAAAAAAAAA
AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHwAAAGDAAACbIAABQFAAApsoA
AUAFAAECgQACoAqAAqgqgAIBAIACqCqAAqAKgAECgQABQAUAAKbKAABQFAAAJsgAABgwAAAHwAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA//////////////////////////////////g////g
D///wAf//4gj//8YMf/+ODj//nx8//wMYH/8A4B//AOAf/wDgH/8DGB//nx8//44OP//GDH//4gj
///AB///4A////g///////////////////////////////////////8=
) );
}
----------------------------------------------------------------
----- Original Message -----
From: "Robert May" <[EMAIL PROTECTED]>
To: "Steven Lloyd" <[EMAIL PROTECTED]>
Cc: <perl-win32-gui-users@lists.sourceforge.net>
Sent: Thursday, August 11, 2005 11:57 AM
Subject: Re: Draggable 'window' [Was: MDIFrame and background Image]
Steven Lloyd wrote:
Rob,
I have got this far but I cannot seem to get SetCapture to allow me to go
outside my window. Any ideas?
Steve,
Please can we keep discussion on-list (unless they are OT) - others may be
able to help, and may like to see the problems being solved.
Read up about SetCapture at:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/userinput/mouseinput/mouseinputreference/mouseinputfunctions/setcapture.asp
You only continue to get mouse move events outside your window if a mouse
button is depressed, so you'll need to catch a mouse down event,
SetCapture(), process mouse moves and then ReleaseCapture() on the mouse
up event (OK, this last step is not strictly necessary, as the system will
do it for you).
I was also wrong about the hit-hest idea - I think you'll need to use some
combination of WindowFromPoint() and ChildWindowFromPoint() - I haven't
looked to see if they're in Win32::GUI or not.
Regards,
Rob.
#!perl -w
# Left-Click on the target image, and drag
use warnings;
use strict;
use Win32::GUI 1.0;
use Win32::GUI::BitmapInline();
my $mw = Win32::GUI::Window->new(
-name => "MainWindow",
-title => "Win32::GUI Spy++",
-pos => [100,100],
-size => [100,100],
);
my $cursor = get_cursor();
$mw->AddLabel(
-name => "Target",
-icon => $cursor,
-notify => 1,
-onMouseDown => \&mouseDown,
-onMouseUp => \&mouseUp,
-onMouseMove => \&mouseMove,
);
$mw->Show();
Win32::GUI::Dialog();
exit(0);
sub mouseDown
{
my $label = shift;
Win32::GUI::SetCursor($cursor);
$label->SetCapture();
return;
}
sub mouseUp
{
my $label = shift;
$label->ReleaseCapture();
return;
}
sub mouseMove
{
my ($label, $x, $y) = @_; # x,y in client co-ordinates
return unless Win32::GUI::GetCapture();
Win32::GUI::SetCursor($cursor);
print "Mouse at: $x,$y\n";
return;
}
sub get_cursor
{
return Win32::GUI::BitmapInline->newCursor( q(
AAACAAEAICAAAA8AEAAwAQAAFgAAACgAAAAgAAAAQAAAAAEAAQAAAAAAAAEAAAAAAAAAAAAAAAAA
AAAAAAAAAAAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHwAAAGDAAACbIAABQFAAApsoA
AUAFAAECgQACoAqAAqgqgAIBAIACqCqAAqAKgAECgQABQAUAAKbKAABQFAAAJsgAABgwAAAHwAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA//////////////////////////////////g////g
D///wAf//4gj//8YMf/+ODj//nx8//wMYH/8A4B//AOAf/wDgH/8DGB//nx8//44OP//GDH//4gj
///AB///4A////g///////////////////////////////////////8=
) );
}
--
No virus found in this incoming message.
Checked by AVG Anti-Virus.
Version: 7.0.338 / Virus Database: 267.10.7/70 - Release Date: 8/11/2005
