[Perl-win32-gui-cvscommit] Win32-GUI CHANGELOG, 1.149, 1.150 GUI.h, 1.32, 1.33 GUI.xs, 1.68, 1.69 GUI_Helpers.cpp, 1.27, 1.28 GUI_Options.cpp, 1.17, 1.18
This is an automatically generated mail from the syncmail system. Do not reply
directly to this email. Further discussion should take place on the hackers
list: perl-win32-gui-hack...@lists.sourceforge.net
Update of /cvsroot/perl-win32-gui/Win32-GUI
In directory vz-cvs-2.sog:/tmp/cvs-serv30632
Modified Files:
CHANGELOG GUI.h GUI.xs GUI_Helpers.cpp GUI_Options.cpp
Log Message:
Fixed -background GDI object leak, added -newui option for BrowseForFolder
Index: GUI_Options.cpp
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Options.cpp,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** GUI_Options.cpp 8 Apr 2010 21:26:48 - 1.17
--- GUI_Options.cpp 16 Jul 2011 14:51:03 - 1.18
***
*** 58,62
eventID = PERLWIN32GUI_NEM_TIMER;
} else if(strcmp(name, "Paint") == 0) {
! eventID = PERLWIN32GUI_NEM_PAINT;
} else if(strcmp(name, "Click") == 0) {
eventID = PERLWIN32GUI_NEM_CLICK;
--- 58,62
eventID = PERLWIN32GUI_NEM_TIMER;
} else if(strcmp(name, "Paint") == 0) {
! eventID = PERLWIN32GUI_NEM_PAINT;
} else if(strcmp(name, "Click") == 0) {
eventID = PERLWIN32GUI_NEM_CLICK;
***
*** 72,78
eventID = PERLWIN32GUI_NEM_LOSTFOCUS;
} else if(strcmp(name, "DropFiles") == 0) {
! eventID = PERLWIN32GUI_NEM_DROPFILE;
} else if(strcmp(name, "Char") == 0) {
! eventID = PERLWIN32GUI_NEM_CHAR;
} else {
W32G_WARN("Win32::GUI: Unrecognized event name '%s' in -names!", name);
--- 72,78
eventID = PERLWIN32GUI_NEM_LOSTFOCUS;
} else if(strcmp(name, "DropFiles") == 0) {
! eventID = PERLWIN32GUI_NEM_DROPFILE;
} else if(strcmp(name, "Char") == 0) {
! eventID = PERLWIN32GUI_NEM_CHAR;
} else {
W32G_WARN("Win32::GUI: Unrecognized event name '%s' in -names!", name);
***
*** 81,85
if(eventID != 0) {
// Clear current event if necessary
! if ( hv_exists(perlcs->hvEvents, name, strlen(name)) )
hv_delete(perlcs->hvEvents, name, strlen(name),G_DISCARD);
// Store event
--- 81,85
if(eventID != 0) {
// Clear current event if necessary
! if ( hv_exists(perlcs->hvEvents, name, strlen(name)) )
hv_delete(perlcs->hvEvents, name, strlen(name),G_DISCARD);
// Store event
***
*** 89,93
SwitchBit(perlcs->dwEventMask, eventID, 1);
} else {
! SwitchBit(perlcs->dwEventMask, eventID, 0);
}
}
--- 89,93
SwitchBit(perlcs->dwEventMask, eventID, 1);
} else {
! SwitchBit(perlcs->dwEventMask, eventID, 0);
}
}
***
*** 124,128
if(strcmp(option, "-class") == 0) {
next_i = i + 1;
! perlcs->cs.lpszClass = (LPCTSTR) classname_From(NOTXSCALL
ST(next_i));
} else if(strcmp(option, "-text") == 0
||strcmp(option, "-caption") == 0
--- 124,128
if(strcmp(option, "-class") == 0) {
next_i = i + 1;
! perlcs->cs.lpszClass = (LPCTSTR) classname_From(NOTXSCALL
ST(next_i));
} else if(strcmp(option, "-text") == 0
||strcmp(option, "-caption") == 0
***
*** 201,208
lb.lbStyle = BS_SOLID;
lb.lbColor = perlcs->clrBackground;
! if(perlcs->hBackgroundBrush != NULL) {
DeleteObject((HGDIOBJ) perlcs->hBackgroundBrush);
}
perlcs->hBackgroundBrush = CreateBrushIndirect(&lb);
}
storing = newSViv((IV) perlcs->clrBackground);
--- 201,209
lb.lbStyle = BS_SOLID;
lb.lbColor = perlcs->clrBackground;
! if(perlcs->hBackgroundBrush != NULL &&
perlcs->bDeleteBackgroundBrush) {
DeleteObject((HGDIOBJ) perlcs->hBackgroundBrush);
}
perlcs->hBackgroundBrush = CreateBrushIndirect(&lb);
+ perlcs->bDeleteBackgroundBrush = TRUE;
}
storing = newSViv((IV) perlcs->clrBackground);
***
*** 210,213
--- 211,223
storing = newSViv((IV) perlcs->hBackgroundBrush);
stored = hv_store_mg(NOTXSCALL perlcs->hvSelf,
"-backgroundbrush", 16, storing, 0);
+ } else if(strcmp(option, "-backgroundbrush") == 0) {
+ next_i = i + 1;
+ if(perlcs->hBackgroundBrush != NULL &&
perlcs->bDeleteBackgroundBrush) {
+
[Perl-win32-gui-cvscommit] Win32-GUI/t 02_background.t,NONE,1.1
This is an automatically generated mail from the syncmail system. Do not reply
directly to this email. Further discussion should take place on the hackers
list: perl-win32-gui-hack...@lists.sourceforge.net
Update of /cvsroot/perl-win32-gui/Win32-GUI/t
In directory vz-cvs-2.sog:/tmp/cvs-serv30632/t
Added Files:
02_background.t
Log Message:
Fixed -background GDI object leak, added -newui option for BrowseForFolder
--- NEW FILE: 02_background.t ---
##!perl -wT
# Win32::GUI test suite.
# $Id: 02_background.t,v 1.1 2011/07/16 14:51:03 acalpini Exp $
#
# Win32::GUI::Window tests:
# - check background brush GDI object leak (cfr. bug #2864551)
use strict;
use warnings;
BEGIN { $| = 1 } # Autoflush
use Test::More tests => 8;
use Win32::GUI();
# we need those to stay in scope
my $hbrush;
my $hbrush1;
my $hbrush2;
{
my $W = new Win32::GUI::Window(
-name => "TestWindow",
-pos => [ 0, 0],
-size => [210, 200],
-text => "TestWindow",
);
my $L = $W->AddLabel(
-background => 0xff00ff,
-name => "label",
);
$hbrush = $L->{"-backgroundbrush"};
my @brushinfo = Win32::GUI::Brush::Info($hbrush);
ok(@brushinfo > 0, "got -backgroundbrush info");
}
# $W/$L go out of scope, $hbrush should now be invalid
my $brushinfo = Win32::GUI::Brush::Info($hbrush);
ok(!defined($brushinfo), "-backgroundbrush gone out of scope");
# create a Win32::GUI::Brush object
my $brush = Win32::GUI::Brush->new(
-style => 0, # BS_SOLID
-color => 0xff00ff,
);
$hbrush = $brush->{"-handle"};
# create 2 windows with the same -backgroundbrush
{
my $W = new Win32::GUI::Window(
-name => "TestWindow",
-pos => [ 0, 0],
-size => [210, 200],
-text => "TestWindow",
);
my $L1 = $W->AddLabel(
-backgroundbrush => $brush,
-name=> "label1",
);
my $L2 = $W->AddLabel(
-backgroundbrush => $brush,
-name=> "label2",
);
my $hbrush1 = $L1->{"-backgroundbrush"};
my $hbrush2 = $L2->{"-backgroundbrush"};
# check if we used the Win32::GUI::Object
ok($hbrush == $hbrush1, "-backgroundbrush works");
# check if we used the same for the two windows
ok($hbrush1 == $hbrush2, "same -backgroundbrush used");
}
# destroying the windows does not destroy the brush
my @brushinfo = Win32::GUI::Brush::Info($hbrush1);
ok(@brushinfo > 0, "-backgroundbrush still in scope");
# test the Change() method
{
my $W = new Win32::GUI::Window(
-name => "TestWindow",
-pos => [ 0, 0],
-size => [210, 200],
-text => "TestWindow",
);
my $L = $W->AddLabel(
-background => 0xff00ff,
-name => "label",
);
$hbrush1 = $L->{"-backgroundbrush"};
$L->Change(
-background => 0x00ff00,
);
my $brushinfo = Win32::GUI::Brush::Info($hbrush1);
ok(!defined($brushinfo), "-backgroundbrush destroyed after Change");
}
# test Change() with a Win32::GUI::Brush object
{
my $W = new Win32::GUI::Window(
-name => "TestWindow",
-pos => [ 0, 0],
-size => [210, 200],
-text => "TestWindow",
);
my $L = $W->AddLabel(
-backgroundbrush => $brush,
-name => "label",
);
$hbrush1 = $L->{"-backgroundbrush"};
$L->Change(
-background => 0x00ff00,
);
$hbrush2 = $L->{"-backgroundbrush"};
my $brushinfo = Win32::GUI::Brush::Info($hbrush1);
ok(@brushinfo > 0, "Win32::GUI::Brush object still in scope");
ok($hbrush1 != $hbrush2, "-backgroundbrush changed after Change");
}
--
AppSumo Presents a FREE Video for the SourceForge Community by Eric
Ries, the creator of the Lean Startup Methodology on "Lean Startup
Secrets Revealed." This video shows you how to validate your ideas,
optimize your ideas and identify your business strategy.
http://p.sf.net/sfu/appsumosfdev2dev
___
Perl-win32-gui-cvscommit mailing list
Perl-win32-gui-cvscommit@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-cvscommit
http://perl-win32-gui.sourceforge.net/
