date:20060111

[Perl-win32-gui-cvscommit] Win32-GUI/samples NotifyIcon.pl,NONE,1.1

2006-01-11 Thread Robert May

Update of /cvsroot/perl-win32-gui/Win32-GUI/samples
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5945/samples

Added Files:
NotifyIcon.pl 
Log Message:
Add Notify Icon Balloon Tooltips;  Re-work splitter class; bug fixes

--- NEW FILE: NotifyIcon.pl ---
#!perl w

# Notify Icon Tester
# A Win32::GUI program to show off the capabilities of
# the Windows Taskbar notification icons.
# Really written to prove the functionality added to
# Win32::GUI, but also an interesting demo.

# (c) 2005 Robert May

# See the Help Menu in the program or embedded POD
# for further information

# TODO:
# Add tooltip to icon filename when it is truncated

use strict;
use warnings;

use Win32;
use Win32::GUI 1.03_02, qw(MB_OK MB_ICONHAND ES_WANTRETURN WS_CLIPCHILDREN 
WS_EX_TOPMOST);
use Win32::GUI::BitmapInline();

sub CW_USEDEFAULT()   {0x8000};
sub WM_NOTIFYICON()   {32768 + 2};   # WM_APP + 2

my $VERSION = "1.00";

my %event_lookup = (
512 => "MouseEvent(WM_MOUSEMOVE)",  # WM_MOUSEMOVE
513 => "Click()",   # WM_LBUTTONDOWN
514 => "MouseEvent(WM_LBUTTONUP)",  # WM_LBUTTONUP
515 => "DblClick()",# WM_LBUTTONDBLCLICK
516 => "RightClick()",  # WM_RBUTTONDOWN
517 => "MouseEvent(WM_RBUTTONUP)",  # WM_RBUTTONUP
518 => "RightDblClick()",   # WM_RBUTTONDBLCLICK
519 => "MiddleClick()", # WM_MBUTTONDOWN
520 => "MouseEvent(WM_MBUTTONUP)",  # WM_MBUTTONUP
521 => "MiddleDlbClick()",  # WM_MBUTTONDBLCLICK

1024 => "MouseEvent(NIN_SELECT)",   # NIN_SELECT v5+
1025 => "MouseEvent(NIN_KEYSELECT)",# NIN_KEYSELECT v5+
1026 => "MouseEvent(NIN_BALLOONSHOW)",  # NIN_BALLOONSHOW v6+
1027 => "MouseEvent(NIN_BALLOONHIDE)",  # NIN_BALLOONSHOW v6+
1028 => "MouseEvent(NIN_BALLOONTIMEOUT)",   # NIN_BALLOONTIMEOUT v6+
1029 => "MouseEvent(NIN_BALLOONUSERCLICK)", # NINBALLOONUSERCLICK v6+
);

my %cfg = (
defaulticon => get_defaulticon(),
iconfile=> undef,
icon=> undef,
ni  => undef,
v5  => ($Win32::GUI::NotifyIcon::SHELLDLL_VERSION >= 5),
events  => [],
max_events  => 100,
);
$cfg{icon} = $cfg{defaulticon};

##
# Main menu
##
my $menu = Win32::GUI::Menu->new(
"&File" => "File",
">&Change Icon ..." => { -name => "File_Chan",  -onClick => 
\&change_icon },
"> -"   => 0,
"> E&xit"   => { -name => "File_Exit",  -onClick => sub{-1} },
"&Help" => "Help",
"> &Help"   => { -name => "Help_Help",  -onClick => \&OnHelp  },
"> &About"  => { -name => "Help_About", -onClick => \&OnAbout },
);

##
# Main window
##
my $mw = Win32::GUI::Window->new(
-title   => "Notify Icon Tester",
-left=> CW_USEDEFAULT,
-size=> [100,100],
-resizable   => 0,
-maximizebox => 0,
-menu=> $menu,
-dialogui=> 1,
);
$mw->Hook(WM_NOTIFYICON, \&record_event);

##
# Layout
##

# Primarily a 2 column layout:
my $col1_width = 235;
my $col2_width = 255;

my $padding = 10;
my $margin = 10;

my $col1_left   = 0;
my $col1_gb_left= $col1_left + $padding;
my $col1_ctrl_left  = $col1_gb_left + $padding;
my $col1_gb_right   = $col1_left + $col1_width - ($padding/2);  # collapse 
padding between columns
my $col1_ctrl_right = $col1_gb_right - $padding;

my $col2_left   = $col1_width;
my $col2_gb_left= $col2_left + ($padding/2);
my $col2_ctrl_left  = $col2_gb_left + $padding;
my $col2_gb_right   = $col2_left + $col2_width - $padding;
my $col2_ctrl_right = $col2_gb_right - $padding;

my $row1_gb_top = 0;  # no padding at top

##
# Version Information group
##
$mw->AddGroupbox(
-name  => "VGB",
-title => "Version Information",
-left  => $col1_gb_left,
-top   => $row1_gb_top,
-width => $col1_gb_right - $col1_gb_left,
);

$mw->AddLabel(
-text  => "Win32::GUI\t\t$Win32::GUI::VERSION",
-left  => $col1_ctrl_left,
-top   => $row1_gb_top + (2 * $padding),
-width => $mw->VGB->Width() - (2 * $padding),
);

$mw->AddLabel(
-text  => "shell32.dll\t\t" . Win32::GetFileVersion("shell32"),

[Perl-win32-gui-cvscommit] Win32-GUI/t 05_NotifyIcon_01_Constructor.t,NONE,1.1 05_NotifyIcon_02_Change.t,NONE,1.1 05_NotifyIcon_03_OtherMethods.t,NONE,1.1 05_NotifyIcon_04_Remove.t,NONE,1.1 05_NotifyI

2006-01-11 Thread Robert May

Update of /cvsroot/perl-win32-gui/Win32-GUI/t
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5945/t

Added Files:
05_NotifyIcon_01_Constructor.t 05_NotifyIcon_02_Change.t 
05_NotifyIcon_03_OtherMethods.t 05_NotifyIcon_04_Remove.t 
05_NotifyIcon_05_DESTROY.t 
Log Message:
Add Notify Icon Balloon Tooltips;  Re-work splitter class; bug fixes

--- NEW FILE: 05_NotifyIcon_04_Remove.t ---
#!perl -wT
# Win32::GUI test suite.
# $Id: 05_NotifyIcon_04_Remove.t,v 1.1 2006/01/11 21:26:16 robertemay Exp $
#
# test coverage of Notify Icons

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More tests => 9;

use Win32::GUI();
use Win32::GUI::BitmapInline();

my $icon = geticon();

my $ctrl = "NotifyIcon";
my $class = "Test::$ctrl";

# Testing Remove()

my $W = new Win32::GUI::Window(
-name => "TestWindow",
);

my $C = Test::NotifyIcon->new(
$W,
-name => "NI",
-icon => $icon
);

isa_ok($C,$class, "\$W->AddNotifyIcon creates $class object");
isa_ok($W->NI, $class, "\$W->NI contains a $class object");

my $id = $C->{-id};
ok(($id > 0), "NI's -id > 0");
ok(defined $W->{-notifyicons}->{$id}, "NI's id is stored in parent");
is($W->{-notifyicons}->{$id}, 'NI', "Timer's name is stored in parent");

# Remove tests
is($Test::NotifyIcon::x, 0, "DESTROY not called yet");
$C->Remove();

ok(!defined $W->{-notifyicons}->{$id}, "NI's id is removed from parent");
ok(!defined $W->{NI}, "object reference removed from parent");
is($Test::NotifyIcon::x, 1, "DESTROY called by Remove");

exit(0);

### -- helper functions --

sub geticon
{
return newIcon Win32::GUI::BitmapInline( q(
AAABAAIAICAQAADoAgAAJgAAACAgqAgAAA4DAAAoIEABAAQA
AIACABAAgAAAgICAAICAAIAAgIAAAMDAwACAgIAA
AAD/AAD///8A/wAAAP8A/wD//wAA
AIgAd3AAiIgHgIcACAiI
CIiIAAiIAIgHiACIB3cACAAA
CIB3gAgIgIiAiAiAgAAA
AAeIiAAIgIAAiAiAAIdwAACAgAAABwAA
AAAICHcACAB3cHAACIgIAAiId3gIAAgHAAiAB3d4
AIAABwAAAId3d3eIiAgAh3eHd3dwAAiAAACACAh3d3d3AAAHeAAA
iAh3dwCIAAgIeAAACIiHAHAAh3gAgHgACIAACAeIgICAAACIcAiA
AAAIiIAACIAIgIAA
/wAAf/8AAH//AAB//wAAf/8A
AH//AAB//wAAP/8AAD//AAA//4AAH/+AAB//wAAf/8AAH//gAB//4AAP/4AAD/gAAA/4AAAP8AAA
H+AAAD/wAAA/+AAAP/iAAH//+AD///4AAf///4f///8oIEABAAgA
AIAEgAAAgICAAICAAIAAgIAAAMDAwADA
3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj
/wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/
AGtr/wBISP8AJSX//gAAANwAAAC5lgAAAHMAAABQAOPU/wDHsf8Aq47/AI9r/wBzSP8A
VyX/AFUA/wBJANwAPQC5ADEAlgAlAHMAGQBQAPDU/wDisf8A1I7/AMZr/wC4SP8AqiX/AKoA/wCS
ANwAegC5AGIAlgBKAHMAMgBQAP/U/wD/sf8A/47/AP9r/wD/SP8A/yX/AP4A/gDcANwAuQC5AJYA
lgBzAHMAUABQAP/U8AD/seIA/47UAP9rxgD/SLgA/yWqAP8AqgDcAJIAuQB6AJYAYgBzAEoAUAAy
AP/U4wD/sccA/46rAP9rjwD/SHMA/yVXAP8AVQDcAEkAuQA9AJYAMQBzACUAUAAZAP/U1AD/sbEA
/46OAP9rawD/SEgA/yUlAP4AAADcuQAAAJYAAABzUP/j1AD/x7EA/6uOAP+PawD/
c0gA/1clAP9VAADcSQAAuT0AAJYxAABzJQAAUBkAAP/w1AD/4rEA/9SOAP/GawD/uEgA/6olAP+q
AADckgAAuXoAAJZiAABzSgAAUDIAAP//1AD//7EA//+OAP//awD//0gA//8lAP7+AADc3AAAubkA
AJaWAABzcwAAUFAAAPD/1ADi/7EA1P+OAMb/awC4/0gAqv8lAKr/AACS3AAAerkAAGKWAABKcwAA
MlAAAOP/1ADH/7EAq/+OAI//awBz/0gAV/8lAFX/AABJ3AAAPbkAADGWAAAlcwAAGVAAANT/1ACx
/7EAjv+OAGv/awBI/0gAJf8lAAD+3LkAAACWcwAAAFAAANT/4wCx/8cAjv+rAGv/
jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q
AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA
ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6
enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgID/AAD/
//8A/wAAAP8A/wD//wAAAOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/
//8A6+sAAAcHBwAAAOvr6///5Ovn5P///wAAAOsAB+sA6wcAAADrAOvr
///k6+fk6wDr6+vr6wD//+Tr5+T///8AAOvr6wAA
AP//5Ovn5P///wAA6+sAB+vr///k6+fkAADr6wAH
BwcAAADrAAD//+Tr5+T///8AAADr6wAHB+sAAOv/5Ovn5P//
/wAA6+sA6+vrAP/k6+fkAOvrAOvrAOsA/+Tr
5+T/AAfr6+vr5Ovn5P8A6+sA6wAAAOvrAOvr
AADk6+fk//8A6wcHAADrAP///+Tr5+T//+sH
5Ovn5P///wAA6wDrBwcAAADk6+fk
AADrAAAHBwcABwDr6+v//+Tr5+T/6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P//
/wAAAOvrAAAHBwcH6wAA6wAH///k6+fk6wcHBwcHBwfr6+vrAOv/
/+Tr5+T//+sHBwfrBwcHBwcHAOvrA

[Perl-win32-gui-cvscommit] Win32-GUI/docs/GUI/Tutorial Part3.pod,1.2,1.3

2006-01-11 Thread Robert May

Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Tutorial
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5945/docs/GUI/Tutorial

Modified Files:
Part3.pod 
Log Message:
Add Notify Icon Balloon Tooltips;  Re-work splitter class; bug fixes

Index: Part3.pod
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Tutorial/Part3.pod,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Part3.pod   5 Oct 2005 22:20:49 -   1.2
--- Part3.pod   11 Jan 2006 21:26:16 -  1.3
***
*** 96,100 
  
  Recent versions of Win32::GUI have a C<-dialogui> option that controls the
! special keyboard handling. Setting this option to C<1> on a basic Window add 
the
  special key handling to the window; setting it to C<0> on a DialogBox removes
  the special key handling.
--- 96,100 
  
  Recent versions of Win32::GUI have a C<-dialogui> option that controls the
! special keyboard handling. Setting this option to C<1> on a basic Window adds 
the
  special key handling to the window; setting it to C<0> on a DialogBox removes
  the special key handling.

[Perl-win32-gui-cvscommit] Win32-GUI CHANGELOG,1.69,1.70 GUI.h,1.23,1.24 GUI.pm,1.36,1.37 GUI.xs,1.47,1.48 GUI_Helpers.cpp,1.14,1.15 GUI_MessageLoops.cpp,1.16,1.17 GUI_Options.cpp,1.9,1.10 Label.xs,1.

2006-01-11 Thread Robert May

Update of /cvsroot/perl-win32-gui/Win32-GUI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5945

Modified Files:
CHANGELOG GUI.h GUI.pm GUI.xs GUI_Helpers.cpp 
GUI_MessageLoops.cpp GUI_Options.cpp Label.xs MANIFEST 
NotifyIcon.xs RichEdit.xs Splitter.xs 
Log Message:
Add Notify Icon Balloon Tooltips;  Re-work splitter class; bug fixes

Index: GUI.xs
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v
retrieving revision 1.47
retrieving revision 1.48
diff -C2 -d -r1.47 -r1.48
*** GUI.xs  3 Dec 2005 01:56:31 -   1.47
--- GUI.xs  11 Jan 2006 21:26:15 -  1.48
***
*** 2047,2054 
  DWORD result;
  PPCODE:
! if(SendMessageTimeout(
! handle, msg, wparam, lparam, flags, timeout, &result
! ) == 0) {
! XSRETURN_NO;
  } else {
  XSRETURN_IV(result);
--- 2047,2052 
  DWORD result;
  PPCODE:
! if(SendMessageTimeout(handle, msg, wparam, lparam, flags, timeout, 
&result) == 0) {
! XSRETURN_UNDEF;
  } else {
  XSRETURN_IV(result);

Index: Label.xs
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Label.xs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Label.xs3 Aug 2005 21:45:57 -   1.6
--- Label.xs11 Jan 2006 21:26:16 -  1.7
***
*** 45,63 
  } else if(strcmp(option, "-truncate") == 0) {
  if(strcmp(SvPV_nolen(value), "path") == 0) {
! SwitchBit(perlcs->cs.style, SS_PATHELLIPSIS, 1);
! SwitchBit(perlcs->cs.style, SS_ENDELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_WORDELLIPSIS, 0);
  } else if(strcmp(SvPV_nolen(value), "word") == 0) {
! SwitchBit(perlcs->cs.style, SS_PATHELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_ENDELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_WORDELLIPSIS, 1);
  } else if(SvIV(value)) {
! SwitchBit(perlcs->cs.style, SS_PATHELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_ENDELLIPSIS, 1);
! SwitchBit(perlcs->cs.style, SS_WORDELLIPSIS, 0);
  } else {
! SwitchBit(perlcs->cs.style, SS_PATHELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_ENDELLIPSIS, 0);
! SwitchBit(perlcs->cs.style, SS_WORDELLIPSIS, 0);
  }
  } else if(strcmp(option, "-frame") == 0) {
--- 45,58 
  } else if(strcmp(option, "-truncate") == 0) {
  if(strcmp(SvPV_nolen(value), "path") == 0) {
!   perlcs->cs.style &= ~SS_ELLIPSISMASK;
!   perlcs->cs.style |= SS_PATHELLIPSIS;
  } else if(strcmp(SvPV_nolen(value), "word") == 0) {
!   perlcs->cs.style &= ~SS_ELLIPSISMASK;
!   perlcs->cs.style |= SS_WORDELLIPSIS;
  } else if(SvIV(value)) {
!   perlcs->cs.style &= ~SS_ELLIPSISMASK;
!   perlcs->cs.style |= SS_ENDELLIPSIS;
  } else {
!   perlcs->cs.style &= ~SS_ELLIPSISMASK;
  }
  } else if(strcmp(option, "-frame") == 0) {

Index: RichEdit.xs
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/RichEdit.xs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** RichEdit.xs 5 Oct 2005 22:20:49 -   1.6
--- RichEdit.xs 11 Jan 2006 21:26:16 -  1.7
***
*** 25,28 
--- 25,44 
  void
  RichEdit_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT 
perlcs) {
+ 
+ if(perlcs->clrForeground != CLR_INVALID) {
+ CHARFORMAT cf;
+ ZeroMemory(&cf, sizeof(CHARFORMAT));
+ cf.cbSize = sizeof(CHARFORMAT);
+ cf.dwMask = CFM_COLOR;
+ cf.crTextColor = perlcs->clrForeground;
+ SendMessage (myhandle, EM_SETCHARFORMAT, (WPARAM)SCF_ALL, 
(LPARAM)&cf);
+ perlcs->clrForeground = CLR_INVALID;  // Don't Store
+ }
+ 
+ if(perlcs->clrBackground != CLR_INVALID) {
+ SendMessage (myhandle, EM_SETBKGNDCOLOR, (WPARAM)0, 
(LPARAM)(perlcs->clrBackground));
+ perlcs->clrBackground = CLR_INVALID;  // Don't Store
+ }
+ 
  }
  

Index: GUI.pm
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** GUI.pm  3 Dec 2005 01:56:31 -   1.36
--- GUI.pm  11 Jan 2006 21:26:14 -  1.37
***
*** 25,32 
  # STATIC OBJECT PROPERTIES
  #
! $VERSION = "1.03_01"; # For MakeMaker
  $XS_VERSION  = $VERSION;  # For dynaloader
  $VERSION = eval $VERSION; # For Perl  (see perldoc perlmodstyle)
! $MenuIdCounter   = 1;
  $TimerIdCounter  = 1;
  $NotifyIconIdCo

[Perl-win32-gui-cvscommit] Win32-GUI/docs/GUI/Tutorial Part4.pod,1.3,1.4

2006-01-11 Thread Robert May

Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Tutorial
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8989/docs/GUI/Tutorial

Modified Files:
Part4.pod 
Log Message:
Fix NotifyIcon description

Index: Part4.pod
===
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Tutorial/Part4.pod,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Part4.pod   13 Nov 2005 18:57:52 -  1.3
--- Part4.pod   11 Jan 2006 21:39:41 -  1.4
***
*** 156,160 
  you can use this line:
  
!   $main->NI->Delete(-id => 1);
  
  =back
--- 156,160 
  you can use this line:
  
!   $main->NI->Remove();
  
  =back

[Perl-win32-gui-cvscommit] Win32-GUI/samples NotifyIcon.pl,NONE,1.1

[Perl-win32-gui-cvscommit] Win32-GUI/t 05_NotifyIcon_01_Constructor.t,NONE,1.1 05_NotifyIcon_02_Change.t,NONE,1.1 05_NotifyIcon_03_OtherMethods.t,NONE,1.1 05_NotifyIcon_04_Remove.t,NONE,1.1 05_NotifyI

[Perl-win32-gui-cvscommit] Win32-GUI/docs/GUI/Tutorial Part3.pod,1.2,1.3

[Perl-win32-gui-cvscommit] Win32-GUI CHANGELOG,1.69,1.70 GUI.h,1.23,1.24 GUI.pm,1.36,1.37 GUI.xs,1.47,1.48 GUI_Helpers.cpp,1.14,1.15 GUI_MessageLoops.cpp,1.16,1.17 GUI_Options.cpp,1.9,1.10 Label.xs,1.

[Perl-win32-gui-cvscommit] Win32-GUI/docs/GUI/Tutorial Part4.pod,1.3,1.4

5 matches

Site Navigation

Mail list logo

Footer information