Menu
▾
▴
perl-win32-gui-cvscommit — Send-only list for receiving email when commits are made to project CVS
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(6) |
Nov
(31) |
Dec
(6) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(6) |
Feb
|
Mar
(17) |
Apr
(17) |
May
(27) |
Jun
(67) |
Jul
(26) |
Aug
(15) |
Sep
(2) |
Oct
(24) |
Nov
(6) |
Dec
|
| 2007 |
Jan
(4) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(28) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2008 |
Jan
(21) |
Feb
(45) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2010 |
Jan
|
Feb
(3) |
Mar
|
Apr
(3) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32127/docs Modified Files: Documentation.txt per_package.tpl per_package_event.tpl per_package_event_section.tpl per_package_method.tpl per_package_method_section.tpl Log Message: Reverted this-mornings changes; They will be re-applied in smaller chunks Index: per_package_method.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_method.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** per_package_method.tpl 16 Mar 2006 08:57:49 -0000 1.2 --- per_package_method.tpl 16 Mar 2006 21:11:13 -0000 1.3 *************** *** 1,2 **** --- 1,4 ---- + =for comment $Id$ + =head2 __W32G_METHODNAME__ Index: per_package.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** per_package.tpl 16 Mar 2006 08:57:49 -0000 1.2 --- per_package.tpl 16 Mar 2006 21:11:13 -0000 1.3 *************** *** 1,2 **** --- 1,4 ---- + =for comment $Id$ + =head1 NAME Index: per_package_event.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_event.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** per_package_event.tpl 16 Mar 2006 08:57:49 -0000 1.2 --- per_package_event.tpl 16 Mar 2006 21:11:13 -0000 1.3 *************** *** 1,2 **** --- 1,4 ---- + =for comment $Id$ + =head2 __W32G_EVENTTITLE__ Index: Documentation.txt =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/Documentation.txt,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Documentation.txt 16 Mar 2006 08:57:49 -0000 1.2 --- Documentation.txt 16 Mar 2006 21:11:12 -0000 1.3 *************** *** 98,102 **** * Packages Introduced by a line containing the text: ! (@)PACKAGE: Win32::GUI::PackageName The first comment line, immediately following such a declaration is taken --- 98,102 ---- * Packages Introduced by a line containing the text: ! (@)PACJAGE: Win32::GUI::PackageName The first comment line, immediately following such a declaration is taken *************** *** 147,151 **** If you wish to provide a link to a page from within the text, please use the form: ! L<description|Win32::GUI::PackageName> even if this means that your link looks like: L<Win32::GUI::PackageName|Win32::GUI::PackageName> --- 147,151 ---- If you wish to provide a link to a page from within the text, please use the form: ! L<descrption|Win32::GUI::PackageName> even if this means that your link looks like: L<Win32::GUI::PackageName|Win32::GUI::PackageName> Index: per_package_event_section.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_event_section.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** per_package_event_section.tpl 16 Mar 2006 08:57:49 -0000 1.2 --- per_package_event_section.tpl 16 Mar 2006 21:11:13 -0000 1.3 *************** *** 1,2 **** --- 1,4 ---- + =for comment $Id$ + =head1 EVENTS Index: per_package_method_section.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_method_section.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** per_package_method_section.tpl 16 Mar 2006 08:57:49 -0000 1.2 --- per_package_method_section.tpl 16 Mar 2006 21:11:13 -0000 1.3 *************** *** 1,2 **** --- 1,4 ---- + =for comment $Id$ + =head1 METHODS |
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815 Modified Files: Button.xs CHANGELOG GUI.h GUI.pm GUI.rc GUI.xs GUI_Events.cpp GUI_Helpers.cpp GUI_MessageLoops.cpp GUI_Options.cpp Header.xs ImageList.xs ListView.xs MANIFEST Makefile.PL NotifyIcon.xs Readme Readme.html Rebar.xs TYPEMAP Toolbar.xs Tooltip.xs Trackbar.xs TreeView.xs Window.xs Added Files: CustomDraw.pm Log Message: Reini Urban changes Index: GUI.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v retrieving revision 1.48 retrieving revision 1.49 diff -C2 -d -r1.48 -r1.49 *** GUI.xs 11 Jan 2006 21:26:15 -0000 1.48 --- GUI.xs 16 Mar 2006 08:57:45 -0000 1.49 *************** *** 19,22 **** --- 19,24 ---- #include "GUI.h" + START_MY_CXT + /* ########################################################################### *************** *** 57,61 **** OUTPUT: [...1021 lines suppressed...] + # names to the window. + # + # Note: Called implicitly by DragQueryFiles. So don't use DragQueryFiles + # if you need further information from this object. + void + DESTROY(handle) + HDROP handle + CODE: + DragFinish(handle); + + + ########################################################################### BOOT: { + MY_CXT_INIT; + MY_CXT.count = 0; INITCOMMONCONTROLSEX icce; icce.dwSize = sizeof(INITCOMMONCONTROLSEX); Index: Tooltip.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Tooltip.xs,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Tooltip.xs 25 Aug 2005 19:30:17 -0000 1.5 --- Tooltip.xs 16 Mar 2006 08:57:48 -0000 1.6 *************** *** 10,14 **** #include "GUI.h" ! void Tooltip_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { --- 10,19 ---- #include "GUI.h" ! typedef struct tagPERLWIN32GUI_NMTTCUSTOMDRAW { ! NMCUSTOMDRAW nmcd; ! UINT uDrawFlags; ! } PERLWIN32GUI_NMTTCUSTOMDRAW, * LPPERLWIN32GUI_NMTTCUSTOMDRAW; ! ! void Tooltip_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { *************** *** 51,54 **** --- 56,60 ---- else if Parse_Event("Pop", PERLWIN32GUI_NEM_CONTROL2) else if Parse_Event("Show", PERLWIN32GUI_NEM_CONTROL3) + else if Parse_Event("CustomDraw", PERLWIN32GUI_NEM_PAINT) else retval = FALSE; *************** *** 99,102 **** --- 105,125 ---- -1); break; + case NM_CUSTOMDRAW: + { + char class_name[] = "Win32::GUI::Tooltip::CustomDraw"; + LPPERLWIN32GUI_NMTTCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMTTCUSTOMDRAW) lParam; + SV *obj = CreateNMCustomDraw(NOTXSCALL class_name, lpCD); + HV *hv = (HV *)SvRV(obj); + hv_store_mg(NOTXSCALL hv, "-drawflags",11,newSViv(lpCD->uDrawFlags), 0); + PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_PAINT, "CustomDraw", + PERLWIN32GUI_ARGTYPE_SV, obj, + -1); + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(CreateNMCustomDraw %s) => %d\n", class_name, PerlResult); + #endif + perlud->forceResult = PerlResult; + PerlResult = 0; /* MsgLoop return ForceResult */ + } + break; } } *************** *** 104,108 **** return PerlResult; } ! MODULE = Win32::GUI::Tooltip PACKAGE = Win32::GUI::Tooltip --- 127,131 ---- return PerlResult; } ! MODULE = Win32::GUI::Tooltip PACKAGE = Win32::GUI::Tooltip Index: Window.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Window.xs,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Window.xs 13 Nov 2005 18:57:52 -0000 1.10 --- Window.xs 16 Mar 2006 08:57:48 -0000 1.11 *************** *** 82,85 **** --- 82,89 ---- storing = newSViv((LONG) handle_From(NOTXSCALL value)); stored = hv_store_mg(NOTXSCALL perlcs->hvSelf, "-accel", 6, storing, 0); + } else if(strcmp(option, "-dropfiles") == 0) { + perlcs->iDropFiles = (int) SvIV(value); + storing = newSViv((LONG) SvIV(value)); + stored = hv_store_mg(NOTXSCALL perlcs->hvSelf, "-dropfiles", 10, storing, 0); } else if(strcmp(option, "-hasmaximize") == 0 || strcmp(option, "-maximizebox") == 0) { *************** *** 113,116 **** --- 117,128 ---- void Window_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { + + if (perlcs->iDropFiles) { + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(Window_onPostCreate DragAcceptFiles) (iDropFiles=%d, myhandle=%ud)\n", + perlcs->iDropFiles, myhandle); + #endif + DragAcceptFiles(myhandle, 1); + } } *************** *** 128,131 **** --- 140,144 ---- else if Parse_Event("Scroll", PERLWIN32GUI_NEM_CONTROL7) else if Parse_Event("InitMenu", PERLWIN32GUI_NEM_CONTROL8) + else if Parse_Event("DropFiles", PERLWIN32GUI_NEM_DROPFILE) else if Parse_Event("Paint", PERLWIN32GUI_NEM_PAINT) else retval = FALSE; *************** *** 260,264 **** * Sent when a menu is about to become active. It occurs when the user clicks * an item on the menu bar or presses a menu key. This allows the application ! * to modify the menu before it is displayed. * (@)APPLIES_TO:Window, DialogBox, MDIFrame */ --- 273,277 ---- * Sent when a menu is about to become active. It occurs when the user clicks * an item on the menu bar or presses a menu key. This allows the application ! * to modify the menu before it is displayed. * (@)APPLIES_TO:Window, DialogBox, MDIFrame */ *************** *** 295,301 **** } ! void DialogBox_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! } --- 308,314 ---- } ! void DialogBox_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! } *************** *** 306,310 **** } ! int DialogBox_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam) { --- 319,323 ---- } ! int DialogBox_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam) { *************** *** 338,344 **** } ! void Graphic_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! } --- 351,357 ---- } ! void Graphic_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! } *************** *** 352,356 **** else if Parse_Event("LButtonUp", PERLWIN32GUI_NEM_CONTROL2) else if Parse_Event("RButtonDown", PERLWIN32GUI_NEM_CONTROL3) ! else if Parse_Event("RButtonUp", PERLWIN32GUI_NEM_CONTROL4) else retval = FALSE; --- 365,369 ---- else if Parse_Event("LButtonUp", PERLWIN32GUI_NEM_CONTROL2) else if Parse_Event("RButtonDown", PERLWIN32GUI_NEM_CONTROL3) ! else if Parse_Event("RButtonUp", PERLWIN32GUI_NEM_CONTROL4) else retval = FALSE; *************** *** 358,362 **** } ! int Graphic_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam) { --- 371,375 ---- } ! int Graphic_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam) { *************** *** 453,456 **** --- 466,496 ---- #pragma message( "*** PACKAGE Win32::GUI::Window..." ) + ########################################################################### + # (@)METHOD:DragAcceptFiles(HANDLE, [ fAccept ] ) + # Set or get the status whether a window or dialogbox accepts dropped files. + # Returns 0 or 1 + # + int + DragAcceptFiles(handle,...) + HWND handle; + CODE: + int fAccept; + HV* self; + SV** tmp; + + RETVAL = 0; + self = (HV*) SvRV(ST(0)); + if (self) { + if ( items > 1 ) { + fAccept = SvIV(ST(1)) ? 1 : 0; + DragAcceptFiles(handle, (BOOL)fAccept); + RETVAL = fAccept; + } else { + if (tmp = hv_fetch_mg(NOTXSCALL self, "-dropfiles", 10, 0)) + RETVAL = SvIV(*tmp);; + } + } + OUTPUT: + RETVAL ########################################################################### Index: Readme =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Readme,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Readme 21 Nov 2005 22:33:33 -0000 1.4 --- Readme 16 Mar 2006 08:57:48 -0000 1.5 *************** *** 14,21 **** AVAILABILITY ! This is the README file for Win32::GUI v1.03 built on 21 Nov 2005. Source and ActiveState Perl PPMs are available from ! http://sourceforge.net/project/showfiles.php?group_id=16572. A cygwin distribution (available through cygwin's setup.exe) is --- 14,21 ---- AVAILABILITY ! This is the README file for Win32::GUI v1.03_03 built on 15 Mar 2006. Source and ActiveState Perl PPMs are available from ! <http://sourceforge.net/project/showfiles.php?group_id=16572>. A cygwin distribution (available through cygwin's setup.exe) is *************** *** 157,166 **** nmake ppm ! This procedure will generate a PPM for you current perl environment, including the HTML documentation, ready for installation as above. VERSION ! Documentation for Win32::GUI v1.03 created 21 Nov 2005 This document is autogenerated by the build process. Edits made here --- 157,166 ---- nmake ppm ! This procedure will generate a PPM for your current perl environment, including the HTML documentation, ready for installation as above. VERSION ! Documentation for Win32::GUI v1.03_03 created 15 Mar 2006 This document is autogenerated by the build process. Edits made here *************** *** 169,183 **** SUPPORT ! Homepage: http://perl-win32-gui.sourceforge.net/. For further support join the users mailing list("per...@li...") from the website at ! http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users. There ! is a searchable list archive at ! http://sourceforge.net/mail/?group_id=16572. COPYRIGHT and LICENCE ! Copyright (c) 1997..2005 Aldo Calpini. All rights reserved. This program is free software; you can redistribute it and/or modify it --- 169,183 ---- SUPPORT ! Homepage: <http://perl-win32-gui.sourceforge.net/>. For further support join the users mailing list("per...@li...") from the website at ! <http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users>. ! There is a searchable list archive at ! <http://sourceforge.net/mail/?group_id=16572>. COPYRIGHT and LICENCE ! Copyright (c) 1997..2006 Aldo Calpini. All rights reserved. This program is free software; you can redistribute it and/or modify it Index: Rebar.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Rebar.xs,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Rebar.xs 26 Jun 2005 16:40:59 -0000 1.7 --- Rebar.xs 16 Mar 2006 08:57:48 -0000 1.8 *************** *** 78,81 **** --- 78,82 ---- if Parse_Event("HeightChange", PERLWIN32GUI_NEM_CONTROL1) else if Parse_Event("ChevronPushed", PERLWIN32GUI_NEM_CONTROL2) + else if Parse_Event("CustomDraw", PERLWIN32GUI_NEM_PAINT) else retval = FALSE; *************** *** 118,121 **** --- 119,139 ---- } break; + + case NM_CUSTOMDRAW: + { + char class_name[] = "Win32::GUI::Rebar::CustomDraw"; + LPPERLWIN32GUI_NMCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMCUSTOMDRAW) lParam; + SV *obj = CreateNMCustomDraw(NOTXSCALL class_name, lpCD); + PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_PAINT, "CustomDraw", + PERLWIN32GUI_ARGTYPE_SV, obj, + -1); + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(CreateNMCustomDraw %s) => %d\n", class_name, PerlResult); + #endif + perlud->forceResult = PerlResult; + PerlResult = 0; /* MsgLoop return ForceResult */ + } + break; + } Index: GUI_Events.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Events.cpp,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** GUI_Events.cpp 30 Jun 2005 22:36:21 -0000 1.10 --- GUI_Events.cpp 16 Mar 2006 08:57:48 -0000 1.11 *************** *** 19,23 **** BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult) { if(SvTRUE(ERRSV)) { ! if(strncmp(Name, "main::", 6) == 0) Name += 6; MessageBeep(MB_ICONASTERISK); *PerlResult = MessageBox(NULL, SvPV_nolen(ERRSV), Name, MB_ICONERROR | MB_OKCANCEL); --- 19,23 ---- BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult) { if(SvTRUE(ERRSV)) { ! if(strncmp(Name, "main::", 6) == 0) Name += 6; MessageBeep(MB_ICONASTERISK); *PerlResult = MessageBox(NULL, SvPV_nolen(ERRSV), Name, MB_ICONERROR | MB_OKCANCEL); *************** *** 72,76 **** break; case PERLWIN32GUI_ARGTYPE_LONG: ! XPUSHs(sv_2mortal(newSViv(va_arg( args, long )))); break; case PERLWIN32GUI_ARGTYPE_WORD: --- 72,76 ---- break; case PERLWIN32GUI_ARGTYPE_LONG: ! XPUSHs(sv_2mortal(newSVuv(va_arg( args, long )))); break; case PERLWIN32GUI_ARGTYPE_WORD: *************** *** 81,84 **** --- 81,87 ---- break; case PERLWIN32GUI_ARGTYPE_SV: + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(DoEvent NEM PERLWIN32GUI_ARGTYPE_SV)\n"); + #endif XPUSHs(va_arg( args, SV *)); break; *************** *** 142,145 **** --- 145,154 ---- XPUSHs(sv_2mortal(newSVpv(va_arg( args, char * ), 0))); break; + case PERLWIN32GUI_ARGTYPE_SV: + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(DoEvent OEM PERLWIN32GUI_ARGTYPE_SV)\n"); + #endif + XPUSHs(va_arg( args, SV *)); + break; default: warn("Win32::GUI: WARNING! unknown argument type (%d) to event '%s'", argtype, Name); *************** *** 1039,1047 **** //but this is slightly quicker:) if(SvTRUE(ERRSV)) { ! ProcessEventError(NOTXSCALL "Hook", PerlResult); ! } ! else { ! if(count > 0) { *PerlResult = POPi; } ! } PUTBACK; FREETMPS; --- 1048,1056 ---- //but this is slightly quicker:) if(SvTRUE(ERRSV)) { ! ProcessEventError(NOTXSCALL "Hook", PerlResult); ! } ! else { ! if(count > 0) { *PerlResult = POPi; } ! } PUTBACK; FREETMPS; Index: TYPEMAP =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/TYPEMAP,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** TYPEMAP 3 Dec 2005 10:37:03 -0000 1.5 --- TYPEMAP 16 Mar 2006 08:57:48 -0000 1.6 *************** *** 13,16 **** --- 13,17 ---- HPEN T_HANDLE HRGN T_HANDLE + HDROP T_HANDLE HTREEITEM T_IV LONG T_IV *************** *** 56,58 **** T_COLOR sv_setiv($arg, (IV) $var); - --- 57,58 ---- Index: Trackbar.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Trackbar.xs,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Trackbar.xs 30 Jun 2005 22:36:21 -0000 1.6 --- Trackbar.xs 16 Mar 2006 08:57:48 -0000 1.7 *************** *** 10,14 **** #include "GUI.h" ! void Trackbar_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { --- 10,14 ---- #include "GUI.h" ! void Trackbar_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { *************** *** 24,28 **** if(strcmp(option, "-tooltip") == 0) { perlcs->hTooltip = (HWND) handle_From(NOTXSCALL value); ! SwitchBit(perlcs->cs.style, TBS_TOOLTIPS , 1); } else if BitmaskOptionValue("-vertical", perlcs->cs.style, TBS_VERT) } else if BitmaskOptionValue("-aligntop", perlcs->cs.style, TBS_TOP) --- 24,28 ---- if(strcmp(option, "-tooltip") == 0) { perlcs->hTooltip = (HWND) handle_From(NOTXSCALL value); ! SwitchBit(perlcs->cs.style, TBS_TOOLTIPS , 1); } else if BitmaskOptionValue("-vertical", perlcs->cs.style, TBS_VERT) } else if BitmaskOptionValue("-aligntop", perlcs->cs.style, TBS_TOP) *************** *** 39,46 **** } ! void Trackbar_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! if (perlcs->hTooltip != NULL) SendMessage(myhandle, TBM_SETTOOLTIPS, (WPARAM) perlcs->hTooltip, 0); } --- 39,46 ---- } ! void Trackbar_onPostCreate(NOTXSPROC HWND myhandle, LPPERLWIN32GUI_CREATESTRUCT perlcs) { ! if (perlcs->hTooltip != NULL) SendMessage(myhandle, TBM_SETTOOLTIPS, (WPARAM) perlcs->hTooltip, 0); } *************** *** 83,86 **** --- 83,102 ---- PERLWIN32GUI_ARGTYPE_INT, (int) HIWORD(wParam), -1 ); break; + + case NM_CUSTOMDRAW: + { + char class_name[] = "Win32::GUI::Trackbar::CustomDraw"; + LPPERLWIN32GUI_NMCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMCUSTOMDRAW) lParam; + SV *obj = CreateNMCustomDraw(NOTXSCALL class_name, lpCD); + PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_PAINT, "CustomDraw", + PERLWIN32GUI_ARGTYPE_SV, obj, + -1); + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(CreateNMCustomDraw %s) => %d\n", class_name, PerlResult); + #endif + perlud->forceResult = PerlResult; + PerlResult = 0; + } + break; } *************** *** 124,128 **** # Retrieves the handle to a trackbar control buddy window at a given location. # ! # The specified location is relative to the control's orientation (horizontal or vertical). # B<LOCATION> = FALSE : Retrieves buddy to the right of the trackbar (or below for vertical trackbar) # B<LOCATION> = TRUE : Retrieves buddy to the left of the trackbar (or above for vertical trackbar) --- 140,144 ---- # Retrieves the handle to a trackbar control buddy window at a given location. # ! # The specified location is relative to the control's orientation (horizontal or vertical). # B<LOCATION> = FALSE : Retrieves buddy to the right of the trackbar (or below for vertical trackbar) # B<LOCATION> = TRUE : Retrieves buddy to the left of the trackbar (or above for vertical trackbar) *************** *** 139,143 **** # (@)METHOD:GetChannelRect() # Retrieves the bounding rectangle for a trackbar's channel. ! # The channel is the area over which the slider moves. It contains the highlight when a range is selected. void --- 155,159 ---- # (@)METHOD:GetChannelRect() # Retrieves the bounding rectangle for a trackbar's channel. ! # The channel is the area over which the slider moves. It contains the highlight when a range is selected. void *************** *** 205,209 **** ########################################################################### # (@)METHOD:GetPics() ! # Retrieves an array of logical positions of the trackbar's tick marks, not including the first and last tick. void --- 221,225 ---- ########################################################################### # (@)METHOD:GetPics() ! # Retrieves an array of logical positions of the trackbar's tick marks, not including the first and last tick. void *************** *** 220,224 **** if (pTics) { EXTEND(SP, nTics); ! for (UINT i = 0; i < nTics; i++) XST_mIV(i, pTics[i]); XSRETURN(nTics); --- 236,240 ---- if (pTics) { EXTEND(SP, nTics); ! for (UINT i = 0; i < nTics; i++) XST_mIV(i, pTics[i]); XSRETURN(nTics); *************** *** 292,296 **** ########################################################################### # (@)METHOD:GetThumbRect() ! # Retrieves the bounding rectangle for the slider in a trackbar. void --- 308,312 ---- ########################################################################### # (@)METHOD:GetThumbRect() ! # Retrieves the bounding rectangle for the slider in a trackbar. void *************** *** 336,340 **** ########################################################################### # (@)METHOD:GetToolTips() ! # Retrieves the handle to the tooltip control assigned to the trackbar, if any. LRESULT --- 352,356 ---- ########################################################################### # (@)METHOD:GetToolTips() ! # Retrieves the handle to the tooltip control assigned to the trackbar, if any. LRESULT *************** *** 348,352 **** ########################################################################### # (@)METHOD:GetUnicodeFormat() ! # Retrieves the UNICODE character format flag for the control. LRESULT --- 364,368 ---- ########################################################################### # (@)METHOD:GetUnicodeFormat() ! # Retrieves the UNICODE character format flag for the control. LRESULT *************** *** 362,366 **** # Assigns a window as the buddy window for a trackbar control # Returns the handle to the window that was previously assigned to the control at that location ! # The specified location is relative to the control's orientation (horizontal or vertical). # LOCATION = FALSE : Retrieves buddy to the right of the trackbar (or below for vertical trackbar) # LOCATION = TRUE : Retrieves buddy to the left of the trackbar (or above for vertical trackbar) --- 378,382 ---- # Assigns a window as the buddy window for a trackbar control # Returns the handle to the window that was previously assigned to the control at that location ! # The specified location is relative to the control's orientation (horizontal or vertical). # LOCATION = FALSE : Retrieves buddy to the right of the trackbar (or below for vertical trackbar) # LOCATION = TRUE : Retrieves buddy to the left of the trackbar (or above for vertical trackbar) *************** *** 390,394 **** ########################################################################### # (@)METHOD:SetPageSize([SIZE=10]) ! # Sets the number of logical positions the trackbar's slider moves in response to keyboard input, such as the PAGE UP or PAGE DOWN keys, or mouse input, such as clicks in the trackbar's channel. LRESULT --- 406,410 ---- ########################################################################### # (@)METHOD:SetPageSize([SIZE=10]) ! # Sets the number of logical positions the trackbar's slider moves in response to keyboard input, such as the PAGE UP or PAGE DOWN keys, or mouse input, such as clicks in the trackbar's channel. LRESULT *************** *** 417,421 **** ########################################################################### # (@)METHOD:SetRange([MIN=0], MAX, [REDRAW=TRUE]) ! # Sets the range of minimum and maximum logical positions for the slider in a trackbar. LRESULT --- 433,437 ---- ########################################################################### # (@)METHOD:SetRange([MIN=0], MAX, [REDRAW=TRUE]) ! # Sets the range of minimum and maximum logical positions for the slider in a trackbar. LRESULT *************** *** 460,464 **** ########################################################################### # (@)METHOD:SetSel([MIN=0], MAX, [REDRAW=TRUE]) ! # Sets the starting and ending logical positions for the current selection range in a trackbar. LRESULT --- 476,480 ---- ########################################################################### # (@)METHOD:SetSel([MIN=0], MAX, [REDRAW=TRUE]) ! # Sets the starting and ending logical positions for the current selection range in a trackbar. LRESULT *************** *** 516,520 **** ########################################################################### # (@)METHOD:SetTic(POSITION) ! # Sets a tick mark in a trackbar at the specified logical position. LRESULT --- 532,536 ---- ########################################################################### # (@)METHOD:SetTic(POSITION) ! # Sets a tick mark in a trackbar at the specified logical position. LRESULT *************** *** 546,552 **** # Positions a tooltip control used by a trackbar control. # TBTS_TOP : The tooltip control will be positioned above the trackbar. This flag is for use with horizontal trackbars. ! # TBTS_LEFT The tooltip control will be positioned to the left of the trackbar. This flag is for use with vertical trackbars. ! # TBTS_BOTTOM The tooltip control will be positioned below the trackbar. This flag is for use with horizontal trackbars. ! # TBTS_RIGHT The tooltip control will be positioned to the right of the trackbar. This flag is for use with vertical trackbars. LRESULT --- 562,568 ---- # Positions a tooltip control used by a trackbar control. # TBTS_TOP : The tooltip control will be positioned above the trackbar. This flag is for use with horizontal trackbars. ! # TBTS_LEFT The tooltip control will be positioned to the left of the trackbar. This flag is for use with vertical trackbars. ! # TBTS_BOTTOM The tooltip control will be positioned below the trackbar. This flag is for use with horizontal trackbars. ! # TBTS_RIGHT The tooltip control will be positioned to the right of the trackbar. This flag is for use with vertical trackbars. LRESULT *************** *** 574,578 **** ########################################################################### # (@)METHOD:SetUnicodeFormat(FLAG) ! # Sets the UNICODE character format flag for the control. LRESULT --- 590,594 ---- ########################################################################### # (@)METHOD:SetUnicodeFormat(FLAG) ! # Sets the UNICODE character format flag for the control. LRESULT *************** *** 597,603 **** HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETRANGEMIN, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETRANGEMIN, 1, (LPARAM) SvIV(ST(1))); --- 613,619 ---- HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETRANGEMIN, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETRANGEMIN, 1, (LPARAM) SvIV(ST(1))); *************** *** 617,623 **** HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETRANGEMAX, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETRANGEMAX, 1, (LPARAM) SvIV(ST(1))); --- 633,639 ---- HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETRANGEMAX, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETRANGEMAX, 1, (LPARAM) SvIV(ST(1))); *************** *** 636,642 **** HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETPOS, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETPOS, 1, (LPARAM) SvIV(ST(1))); --- 652,658 ---- HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETPOS, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETPOS, 1, (LPARAM) SvIV(ST(1))); *************** *** 655,661 **** HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETSELSTART, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETSELSTART, 1, (LPARAM) SvIV(ST(1))); --- 671,677 ---- HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETSELSTART, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETSELSTART, 1, (LPARAM) SvIV(ST(1))); *************** *** 674,680 **** HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETSELEND, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETSELEND, 1, (LPARAM) SvIV(ST(1))); --- 690,696 ---- HWND handle CODE: ! if(items > 1) { if(items > 2) ! RETVAL = SendMessage(handle, TBM_SETSELEND, (WPARAM) SvIV(ST(2)), (LPARAM) SvIV(ST(1))); else RETVAL = SendMessage(handle, TBM_SETSELEND, 1, (LPARAM) SvIV(ST(1))); Index: Toolbar.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Toolbar.xs,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Toolbar.xs 26 Jun 2005 16:41:00 -0000 1.5 --- Toolbar.xs 16 Mar 2006 08:57:48 -0000 1.6 *************** *** 10,14 **** #include "GUI.h" ! void Toolbar_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { --- 10,35 ---- #include "GUI.h" ! typedef struct tagPERLWIN32GUI_NMTBCUSTOMDRAW { ! NMCUSTOMDRAW nmcd; [...1062 lines suppressed...] + if ((tempsv = av_fetch(array, 3)) && SvIOK(*tempsv)) + lpCD->rcText.bottom = SvIV(*tempsv); + if (SvROK(ST(0))) + hv_store_mg(NOTXSCALL hv, "-textrect", 9, newRV_inc(SvRV(ST(1))), 0); + } else { + AV* rect = newAV(); + av_push(rect, newSViv(lpCD->rcText.left)); + av_push(rect, newSViv(lpCD->rcText.top)); + av_push(rect, newSViv(lpCD->rcText.right)); + av_push(rect, newSViv(lpCD->rcText.bottom)); + RETVAL = newRV((SV *)rect), 0); + } + #else + MessageBox(NULL, "Unsupported member -textrect. Requires Comctl32.dll version 6.\r\nComctl32.dll version 6 is not redistributable but it is included in Microsoft Windows XP or later", + "Win32::GUI::Toolbar::CustomDraw", + MB_ICONERROR | MB_OKCANCEL); + RETVAL = &PL_sv_undef; + #endif + OUTPUT: + RETVAL Index: TreeView.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/TreeView.xs,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** TreeView.xs 8 May 2004 17:32:41 -0000 1.5 --- TreeView.xs 16 Mar 2006 08:57:48 -0000 1.6 *************** *** 10,14 **** #include "GUI.h" ! void TreeView_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { --- 10,23 ---- #include "GUI.h" ! typedef struct tagPERLWIN32GUI_NMTVCUSTOMDRAWINFO { ! PERLWIN32GUI_NMCUSTOMDRAW nmcd; ! COLORREF clrText; ! COLORREF clrTextBk; ! #if (_WIN32_IE >= 0x0400) ! int iLevel; ! #endif ! } PERLWIN32GUI_NMTVCUSTOMDRAW, *LPPERLWIN32GUI_NMTVCUSTOMDRAW; ! ! void TreeView_onPreCreate(NOTXSPROC LPPERLWIN32GUI_CREATESTRUCT perlcs) { *************** *** 22,31 **** BOOL retval = TRUE; ! if(strcmp(option, "-imagelist") == 0) { perlcs->hImageList = (HIMAGELIST) handle_From(NOTXSCALL value); } else if(strcmp(option, "-tooltip") == 0) { perlcs->hTooltip = (HWND) handle_From(NOTXSCALL value); ! SwitchBit(perlcs->cs.style, TVS_NOTOOLTIPS, 0); } else if BitmaskOptionValue("-lines", perlcs->cs.style, TVS_HASLINES) } else if BitmaskOptionValue("-rootlines", perlcs->cs.style, TVS_LINESATROOT) --- 31,40 ---- BOOL retval = TRUE; ! if(strcmp(option, "-imagelist") == 0) { perlcs->hImageList = (HIMAGELIST) handle_From(NOTXSCALL value); } else if(strcmp(option, "-tooltip") == 0) { perlcs->hTooltip = (HWND) handle_From(NOTXSCALL value); ! SwitchBit(perlcs->cs.style, TVS_NOTOOLTIPS, 0); } else if BitmaskOptionValue("-lines", perlcs->cs.style, TVS_HASLINES) } else if BitmaskOptionValue("-rootlines", perlcs->cs.style, TVS_LINESATROOT) *************** *** 52,57 **** if(perlcs->hImageList != NULL) TreeView_SetImageList(myhandle, perlcs->hImageList, TVSIL_NORMAL); ! ! if (perlcs->hTooltip != NULL) TreeView_SetToolTips (myhandle, perlcs->hTooltip); --- 61,66 ---- if(perlcs->hImageList != NULL) TreeView_SetImageList(myhandle, perlcs->hImageList, TVSIL_NORMAL); ! ! if (perlcs->hTooltip != NULL) TreeView_SetToolTips (myhandle, perlcs->hTooltip); *************** *** 80,83 **** --- 89,93 ---- else if Parse_Event("EndLabelEdit", PERLWIN32GUI_NEM_CONTROL7) else if Parse_Event("KeyDown", PERLWIN32GUI_NEM_KEYDOWN) + else if Parse_Event("CustomDraw", PERLWIN32GUI_NEM_PAINT) else retval = FALSE; *************** *** 90,99 **** int PerlResult = 1; TV_ITEM *pItem; ! if ( uMsg == WM_NOTIFY ) { LPNM_TREEVIEW tv_notify = (LPNM_TREEVIEW) lParam; switch(tv_notify->hdr.code) { ! case TVN_BEGINLABELEDIT: /* --- 100,109 ---- int PerlResult = 1; TV_ITEM *pItem; ! if ( uMsg == WM_NOTIFY ) { LPNM_TREEVIEW tv_notify = (LPNM_TREEVIEW) lParam; switch(tv_notify->hdr.code) { ! case TVN_BEGINLABELEDIT: /* *************** *** 104,113 **** * For a treeview to receive this event, -editlabels need to be set to true. * (@)APPLIES_TO:TreeView ! */ pItem = &((TV_DISPINFO*)lParam)->item; PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL6, "BeginLabelEdit", PERLWIN32GUI_ARGTYPE_LONG, (LONG) pItem->hItem, -1); ! // Force result if event is handle if (perlud->dwPlStyle & PERLWIN32GUI_EVENTHANDLING) { --- 114,123 ---- * For a treeview to receive this event, -editlabels need to be set to true. * (@)APPLIES_TO:TreeView ! */ pItem = &((TV_DISPINFO*)lParam)->item; PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL6, "BeginLabelEdit", PERLWIN32GUI_ARGTYPE_LONG, (LONG) pItem->hItem, -1); ! // Force result if event is handle if (perlud->dwPlStyle & PERLWIN32GUI_EVENTHANDLING) { *************** *** 117,125 **** break; ! case TVN_ENDLABELEDIT: /* * (@)EVENT:EndLabelEdit(NODE,TEXT) * Sent when the user has finished editing a label in the TreeView control. ! * You have explicitly set the text of the node to reflect the new changes. * If the user cancels the edit, the text is undef. * (@)APPLIES_TO:TreeView --- 127,135 ---- break; ! case TVN_ENDLABELEDIT: /* * (@)EVENT:EndLabelEdit(NODE,TEXT) * Sent when the user has finished editing a label in the TreeView control. ! * You have explicitly set the text of the node to reflect the new changes. * If the user cancels the edit, the text is undef. * (@)APPLIES_TO:TreeView *************** *** 135,143 **** PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL7, "EndLabelEdit", PERLWIN32GUI_ARGTYPE_LONG, (LONG) pItem->hItem, ! -1); } ! break; ! case TVN_SELCHANGED: /* --- 145,153 ---- PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL7, "EndLabelEdit", PERLWIN32GUI_ARGTYPE_LONG, (LONG) pItem->hItem, ! -1); } ! break; ! case TVN_SELCHANGED: /* *************** *** 204,213 **** if (perlud->dwPlStyle & PERLWIN32GUI_EVENTHANDLING) { perlud->forceResult = (PerlResult == 0 ? TRUE : FALSE); ! PerlResult = 0; // MsgLoop return ForceResult } break; case TVN_KEYDOWN: ! /* * (@)EVENT:KeyDown(KEY) --- 214,223 ---- if (perlud->dwPlStyle & PERLWIN32GUI_EVENTHANDLING) { perlud->forceResult = (PerlResult == 0 ? TRUE : FALSE); ! PerlResult = 0; // MsgLoop return ForceResult } break; case TVN_KEYDOWN: ! { /* * (@)EVENT:KeyDown(KEY) *************** *** 221,227 **** PERLWIN32GUI_ARGTYPE_LONG, (LONG) tv_keydown->wVKey, -1); ! break; ! } } --- 231,258 ---- PERLWIN32GUI_ARGTYPE_LONG, (LONG) tv_keydown->wVKey, -1); + } + break; ! case NM_CUSTOMDRAW: ! { ! LPPERLWIN32GUI_NMTVCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMTVCUSTOMDRAW) lParam; ! SV *obj = CreateNMCustomDraw(NOTXSCALL "Win32::GUI::TreeView::CustomDraw", lpCD); ! HV *hv = (HV *)SvRV(obj); ! hv_store_mg(NOTXSCALL hv, "-clrtext", 8, newSVuv((DWORD) lpCD->clrText), 0); ! hv_store_mg(NOTXSCALL hv, "-clrtextbk", 10, newSVuv((DWORD) lpCD->clrTextBk), 0); ! #if (_WIN32_IE >= 0x0400) ! hv_store_mg(NOTXSCALL hv, "-level", 6, newSViv(lpCD->iLevel), 0); ! #endif ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_PAINT, "CustomDraw", ! PERLWIN32GUI_ARGTYPE_SV, obj, ! -1); ! #ifdef PERLWIN32GUI_STRONGDEBUG ! printf("XS(CreateNMCustomDraw %s) => %d\n", class_name, PerlResult); ! #endif ! perlud->forceResult = PerlResult; ! PerlResult = 0; /* MsgLoop return ForceResult */ ! } ! break; ! } } *************** *** 236,240 **** - ########################################################################### # (@)METHOD:CreateDragImage(NODE) --- 267,270 ---- *************** *** 289,294 **** ########################################################################### # (@)METHOD:EndEditLabelNow([FLAG_CANCEL=TRUE]) ! # Ends the editing of a tree view item's label. ! BOOL EndEditLabelNow(handle,flag=TRUE) HWND handle --- 319,324 ---- ########################################################################### # (@)METHOD:EndEditLabelNow([FLAG_CANCEL=TRUE]) ! # Ends the editing of a tree view item's label. ! BOOL EndEditLabelNow(handle,flag=TRUE) HWND handle *************** *** 385,389 **** ########################################################################### # (@)METHOD:GetFirstVisible() ! # Retrieves the first visible item in a TreeView. HTREEITEM GetFirstVisible(handle) --- 415,419 ---- ########################################################################### # (@)METHOD:GetFirstVisible() ! # Retrieves the first visible item in a TreeView. HTREEITEM GetFirstVisible(handle) *************** *** 397,401 **** # (@)METHOD:GetImageList([TYPE=TVSIL_NORMAL]) # Retrieves the handle to the normal or state image list associated with a TreeView. ! # B<TYPE> = TVSIL_NORMAL | TVSIL_STATE HIMAGELIST GetImageList(handle,type=TVSIL_NORMAL ) --- 427,431 ---- # (@)METHOD:GetImageList([TYPE=TVSIL_NORMAL]) # Retrieves the handle to the normal or state image list associated with a TreeView. ! # B<TYPE> = TVSIL_NORMAL | TVSIL_STATE HIMAGELIST GetImageList(handle,type=TVSIL_NORMAL ) *************** *** 409,413 **** ########################################################################### # (@)METHOD:GetIndent() ! # Retrieves the amount, in pixels, that child items are indented relative to their parent items. UINT GetIndent(handle) --- 439,443 ---- ########################################################################### # (@)METHOD:GetIndent() ! # Retrieves the amount, in pixels, that child items are indented relative to their parent items. UINT GetIndent(handle) *************** *** 501,505 **** # (@)METHOD:GetItemRect(NODE,[FLAG=FALSE]) # Retrieves the bounding rectangle for a tree view item and indicates whether the item is visible. ! # If B<FLAG> is TRUE, the bounding rectangle includes only the text of the item. Otherwise, it includes the entire line that the item occupies in the tree view control. void GetItemRect(handle,item,flag=FALSE) --- 531,535 ---- # (@)METHOD:GetItemRect(NODE,[FLAG=FALSE]) # Retrieves the bounding rectangle for a tree view item and indicates whether the item is visible. ! # If B<FLAG> is TRUE, the bounding rectangle includes only the text of the item. Otherwise, it includes the entire line that the item occupies in the tree view control. void GetItemRect(handle,item,flag=FALSE) *************** *** 523,527 **** ########################################################################### # (@)METHOD:GetLastVisible() ! # Retrieves the last expanded item in a tree view control. HTREEITEM GetLastVisible(handle) --- 553,557 ---- ########################################################################### # (@)METHOD:GetLastVisible() ! # Retrieves the last expanded item in a tree view control. HTREEITEM GetLastVisible(handle) *************** *** 536,548 **** # Retrieves the tree view item that bears the specified relationship to a specified item. # ! # B<FLAG> specifying the item to retrieve : # TVGN_CARET = Retrieves the currently selected item. ! # TVGN_CHILD = Retrieves the first child item of the item specified by the hitem parameter. # TVGN_DROPHILITE = Retrieves the item that is the target of a drag-and-drop operation. ! # TVGN_FIRSTVISIBLE = Retrieves the first visible item. # TVGN_NEXT = Retrieves the next sibling item. # TVGN_NEXTVISIBLE = Retrieves the next visible item that follows the specified item. The specified item must be visible. ! # TVGN_PARENT = Retrieves the parent of the specified item. ! # TVGN_PREVIOUS = Retrieves the previous sibling item. # TVGN_PREVIOUSVISIBLE = Retrieves the first visible item that precedes the specified item. The specified item must be visible. # TVGN_ROOT = Retrieves the topmost or very first item of the tree view control. --- 566,578 ---- # Retrieves the tree view item that bears the specified relationship to a specified item. # ! # B<FLAG> specifying the item to retrieve : # TVGN_CARET = Retrieves the currently selected item. ! # TVGN_CHILD = Retrieves the first child item of the item specified by the hitem parameter. # TVGN_DROPHILITE = Retrieves the item that is the target of a drag-and-drop operation. ! # TVGN_FIRSTVISIBLE = Retrieves the first visible item. # TVGN_NEXT = Retrieves the next sibling item. # TVGN_NEXTVISIBLE = Retrieves the next visible item that follows the specified item. The specified item must be visible. ! # TVGN_PARENT = Retrieves the parent of the specified item. ! # TVGN_PREVIOUS = Retrieves the previous sibling item. # TVGN_PREVIOUSVISIBLE = Retrieves the first visible item that precedes the specified item. The specified item must be visible. # TVGN_ROOT = Retrieves the topmost or very first item of the tree view control. *************** *** 823,832 **** ########################################################################### # (@)METHOD:Select(NODE, [FLAG=TVGN_CARET]) ! # Selects the given B<NODE >in the TreeView. # If B<NODE> is 0 (zero), the selected item, if any, is deselected. # # Optional B<FLAG> parameter ! # TVGN_CARET = Sets the selection to the given item. ! # TVGN_DROPHILITE = Redraws the given item in the style used to indicate the target of a drag-and-drop operation. # TVGN_FIRSTVISIBLE = Ensures that the specified item is visible, and, if possible, displays it at the top of the control's window. BOOL --- 853,862 ---- ########################################################################### # (@)METHOD:Select(NODE, [FLAG=TVGN_CARET]) ! # Selects the given B<NODE >in the TreeView. # If B<NODE> is 0 (zero), the selected item, if any, is deselected. # # Optional B<FLAG> parameter ! # TVGN_CARET = Sets the selection to the given item. ! # TVGN_DROPHILITE = Redraws the given item in the style used to indicate the target of a drag-and-drop operation. # TVGN_FIRSTVISIBLE = Ensures that the specified item is visible, and, if possible, displays it at the top of the control's window. BOOL *************** *** 1020,1024 **** ########################################################################### # (@)METHOD:SetScrollTime(TIME) ! # Sets the maximum scroll time for the tree view control. int SetScrollTime(handle,time) --- 1050,1054 ---- ########################################################################### # (@)METHOD:SetScrollTime(TIME) ! # Sets the maximum scroll time for the tree view control. int SetScrollTime(handle,time) *************** *** 1056,1060 **** ########################################################################### # (@)METHOD:SetUnicodeFormat(FLAG) ! # Sets the UNICODE character format flag for the control. BOOL SetUnicodeFormat(handle,flag) --- 1086,1090 ---- ########################################################################### # (@)METHOD:SetUnicodeFormat(FLAG) ! # Sets the UNICODE character format flag for the control. BOOL SetUnicodeFormat(handle,flag) *************** *** 1210,1211 **** --- 1240,1302 ---- RETVAL + + MODULE = Win32::GUI::TreeView PACKAGE = Win32::GUI::TreeView::CustomDraw + + PROTOTYPES: DISABLE + + ########################################################################### + # (@)PACKAGE:Win32::GUI::TreeView::CustomDraw + + #pragma message( "*** PACKAGE Win32::GUI::TreeView::CustomDraw..." ) + + ########################################################################### + # (@)METHOD:TextColor([COLOR]) + # Set or Get the CustomDraw -clrtext property. + # + # COLOR may be either a numerical value, + # or a color expressed as [RR, GG, BB], + # or a color expressed in HTML notation (#RRGGBB) + SV * + TextColor(handle,color=FALSE) + HWND handle + COLORREF color + PREINIT: + HV* hv = (HV*)SvRV(ST(0)); + CODE: + LPPERLWIN32GUI_NMTVCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMTVCUSTOMDRAW) handle; + if (items == 2) { + RETVAL = newSViv(color); + if(SvROK(ST(0))) + hv_store_mg(NOTXSCALL hv, "-clrtext", 8, RETVAL, 0); + lpCD->clrText = color; + } else { + RETVAL = newSViv(lpCD->clrText); + } + OUTPUT: + RETVAL + + ########################################################################### + # (@)METHOD:BackColor([COLOR]) + # Set or Get the CustomDraw -clrtextbk property. + # + # COLOR may be either a numerical value, + # or a color expressed as [RR, GG, BB], + # or a color expressed in HTML notation (#RRGGBB) + SV * + BackColor(handle,color=FALSE) + HWND handle + COLORREF color + PREINIT: + HV* hv = (HV*)SvRV(ST(0)); + CODE: + LPPERLWIN32GUI_NMTVCUSTOMDRAW lpCD = (LPPERLWIN32GUI_NMTVCUSTOMDRAW) handle; + if (items == 2) { + RETVAL = newSViv(color); + if(SvROK(ST(0))) + hv_store_mg(NOTXSCALL hv, "-clrtextbk", 10, RETVAL, 0); + lpCD->clrTextBk = color; + } else { + RETVAL = newSViv(lpCD->clrTextBk); + } + OUTPUT: + RETVAL Index: GUI_Options.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Options.cpp,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** GUI_Options.cpp 11 Jan 2006 21:26:16 -0000 1.10 --- GUI_Options.cpp 16 Mar 2006 08:57:48 -0000 1.11 *************** *** 856,860 **** I32 items, int from_i, ! NOTIFYICONDATA *nid) { int i, next_i; --- 856,861 ---- I32 items, int from_i, ! NOTIFYICONDATA *nid) ! { int i, next_i; *************** *** 928,931 **** --- 929,935 ---- ParseNEMNotifyIconEvent( NOTXSCALL hvEvents, option+3, ST(next_i) ); + } else if(version < 5) { + ; + #if (_WIN32_IE > 0x0501) } else if(strcmp(option, "-behaviour") == 0) { next_i = i + 1; *************** *** 960,963 **** --- 964,968 ---- W32G_WARN("Win32::GUI: Invalid value for -balloon_icon!"); } + #endif } } else { Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/MANIFEST,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** MANIFEST 11 Jan 2006 21:26:16 -0000 1.12 --- MANIFEST 16 Mar 2006 08:57:48 -0000 1.13 *************** *** 12,15 **** --- 12,16 ---- Button.xs CHANGELOG + CustomDraw.pm Combobox.xs cygwin.c *************** *** 79,82 **** --- 80,84 ---- samples/Animation.pl samples/BitmapScroll.pl + samples/CustomDraw.pl samples/DateTime.pl samples/Draw.pl *************** *** 85,88 **** --- 87,91 ---- samples/guiperl.ico samples/harrow.cur + samples/Listbox.pl samples/listview_drag_drop.pl samples/MDI.pl *************** *** 90,93 **** --- 93,99 ---- samples/Notepad.pl samples/NotifyIcon.pl + samples/pmx.pl + samples/pride.pl + samples/ProgressBar.pl samples/Region.pl samples/SplashScreen.pl *************** *** 108,111 **** --- 114,118 ---- samples/Tutorial_Part5_twoWindows.pl samples/Tutorial_Part9_noDosWindow.pl + samples/winppm.pl Splitter.xs StatusBar.xs *************** *** 128,131 **** --- 135,139 ---- t/06_Cursor.t t/06_Icon.t + t/07_CustomDraw.t t/50_Font_GetMetrics.t t/50_Richedit_GetCharFormat.t Index: GUI_MessageLoops.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_MessageLoops.cpp,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** GUI_MessageLoops.cpp 11 Jan 2006 21:26:16 -0000 1.17 --- GUI_MessageLoops.cpp 16 Mar 2006 08:57:48 -0000 1.18 *************** *** 170,180 **** } } - #ifdef PERLWIN32GUI_STRONGDEBUG - printf("!XS(CommonMsgLoop) returning DefWindowProc\n"); - #endif if (wndprocOriginal != NULL) { return CallWindowProc((WNDPROC_CAST) wndprocOriginal, hwnd, uMsg, wParam, lParam); } else { return DefWindowProc(hwnd, uMsg, wParam, lParam); } --- 170,183 ---- } } if (wndprocOriginal != NULL) { + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("!XS(CommonMsgLoop) returning CallWindowProc 0x%x\n", wndprocOriginal); + #endif return CallWindowProc((WNDPROC_CAST) wndprocOriginal, hwnd, uMsg, wParam, lParam); } else { + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("!XS(CommonMsgLoop) returning DefWindowProc\n"); + #endif return DefWindowProc(hwnd, uMsg, wParam, lParam); } *************** *** 323,328 **** --- 326,340 ---- PerlResult = DoEvent(NOTXSCALL childud, PERLWIN32GUI_NEM_LOSTFOCUS, "LostFocus", -1 ); break; + + /*case NM_CUSTOMDRAW: + PerlResult = DoEvent(NOTXSCALL childud, PERLWIN32GUI_NEM_PAINT, "CustomDraw", -1 ); + childud->forceResult = PerlResult; + break;*/ + default : PerlResult = OnEvent[childud->iClass](NOTXSCALL childud, uMsg, wParam, lParam); + #ifdef PERLWIN32GUI_STRONGDEBUG + printf("XS(WindowMsgLoop WM_NOTIFY default) (class=%d) => %d\n", childud->iClass, PerlResult); + #endif break; } *************** *** 627,637 **** case WM_DROPFILES: /* ! * (@)EVENT:DropFiles(DROP_HANDLE) * Sent when the window receives dropped files. ! * (@)APPLIES_TO:* */ ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_DROPFILE, "DropFiles", ! PERLWIN32GUI_ARGTYPE_LONG, (LONG) wParam, ! -1); break; } --- 639,658 ---- case WM_DROPFILES: /* ! * (@)EVENT:DropFiles(DRAGDROP) ! * (@)APPLIES_TO:Window, DialogBox ! * * Sent when the window receives dropped files. ! * ! * DRAGDROP - L<DragDrop|Win32::GUI::DragDrop> object. ! * */ ! ! #ifdef PERLWIN32GUI_STRONGDEBUG ! printf("XS(WindowMsgLoop DropFiles) (HDROP=0x%x)\n", wParam); ! #endif ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_DROPFILE, "DropFiles", ! PERLWIN32GUI_ARGTYPE_SV, ! CreateObjectWithHandle(NOTXSCALL "Win32::GUI::DragDrop", (HWND) wParam), ! -1 ); break; } *************** *** 966,972 **** break; case WM_DROPFILES: ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_DROPFILE, "DropFiles", ! PERLWIN32GUI_ARGTYPE_LONG, (LONG) wParam, ! -1); } --- 987,994 ---- break; case WM_DROPFILES: ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_DROPFILE, "DropFiles", ! PERLWIN32GUI_ARGTYPE_SV, ! CreateObjectWithHandle(NOTXSCALL "Win32::GUI::DragDrop", (HWND) wParam), ! -1 ); } Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.70 retrieving revision 1.71 diff -C2 -d -r1.70 -r1.71 *** CHANGELOG 11 Jan 2006 21:26:14 -0000 1.70 --- CHANGELOG 16 Mar 2006 08:57:42 -0000 1.71 *************** *** 6,9 **** --- 6,32 ---- Win32-GUI ChangeLog =================== + + [Reini Urban] : 15 Mar 2006 + - GUI.pm : Change version to 1.04, add -dropfiles to Window + - GUI.h : add CustomDraw and DropFiles support, + start with thread safe static data definitions. + - Button.xs, Header.xs, ListView.xs, Rebar.xs, Toolbar.xs, Tooltip.xs, TreeView.xs: + add CustomDraw EVENT with Win32::GUI::Button::CustomDraw object as param. + abuse the PAINT constant for NEM, which should not conflict. + - CustomDraw.pm : CustomDraw package definition and helpers + - GUI.xs : DoEvents(hwnd=NULL,wMsgFilterMin=0,wMsgFilterMax=0,wRemoveMsg=PM_REMOVE), + Try additional OEM ressource in LoadImage, + Add Win32::GUI::DragDrop object which is passed to the DropFiles event as argument. + - GUI_Helpers.cpp: add SV* CreateNMCustomDraw() + - GUI_MessageLoops.cpp : Change DropFiles EVENT to pass the Win32::GUI::DragDrop object + - ImageList.xs: Add to documention. + - TYPEMAP: Add HDROP as first-class citizen (Win32::GUI::DragDrop) + - Window.xs: support -dropfiles property, store it onPostCreate in perlcs + - SrcParser.pm, Documentation.txt: fix some typos + - t/07_CustomDraw.t: added + - samples/CustomDraw.pl: added + - guard against Win32::GetFileVersion for older perls + - guard against undefined NOTIFYICONDATA for older compilers also (<= MSVC98) + - Upped version to 1.03_03 + + [Robert May] : 11 Jan 2006 - bug fixes and add balloon tips for Notify Icon - Label.xs correct -truncate option processing, as SS_.*ELLIPSIS.* Index: ImageList.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/ImageList.xs,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** ImageList.xs 5 Oct 2005 22:20:49 -0000 1.7 --- ImageList.xs 16 Mar 2006 08:57:48 -0000 1.8 *************** *** 48,52 **** ########################################################################### # (@)METHOD:BeginDrag(INDEX, X, Y) ! # Creates a temporary image list that is used for dragging. BOOL BeginDrag(handle, index, x, y) --- 48,52 ---- ########################################################################### # (@)METHOD:BeginDrag(INDEX, X, Y) ! # Creates a temporary image list that is used for dragging. BOOL BeginDrag(handle, index, x, y) *************** *** 212,216 **** ########################################################################### # (@)METHOD:GetBkColor() ! # Retrieves the current background color for an image list. COLORREF GetBkColor(handle) --- 212,216 ---- ########################################################################### # (@)METHOD:GetBkColor() ! # Retrieves the current background color for an image list. COLORREF GetBkColor(handle) *************** *** 231,235 **** PREINIT: HICON hicon; ! PPCODE: hicon = ImageList_GetIcon(handle, index, flags); if (hicon == NULL) XSRETURN_UNDEF; --- 231,235 ---- PREINIT: HICON hicon; ! PPCODE: hicon = ImageList_GetIcon(handle, index, flags); if (hicon == NULL) XSRETURN_UNDEF; *************** *** 280,284 **** int cx UINT uFlags ! UINT uType COLORREF crMask HINSTANCE hi --- 280,284 ---- int cx UINT uFlags ! UINT uType COLORREF crMask HINSTANCE hi *************** *** 298,305 **** XPUSHs(CreateObjectWithHandle(NOTXSCALL "Win32::GUI::ImageList", (HWND) handle)); XSRETURN(1); ! ########################################################################### # (@)METHOD:Merge(INDEX1,INDEX2, DX,DY,[IMAGELIST=SELF]) ! # Creates a new image by combining two existing images. The function also creates a new image list in which to store the image. # Return a new Win32::GUI::ImageList object. void --- 298,305 ---- XPUSHs(CreateObjectWithHandle(NOTXSCALL "Win32::GUI::ImageList", (HWND) handle)); XSRETURN(1); ! ########################################################################### # (@)METHOD:Merge(INDEX1,INDEX2, DX,DY,[IMAGELIST=SELF]) ! # Creates a new image by combining two existing images. The function also creates a new image list in which to store the image. # Return a new Win32::GUI::ImageList object. void *************** *** 317,321 **** if (hnew == NULL) XSRETURN_UNDEF; XPUSHs(CreateObjectWithHandle(NOTXSCALL "Win32::GUI::ImageList", (HWND) hnew)); ! XSRETURN(1); # TODO : ImageList_Read --- 317,321 ---- if (hnew == NULL) XSRETURN_UNDEF; XPUSHs(CreateObjectWithHandle(NOTXSCALL "Win32::GUI::ImageList", (HWND) hnew)); ! XSRETURN(1); # TODO : ImageList_Read *************** *** 364,368 **** ##############################... [truncated message content] |
|
From: jw <jw...@us...> - 2006-03-16 08:57:58
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/t Modified Files: 01_basic.t 98_Pod.t Added Files: 07_CustomDraw.t Log Message: Reini Urban changes Index: 01_basic.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/01_basic.t,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** 01_basic.t 21 Nov 2005 22:33:34 -0000 1.3 --- 01_basic.t 16 Mar 2006 08:57:49 -0000 1.4 *************** *** 1,3 **** ! #!perl -wT # Win32::GUI test suite. # $Id$ --- 1,3 ---- ! #!perl -w # Win32::GUI test suite. # $Id$ --- NEW FILE: 07_CustomDraw.t --- #!perl -wT # Win32::GUI test suite. # $Id: 07_CustomDraw.t,v 1.1 2006/03/16 08:57:49 jwgui Exp $ # # Test most CustomDraw events, objects, methods and properties. # By Reini Urban. use strict; use warnings; BEGIN { $| = 1 } # Autoflush$win use Test::More qw/no_plan/; use Win32::GUI; use Win32::GUI::CustomDraw; # import the methods and constants sub CLR_WHITE {0xFFFFFF}; sub CLR_BLACK {0x000000}; sub CLR_GREY {0x888888}; # my @Controls = qw/ListView Toolbar Header Button Rebar Tooltip TrackBar TreeView/; # my @FullControls = qw/Header ListView Rebar Trackbar TreeView Tooltip/; my @ItemDraw = qw/ListView TreeView/; my @SubItemDraw = qw/ListView TreeView/; my $W = new Win32::GUI::Window( -name => "TestWindow", -pos => [ 0, 0], -size => [800, 600], -text => "TestWindow", ); for my $ctrl (@ItemDraw) { my $method = "Add$ctrl"; my $name = "$ctrl"; my $populate = $ctrl."_Populate"; my $C = $W->$method(-name => $name, -onCustomDraw => \&FullControl_ItemDraw, -width => $W->ScaleWidth, -height => $W->ScaleHeight); { no strict 'refs'; &$populate(); } $C->DESTROY(); } for my $ctrl (@SubItemDraw) { my $method = "Add$ctrl"; my $name = "$ctrl"; my $populate = $ctrl."_Populate"; my $C = $W->$method(-name => $name, -onCustomDraw => \&FullControl_SubItemDraw, -width => $W->ScaleWidth, -height => $W->ScaleHeight); { no strict 'refs'; &$populate(); } $C->DESTROY(); } $W->DESTROY(); sub ListView_Populate { $W->Show(); $W->ListView->InsertItem(-item => 0, -text => "Line 0"); $W->ListView->EnsureVisible(0); $W->ListView->InsertItem(-item => 1, -text => "Line 1"); $W->ListView->InsertItem(-item => 2, -text => "Line 2", -selected => 1); $W->ListView->EnsureVisible(2); $W->Update(); sleep(0.03); $W->DoEvents(); } sub Header_Populate { $W->Show(); $W->Header->InsertItem(-item => 0, -text => "Line 0"); $W->Header->InsertItem(-item => 1, -text => "Line 1"); $W->Header->InsertItem(-item => 2, -text => "Line 2", -selected => 1); $W->Update(); sleep(0.03); $W->DoEvents(); } sub TreeView_Populate { $W->TreeView->InsertItem(-item => 0, -text => "Line 0"); $W->Show(); $W->TreeView->EnsureVisible(0); $W->TreeView->InsertItem(-item => 1, -text => "Line 1", -bold => 1); $W->TreeView->InsertItem(-item => 2, -text => "Line 2", -selected => 1); $W->TreeView->EnsureVisible(2); $W->Update(); sleep(0.03); $W->DoEvents(); } sub FullControl_ItemDraw { my ($win, $ctrl) = @_; is(ref($ctrl), ref($win)."::CustomDraw", "got ".ref($ctrl)); my $drawstage = $ctrl->{-drawstage}; my $item = $ctrl->{-item}; # can_ok(ref($ctrl), qw(STORE Handle WindowFrom Item Rect HDC IdFrom # Code DrawStage ItemState ItemLParam)); is($drawstage, $ctrl->DrawStage(), "AUTOLOAD DrawStage"); is($item, $ctrl->Item(), "AUTOLOAD Item"); return CDRF_NOTIFYITEMDRAW if $drawstage == CDDS_PREPAINT; if ($drawstage == CDDS_ITEMPREPAINT) { my $rect = $ctrl->Rect(); ok(@$rect, "AUTOLOAD Rect"); my $hdc = $ctrl->HDC(); ok($hdc, "AUTOLOAD HDC"); ok($ctrl->ItemState() >= 0, "AUTOLOAD ItemState"); if ($item == 2) { is(($ctrl->ItemState() & CDIS_SELECTED), CDIS_SELECTED); ok(1, "ITEM 2 Selected"); } if ($item) { $ctrl->TextColor(CLR_WHITE); $ctrl->BackColor(CLR_GREY); } else { ok(1, "CDDS_ITEMPREPAINT Item 0"); return CDRF_DODEFAULT; # do nothing on first item } return CDRF_NEWFONT; } return CDRF_DODEFAULT; } sub FullControl_SubItemDraw { my ($win, $ctrl) = @_; isa_ok($ctrl, ref($win)."::CustomDraw"); my $drawstage = $ctrl->{-drawstage}; my $item = $ctrl->{-item}; return CDRF_NOTIFYITEMDRAW if $drawstage == CDDS_PREPAINT; if ($drawstage == CDDS_ITEMPREPAINT) { if ($item) { $ctrl->TextColor(CLR_WHITE); $ctrl->BackColor(CLR_GREY); return CDRF_NEWFONT; } else { ok(1, "CDDS_ITEMPREPAINT 0"); return CDRF_DODEFAULT; # do nothing on first item } } elsif ($drawstage == (CDDS_SUBITEM | CDDS_ITEMPREPAINT)) { if ($ctrl->SubItem() == 0) { $ctrl->TextColor(CLR_GREY); $ctrl->BackColor(CLR_WHITE); ok(1, "CDDS_SUBITEM 0"); return CDRF_NEWFONT; } else { return CDRF_DODEFAULT; } } return CDRF_DODEFAULT; } Index: 98_Pod.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/98_Pod.t,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** 98_Pod.t 21 Nov 2005 22:33:34 -0000 1.1 --- 98_Pod.t 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 3,8 **** # $Id$ - # Testing RichEdit::GetCharFormat() - use strict; use warnings; --- 3,6 ---- |
|
From: jw <jw...@us...> - 2006-03-16 08:57:58
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Reference In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/docs/GUI/Reference Modified Files: Events_event.tpl Packages_package.tpl Log Message: Reini Urban changes Index: Packages_package.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Reference/Packages_package.tpl,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Packages_package.tpl 21 Nov 2005 22:33:34 -0000 1.2 --- Packages_package.tpl 16 Mar 2006 08:57:49 -0000 1.3 *************** *** 1,3 **** =item L<__W32G_PKGNAME__|__W32G_PKGLINK__> - - =for comment $Id$ --- 1 ---- Index: Events_event.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Reference/Events_event.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Events_event.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- Events_event.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head2 __W32G_EVENTNAME__ --- 1,2 ---- |
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/docs Modified Files: Documentation.txt per_package.tpl per_package_event.tpl per_package_event_section.tpl per_package_method.tpl per_package_method_section.tpl Log Message: Reini Urban changes Index: per_package_method.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_method.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** per_package_method.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- per_package_method.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head2 __W32G_METHODNAME__ --- 1,2 ---- Index: per_package.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** per_package.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- per_package.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head1 NAME --- 1,2 ---- Index: per_package_event.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_event.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** per_package_event.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- per_package_event.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head2 __W32G_EVENTTITLE__ --- 1,2 ---- Index: Documentation.txt =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/Documentation.txt,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Documentation.txt 26 Jun 2005 18:03:35 -0000 1.1 --- Documentation.txt 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 98,102 **** * Packages Introduced by a line containing the text: ! (@)PACJAGE: Win32::GUI::PackageName The first comment line, immediately following such a declaration is taken --- 98,102 ---- * Packages Introduced by a line containing the text: ! (@)PACKAGE: Win32::GUI::PackageName The first comment line, immediately following such a declaration is taken *************** *** 147,151 **** If you wish to provide a link to a page from within the text, please use the form: ! L<descrption|Win32::GUI::PackageName> even if this means that your link looks like: L<Win32::GUI::PackageName|Win32::GUI::PackageName> --- 147,151 ---- If you wish to provide a link to a page from within the text, please use the form: ! L<description|Win32::GUI::PackageName> even if this means that your link looks like: L<Win32::GUI::PackageName|Win32::GUI::PackageName> Index: per_package_event_section.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_event_section.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** per_package_event_section.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- per_package_event_section.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head1 EVENTS --- 1,2 ---- Index: per_package_method_section.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/per_package_method_section.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** per_package_method_section.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- per_package_method_section.tpl 16 Mar 2006 08:57:49 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =head1 METHODS --- 1,2 ---- |
|
From: jw <jw...@us...> - 2006-03-16 08:57:54
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/samples In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/samples Added Files: CustomDraw.pl Log Message: Reini Urban changes --- NEW FILE: CustomDraw.pl --- #!perl # CustomDraw example. Reini Urban 2006 use Win32::GUI; use Win32::GUI::CustomDraw; use FindBin; use File::Basename; use POSIX qw(strftime); $NEM = 1; $OLD_CUSTOMDRAW = 0; sub CLR_RED {0x0000FF}; sub CLR_GREEN {0x00FF00}; sub CLR_BLUE {0xFF0000}; sub CLR_WHITE {0xFFFFFF}; sub CLR_BLACK {0x000000}; sub CLR_GREY {0x888888}; $W = new Win32::GUI::Window( -title => "Win32::GUI::CustomDraw test", -left => 100, -top => 100, -width => 400, -height => 650, -name => "W", -dropfiles => 1, ) or print_and_die("new Window"); my @listview_opts = (-name =>'List', -list => 0, -report => 1, -pos => [0, 0], -height => $W->ScaleHeight - 35, -width => $W->ScaleWidth, -fullrowselect => 1, ); push @listview_opts, (-onCustomDraw => \&List_CustomDraw) if $NEM; $List = $W->AddListView(@listview_opts); $List->View(1); $W->AddButton(-name => 'Exit', -text => "Exit", -width => 60); $W->AddStatusBar(-name => 'Status', -text => "", -width => $W->ScaleWidth - 65); my $filewidth = $List->GetStringWidth("typicalfilename.pl") + 5; $List->InsertColumn(-align => 'left', -text => 'File', -subitem => 1, -width => $filewidth); $List->InsertColumn(-align => 'left', -text => 'No', -subitem => 2, -width => 25); $List->InsertColumn(-align => 'left', -text => 'Line', -subitem => 3, -width => $List->Width() - (22 + 25 + $filewidth)); $List->Hook(NM_CUSTOMDRAW, \&List_CustomDraw_Hook) if $OLD_CUSTOMDRAW; $List->SetFocus(); $W->Show; W_Resize(); $List->Clear(); $W->Status->Text("filling list ..."); $W->Status->Update; opendir(DIR, $FindBin::Bin); while (my $file = readdir DIR) { my $path = $FindBin::Bin . "\\" . $file; next unless ((-f $path) and ($path =~ /\.pl$/)); add_file($path, $file); last if $List->Count > 2000; # 2000 max } closedir DIR; $W->Status->Text("Add files with Drag & Drop"); $return = $W->Dialog(); print "Dialog: $return\n"; sub add_file { my ($path, $file) = @_; $file = basename($path) unless $file; open F, "< $path"; $W->Status->Text("reading $file ..."); $W->Status->Update; my $i = 1; while (my $line = <F>) { next if $line =~ /^\s*$/; next if $line =~ /^\s*#/; chomp $line; my $item = $List->Count(); $List->InsertItem(-item => $item, -text => $file); $List->Item($item)->SubItem(1)->Text($i); $List->Item($item)->SubItem(2)->Text(substr($line,0,255)); $List->EnsureVisible($item); last if $i++ > 200; # max 200 lines per file } close F; } sub List_CustomDraw { my ($win, $ctrl) = @_; if ($opts{debug} and !$opts{debug_ctrl}) { $opts{debug_ctrl}++; use Devel::Peek; Dump $win; Dump $ctrl, 20; } my $drawstage = $ctrl->{-drawstage}; my $item = $ctrl->{-item}; if ($drawstage == CDDS_PREPAINT) { return CDRF_NOTIFYITEMDRAW; } elsif ($drawstage == CDDS_ITEMPREPAINT) { my $line = $List->Item($item)->SubItem(2)->Text(); if ($line =~ /^sub\s+/) { # whole line $ctrl->TextColor(CLR_WHITE); $ctrl->BackColor(CLR_GREY); } elsif ($line =~ /^use\s+/) { return CDRF_NOTIFYSUBITEMDRAW; } elsif ($line =~ /die / or $line =~ /croak /) { return CDRF_NOTIFYSUBITEMDRAW; } else { return CDRF_DODEFAULT; } } elsif ($drawstage == (CDDS_ITEMPREPAINT | CDDS_SUBITEM) and ($ctrl->{-subitem} == 2)) { my $line = $List->Item($item)->SubItem(2)->Text(); if ($line =~ /^sub\s+/) { } elsif ($line =~ /^use\s+/) { $ctrl->TextColor(CLR_BLUE); } elsif ($line =~ /die / or $line =~ /croak /) { $ctrl->TextColor(CLR_RED); } else { return CDRF_DODEFAULT; } return CDRF_NEWFONT; } return CDRF_DODEFAULT; } # the old method via Hook sub List_CustomDraw_Hook { my ($object, $wParam, $lParam, $type, $msgcode) = @_; return if $type != WM_NOTIFY; return if $msgcode != NM_CUSTOMDRAW; if ($opts{debug} and !$opts{debug_ctrl}) { $opts{debug_ctrl}++; use Devel::Peek; Dump $win; Dump $ctrl, 20; } my ($drawstage, $item)= unpack("x12Ix20i", unpack("P40", pack("L", $lParam))); if ($drawstage == CDDS_PREPAINT) { return CDRF_NOTIFYITEMDRAW; } elsif ($drawstage == CDDS_ITEMPREPAINT) { my $line = $List->Item($item)->SubItem(2)->Text(); if ($line =~ /^sub\s+/) { # whole line substr($lParam,48,8,pack("II",CLR_WHITE,CLR_GREY)); $object->Result(CDRF_NEWFONT); } elsif ($line =~ /^use\s+/) { $object->Result(CDRF_NOTIFYSUBITEMDRAW); } elsif ($line =~ /die / or $line =~ /croak /) { $object->Result(CDRF_NOTIFYSUBITEMDRAW); } else { $object->Result(CDRF_DODEFAULT); } return 0; } elsif ($drawstage == (CDDS_ITEMPREPAINT | CDDS_SUBITEM) and ($ctrl->{-subitem} == 2)) { my $line = $List->Item($item)->SubItem(2)->Text(); my $clrText; if ($line =~ /^sub\s+/) { } elsif ($line =~ /^use\s+/) { $clrText = pack("II",CLR_BLUE,CLR_WHITE); } elsif ($line =~ /die / or $line =~ /croak /) { $clrText = pack("II",CLR_RED,CLR_WHITE); } else { $object->Result(CDRF_DODEFAULT); return 0; } substr($lParam,48,8,$clrText); $object->Result(CDRF_NEWFONT); return 0; } return 0; } sub print_and_die {use POSIX qw(strftime); my($text) = @_; my $err = Win32::GetLastError(); die "$text: Error $err\n"; } sub W_DropFiles { my $drop = shift; for (@{$drop->DragQueryFiles()}) { add_file($_); } } sub W_Resize { my $dx = $List->Width - $List->ColumnWidth(2); $List->Width($W->ScaleWidth); $List->Height($W->ScaleHeight() - $W->Status->Height); $List->ColumnWidth(2, $List->Width - $dx); $W->Status->Top($W->Height - $W->Status->Height - 2); $W->Exit->Top($W->ScaleHeight - $W->Status->Height - 1); $W->Exit->Left($W->ScaleWidth - 61); $W->Redraw(-1); $W->Exit->Redraw(-1); return 0; } sub Exit_Click { -1 }; |
|
From: jw <jw...@us...> - 2006-03-16 08:57:53
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/build_tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/build_tools Modified Files: SrcParser.pm doPodDocs.pl Log Message: Reini Urban changes Index: doPodDocs.pl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/build_tools/doPodDocs.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** doPodDocs.pl 1 Oct 2005 18:00:40 -0000 1.3 --- doPodDocs.pl 16 Mar 2006 08:57:48 -0000 1.4 *************** *** 41,44 **** --- 41,45 ---- # GUI_MessageLoops.cpp push @files, "$src_dir/GUI_MessageLoops.cpp"; + push @files, "$src_dir/CustomDraw.pm"; # and all the XS files *************** *** 163,167 **** BuildTools::macro_set("EVENTNAME", SrcParser::get_package_event_name($package, $event)); BuildTools::macro_set("EVENTPROTO", SrcParser::get_package_event_prototype($package, $event)); ! BuildTools::macro_set("EVENTDESCR", fix_description( $package, SrcParser::get_package_event_description($package, $event) ) ); --- 164,168 ---- BuildTools::macro_set("EVENTNAME", SrcParser::get_package_event_name($package, $event)); BuildTools::macro_set("EVENTPROTO", SrcParser::get_package_event_prototype($package, $event)); ! BuildTools::macro_set("EVENTDESCR", fix_description( $package, SrcParser::get_package_event_description($package, $event) ) ); Index: SrcParser.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/build_tools/SrcParser.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** SrcParser.pm 3 Aug 2005 21:45:58 -0000 1.2 --- SrcParser.pm 16 Mar 2006 08:57:48 -0000 1.3 *************** *** 163,167 **** $pack = "Win32::GUI::" . $pack unless $pack eq '*'; ! # The same evnet has multiple legitimate definitions in different packages # for the same package: # for example, Terminate() is described in both Window.xs and MDI.xs, --- 163,167 ---- $pack = "Win32::GUI::" . $pack unless $pack eq '*'; ! # The same event has multiple legitimate definitions in different packages # for the same package: # for example, Terminate() is described in both Window.xs and MDI.xs, |
|
From: Robert M. <rob...@us...> - 2006-01-12 22:23:35
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5523 Modified Files: GUI.h Log Message: Add NOTIFYICONDATA_V1_SIZE macro for MinGW Index: GUI.h =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.h,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** GUI.h 11 Jan 2006 21:26:14 -0000 1.24 --- GUI.h 12 Jan 2006 22:23:27 -0000 1.25 *************** *** 780,783 **** --- 780,788 ---- #endif #endif + + #ifndef NOTIFYICONDATA_V1_SIZE + # define NOTIFYICONDATA_V1_SIZE CCSIZEOF_STRUCT(NOTIFYICONDATA, szTip[63]) + #endif + #else #define WNDPROC_CAST FARPROC |
|
From: Robert M. <rob...@us...> - 2006-01-11 21:39:49
|
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 -0000 1.3 --- Part4.pod 11 Jan 2006 21:39:41 -0000 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 |
|
From: Robert M. <rob...@us...> - 2006-01-11 21:26:30
|
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 -0000 1.2 --- Part3.pod 11 Jan 2006 21:26:16 -0000 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. |
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( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } package Test::NotifyIcon; our (@ISA, $x); BEGIN { @ISA = qw(Win32::GUI::NotifyIcon); $x = 0; } sub DESTROY { ++$x; shift->SUPER::DESTROY(); } --- NEW FILE: 05_NotifyIcon_02_Change.t --- #!perl -wT # Win32::GUI test suite. # $Id: 05_NotifyIcon_02_Change.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 => 16; use Win32::GUI(); use Win32::GUI::BitmapInline(); my $icon = geticon(); my $ctrl = "NotifyIcon"; my $class = "Win32::GUI::$ctrl"; # Test the basic Change() method my $W = new Win32::GUI::Window( -name => "TestWindow", ); isa_ok($W, "Win32::GUI::Window", "\$W"); my $C = $W->AddNotifyIcon( -name => "NI", -icon => $icon, -tip => "Win32::GUI NotifyIcon Test", -balloon_tip => "Win32::GUI NotifyIcon Test Balloon Tip", -balloon_title => "Win32::GUI NotifyIcon Title", -balloon_icon => 'error', -balloon_timeout => 20000, ); isa_ok($C,$class, "\$W->AddNotifyIcon creates $class object"); isa_ok($W->NI, $class, "\$W->NI contains a $class object"); is($C, $W->NI, "Parent references $ctrl"); # TODO: how to test the -icon option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -icon option"; fail("Can't test -icon option"); } # TODO: how to test the -tip option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -tip option"; fail("Can't test -tip option"); } is($C->{-balloon_tip}, "Win32::GUI NotifyIcon Test Balloon Tip", "-balloon_tip stored in object"); is($C->{-balloon_title}, "Win32::GUI NotifyIcon Title", "-balloon_title stored in object"); is($C->{-balloon_icon}, "error", "-balloon_icon stored in object"); is($C->{-balloon_timeout}, 20000, "-balloon_timeout stored in object"); ## Change() method tests $C->Change(-icon => 0); # TODO: how to test the -icon option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -icon option"; fail("Don't know if icon has changed"); } $C->Change(-tip => "Changed Tip"); # TODO: how to test the -tip option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -tip option"; fail("Don't know if tip has changed"); } $C->Change(-balloon_tip => "Changed Tip"); is($C->{-balloon_tip}, "Changed Tip", "-balloon_tip has been changed"); $C->Change(-balloon_title => "Changed Title"); is($C->{-balloon_title}, "Changed Title", "-balloon_title has been changed"); $C->Change(-balloon_icon => "none"); is($C->{-balloon_icon}, "none", "-balloon_icon has been changed"); $C->Change(-balloon_timeout => 10000); is($C->{-balloon_timeout}, 10000, "-balloon_timeout has been changed"); ### -- helper functions -- sub geticon { return newIcon Win32::GUI::BitmapInline( q( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } --- NEW FILE: 05_NotifyIcon_05_DESTROY.t --- #!perl -wT # Win32::GUI test suite. # $Id: 05_NotifyIcon_05_DESTROY.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 => 13; use Win32::GUI(); use Win32::GUI::BitmapInline(); my $icon = geticon(); my $ctrl = "NotifyIcon"; my $class = "Test::$ctrl"; # Test DESTRUCTION { 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"); # DESTROY tests is($Test::NotifyIcon::x, 0, "DESTROY not called yet"); undef $C; # should still be a reference from the parent object is($Test::NotifyIcon::x, 0, "DESTROY not called yet"); undef $W; # should reduce ref count to parent to zero, and in turn Timer is($Test::NotifyIcon::x, 1, "DESTROY called when parent destroyed"); } { my $W = new Win32::GUI::Window( -name => "TestWindow", ); my $C = Test::NotifyIcon->new( $W, -name => "NI", -icon => $icon ); my $id = $C->{-id}; ok(defined $W->{-notifyicons}->{$id}, "Timer's id is stored in parent"); is($C, $W->NI, "Reference sotered in Parent"); # DESTROY tests $Test::NotifyIcon::x = 0; is($Test::NotifyIcon::x, 0, "DESTROY not called yet"); undef $C; # should still be a reference from the parent object is($Test::NotifyIcon::x, 0, "DESTROY not called yet"); $W->{NI} = undef; # naughty way to remove timer is($Test::NotifyIcon::x, 1, "DESTROY called when parent reference removed"); ok(!defined $W->{-notifyicons}->{$id}, "DESTROY() tidies parent"); ok(!defined $W->{NI}, "DESTROY() tidies parent"); undef $W; is($Test::NotifyIcon::x, 1, "DESTROY not called when parent destroyed"); } exit(0); ### -- helper functions -- sub geticon { return newIcon Win32::GUI::BitmapInline( q( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } package Test::NotifyIcon; our (@ISA, $x); BEGIN { @ISA = qw(Win32::GUI::NotifyIcon); $x = 0; } sub DESTROY { ++$x; shift->SUPER::DESTROY(); } --- NEW FILE: 05_NotifyIcon_03_OtherMethods.t --- #!perl -wT # Win32::GUI test suite. # $Id: 05_NotifyIcon_03_OtherMethods.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 = "Win32::GUI::$ctrl"; # Test these methods: # SetFocus, SetBehaviour, ShowBalloon, HideBalloon my $W = new Win32::GUI::Window( -name => "TestWindow", ); isa_ok($W, "Win32::GUI::Window", "\$W"); my $C = $W->AddNotifyIcon( -name => "NI", -icon => $icon, -tip => "Win32::GUI NotifyIcon Test", -balloon_tip => "Win32::GUI NotifyIcon Test Balloon Tip", -balloon_title => "Win32::GUI NotifyIcon Title", -balloon_icon => 'error', -balloon_timeout => 20000, ); isa_ok($C,$class, "\$W->AddNotifyIcon creates $class object"); isa_ok($W->NI, $class, "\$W->NI contains a $class object"); is($C, $W->NI, "Parent references $ctrl"); TODO: { local $TODO = q(Win32::GUI::NotifyIcon Don't know how to test $SHELLDLL_VERSION); fail(q(Can't test $SHELLDLL_VERSION)); } ## test methods: ShowBalloon, HideBalloon, SetFocus, SetBehaviour my $result = undef; ## ShowBalloon() $result = $C->ShowBalloon(); if($Win32::GUI::NotifyIcon::SHELLDLL_VERSION < 5) { ok(!defined $result, "ShowBalloon() returns undef for older shell.dll"); } else { TODO: { local $TODO = "Win32::GUI::NotifyIcon don't know how to test ShowBalloon()"; fail("Can't test ShowBalloon"); } } $result = undef; ## HideBalloon() $result = $C->HideBalloon(); if($Win32::GUI::NotifyIcon::SHELLDLL_VERSION < 5) { ok(!defined $result, "HideBalloon() returns undef for older shell.dll"); } else { TODO: { local $TODO = "Win32::GUI::NotifyIcon don't know how to test HideBalloon()"; fail("Can't test HideBalloon"); } } $result = undef; ## SetFocus() $result = $C->SetFocus(); if($Win32::GUI::NotifyIcon::SHELLDLL_VERSION < 5) { ok(!defined $result, "SetFocus() returns undef for older shell.dll"); } else { TODO: { local $TODO = "Win32::GUI::NotifyIcon don't know how to test SetFocus()"; fail("Can't test SetFocus"); } } $result = undef; ## SetBehaviour() $result = $C->SetBehaviour(); if($Win32::GUI::NotifyIcon::SHELLDLL_VERSION < 5) { ok(!defined $result, "SetBehaviour() returns undef for older shell.dll"); } else { TODO: { local $TODO = "Win32::GUI::NotifyIcon don't know how to test SetBehaviour()"; fail("Can't test SetBehaviour"); } } $result = undef; ### -- helper functions -- sub geticon { return newIcon Win32::GUI::BitmapInline( q( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } --- NEW FILE: 05_NotifyIcon_01_Constructor.t --- #!perl -wT # Win32::GUI test suite. # $Id: 05_NotifyIcon_01_Constructor.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 => 15; use Win32::GUI(); use Win32::GUI::BitmapInline(); my $icon = geticon(); my $ctrl = "NotifyIcon"; my $class = "Win32::GUI::$ctrl"; # Test the basic construction my $W = new Win32::GUI::Window( -name => "TestWindow", ); isa_ok($W, "Win32::GUI::Window", "\$W"); my $C = $W->AddNotifyIcon( -name => "NI", -icon => $icon, -tip => "Win32::GUI NotifyIcon Test", -balloon_tip => "Win32::GUI NotifyIcon Test Balloon Tip", -balloon_title => "Win32::GUI NotifyIcon Title", -balloon_icon => 'error', -balloon_timeout => 20000, ); isa_ok($C,$class, "\$W->AddNotifyIcon creates $class object"); isa_ok($W->NI, $class, "\$W->NI contains a $class object"); is($C, $W->NI, "Parent references $ctrl"); 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"); is($C->{-name}, 'NI', "NI's name is stored in timer object"); is($C->{-handle}, $W->{-handle}, "Parent's handle is stored in NI object"); # TODO: how to test the -icon option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -icon option"; fail("Can't test -icon option"); } # TODO: how to test the -tip option? TODO: { local $TODO = "Win32::GUI::NotifyIcon - Don't know how to test -tip option"; fail("Can't test -tip option"); } is($C->{-balloon_tip}, "Win32::GUI NotifyIcon Test Balloon Tip", "-balloon_tip stored in object"); is($C->{-balloon_title}, "Win32::GUI NotifyIcon Title", "-balloon_title stored in object"); is($C->{-balloon_icon}, "error", "-balloon_icon stored in object"); is($C->{-balloon_timeout}, 20000, "-balloon_timeout stored in object"); ### -- helper functions -- sub geticon { return newIcon Win32::GUI::BitmapInline( q( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } |
|
From: Robert M. <rob...@us...> - 2006-01-11 21:26:26
|
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() {0x80000000}; 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"), -left => $col1_ctrl_left, -top => $row1_gb_top + (4 * $padding), -width => $mw->VGB->Width() - (2 * $padding), ); $mw->AddLabel( -name => "VL3", -text => "Notify Icon Tester\t$VERSION", -left => $col1_ctrl_left, -top => $row1_gb_top + (6 * $padding), -width => $mw->VGB->Width() - (2 * $padding), ); my $row1_gb_bottom = $mw->VL3->Top() + $mw->VL3->Height() + $padding; $mw->VGB->Height($row1_gb_bottom - $row1_gb_top); my$row2_gb_top = $row1_gb_bottom + $padding; ###################################################################### # Icon selection group ###################################################################### $mw->AddGroupbox( -name => "IGB", -title => "Tray &Icon", -left => $col1_gb_left, -top => $row2_gb_top, -width => $col1_gb_right - $col1_gb_left, -group => 1, ); $mw->AddCheckbox( -name => "ICB", -text => "Use Default Icon", -left => $col1_ctrl_left, -top => $row2_gb_top + 20, -onClick => \&toggle_icon, -tabstop => 1, ); $mw->AddLabel( -name => "IL", -text => "Placeholder", -truncate => "path", # only Win NT and higher - see update_ui() -left => $col1_ctrl_left, -top => $mw->ICB->Top() + $mw->ICB->Height() + 4, -width => $col1_ctrl_right - $col1_ctrl_left, ); $mw->AddButton( -name => "IB", -text => "Change Icon ...", -top => $row2_gb_top + 20, -onClick => \&change_icon, -tabstop => 1, ); $mw->IB->Left($col1_ctrl_right - $mw->IB->Width()); my $row2_gb_bottom = $mw->IL->Top() + $mw->IL->Height() + $margin; $mw->IGB->Height($row2_gb_bottom - $row2_gb_top); ###################################################################### # Events groupbox ###################################################################### $mw->AddGroupbox( -title => "&Events", -left => $col2_gb_left, -top => $row1_gb_top, -width => $col2_gb_right - $col2_gb_left, -height => $row2_gb_bottom - $row1_gb_top, -group => 1, ); $mw->AddRadioButton( -name => "ERB1", -text => "Win95", -checked => 1, -left => $col2_ctrl_left, -top => $row1_gb_top + 20, -onClick => sub { $cfg{ni}->SetBehaviour(0) if $cfg{ni}; 1;}, -tabstop => 1, -group => 1, ); $mw->AddRadioButton( -name => "ERB2", -text => "Win2k", -left => $col2_ctrl_left + $mw->ERB1->Width() + 4, -top => $row1_gb_top + 20, -onClick => sub { $cfg{ni}->SetBehaviour(1) if $cfg{ni}; 1;}, ); $mw->AddTextfield( -name => "ETF", -multiline => 1, -vscroll => 1, -readonly => 1, -background => 0xFFFFFF, -left => $col2_ctrl_left, -top => $mw->ERB1->Top() + $mw->ERB1->Height() + 4, -width => $col2_ctrl_right - $col2_ctrl_left, -height => $row2_gb_bottom - $margin - ($mw->ERB1->Top() + $mw->ERB1->Height() + 4), -tabstop => 1, -group => 1, ); my$row3gb_top = $row2_gb_bottom + $padding; ###################################################################### # Simple Tooltip groupbox ###################################################################### $mw->AddGroupbox( -name => "TGB", -title => "&Tooltip", -left => $col1_gb_left, -top => $row3gb_top, -width => $col2_gb_right - $col1_gb_left, -group => 1, ); $mw->AddTextfield( -name => "TTF", -text => "Simple Tooltip Text", -prompt => [ "Text", 30 ], -left => $col1_ctrl_left, -top => $row3gb_top + 20, -height => 20, -width => $col2_ctrl_right - $col1_ctrl_left - 30, -onChange => sub { $cfg{ni}->Change(-tip => $_[0]->Text()) if $cfg{ni}; 0;}, -tabstop => 1, ); $mw->TTF->LimitText($cfg{v5} ? 127 : 63); my $row3_gb_bottom = $mw->TTF->Top() + $mw->TTF->Height() + $margin; $mw->TGB->Height($row3_gb_bottom - $row3gb_top); my $row4_gb_top = $row3_gb_bottom + $padding; ###################################################################### # Balloon Tooltip groupbox ###################################################################### $mw->AddGroupbox( -name => "BGB", -title => "&Balloon Tooltip", -left => $col1_gb_left, -top => $row4_gb_top, -width => $col2_gb_right - $col1_gb_left, -group => 1, ); $mw->AddTextfield( -name => "BTF1", -text => "Balloon Title", -prompt => [ "Title", 30 ], -left => $col1_ctrl_left, -top => $row4_gb_top + 20, -width => $col1_gb_right - $col1_ctrl_left + 70, -height => 20, -onChange => sub { change_balloon("title" => $_[0]->Text()); }, -tabstop => 1, ); $mw->BTF1->LimitText(63); $mw->AddTextfield( -name => "BTF2", -text => "Balloon tip text.", -prompt => [ "Body", 30 ], -multiline => 1, -vscroll => 1, -pushstyle => ES_WANTRETURN, -left => $col1_ctrl_left, -top => $mw->BTF1->Top() + $mw->BTF1->Height() + 4, -height => 100, -width => $col1_gb_right - $col1_ctrl_left + 70, -onChange => sub { change_balloon("tip" => $_[0]->Text()); }, -tabstop => 1, ); $mw->BTF2->LimitText(254); my $row4_gb_bottom = $mw->BTF2->Top() + $mw->BTF2->Height() + $margin; $mw->BGB->Height($row4_gb_bottom - $row4_gb_top); $mw->AddTextfield( -name => "BTF3", -text => "10000", -prompt => [ "Timeout", -45 ], -number => 1, -left => $col2_ctrl_right - 65, -top => $row4_gb_top + 20, -height => 20, -width => 45, -onChange => sub { change_balloon("timeout" => $_[0]->Text()); }, -tabstop => 1, ); $mw->BTF3->LimitText(5); $mw->AddLabel( -name => "BL1", -text => "ms", -left => $mw->BTF3->Left() + $mw->BTF3->Width() + 4, -top => $mw->BTF3->Top(), ); $mw->AddLabel( -name => "BL2", -text => "Icon", -left => $mw->BTF3_Prompt->Left(), -top => $mw->BTF3->Top() + $mw->BTF3->Height() + 7, ); $mw->AddCombobox( -name => "BCB", -dropdownlist => 1, -left => $col2_ctrl_right - 65, -top => $mw->BTF3->Top() + $mw->BTF3->Height() + 4, -height => 80, -width => 65, -onChange => sub { change_balloon("icon" => $_[0]->Text()); }, -tabstop => 1, ); $mw->BCB->Add('none', 'info', 'warning', 'error'); $mw->BCB->SetCurSel(0); $mw->AddCheckbox( -name => "BCBB", -text => "Show while editing", -left => $mw->BTF3_Prompt->Left(), -top => $mw->BCB->Top() + $mw->BCB->Height() + 4, -tabstop => 1, ); $mw->AddButton( -name => "BB1", -text => "Show Balloon", -left => $col2_ctrl_right - 81, -top => $row4_gb_bottom - $margin - 4 - (2 * 21), -width => 81, -height => 21, -onClick => sub { $cfg{ni}->ShowBalloon(0),$cfg{ni}->ShowBalloon(1) if $cfg{ni}; 1;}, -tabstop => 1, -group => 1, ); $mw->AddButton( -name => "BB2", -text => "Hide Balloon", -left => $col2_ctrl_right - 81, -top => $row4_gb_bottom - $margin - (1 * 21), -width => 81, -height => 21, -onClick => sub { $cfg{ni}->ShowBalloon(0) if $cfg{ni}; 1;}, -tabstop => 1, ); ###################################################################### # Show/Remove Notify Icon Button ###################################################################### $mw->AddButton( -name => "SB", -top => $row4_gb_bottom + $padding, -size => [110,21], -onClick => \&toggle_ni_state, -tabstop => 1, -group => 1, ); $mw->SB->Left($col2_gb_right - $mw->SB->Width()); my $ncw = $mw->Width() - $mw->ScaleWidth(); my $nch = $mw->Height() - $mw->ScaleHeight(); $mw->Resize($ncw + $col1_width + $col2_width, $nch + $mw->SB->Top() + $mw->SB->Height() + $padding); update_ui(); $mw->Show(); Win32::GUI::Dialog(); $mw->Hide(); exit(0); sub toggle_icon { if($cfg{icon} == $cfg{defaulticon}) { my $icon; $icon = Win32::GUI::Icon->new($cfg{iconfile}) if ($cfg{iconfile}); if($icon) { $cfg{icon} = $icon; } else { $cfg{iconfile} = undef; } } else { $cfg{icon} = $cfg{defaulticon}; } $cfg{ni}->Change(-icon => $cfg{icon}) if $cfg{ni}; update_ui(); return; } sub change_icon { my $win = shift; my $file = Win32::GUI::GetOpenFileName ( -owner => $win, -filter => [ 'Icon files (*.ico)', '*.ico', 'All Files', '*' ], -title => 'Select a new icon', -defaultfilter => 0, -filemustexist => 1, -pathmustexist => 1, ); my $icon; $icon = Win32::GUI::Icon->new($file) if ($file); if($icon) { $cfg{icon} = $icon; $cfg{iconfile} = $file; } else { $win->MessageBox( "$file does not appear to be valid icon format", "Notify Icon Tester error", MB_OK|MB_ICONHAND, ) if $file; } $cfg{ni}->Change(-icon => $cfg{icon}) if $cfg{ni}; update_ui(); return; } sub toggle_ni_state { my $win = $_[0]->GetParent(); if($cfg{ni}) { $cfg{ni}->Remove(); undef $cfg{ni}; } else { $cfg{ni} = $win->AddNotifyIcon( -icon => $cfg{icon}, -tip => $win->TTF->Text(), -balloon => 0, -balloon_tip => $win->BTF2->Text(), -balloon_title => $win->BTF1->Text(), -balloon_timeout => $win->BTF3->Text(), -balloon_icon => $win->BCB->Text(), ); } update_ui(); return; } sub change_balloon { my $item = shift; my $value = shift; if($cfg{ni}) { $cfg{ni}->Change("-balloon_$item" => $value); if($mw->BCBB->Checked()) { $cfg{ni}->ShowBalloon(0); $cfg{ni}->ShowBalloon(1); } } update_ui(); return 0; } sub update_ui { $mw->ICB->Checked($cfg{defaulticon} == $cfg{icon}); $mw->ICB->Enable(defined $cfg{iconfile} || ($cfg{defaulticon} != $cfg{icon})); { my $text = "Icon file: " . ($cfg{iconfile} ? $cfg{iconfile} : " - Not Set -"); if(Win32::GetOSVersion() < 2) { # implement -truncate => 'path' for Win9X/ME my $font = $mw->IL->GetFont(); my $width = $mw->IL->Width(); if(($mw->IL->GetTextExtentPoint32($text,$font))[0] > $width) { my($trunc, $keep); if($text =~ m/^(.*)(\\[^\\]*)$/) { $trunc = $1; $keep = $2; } else { $trunc = ''; $keep = $text; } while(($mw->IL->GetTextExtentPoint32($trunc."...".$keep,$font))[0] > $width) { $trunc = substr($trunc,0,-1), next if length $trunc; $keep = substr($keep,1), next if length $keep; last; # ensure we exit this loop } $text=$trunc."...".$keep; } } $mw->IL->Text($text); } $mw->IL->Enable($cfg{defaulticon} != $cfg{icon}); $mw->ERB1->Enable($cfg{v5}); $mw->ERB2->Enable($cfg{v5}); $mw->BGB->Enable ($cfg{v5}); $mw->BTF1_Prompt->Enable($cfg{v5}); $mw->BTF1->Enable($cfg{v5}); $mw->BTF2_Prompt->Enable($cfg{v5}); $mw->BTF2->Enable($cfg{v5}); $mw->BTF3_Prompt->Enable($cfg{v5}); $mw->BTF3->Enable($cfg{v5}); $mw->BL1->Enable ($cfg{v5}); $mw->BCB->Enable ($cfg{v5} && (length $mw->BTF1->Text() > 0)); $mw->BL2->Enable ($cfg{v5} && (length $mw->BTF1->Text() > 0)); $mw->BCBB->Enable($cfg{v5}); $mw->BB1->Enable ($cfg{v5} && defined($cfg{ni}) && (length $mw->BTF2->Text() > 0)); $mw->BB2->Enable ($cfg{v5} && defined($cfg{ni})); $mw->SB->Text(($cfg{ni} ? "Remove" : "Show") . " Notify Icon"); return; } sub record_event { my ($win, $id, $lParam, $type, $msgcode) = @_; return unless $msgcode == WM_NOTIFYICON; return unless $type == 0; # Event numbers are in lParam # decode event my $event; $event = $event_lookup{$lParam} if exists $event_lookup{$lParam}; $event = "$lParam (unknown)" unless $event; push @{$cfg{events}}, $event; while (@{$cfg{events}} > $cfg{max_events}) { shift @{$cfg{events}} } { my $text=''; for my $e (@{$cfg{events}}) { $text .= "$e\r\n"; } $win->ETF->SetSel(0,-1); $win->ETF->ReplaceSel($text); } return; } sub get_defaulticon { return newIcon Win32::GUI::BitmapInline( q( AAABAAIAICAQAAAAAADoAgAAJgAAACAgAAAAAAAAqAgAAA4DAAAoAAAAIAAAAEAAAAABAAQAAAAA AIACAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwACAgIAA AAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIgAd3AAiIAAAAAAAAAAAAgHgIcACAiAAAAAAAAAAAAI CIiAAAAIAAAAAAAAAAAAAAiIAAAAAAAAAAAAAAAAAIgHiAAAAAAAAAAAAAAAAACIB3cACAAAAAAA AAAAAAAACIB3gAAAAAgAAAAAAAAAAAAIgIiAAAAAAAAAAAAAAAAAAAAAiAiAgAAAAAAAAAAAAAAA AAeIiAAAAAAAAAAAAAAIgIAAiAiAAAAAAAAAAAAAAIdwAACAAAAAAAAAAAAAgAAABwAAAAAAAAAA AAAAAAAICHcAAAAAAAAAAAAAAAAACAB3cHAACIgAAAAAAAAIAAiId3gIAAgHAAAAAAAAAAiAB3d4 AIAABwAAAAAAAId3d3eIiAAAAAgAAAAAh3eHd3dwAAiAAACAAAAACAh3d3d3AAAHeAAAAAAAAAAA iAh3dwCIAAgIeAAAAAAACIiHAHAAh3gAgHAAAAAAAAgACIAACAeIgICAAAAAAAAAAAAAAACIcAiA AAAAAAAAAAAAAAAAAAAIiAAAAAAAAAAAAAAAAIAACIAAAAAAAAAAAAAAAAAIgIAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA/////////////////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///4A////Af///4f///////////8oAAAAIAAAAEAAAAABAAgA AAAAAIAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAMDAwADA 3MAA8MqmANTw/wCx4v8AjtT/AGvG/wBIuP8AJar/AACq/wAAktwAAHq5AABilgAASnMAADJQANTj /wCxx/8Ajqv/AGuP/wBIc/8AJVf/AABV/wAASdwAAD25AAAxlgAAJXMAABlQANTU/wCxsf8Ajo7/ AGtr/wBISP8AJSX/AAAA/gAAANwAAAC5AAAAlgAAAHMAAABQAOPU/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/yUlAP4AAADcAAAAuQAAAJYAAABzAAAAUAAAAP/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+AAAA3AAAALkAAACWAAAAcwAAAFAAANT/4wCx/8cAjv+rAGv/ jwBI/3MAJf9XAAD/VQAA3EkAALk9AACWMQAAcyUAAFAZANT/8ACx/+IAjv/UAGv/xgBI/7gAJf+q AAD/qgAA3JIAALl6AACWYgAAc0oAAFAyANT//wCx//8Ajv//AGv//wBI//8AJf//AAD+/gAA3NwA ALm5AACWlgAAc3MAAFBQAPLy8gDm5uYA2traAM7OzgDCwsIAtra2AKqqqgCenp4AkpKSAIaGhgB6 enoAbm5uAGJiYgBWVlYASkpKAD4+PgAyMjIAJiYmABoaGgAODg4A8Pv/AKSgoACAgIAAAAD/AAD/ AAAA//8A/wAAAP8A/wD//wAA////AOnp6enp6enp6enp6enp6enp6enp6enp6enp6enp6enr5+T/ //////8AAAAA6+sAAAcHBwAAAOvr6///////5Ovn5P///////wAAAOsAB+sA6wcAAADrAOvr//// ///k6+fk////////AAAA6wDr6+vrAAAAAAAA6wD//////+Tr5+T///////8AAAAAAOvr6wAAAAAA AAAAAP//////5Ovn5P///////wAA6+sAB+vrAAAAAAAAAAAA///////k6+fk////////AADr6wAH BwcAAADrAAAAAAD//////+Tr5+T///////8AAADr6wAHB+sAAAAAAAAAAOv/////5Ovn5P////// /wAAAAAA6+sA6+vrAAAAAAAAAP/////k6+fk////////AAAAAAAAAAAAAOvrAOvrAOsA/////+Tr 5+T/////////AAAAAAAAAAAAAAfr6+vrAAAA////5Ovn5P////////8AAAAA6+sA6wAAAOvrAOvr AAD////k6+fk//////////8AAAAA6wcHAAAAAADrAAAAAP///+Tr5+T//////////+sAAAAAAAAH AAAAAAAAAAAA////5Ovn5P///////////wAA6wDrBwcAAAAAAAAAAAD////k6+fk//////////// AADrAAAHBwcABwAAAADr6+v//+Tr5+T/////////6wAAAOvr6wcHB+sA6wAAAOsAB///5Ovn5P// /wAAAAAAAOvrAAAHBwcH6wAA6wAAAAAH///k6+fk////AAAA6wcHBwcHBwfr6+vrAAAAAAAAAOv/ /+Tr5+T//+sHBwfrBwcHBwcHAAAAAOvrAAAAAADr////5Ovn5P/rAOsHBwcHBwcHBwAAAAAABwfr AAAAAP/////k6+fk//8AAOvrAOsHBwcHAADr6wAAAOsA6wfr/////+Tr5+T////r6+vrBwAABwAA AOsHB+sAAOsABwD/////5Ovn5P///+sAAP/r6wAAAADrAAfr6+sA6wDr///////k6+fk//////// //////8AAADr6wcAAOvrAP///////+Tr5+T/////////////////AAAAAAAA6+vr////////5Ovn 5P//////////////////6wAAAADr6//////////k6+fn5+fn5+fn5+fn5+fn5+fn6+sA6+fn5+fn 5+fn5wfr5wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB+vnZxFnZ2dnZ2dnZ2dnZ2dnZ2dn Z2dnZ2dn6+vr6+tn6+dnDmdnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2cH6gfqB2fr5+vr6+vr6+vr6+vr 6+vr6+vr6+vr6+vr6+vr6+vr6+sAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== ) ); } sub get_help_text { my $parser; eval "require Pod::Simple::RTF"; if($@) { eval "require Pod::Simple::Text"; if($@) { return "Pod::Simple required to get help."; } else { $parser = Pod::Simple::Text->new(); } } else { $parser = Pod::Simple::RTF->new(); } my $string; $parser->output_string(\$string); $parser->parse_file($0); return $string; } sub OnAbout { my $win = shift; $win->MessageBox( "Notify Icon Tester v$VERSION\r\n" . "(c) Robert May, 2006", "About Notify Icon Tester", MB_OK, ); } sub OnHelp { my $win; $win = Win32::GUI::Window->new( -title => "Notify Icon Tester Help", -left => CW_USEDEFAULT, -size => [600, 500], -pushstyle => WS_CLIPCHILDREN, -onResize => sub { $_[0]->TEXT->Resize($_[0]->ScaleWidth(), $_[0]->ScaleHeight); 1; }, -onTerminate => sub { undef $win; 0; }, # Closure prevents $win going out of scope # at end of OnHelp(). Ref count to $win forced # to zero on Terminate event. -dialogui => 1, ); # Hidden button that handles ESC char. # Might be better to use an accelerator table # but this is nice and quick $win->AddButton( -visible => 0, -cancel => 1, -onClick => sub { undef $win; 0; }, # See comments above ); $win->AddRichEdit( -name => "TEXT", #-class => "RichEdit20A", -readonly => 1, -background => 0xFFFFFF, -width => $win->ScaleWidth(), -height => $win->ScaleHeight(), -vscroll => 1, -autohscroll => 0, ); $win->TEXT->Text(get_help_text()); $win->Show(); return; } __END__ =head1 NAME Notify Icon Tester =head1 SYNOPSIS C<perl NotifyIcon.pl> =head1 OVERVIEW This program has evolved from a simple utility designed to allow for testing of the Win32::GUI::NotifyIcon functionality into a program showing off some of the features available from Win32::GUI. =head1 VERSIONS This program requires Win32::GUI v1.03_01 or higher, and should run with any 32-bit version of windows (Win95/98/NT/ME/2K/XP). The version of Win32::GUI is displayed in the 'Version Information' panel. Different versions of windows ship with different version of shell32.dll. Some versions of Internet Explorer may update the system version of shell32.dll. The version of shell32.dll installed on your system is displayed in the 'Version Information' panel. Balloon tooltips and some of the notification events are only available with shell32.dll V5.0 and later. Functions that are not available will be disabled in the GUI. =head1 USING =head2 Showing and Removing the tray icon Pressing the bottom-right button 'Show/Remove Notify Icon' shows and removes a tray icon from the taskbar's system tray. =head2 Selecting the icon By default the Win32::GUI icon is displayed in the system tray. It is possible to change this icon by selecting the 'Change Icon ...' option from the 'File' menu, or by pressing the 'Change Icon ...' button. The file selected must be a vaild windows icon (usually a *.ico file). The microsoft documentation give the following limitations for the icon colour depth: =over 4 I<< To avoid icon distortion, be aware that notification area icons have different levels of support under different versions of Microsoft Windows. Windows 95, Windows 98, and Microsoft Windows NT 4.0 support icons of up to 4 bits per pixel (BPP). Windows Millennium Edition (Windows Me) and Windows 2000 support icons of a color depth up to the current display mode. Windows XP supports icons of up to 32 BPP. >> =back =head2 Setting the Tooltip Text entered in the Tooltip Text Textfield will be displayed as a tooltip when the icon is displayed in the system tray and the mouse hovers over the icon. The text is limited to 63 characters for shell32.dll before 5.0 and 127 characters for later versions. =head2 Balloon Tooltips Balloon tooltips are available to systems with shell32.dll greater than 5.0. Balloon tooltips are larger tooltips, capable of showing more information. While the notify icon is displayed in the taskbar a balloon tooltip can be shown and hidden using the 'Show Balloon' and 'Hide Balloon' buttons. The 'Show while editing' checkbox, if checked, shows the balloon tooltip while you edit it's contents within the 'Balloon Tooltip' panel. You may adjust the following values affecting the display of a Balloon Tooltip: =over 4 =item Title Sets the title of the balloon tooltip. The title is displayed in bold at the top of the tooltip. =item Body The main content of the balloon tooltip. The ballon tooltip will not be displayed if this field is empty. =item Icon Set the system icon that is disaplyed next to the balloon tooltip title. One of: none (no icon), info, warn or error. The icon is not displayed if there is no title. =item Timeout The maximum time in milliseconds for which the tooltip will be displayed. The tooltip may be displayed for a shorter time if another balloon tooltip is displayed by either the same or any other system tray icon. The system enforces minimum and maximum timeout values. Timeout values that are too large are set to the maximum value and values that are too small default to the minimum value. The system minimum and maximum timeout values are set by the operating system and for all current version sof windows are 10 seconds and 30 seconds, respectively. =back =head2 Events The 'Events' panel shows events that are sent from the Notify Icon to the owner window. Typically these are mouse-related events, and can be triggered by moving and clicking the mouse on the Notify Icon. v5.0 supports 2 behaviours for messages sent when the notify icon has keyboard focus and the <enter> and <space> key are pressed. The behavious can be changed by clicking the radio-buttons at the top of the 'Events' panel. See the microsoft documentation for 'Shell_NotifyIcon' for further details. The text control at the bottom of the 'Events' panel shows the events as they happen. v6.0 of shell32.dll support various additional event messages that occur as the balloon tooltip is displayed and hidden. =head1 AUTHOR Robert May - rob...@us... =head1 COPYRIGHT AND LICENCE This software is released under the same terms as Perl itself. =cut |
|
From: Robert M. <rob...@us...> - 2006-01-11 21:26:25
|
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 -0000 1.47 --- GUI.xs 11 Jan 2006 21:26:15 -0000 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.xs 3 Aug 2005 21:45:57 -0000 1.6 --- Label.xs 11 Jan 2006 21:26:16 -0000 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 -0000 1.6 --- RichEdit.xs 11 Jan 2006 21:26:16 -0000 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 -0000 1.36 --- GUI.pm 11 Jan 2006 21:26:14 -0000 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; $NotifyIconIdCounter = 1; --- 25,32 ---- # STATIC OBJECT PROPERTIES # ! $VERSION = "1.03_02"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) ! $MenuIdCounter = 101; $TimerIdCounter = 1; $NotifyIconIdCounter = 1; *************** *** 1469,1474 **** # -uppercase => 0/1 (default 0) # Convert all caracter into uppercase ! # -autohscroll => 0/1 (default 0) ! # -autovscroll => 0/1 (default 0) # -number => 0/1 (default 0) # Allows only digits to be entered into the edit control --- 1469,1479 ---- # -uppercase => 0/1 (default 0) # Convert all caracter into uppercase ! # -autohscroll => 0/1 (default 1 (0 for a multiline Textfield)) ! # Automatically scroll to right as text is typed past the right ! # margin; If 0 for a multiline Textfield, then wrap to the next ! # line. ! # -autovscroll => 0/1 (default 1) ! # For a multiline Textfiled automatically scroll down as lines ! # pass the bottom of the control. # -number => 0/1 (default 0) # Allows only digits to be entered into the edit control *************** *** 1824,1828 **** # (@)PACKAGE:Win32::GUI::RichEdit # Create and manipulate Richedit controls. ! # Most of the methods and events that apply to a L<TextField|Win32::GUI::Textfield> # also apply to Win32::GUI::RichEdit. # --- 1829,1833 ---- # (@)PACKAGE:Win32::GUI::RichEdit # Create and manipulate Richedit controls. ! # Most of the methods and events that apply to a L<Textfield|Win32::GUI::Textfield> # also apply to Win32::GUI::RichEdit. # *************** *** 1842,1846 **** # Creates a new RichEdit object; # can also be called as PARENT->AddRichEdit(%OPTIONS). ! # See new Win32::GUI::TextField() for B<%OPTIONS> sub new { $Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32") unless defined $Win32::GUI::RICHED; --- 1847,1851 ---- # Creates a new RichEdit object; # can also be called as PARENT->AddRichEdit(%OPTIONS). ! # See new Win32::GUI::Textfield() for B<%OPTIONS> sub new { $Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32") unless defined $Win32::GUI::RICHED; *************** *** 2753,2759 **** ############################################################################### # (@)PACKAGE:Win32::GUI::NotifyIcon ! # Create and manipulate notify icons in the system tray # package Win32::GUI::NotifyIcon; ########################################################################### --- 2758,2774 ---- ############################################################################### # (@)PACKAGE:Win32::GUI::NotifyIcon ! # Create and manipulate icons and tooltips in the system tray # + # The functionality of Win32::GUI::NotifyIcon is affected by the version + # of shell.dll installed with the windows system running your script. You + # can find this version from $Win32::GUI::NotifyIcon::SHELLDLL_VERSION, + # which contains the major version number of the shell.dll library that + # has been loaded. package Win32::GUI::NotifyIcon; + use Win32(); + our $SHELLDLL_VERSION; + BEGIN { + $SHELLDLL_VERSION = (Win32::GetFileVersion('shell32'))[0]; + } ########################################################################### *************** *** 2764,2777 **** # B<%OPTIONS> are: # -icon => Win32::GUI::Icon object ! # -id => NUMBER ! # a unique identifier for the NotifyIcon object # -name => STRING # the name for the object # -tip => STRING ! # the text that will appear as tooltip when the mouse is ! # on the NotifyIcon # -event => NEM Event Hash # Set NEM event handler (you can also use -on Event Option). ! sub new { my $class = shift; --- 2779,2828 ---- # B<%OPTIONS> are: # -icon => Win32::GUI::Icon object ! # the icon to display in the taskbar # -name => STRING # the name for the object # -tip => STRING ! # the text that will appear as a tooltip when the mouse is ! # hovering over the NotifyIcon. For shell.dll versions prior ! # to 5.0 the text length is limited to 63 characters; For ! # later versions it is limited to 127 characters. The string ! # provided will be truncated as necessary. # -event => NEM Event Hash # Set NEM event handler (you can also use -on Event Option). ! # ! # For shell.dll version 5.0 and later balloon tooltips can be used, ! # the following options control balloon tooltips. If your version ! # of shell.dll does not support balloon tooltips, then these options ! # are silently ignored: ! # -balloon => 0/1 ! # A flag controlling whether the ballon tip is displayed by ! # new() or Change(), or whether the ShowBalloon() method ! # must be called to display the balloon tooltip. Defaults ! # to 0 (not displayed). ! # -balloon_tip => STRING ! # Sets the text that will appear in the body of the balloon tip. ! # Will cause the balloon tip to be removed from the screen if set ! # to the empty string and displayed. The string is limited to ! # 255 characters and will be truncated as necessary. ! # -balloon_title => STRING ! # Sets the text that appears as a title at the top of the balloon ! # tip. The string is limited to 63 characters and will be truncated ! # as necessary. ! # -balloon_icon => STRING ! # Sets the icon that is displayed next to the balloon tip title. If ! # the balloon tip title is not set (or is set to the empty string), ! # then no icon is displayed. Allowed values for STRING are: ! # error, info, warning, none. Defaults to 'none'. ! # -balloon_timeout => NUMBER ! # The maximum time for which a balloon tooltip is displayed before ! # being removed, in milliseconds. The system will limit the range ! # allowed (typically to between 10 and 30 seconds). If a balloon ! # is being displayed and another taskbar icon tries to display a ! # balloon tip, then the one being displayed will be removed after ! # it has been displayed for the system minimum time (typically 10 ! # seconds), and only then will the new tooltip be displayed. ! # Defaults to 10 seconds. ! # ! # Returns a Win32::GUI::NotifyIcon object on success, undef on failure sub new { my $class = shift; *************** *** 2782,2787 **** if(!exists($args{-id})) { ! $args{-id} = $Win32::GUI::NotifyIconIdCounter; ! $Win32::GUI::NotifyIconIdCounter++; } --- 2833,2840 ---- if(!exists($args{-id})) { ! $args{-id} = $Win32::GUI::NotifyIconIdCounter++; # TODO - deprecate ! } ! else { ! warn qq(The -id option is deprecated, and you should not be setting it.); } *************** *** 2790,2793 **** --- 2843,2848 ---- } + $args{-balloon} = 0 unless exists $args{-balloon}; + my $self = {}; bless($self, $class); *************** *** 2796,2811 **** $self->{-name} = $args{-name}; $self->{-handle} = $window->{-handle}; ! # Store name in notifyicons hash $window->{-notifyicons}->{$args{-id}} = $args{-name}; ! # AutoReference to parent $window->{$args{-name}} = $self; - # Only if perl is circular ref-safe - if ($] > 5.006) { - $self->{-window} = \$window; - } ! Win32::GUI::NotifyIcon::Add($self->{-handle}, %args); return $self; } --- 2851,2867 ---- $self->{-name} = $args{-name}; $self->{-handle} = $window->{-handle}; + $self->{-balloon_tip} = $args{-balloon_tip}; + $self->{-balloon_title} = $args{-balloon_title}; + $self->{-balloon_timeout} = $args{-balloon_timeout}; + $self->{-balloon_icon} = $args{-balloon_icon}; ! # Store name in parent's notifyicons hash $window->{-notifyicons}->{$args{-id}} = $args{-name}; ! # Add NotifyIcon into parent's hash $window->{$args{-name}} = $self; ! my $result = Win32::GUI::NotifyIcon::_Add($self->{-handle}, %args); + return undef unless $result; return $self; } *************** *** 2813,2821 **** ########################################################################### # (@)METHOD:Change(%OPTIONS) ! # Change most option. See new Win32::GUI::NotifyIcon(). sub Change { my $self = shift; my %args = @_; ! return Win32::GUI::NotifyIcon::Modify($self->{-handle}, %args); } --- 2869,2998 ---- ########################################################################### # (@)METHOD:Change(%OPTIONS) ! # Change all options. See new Win32::GUI::NotifyIcon(). ! # ! # Returns 1 on success, 0 on failure sub Change { my $self = shift; my %args = @_; ! ! $args{-balloon} = 0 unless exists $args{-balloon}; ! ! $self->{-balloon_tip} = $args{-balloon_tip} if exists $args{-balloon_tip}; ! $self->{-balloon_title} = $args{-balloon_title} if exists $args{-balloon_title}; ! $self->{-balloon_timeout} = $args{-balloon_timeout} if exists $args{-balloon_timeout}; ! $self->{-balloon_icon} = $args{-balloon_icon} if exists $args{-balloon_icon}; ! ! if($self->{-balloon}) { ! $args{-balloon_tip} = $self->{-balloon_tip}; ! $args{-balloon_title} = $self->{-balloon_title}; ! $args{-balloon_timeout} = $self->{-balloon_timeout}; ! $args{-balloon_icon} = $self->{-balloon_icon}; ! } ! ! return Win32::GUI::NotifyIcon::_Modify($self->{-handle}, -id => $self->{-id}, %args); ! } ! ! ########################################################################### ! # (@)METHOD:ShowBalloon([FLAG=1]) ! # Only supported by shell32.dll v5.0 and above ! # ! # Show or hide a balloon tooltip with details supplied from the new() or ! # Change() methods, using the -balloon_tip, -balloon_title, -balloon_timeout ! # and -balloon_icon options. ! # ! # Set B<FLAG> to a true value to display the balloon tooltip, or to a false ! # value to hide the tip (it will automatically be hidden by the system ! # after -balloon_timeout millseconds). If B<FLAG> is omitted, displays the ! # tooltip. If the tooltip is already showing, re-showing it queues ! # a new balloon tooltip to be displayed once the existing one times out. ! # ! # Returns 1 on success, 0 on failure or undef if not supported. ! sub ShowBalloon { ! return undef if $SHELLDLL_VERSION < 5; ! my $self = shift; ! my $flag = shift; ! $flag = 1 unless defined $flag; ! ! return Win32::GUI::NotifyIcon::_Modify( ! $self->{-handle}, ! -id => $self->{-id}, ! -balloon => 1, ! -balloon_tip => $flag ? $self->{-balloon_tip} : '', ! -balloon_title => $self->{-balloon_title}, ! -balloon_timeout => $self->{-balloon_timeout}, ! -balloon_icon => $self->{-balloon_icon}, ! ); ! } ! ! ########################################################################### ! # (@)METHOD:HideBalloon([FLAG=1]) ! # Only supported by shell32.dll v5.0 and above ! # ! # Show or hide a balloon tooltip with details supplied from the new() or ! # Change() methods, using the -balloon_tip, -balloon_title, -balloon_timeout ! # and -balloon_icon options. ! # ! # Set B<FLAG> to a false value to display the balloon tooltip, or to a true ! # value to hide the tip (it will automatically be hidden by the system ! # after -balloon_timeout millseconds). If B<FLAG> is omitted, hides the ! # tooltip. If the tooltip is already showing, re-showing it queues ! # a new balloon tooltip to be displayed once the existing one times out. ! # ! # Returns 1 on success, 0 on failure or undef if not supported. ! sub HideBalloon { ! return undef if $SHELLDLL_VERSION < 5; ! my $self = shift; ! my $flag = shift; ! $flag = 1 unless defined $flag; ! ! return $self->ShowBalloon(!$flag); ! } ! ! ########################################################################### ! # (@)METHOD:SetFocus() ! # Only supported by shell32.dll v5.0 and above ! # ! # Return focus to the taskbar notification area. For example if the taskbar ! # icon displays a shortcut menu and the use cancels the menu with ESC, then ! # use this method to return focus to the taskbar notification area. ! # ! # Returns 1 on success, 0 on failure and undef if not supported. ! sub SetFocus { ! return undef if $SHELLDLL_VERSION < 5; ! my $self = shift; ! return Win32::GUI::NotifyIcon::_SetFocus($self->{-handle}, -id => $self->{-id}); ! } ! ! ########################################################################### ! # (@)METHOD:SetBehaviour([FLAG]) ! # Only supported by shell32.dll v5.0 and above ! # ! # Set FLAG to a true value to get the Windows 2000 taskbar behaviour. set ! # FLAG to a flase value to get Windows 95 taskbar behaviour. See the MSDN ! # documentation for Shell_NotifyIcon for more details. ! # ! # Returns 1 on success, 0 on failure and undef if not supported. ! sub SetBehaviour { ! return undef if $SHELLDLL_VERSION < 5; ! my $self = shift; ! my $flag = shift || 0; ! return Win32::GUI::NotifyIcon::_SetVersion($self->{-handle}, -id => $self->{-id}, -behaviour => $flag); ! } ! ! ########################################################################### ! # (@)METHOD:Remove() ! # Remove the Notify Icon from the system tray, and free its related resources ! sub Remove { ! my $self = shift; ! $self->DESTROY(); ! } ! ! ########################################################################### ! # (@)METHOD:Delete() ! # Deprecated method for removing notify icon from the system tray. Will be ! # removed from future Win32::GUI versions without further warning. ! sub Delete { ! warn qq(Win32::GUI::NotifyIcon::Delete() is deprecated, please use Win32::GUI::NofityIcon::Remove()); ! return Win32::GUI::_Delete(@_); } *************** *** 2824,2846 **** sub DESTROY { ! my($self) = @_; ! if ( defined $self && ! defined $self->{-handle} && ! defined $self->{-id} ) { ! ! Win32::GUI::NotifyIcon::Delete( ! $self->{-handle}, ! -id => $self->{-id}, ! ); ! if (defined $self->{-window}) { ! my $window = ${$self->{-window}}; ! # Remove id from parent ! delete $window->{-notifyicons}->{$self->{-id}} ! if ref($window) and defined $window->{-notifyicons}->{$self->{-id}}; ! # Remove name from parent ! delete $window->{$self->{-name}} if defined $window; ! } } } --- 3001,3018 ---- sub DESTROY { + my $self = shift; ! # Remove the notify icon ! Win32::GUI::NotifyIcon::_Delete($self->{-handle}, -id => $self->{-id}); ! # We put this code to tidy up the parent here, rather than ! # in NofifyIcon->Delete(), so that we still tidy up, even in the ! # unlikely event of someone doing PARENT->{NotifyIcon name} = undef; ! my $window = Win32::GUI::GetWindowObject($self->{-handle}); ! if(defined $window) { ! # Remove id from -notifyicons hash ! delete $window->{-notifyicons}->{$self->{-id}} if defined $window->{-notifyicons}; ! # Remove name from parent ! delete $window->{$self->{-name}}; } } *************** *** 3359,3363 **** } ! # print "[DESTROY Fin] self='$self'\n"; } --- 3531,3535 ---- } ! # print "[DESTROY Fin ] self='$self'\n"; } Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.69 retrieving revision 1.70 diff -C2 -d -r1.69 -r1.70 *** CHANGELOG 3 Dec 2005 01:56:31 -0000 1.69 --- CHANGELOG 11 Jan 2006 21:26:14 -0000 1.70 *************** *** 6,29 **** Win32-GUI ChangeLog =================== ! + [Robert May] : 3 Dec 2003 - bug fixes ! - GUI.h change order of instructions to prevent crashes (Trackers ! 1243378 and 1248578) - GUI.pm up version to 1.03_01 and tidy up - GUI.xs change logic in all message loops (Dialog, DoEvents, DoModal) to ! prevent memoy leak (Tracker: 1201190) - Listbox.xs add documentation to differentiate between SetCurSel and ! SetSel ! + [Robert May] : 22 Nov 2003 - 1.03 release - Tagged head as Win32-GUI-1_03 ! + [Robert May] : 21 Nov 2003 - 1.03 release candidate - t\05_Timer_*.t change interval test to use milli-seconds using ! Win32::GetTickCount() rather than time(). ! -t\01_basic.t add tests for Test::More availability and correct OS. ! -t\98_Pod.t new test of POD syntax - various minor documentation edits to correct POD syntax ! -Makefile.PL added test for presence of compiler to stop us failing CPAN ! Smoke tests in test environments with no compilers. - Up version to 1.03 --- 6,55 ---- Win32-GUI ChangeLog =================== ! + [Robert May] : 11 Jan 2006 - bug fixes and add balloon tips for Notify Icon ! - Label.xs correct -truncate option processing, as SS_.*ELLIPSIS.* ! styles are not single bits ! - NotifyIcon.xs, GUI_Options.cpp, GUI.pm re-work NofifyIcon ! class. Add balloon tooltips. Add support for message behaviour. Add ! support for setfocus. Add documentation. (Tracker: 1065072) ! - t\05_NotifyIcon*.t, MANIFEST Notify Icon Tests added ! - samples\NotifyIcon.pl, MANIFEST add demo app ! - GUI.pm Changed initial value of $Win32::GUI::MenuIdCounter to avoid ID ! clash with predefined WM_COMMAND values (IDOK, IDCANCEL, etc.) ! - GUI.xs Fix SendMessageTimeout to match documentation and return ! undef on failure. (XSRETURN_UNDEF rather than XSRETURN_NO). ! - GUI.pm corrected documentation of default values for autohscroll ! and autovscroll in Textfield documentation ! - GUI_MessageLoops.cpp added processing of WM_NEXTDLGCTL to ! CommonMessageLoop to allow for tabbing out of multiline Textfields ! when using -dialogui ! - GUI_MessageLoops.cpp fixed WM_ERASEBACKGROUND (Tracker:1363141) ! - Splitter.xs, GUI_Helpers.cpp, GUI.h re-worked splitter class. ! (Tracker:1363141) ! - RichEdit.xs made -background and -foreground work ! - GUI_MessageLoops.cpp made -background work for Splitter windows ! - GUI_Helpers.cpp removed an unnecessary dTHX, replacing it with ! PERLUD_FETCH ! - Upped version to 1.03_02 ! ! + [Robert May] : 3 Dec 2005 - bug fixes ! - GUI.h change order of instructions in PERLUD_FREE macro to prevent ! crashes (Trackers 1243378 and 1248578) - GUI.pm up version to 1.03_01 and tidy up - GUI.xs change logic in all message loops (Dialog, DoEvents, DoModal) to ! prevent memory leak (Tracker: 1201190) - Listbox.xs add documentation to differentiate between SetCurSel and ! SetSel (Tracker: 1177898) ! + [Robert May] : 22 Nov 2005 - 1.03 release - Tagged head as Win32-GUI-1_03 ! + [Robert May] : 21 Nov 2005 - 1.03 release candidate - t\05_Timer_*.t change interval test to use milli-seconds using ! Win32::GetTickCount() rather than time(). ! - t\01_basic.t add tests for Test::More availability and correct OS. ! - t\98_Pod.t new test of POD syntax - various minor documentation edits to correct POD syntax ! - Makefile.PL added test for presence of compiler to stop us failing CPAN ! Smoke tests in test environments with no compilers. - Up version to 1.03 *************** *** 31,44 **** - Makefile.PL added code to remove Test::More dependence from PPD - GUI_MessageLoops.cpp, Window.xs change all mouse related handlers to ! use GET_X_LPARAM and GET_Y_LPARAM rather than HIWORD and LOWORD ! (Tracker: 1262098) - GUI.xs added INTERNAL function GetWindowObject to get the perl window ! object from a window handle - GUI.pm, t\05_Timer*.t, docs\GUI\Tutorial\Part4.pod - re-wrote ! Win32::GUI::Timer implementation and updated docs to make it all ! consistent, and to make destruction happen correctly. Added full tests ! for the package. - GUI.xs fixed GetAsyncKeyState(), which was checking the wrong bit of ! window's return value. Updated documentation. - MANIFEST updated with new samples and new tests - GUI.pm upped version to 1.02_03 --- 57,70 ---- - Makefile.PL added code to remove Test::More dependence from PPD - GUI_MessageLoops.cpp, Window.xs change all mouse related handlers to ! use GET_X_LPARAM and GET_Y_LPARAM rather than HIWORD and LOWORD ! (Tracker: 1262098) - GUI.xs added INTERNAL function GetWindowObject to get the perl window ! object from a window handle - GUI.pm, t\05_Timer*.t, docs\GUI\Tutorial\Part4.pod - re-wrote ! Win32::GUI::Timer implementation and updated docs to make it all ! consistent, and to make destruction happen correctly. Added full tests ! for the package. - GUI.xs fixed GetAsyncKeyState(), which was checking the wrong bit of ! window's return value. Updated documentation. - MANIFEST updated with new samples and new tests - GUI.pm upped version to 1.02_03 Index: NotifyIcon.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/NotifyIcon.xs,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** NotifyIcon.xs 28 Mar 2004 15:01:47 -0000 1.3 --- NotifyIcon.xs 11 Jan 2006 21:26:16 -0000 1.4 *************** *** 19,23 **** # (@)INTERNAL:Add(PARENT, %OPTIONS) BOOL ! Add(parent,...) HWND parent PREINIT: --- 19,23 ---- # (@)INTERNAL:Add(PARENT, %OPTIONS) BOOL ! _Add(parent,...) HWND parent PREINIT: *************** *** 25,33 **** CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! nid.cbSize = sizeof(NOTIFYICONDATA); ! nid.hWnd = parent; nid.uCallbackMessage = WM_NOTIFYICON; SwitchBit(nid.uFlags, NIF_MESSAGE, 1); ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); --- 25,34 ---- CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! nid.cbSize = NOTIFYICONDATA_V1_SIZE; nid.hWnd = parent; nid.uCallbackMessage = WM_NOTIFYICON; SwitchBit(nid.uFlags, NIF_MESSAGE, 1); + SwitchBit(nid.uFlags, NIF_INFO, 1); + nid.uTimeout = 10000; ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); *************** *** 41,45 **** # (@)INTERNAL:Modify(PARENT, %OPTIONS) BOOL ! Modify(parent,...) HWND parent PREINIT: --- 42,46 ---- # (@)INTERNAL:Modify(PARENT, %OPTIONS) BOOL ! _Modify(parent,...) HWND parent PREINIT: *************** *** 47,53 **** CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! ! nid.cbSize = sizeof(NOTIFYICONDATA); nid.hWnd = parent; ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); --- 48,54 ---- CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! nid.cbSize = NOTIFYICONDATA_V1_SIZE; nid.hWnd = parent; + nid.uTimeout = 10000; ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); *************** *** 61,65 **** # (@)INTERNAL:Delete(PARENT, %OPTIONS) BOOL ! Delete(parent,...) HWND parent PREINIT: --- 62,66 ---- # (@)INTERNAL:Delete(PARENT, %OPTIONS) BOOL ! _Delete(parent,...) HWND parent PREINIT: *************** *** 67,71 **** CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! nid.cbSize = sizeof(NOTIFYICONDATA); nid.hWnd = parent; --- 68,72 ---- CODE: ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); ! nid.cbSize = NOTIFYICONDATA_V1_SIZE; nid.hWnd = parent; *************** *** 75,76 **** --- 76,114 ---- OUTPUT: RETVAL + + ########################################################################### + # (@)INTERNAL:SetFocus(PARENT, %OPTIONS) + BOOL + _SetFocus(parent,...) + HWND parent + PREINIT: + NOTIFYICONDATA nid; + CODE: + ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); + nid.cbSize = NOTIFYICONDATA_V1_SIZE; + nid.hWnd = parent; + + ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); + + RETVAL = Shell_NotifyIcon(NIM_SETFOCUS, &nid); + OUTPUT: + RETVAL + + ########################################################################### + # (@)INTERNAL:SetVersion(PARENT, %OPTIONS) + BOOL + _SetVersion(parent,...) + HWND parent + PREINIT: + NOTIFYICONDATA nid; + CODE: + ZeroMemory(&nid, sizeof(NOTIFYICONDATA)); + nid.cbSize = NOTIFYICONDATA_V1_SIZE; + nid.hWnd = parent; + + ParseNotifyIconOptions(NOTXSCALL sp, mark, ax, items, 1, &nid); + + RETVAL = Shell_NotifyIcon(NIM_SETVERSION, &nid); + OUTPUT: + RETVAL + Index: Splitter.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Splitter.xs,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Splitter.xs 3 Aug 2005 21:45:57 -0000 1.4 --- Splitter.xs 11 Jan 2006 21:26:16 -0000 1.5 *************** *** 82,168 **** int PerlResult = 0; - BOOL tracking, horizontal; POINT pt; HWND phwnd, hwnd; RECT rc; switch(uMsg) { case WM_MOUSEMOVE: - tracking = perlud->dwPlStyle & PERLWIN32GUI_TRACKING; if(tracking) { - horizontal = perlud->dwPlStyle & PERLWIN32GUI_HORIZONTAL; hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetCursorPos(&pt); ! ScreenToClient(phwnd, &pt); if(horizontal) { ! pt.y = AdjustSplitterCoord(NOTXSCALL perlud, pt.y, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! GetWindowRect(hwnd, &rc); ! ScreenToClient(phwnd, (POINT*)&rc); ! SetWindowPos(hwnd, NULL, rc.left, pt.y, 0, 0, SWP_NOZORDER | SWP_NOSIZE); ! DrawSplitter(NOTXSCALL hwnd); } else { ! pt.x = AdjustSplitterCoord(NOTXSCALL perlud, pt.x, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! GetWindowRect(hwnd, &rc); ! ScreenToClient(phwnd, (POINT*)&rc); ! SetWindowPos(hwnd, NULL, pt.x, rc.top, 0, 0, SWP_NOZORDER | SWP_NOSIZE); ! DrawSplitter(NOTXSCALL hwnd); } } break; case WM_LBUTTONDOWN: - SwitchBit(perlud->dwPlStyle, PERLWIN32GUI_TRACKING, 1); - horizontal = perlud->dwPlStyle & PERLWIN32GUI_HORIZONTAL; hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetCursorPos(&pt); ! ScreenToClient(phwnd, &pt); if(horizontal) { ! pt.y = AdjustSplitterCoord(NOTXSCALL perlud, pt.y, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! SetCapture(hwnd); } else { ! pt.x = AdjustSplitterCoord(NOTXSCALL perlud, pt.x, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! SetCapture(hwnd); } break; case WM_LBUTTONUP: - tracking = perlud->dwPlStyle & PERLWIN32GUI_TRACKING; if(tracking) { ! horizontal = perlud->dwPlStyle & PERLWIN32GUI_HORIZONTAL; hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetCursorPos(&pt); ! ScreenToClient(phwnd, &pt); /* * (@)EVENT:Release(COORD) * Sent when the Splitter is released after being * dragged to a new location (identified by the ! * COORD parameter). * (@)APPLIES_TO:Splitter */ ! if(horizontal) { ! pt.y = AdjustSplitterCoord(NOTXSCALL perlud, pt.y, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL1, "Release", ! PERLWIN32GUI_ARGTYPE_LONG, (long) pt.y, ! -1); } else { ! pt.x = AdjustSplitterCoord(NOTXSCALL perlud, pt.x, phwnd); ! DrawSplitter(NOTXSCALL hwnd); ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL1, "Release", ! PERLWIN32GUI_ARGTYPE_LONG, (long) pt.x, ! -1); } } - SwitchBit(perlud->dwPlStyle, PERLWIN32GUI_TRACKING, 0); - SetWindowLong(hwnd, GWL_USERDATA, (LONG) perlud); - ReleaseCapture(); break; --- 82,189 ---- int PerlResult = 0; POINT pt; HWND phwnd, hwnd; RECT rc; + int w,h; + + BOOL tracking = perlud->dwPlStyle & PERLWIN32GUI_TRACKING; + BOOL horizontal = perlud->dwPlStyle & PERLWIN32GUI_HORIZONTAL; switch(uMsg) { case WM_MOUSEMOVE: if(tracking) { hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetWindowRect(hwnd, &rc); ! w = rc.right - rc.left; ! h = rc.bottom - rc.top; ! ScreenToClient(phwnd, (POINT*)&rc); ! pt.x = GET_X_LPARAM(lParam); ! pt.y = GET_Y_LPARAM(lParam); ! MapWindowPoints(hwnd, phwnd, (LPPOINT)&pt, 1); ! if(horizontal) { ! DrawSplitter(NOTXSCALL phwnd, rc.left, (int)(perlud->dwData), w, h); ! pt.y = AdjustSplitterCoord(NOTXSCALL perlud, pt.y, h, phwnd); ! perlud->dwData = (DWORD)pt.y; ! DrawSplitter(NOTXSCALL phwnd, rc.left, pt.y, w, h); } else { ! DrawSplitter(NOTXSCALL phwnd, (int)(perlud->dwData), rc.top, w, h); ! pt.x = AdjustSplitterCoord(NOTXSCALL perlud, pt.x, w, phwnd); ! perlud->dwData = (DWORD)pt.x; ! DrawSplitter(NOTXSCALL phwnd, pt.x, rc.top, w, h); } } break; case WM_LBUTTONDOWN: hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetWindowRect(hwnd, &rc); ! w = rc.right - rc.left; ! h = rc.bottom - rc.top; ! ScreenToClient(phwnd, (POINT*)&rc); ! pt.x = GET_X_LPARAM(lParam); ! pt.y = GET_Y_LPARAM(lParam); ! MapWindowPoints(hwnd, phwnd, (LPPOINT)&pt, 1); if(horizontal) { ! pt.y = AdjustSplitterCoord(NOTXSCALL perlud, pt.y, h, phwnd); ! perlud->dwData = (DWORD)rc.top; ! DrawSplitter(NOTXSCALL phwnd, rc.left, rc.top, w, h); } else { ! pt.x = AdjustSplitterCoord(NOTXSCALL perlud, pt.x, w, phwnd); ! perlud->dwData = (DWORD)rc.left; ! DrawSplitter(NOTXSCALL phwnd, rc.left, rc.top, w, h); } + SwitchBit(perlud->dwPlStyle, PERLWIN32GUI_TRACKING, 1); + SetCapture(hwnd); break; case WM_LBUTTONUP: if(tracking) { ! ReleaseCapture(); // Sends us a WM_CAPTURECHANGED message hwnd = handle_From (NOTXSCALL perlud->svSelf); phwnd = GetParent(hwnd); ! GetWindowRect(hwnd, &rc); ! w = rc.right - rc.left; ! h = rc.bottom - rc.top; ! ScreenToClient(phwnd, (POINT*)&rc); ! ! if(horizontal) { ! MoveWindow(hwnd, rc.left, (int)(perlud->dwData), w, h, 1); ! } else { ! MoveWindow(hwnd, (int)(perlud->dwData), rc.top, w, h, 1); ! } ! /* * (@)EVENT:Release(COORD) * Sent when the Splitter is released after being * dragged to a new location (identified by the ! * COORD parameter). COORD is the top coordinate ! * of a horizontal splitter or the left coordinate ! * of a vertical splitter. * (@)APPLIES_TO:Splitter */ ! PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL1, "Release", ! PERLWIN32GUI_ARGTYPE_LONG, (long) perlud->dwData, ! -1); ! } ! break; ! case WM_CAPTURECHANGED: ! if(tracking) { ! hwnd = handle_From (NOTXSCALL perlud->svSelf); ! phwnd = GetParent(hwnd); ! GetWindowRect(hwnd, &rc); ! w = rc.right - rc.left; ! h = rc.bottom - rc.top; ! ScreenToClient(phwnd, (POINT*)&rc); ! SwitchBit(perlud->dwPlStyle, PERLWIN32GUI_TRACKING, 0); + if(horizontal) { + DrawSplitter(NOTXSCALL phwnd, rc.left, (int)(perlud->dwData), w, h); } else { ! DrawSplitter(NOTXSCALL phwnd, (int)(perlud->dwData), rc.top, w, h); } } break; *************** *** 182,186 **** ########################################################################### # (@)METHOD:Min([VALUE]) ! # Get or Set Min value void --- 203,209 ---- ########################################################################### # (@)METHOD:Min([VALUE]) ! # Get or Set Min value. The min value is the minimum position ! # to which the left(top) of the splitter can be dragged, in ! # the parent window for a horizontal(vertical) splitter. void *************** *** 207,211 **** ########################################################################### # (@)METHOD:Max([VALUE]) ! # Get or Set Max value void --- 230,236 ---- ########################################################################### # (@)METHOD:Max([VALUE]) ! # Get or Set Max value. The max value is the maximum position ! # to which the left(top) of the splitter can be dragged, in ! # the parent window for a horizontal(vertical) splitter. void *************** *** 232,236 **** ########################################################################### # (@)METHOD:Horizontal([VALUE]) ! # Get or Set Horizontal value void --- 257,263 ---- ########################################################################### # (@)METHOD:Horizontal([VALUE]) ! # Get or Set Horizontal orientation. If value is true, then sets ! # the splitter orientation to horizontal. If value is false, then ! # sets the splitter to Vertical orintation. void *************** *** 257,261 **** ########################################################################### # (@)METHOD:Vertical([VALUE]) ! # Get or Set Vertical value void --- 284,290 ---- ########################################################################### # (@)METHOD:Vertical([VALUE]) ! # Get or Set Vertical orientation. If value is true, then sets ! # the splitter orientation to vertuical. If value is false, then ! # sets the splitter to horizontal orintation. void Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/MANIFEST,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** MANIFEST 21 Nov 2005 22:33:33 -0000 1.11 --- MANIFEST 11 Jan 2006 21:26:16 -0000 1.12 *************** *** 89,92 **** --- 89,93 ---- samples/MonthCal.pl samples/Notepad.pl + samples/NotifyIcon.pl samples/Region.pl samples/SplashScreen.pl *************** *** 115,118 **** --- 116,124 ---- t/05_AcceleratorTable.t t/05_Menu.t + t/05_NotifyIcon_01_Constructor.t + t/05_NotifyIcon_02_Change.t + t/05_NotifyIcon_03_OtherMethods.t + t/05_NotifyIcon_04_Remove.t + t/05_NotifyIcon_05_DESTROY.t t/05_Timer_01_OEM.t t/05_Timer_02_NEM.t Index: GUI_Options.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Options.cpp,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** GUI_Options.cpp 3 Aug 2005 21:45:57 -0000 1.9 --- GUI_Options.cpp 11 Jan 2006 21:26:16 -0000 1.10 *************** *** 860,866 **** --- 860,886 ---- int i, next_i; char * option; + SV* shversion; + UINT version = 0; HV* hvEvents = NULL; + shversion = get_sv("Win32::GUI::NotifyIcon::SHELLDLL_VERSION",0); + if(shversion != NULL) { + version = (UINT)SvIV(shversion); + #if (_WIN32_IE >= 0x0500) && (_WIN32_IE < 0x0600) + if (version >= 5) { + nid->cbSize = sizeof(NOTIFYICONDATA); + } + #endif + #if (_WIN32_IE >= 0x0600) + if (version >= 5) { + nid->cbSize = NOTIFYICONDATA_V2_SIZE; + } + if (version >= 6) { + nid->cbSize = sizeof(NOTIFYICONDATA); + } + #endif + } + next_i = -1; for(i = from_i; i < items; i++) { *************** *** 876,880 **** } else if(strcmp(option, "-tip") == 0) { next_i = i + 1; ! strcpy(nid->szTip, SvPV_nolen(ST(next_i))); SwitchBit(nid->uFlags, NIF_TIP, 1); } else if(strcmp(option, "-events") == 0) { --- 896,906 ---- } else if(strcmp(option, "-tip") == 0) { next_i = i + 1; ! if( version < 5 ) { ! strncpy(nid->szTip, SvPV_nolen(ST(next_i)), 64); ! nid->szTip[63] = '\0'; ! } else { ! strncpy(nid->szTip, SvPV_nolen(ST(next_i)), 128); ! nid->szTip[127] = '\0'; ! } SwitchBit(nid->uFlags, NIF_TIP, 1); } else if(strcmp(option, "-events") == 0) { *************** *** 902,905 **** --- 928,963 ---- ParseNEMNotifyIconEvent( NOTXSCALL hvEvents, option+3, ST(next_i) ); + } else if(strcmp(option, "-behaviour") == 0) { + next_i = i + 1; + if (SvIV(ST(next_i))) { + nid->uVersion = NOTIFYICON_VERSION; + } + } else if(strcmp(option, "-balloon") == 0) { + next_i = i + 1; + SwitchBit(nid->uFlags, NIF_INFO, SvIV(ST(next_i))); + } else if(strcmp(option, "-balloon_tip") == 0) { + next_i = i + 1; + strncpy(nid->szInfo, SvPV_nolen(ST(next_i)), 256); + nid->szInfo[255] = '\0'; + } else if(strcmp(option, "-balloon_title") == 0) { + next_i = i + 1; + strncpy(nid->szInfoTitle, SvPV_nolen(ST(next_i)), 64); + nid->szInfoTitle[63] = '\0'; + } else if(strcmp(option, "-balloon_timeout") == 0) { + next_i = i + 1; + nid->uTimeout = (UINT) SvIV(ST(next_i)); + } else if(strcmp(option, "-balloon_icon") == 0) { + next_i = i + 1; + if(strcmp(SvPV_nolen(ST(next_i)), "error") == 0) { + nid->dwInfoFlags = NIIF_ERROR; + } else if(strcmp(SvPV_nolen(ST(next_i)), "info") == 0) { + nid->dwInfoFlags = NIIF_INFO; + } else if(strcmp(SvPV_nolen(ST(next_i)), "warning") == 0) { + nid->dwInfoFlags = NIIF_WARNING; + } else if(strcmp(SvPV_nolen(ST(next_i)), "none") == 0) { + nid->dwInfoFlags = NIIF_NONE; + } else { + W32G_WARN("Win32::GUI: Invalid value for -balloon_icon!"); + } } } else { *************** *** 957,959 **** hv_undef(hvEvents); } - --- 1015,1016 ---- Index: GUI.h =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.h,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** GUI.h 5 Dec 2005 09:38:58 -0000 1.23 --- GUI.h 11 Jan 2006 21:26:14 -0000 1.24 *************** *** 420,425 **** DWORD CALLBACK RichEditLoad(DWORD dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb); int CALLBACK BrowseForFolderProc(HWND hWnd, UINT uMsg, LPARAM lParam, LPARAM lpData); ! int AdjustSplitterCoord(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int x, HWND phwnd); ! void DrawSplitter(NOTXSPROC HWND hwnd); BOOL CALLBACK EnumMyWindowsProc(HWND hwnd, LPARAM lparam); BOOL CALLBACK CountMyWindowsProc(HWND hwnd, LPARAM lparam); --- 420,425 ---- DWORD CALLBACK RichEditLoad(DWORD dwCookie, LPBYTE pbBuff, LONG cb, LONG FAR *pcb); int CALLBACK BrowseForFolderProc(HWND hWnd, UINT uMsg, LPARAM lParam, LPARAM lpData); ! int AdjustSplitterCoord(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int x, int w, HWND phwnd); ! void DrawSplitter(NOTXSPROC HWND hwnd, int x, int y, int w, int h); BOOL CALLBACK EnumMyWindowsProc(HWND hwnd, LPARAM lparam); BOOL CALLBACK CountMyWindowsProc(HWND hwnd, LPARAM lparam); Index: GUI_Helpers.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_Helpers.cpp,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** GUI_Helpers.cpp 6 Aug 2005 10:36:20 -0000 1.14 --- GUI_Helpers.cpp 11 Jan 2006 21:26:15 -0000 1.15 *************** *** 573,577 **** # (@)INTERNAL:AdjustSplitterCoord(self, x) */ ! int AdjustSplitterCoord(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int x, HWND phwnd) { int min, max; int adjusted; --- 573,577 ---- # (@)INTERNAL:AdjustSplitterCoord(self, x) */ ! int AdjustSplitterCoord(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int x, int w, HWND phwnd) { int min, max; int adjusted; *************** *** 584,588 **** max = -1; max = perlud->iMaxWidth; ! if(max == -1) max = rc.right; if(adjusted < min) adjusted = min; if(adjusted > max) adjusted = max; --- 584,588 ---- max = -1; max = perlud->iMaxWidth; ! if(max == -1) max = rc.right - w; if(adjusted < min) adjusted = min; if(adjusted > max) adjusted = max; *************** *** 594,611 **** # (@)INTERNAL:DrawSplitter(hwnd) */ ! void DrawSplitter(NOTXSPROC HWND hwnd) { ! RECT rc; HDC hdc; ! HBRUSH oldBrush; ! HPEN oldPen; hdc = GetDC(hwnd); ! oldBrush = (HBRUSH) SelectObject(hdc, GetStockObject(GRAY_BRUSH)); ! oldPen = (HPEN) SelectObject(hdc, GetStockObject(NULL_PEN)); ! GetClientRect(hwnd, &rc); ! PatBlt(hdc, rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, DSTINVERT); ! if(oldBrush != NULL) SelectObject(hdc, oldBrush); ! if(oldPen != NULL) SelectObject(hdc, oldPen ); ReleaseDC(hwnd, hdc); } --- 594,624 ---- # (@)INTERNAL:DrawSplitter(hwnd) */ ! void DrawSplitter(NOTXSPROC HWND hwnd, int x, int y, int w, int h) { ! ! static WORD _dotPatternBmp[8] = { 0x00aa, 0x0055, 0x00aa, 0x0055, ! 0x00aa, 0x0055, 0x00aa, 0x0055}; ! HDC hdc; ! HBITMAP hbm; ! HBRUSH hbr, hbrushOld; ! ! /* create a monochrome checkered pattern */ ! hbm = CreateBitmap(8, 8, 1, 1, _dotPatternBmp); ! hbr = CreatePatternBrush(hbm); hdc = GetDC(hwnd); ! ! SetBrushOrgEx(hdc, x, y, NULL); ! hbrushOld = (HBRUSH)SelectObject(hdc, hbr); ! ! /* draw the checkered rectangle to the screen */ ! PatBlt(hdc, x, y, w, h, PATINVERT); ! ! SelectObject(hdc, hbrushOld); ! ReleaseDC(hwnd, hdc); + + DeleteObject(hbr); + DeleteObject(hbm); } *************** *** 696,701 **** if(code == MSGF_MENU) { - dTHX; /* fetch context */ - PerlResult = 1; pmsg = (MSG *)lParam; --- 709,712 ---- *************** *** 703,706 **** --- 714,718 ---- if(ValidUserData(perlud)) { + PERLUD_FETCH; /* fetch context */ arrayref = av_fetch(perlud->avHooks, WM_TRACKPOPUP_MSGHOOK, 0); Index: GUI_MessageLoops.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_MessageLoops.cpp,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** GUI_MessageLoops.cpp 5 Dec 2005 09:38:58 -0000 1.16 --- GUI_MessageLoops.cpp 11 Jan 2006 21:26:16 -0000 1.17 *************** *** 76,88 **** perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong((HWND) hwnd, GWL_USERDATA); if(perlud && (perlud->dwPlStyle & PERLWIN32GUI_FLICKERFREE)) { ! return (LRESULT) 1; } // If we're a window and we have a background brush, then use it ! if(perlud && perlud->hBackgroundBrush && ! (perlud->iClass == WIN32__GUI__WINDOW || perlud->iClass == WIN32__GUI__DIALOG) ) { ! RECT rc; ! GetUpdateRect((HWND)hwnd, &rc, 0); ! FillRect((HDC)wParam, &rc, perlud->hBackgroundBrush); ! return (LRESULT) 1; } break; --- 76,91 ---- perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong((HWND) hwnd, GWL_USERDATA); if(perlud && (perlud->dwPlStyle & PERLWIN32GUI_FLICKERFREE)) { ! return (LRESULT) 1; } // If we're a window and we have a background brush, then use it ! if(perlud && perlud->hBackgroundBrush && (perlud->iClass == WIN32__GUI__WINDOW || ! perlud->iClass == WIN32__GUI__DIALOG || ! perlud->iClass == WIN32__GUI__SPLITTER) ) { ! // Although this looks like we paint the whole of the background ! // the HDC passed in wParam is clipped to the update region ! RECT rc; ! GetClientRect(hwnd, &rc); ! FillRect((HDC)wParam, &rc, perlud->hBackgroundBrush); ! return (LRESULT) 1; } break; *************** *** 95,103 **** if( ValidUserData(perlud) ) { if(uMsg == WM_CTLCOLORSTATIC) { ! if(perlud->iClass == WIN32__GUI__EDIT) // Read-only Edit control ! SetBkColor((HDC) wParam, GetSysColor(COLOR_BTNFACE)); ! else ! SetBkMode((HDC) wParam, TRANSPARENT); ! } if(perlud->clrForeground != CLR_INVALID) SetTextColor((HDC) wParam, perlud->clrForeground); --- 98,106 ---- if( ValidUserData(perlud) ) { if(uMsg == WM_CTLCOLORSTATIC) { ! if(perlud->iClass == WIN32__GUI__EDIT) // Read-only Edit control ! SetBkColor((HDC) wParam, GetSysColor(COLOR_BTNFACE)); ! else ! SetBkMode((HDC) wParam, TRANSPARENT); ! } if(perlud->clrForeground != CLR_INVALID) SetTextColor((HDC) wParam, perlud->clrForeground); *************** *** 108,114 **** } ! DWORD hbrBackground; ! if(hbrBackground = GetClassLong((HWND)lParam, GCL_HBRBACKGROUND)) ! return ((LRESULT) hbrBackground); switch(uMsg) { --- 111,117 ---- } ! DWORD hbrBackground; ! if(hbrBackground = GetClassLong((HWND)lParam, GCL_HBRBACKGROUND)) ! return ((LRESULT) hbrBackground); switch(uMsg) { *************** *** 153,156 **** --- 156,172 ---- break; } + + case WM_NEXTDLGCTL: + { + perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong(hwnd, GWL_USERDATA); + if( ValidUserData(perlud) && (perlud->dwPlStyle & PERLWIN32GUI_DIALOGUI) ) { + if(LOWORD(lParam)) + SetFocus((HWND)wParam); + else + SetFocus(GetNextDlgTabItem(hwnd, GetFocus(), (BOOL)wParam)); + + return 0; + } + } } #ifdef PERLWIN32GUI_STRONGDEBUG *************** *** 596,601 **** /* * (@)EVENT:MouseEvent(MSG) ! * Sent when the user performs a mouse event on * a NotifyIcon; MSG is the message code. * (@)APPLIES_TO:NotifyIcon */ --- 612,619 ---- /* * (@)EVENT:MouseEvent(MSG) ! * Sent when the user performs any other mouse event on * a NotifyIcon; MSG is the message code. + * For shell.dll greater than V6 will also fire for balloon + * events. * (@)APPLIES_TO:NotifyIcon */ |
|
From: jw <jw...@us...> - 2005-12-05 10:38:05
|
Update of /cvsroot/perl-win32-gui/Win32-GUI-Scintilla In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7886 Modified Files: Changes README Scintilla.pm Scintilla.pm.begin Scintilla.xs Log Message: Fixed bugs which caused crashes and no events firing in perl 5.8.x. Use Scintilla 1.66 Index: Scintilla.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Scintilla.xs,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Scintilla.xs 1 Nov 2005 10:36:51 -0000 1.1 --- Scintilla.xs 5 Dec 2005 10:37:56 -0000 1.2 *************** *** 3,71 **** /**********************************************************************/ ! #include "EXTERN.h" ! #include "perl.h" ! #include "XSUB.h" ! ! #include <windows.h> ! #include "./include/Scintilla.h" ! ! /*====================================================================*/ ! /* W I N 3 2 : : G U I */ ! /*====================================================================*/ ! ! #define MAX_WINDOW_NAME 128 ! ! /* ! * Various definitions to accomodate the different Perl versions around ! */ ! ! #ifdef PERL_OBJECT ! # ifdef _INC_WIN32_PERL5 ! # pragma message( "\n*** Using the 5.005 Perl Object CPerlObj class.\n" ) ! # define NOTXSPROC CPerlObj *pPerl, ! # define NOTXSCALL pPerl, ! # define CPerl CPerlObj ! # else // not _INC_WIN32_PERL5 ! # pragma message( "\n*** Using the 5.004 Perl Object CPerl class.\n" ) ! # define NOTXSPROC CPerl *pPerl, ! # define NOTXSCALL pPerl, ! # endif // _INC_WIN32_PERL5 ! #else ! # pragma message( "\n*** Using a non-Object Core Perl.\n" ) ! # define NOTXSPROC ! # define NOTXSCALL ! #endif ! /* ! * what we'll store in GWL_USERDATA ! */ ! typedef struct tagPERLWIN32GUI_USERDATA { ! DWORD dwSize; // struct size (our signature) ! #ifdef PERL_OBJECT ! CPerl *pPerl; // a pointer to the Perl Object ! #endif ! SV* svSelf; // a pointer to ourself ! char szWindowName[MAX_WINDOW_NAME]; // our -name ! BOOL fDialogUI; // are we to intercept dialog messages? ! int iClass; // our (Perl) class ! HACCEL hAcc; // our accelerator table ! HWND hTooltip; ! HCURSOR hCursor; ! DWORD dwPlStyle; ! int iMinWidth; ! int iMaxWidth; ! int iMinHeight; ! int iMaxHeight; ! COLORREF clrForeground; ! COLORREF clrBackground; ! HBRUSH hBackgroundBrush; ! WNDPROC wndprocPreContainer; ! WNDPROC wndprocPreNEM; ! int iEventModel; ! HV* hvEvents; ! DWORD dwEventMask; ! HWND Modal; ! } PERLWIN32GUI_USERDATA, *LPPERLWIN32GUI_USERDATA; BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult) { --- 3,13 ---- /**********************************************************************/ ! #define PERL_NO_GET_CONTEXT /* we want efficiency */ ! //Bring in the Win32-GUI header files, this defines common structures that ! //we will need/use + #include "../Win32-GUI/GUI.h" + #include "./include/Scintilla.h" BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult) { *************** *** 119,123 **** ! int DoEvent (NOTXSPROC char *Name, UINT code, pSCNotification evt) { int PerlResult; int count; --- 61,65 ---- ! int DoEvent_Scintilla (NOTXSPROC char *Name, UINT code, pSCNotification evt) { int PerlResult; int count; *************** *** 257,265 **** if (memcmp (Name, "Scintilla", 9) == 0) { - - // Perl contexte - #ifdef PERL_OBJECT - CPerl *pPerl; - #endif LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong(lpnmhdr->hwndFrom, GWL_USERDATA); --- 199,202 ---- *************** *** 267,274 **** { ! #ifdef PERL_OBJECT ! pPerl = perlud->pPerl; ! #endif ! // Build name strcpy(Name, "main::"); --- 204,209 ---- { ! //fetch the perl context from perlud ! PERLUD_FETCH; // Build name strcpy(Name, "main::"); *************** *** 276,280 **** strcat(Name, "_Notify"); ! DoEvent(NOTXSCALL Name, lpnmhdr->code, (pSCNotification) msg->lParam); } } --- 211,215 ---- strcat(Name, "_Notify"); ! DoEvent_Scintilla(NOTXSCALL Name, lpnmhdr->code, (pSCNotification) msg->lParam); } } *************** *** 289,311 **** if (memcmp (Name, "Scintilla", 9) == 0) { ! // Perl contexte ! #ifdef PERL_OBJECT ! CPerl *pPerl; ! #endif LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong((HWND) msg->lParam, GWL_USERDATA); if (perlud != NULL) { ! ! #ifdef PERL_OBJECT ! pPerl = perlud->pPerl; ! #endif // Build name strcpy(Name, "main::"); strcat(Name, (char *) perlud->szWindowName); - switch (HIWORD(msg->wParam)) { case SCEN_CHANGE : ! strcat(Name, "_Change"); DoEvent_Generic (NOTXSCALL Name); break; --- 224,240 ---- if (memcmp (Name, "Scintilla", 9) == 0) { ! // Perl contexte LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLong((HWND) msg->lParam, GWL_USERDATA); if (perlud != NULL) { ! //fetch the perl context from perlud ! PERLUD_FETCH; // Build name strcpy(Name, "main::"); strcat(Name, (char *) perlud->szWindowName); switch (HIWORD(msg->wParam)) { case SCEN_CHANGE : ! strcat(Name, "_Change"); DoEvent_Generic (NOTXSCALL Name); break; Index: README =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/README,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** README 1 Nov 2005 10:36:51 -0000 1.1 --- README 5 Dec 2005 10:37:56 -0000 1.2 *************** *** 1,3 **** ! Win32::GUI::Scintilla version 1.7 ================================= --- 1,3 ---- ! Win32::GUI::Scintilla version 1.8 ================================= *************** *** 21,25 **** This module requires these other modules and libraries: ! Win32::GUI Scintilla (http:/www.scintilla.org/) --- 21,25 ---- This module requires these other modules and libraries: ! Win32::GUI (http://sourceforge.net/projects/perl-win32-gui) Scintilla (http:/www.scintilla.org/) *************** *** 27,30 **** --- 27,31 ---- See: http://perso.club-internet.fr/rocherl/Win32GUI.html + See: http://sourceforge.net/projects/perl-win32-gui COPYRIGHT AND LICENCE Index: Changes =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Changes,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Changes 1 Nov 2005 10:36:51 -0000 1.1 --- Changes 5 Dec 2005 10:37:56 -0000 1.2 *************** *** 1,4 **** --- 1,8 ---- Revision history for Perl extension Scintilla. + 1.8 05/12/2005 + - Fixed bugs which caused crashes and no events firing in perl 5.8.x + - Use Scintilla 1.66 + 1.7 28/02/2004 - Use Scintilla 1.59 Index: Scintilla.pm.begin =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Scintilla.pm.begin,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Scintilla.pm.begin 1 Nov 2005 10:36:51 -0000 1.1 --- Scintilla.pm.begin 5 Dec 2005 10:37:56 -0000 1.2 *************** *** 17,21 **** @ISA = qw(Exporter DynaLoader Win32::GUI::Window); ! $VERSION = '1.7'; bootstrap Win32::GUI::Scintilla $VERSION; --- 17,21 ---- @ISA = qw(Exporter DynaLoader Win32::GUI::Window); ! $VERSION = '1.8'; bootstrap Win32::GUI::Scintilla $VERSION; *************** *** 31,36 **** END { # Free Scintilla DLL - Win32::GUI::FreeLibrary($SCINTILLA_DLL); Win32::GUI::Scintilla::_UnInitialise(); } --- 31,37 ---- END { # Free Scintilla DLL Win32::GUI::Scintilla::_UnInitialise(); + #Win32::GUI::FreeLibrary($SCINTILLA_DLL); + #The above line causes some scripts to crash - such as test2.pl in the samples when running under 5.8.7 } Index: Scintilla.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Scintilla.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Scintilla.pm 1 Nov 2005 10:36:51 -0000 1.1 --- Scintilla.pm 5 Dec 2005 10:37:56 -0000 1.2 *************** *** 17,21 **** @ISA = qw(Exporter DynaLoader Win32::GUI::Window); ! $VERSION = '1.7'; bootstrap Win32::GUI::Scintilla $VERSION; --- 17,21 ---- @ISA = qw(Exporter DynaLoader Win32::GUI::Window); ! $VERSION = '1.8'; bootstrap Win32::GUI::Scintilla $VERSION; *************** *** 31,36 **** END { # Free Scintilla DLL - Win32::GUI::FreeLibrary($SCINTILLA_DLL); Win32::GUI::Scintilla::_UnInitialise(); } --- 31,37 ---- END { # Free Scintilla DLL Win32::GUI::Scintilla::_UnInitialise(); + #Win32::GUI::FreeLibrary($SCINTILLA_DLL); + #The above line causes some scripts to crash - such as test2.pl in the samples when running under 5.8.7 } |
|
From: jw <jw...@us...> - 2005-12-05 10:38:04
|
Update of /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Include In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7886/Include Modified Files: SciLexer.dll Log Message: Fixed bugs which caused crashes and no events firing in perl 5.8.x. Use Scintilla 1.66 Index: SciLexer.dll =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI-Scintilla/Include/SciLexer.dll,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvs2wPGb2 and /tmp/cvsO11Shi differ |
|
From: jw <jw...@us...> - 2005-12-05 09:39:06
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31588 Modified Files: GUI.h GUI_MessageLoops.cpp Log Message: Change to make GUI.h work under a C compiler, DoHook now explicitly passes zero Index: GUI.h =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.h,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** GUI.h 3 Dec 2005 01:56:31 -0000 1.22 --- GUI.h 5 Dec 2005 09:38:58 -0000 1.23 *************** *** 437,441 **** int DoEvent_NotifyIcon (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int iNotifyId, char* Name, ...); int DoEvent_Paint (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud); ! void DoHook(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam, int* PerlResult, int notify = 0); BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult); --- 437,441 ---- int DoEvent_NotifyIcon (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, int iNotifyId, char* Name, ...); int DoEvent_Paint (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud); ! void DoHook(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam, int* PerlResult, int notify); BOOL ProcessEventError(NOTXSPROC char *Name, int* PerlResult); *************** *** 683,687 **** int MonthCal_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam); ! // From windowsX.h (if we use any more from there, then probably better to // include it, and remove these) #define GET_X_LPARAM(lp) ((int)(short)LOWORD(lp)) --- 683,687 ---- int MonthCal_onEvent (NOTXSPROC LPPERLWIN32GUI_USERDATA perlud, UINT uMsg, WPARAM wParam, LPARAM lParam); ! // From windowsX.h (if we use any more from there, then probably better to // include it, and remove these) #define GET_X_LPARAM(lp) ((int)(short)LOWORD(lp)) *************** *** 807,811 **** #define WS_ACTIVECAPTION 0x0001 ! extern "C" BOOL WINAPI GetWindowInfo( HWND hwnd, --- 807,814 ---- #define WS_ACTIVECAPTION 0x0001 ! #ifdef __cplusplus ! extern "C" ! #endif ! BOOL WINAPI GetWindowInfo( HWND hwnd, Index: GUI_MessageLoops.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_MessageLoops.cpp,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** GUI_MessageLoops.cpp 13 Nov 2005 18:57:52 -0000 1.15 --- GUI_MessageLoops.cpp 5 Dec 2005 09:38:58 -0000 1.16 *************** *** 82,87 **** (perlud->iClass == WIN32__GUI__WINDOW || perlud->iClass == WIN32__GUI__DIALOG) ) { RECT rc; ! GetUpdateRect((HWND)hwnd, &rc, 0); ! FillRect((HDC)wParam, &rc, perlud->hBackgroundBrush); return (LRESULT) 1; } --- 82,87 ---- (perlud->iClass == WIN32__GUI__WINDOW || perlud->iClass == WIN32__GUI__DIALOG) ) { RECT rc; ! GetUpdateRect((HWND)hwnd, &rc, 0); ! FillRect((HDC)wParam, &rc, perlud->hBackgroundBrush); return (LRESULT) 1; } *************** *** 621,625 **** // Hook processing if(perlud->avHooks != NULL) { ! DoHook(NOTXSCALL perlud, uMsg, wParam, lParam, &PerlResult); } --- 621,625 ---- // Hook processing if(perlud->avHooks != NULL) { ! DoHook(NOTXSCALL perlud, uMsg, wParam, lParam, &PerlResult,0); } *************** *** 954,958 **** if (perlud->avHooks != NULL) ! DoHook(NOTXSCALL perlud, uMsg,wParam,lParam,&PerlResult); --- 954,958 ---- if (perlud->avHooks != NULL) ! DoHook(NOTXSCALL perlud, uMsg,wParam,lParam,&PerlResult,0); *************** *** 1060,1064 **** // Hook for non interactive control if (perlud->avHooks != NULL && !(perlud->dwPlStyle & PERLWIN32GUI_INTERACTIVE)) ! DoHook(NOTXSCALL perlud, uMsg,wParam,lParam,&PerlResult); if (PerlResult != 0) { --- 1060,1064 ---- // Hook for non interactive control if (perlud->avHooks != NULL && !(perlud->dwPlStyle & PERLWIN32GUI_INTERACTIVE)) ! DoHook(NOTXSCALL perlud, uMsg,wParam,lParam,&PerlResult,0); if (PerlResult != 0) { |
|
From: jw <jw...@us...> - 2005-12-03 10:37:13
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12256 Modified Files: TYPEMAP Log Message: Removed a hash lookup, results in faster method calls Index: TYPEMAP =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/TYPEMAP,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** TYPEMAP 4 Apr 2004 18:01:34 -0000 1.4 --- TYPEMAP 3 Dec 2005 10:37:03 -0000 1.5 *************** *** 35,44 **** T_HANDLE if(SvROK($arg)) { ! if(hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0) != NULL) ! $var = ($type) SvIV(*(hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0))); else $var = NULL; } else ! $var = ($type) SvIV($arg); T_COLOR $var = SvCOLORREF(NOTXSCALL $arg); --- 35,46 ---- T_HANDLE if(SvROK($arg)) { ! SV** out=hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0); ! if(out != NULL) ! $var = ($type) SvIV(*out); else $var = NULL; } else ! $var = ($type) SvIV($arg); ! T_COLOR $var = SvCOLORREF(NOTXSCALL $arg); |
|
From: Robert M. <rob...@us...> - 2005-12-03 01:56:45
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28500 Modified Files: CHANGELOG GUI.h GUI.pm GUI.xs ListView.xs Listbox.xs Readme.html Log Message: Bug fixes (1.03_01) Index: GUI.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** GUI.xs 13 Nov 2005 18:57:52 -0000 1.46 --- GUI.xs 3 Dec 2005 01:56:31 -0000 1.47 *************** *** 950,967 **** } ! if(fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) { ! continue; ! } ! ! if(acc && TranslateAccelerator(phwnd, acc, &msg)) { ! continue; ! } ! ! if(fIsDialog && IsDialogMessage(phwnd, &msg)) { ! continue; } - - TranslateMessage(&msg); - DispatchMessage(&msg); } --- 950,960 ---- } ! if( !( (fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) || ! (acc && TranslateAccelerator(phwnd, acc, &msg)) || ! (fIsDialog && IsDialogMessage(phwnd, &msg)) ) ! ){ ! TranslateMessage(&msg); ! DispatchMessage(&msg); } } *************** *** 1025,1042 **** } ! if(fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) { ! continue; ! } ! ! if(acc && TranslateAccelerator(phwnd, acc, &msg)) { ! continue; ! } ! ! if(fIsDialog && IsDialogMessage(phwnd, &msg)) { ! continue; } - - TranslateMessage(&msg); - DispatchMessage(&msg); } } --- 1018,1028 ---- } ! if( !( (fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) || ! (acc && TranslateAccelerator(phwnd, acc, &msg)) || ! (fIsDialog && IsDialogMessage(phwnd, &msg)) ) ! ){ ! TranslateMessage(&msg); ! DispatchMessage(&msg); } } } *************** *** 1136,1153 **** } ! if(fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) { ! continue; ! } ! ! if(acc && TranslateAccelerator(handle, acc, &msg)) { ! continue; ! } ! ! if(fIsDialog && IsDialogMessage(handle, &msg)) { ! continue; } - - TranslateMessage(&msg); - DispatchMessage(&msg); } --- 1122,1132 ---- } ! if( !( (fIsMDI && TranslateMDISysAccel((HWND)perlud->dwData, &msg)) || ! (acc && TranslateAccelerator(phwnd, acc, &msg)) || ! (fIsDialog && IsDialogMessage(phwnd, &msg)) ) ! ){ ! TranslateMessage(&msg); ! DispatchMessage(&msg); } } Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** GUI.pm 21 Nov 2005 22:33:33 -0000 1.35 --- GUI.pm 3 Dec 2005 01:56:31 -0000 1.36 *************** *** 25,29 **** # STATIC OBJECT PROPERTIES # ! $VERSION = "1.03"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) --- 25,29 ---- # STATIC OBJECT PROPERTIES # ! $VERSION = "1.03_01"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) *************** *** 1845,1848 **** --- 1845,1850 ---- sub new { $Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32") unless defined $Win32::GUI::RICHED; + #TODO: should FreeLibrary when last RichEdit control gets DESTROYed, rather than + #allowing the process tidy-up to do it. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__RICHEDIT", 0), @_); } *************** *** 3428,3438 **** ); - #$Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32"); - - #END { - # print "Freeing library RICHED32\n"; - # Win32::GUI::FreeLibrary($Win32::GUI::RICHED); - #} - #Currently Autoloading is not implemented in Perl for win32 # Autoload methods go after __END__, and are processed by the autosplit program. --- 3430,3433 ---- Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.68 retrieving revision 1.69 diff -C2 -d -r1.68 -r1.69 *** CHANGELOG 22 Nov 2005 20:54:45 -0000 1.68 --- CHANGELOG 3 Dec 2005 01:56:31 -0000 1.69 *************** *** 6,9 **** --- 6,18 ---- Win32-GUI ChangeLog =================== + + [Robert May] : 3 Dec 2003 - bug fixes + - GUI.h change order of instructions to prevent crashes (Trackers + 1243378 and 1248578) + - GUI.pm up version to 1.03_01 and tidy up + - GUI.xs change logic in all message loops (Dialog, DoEvents, DoModal) to + prevent memoy leak (Tracker: 1201190) + - Listbox.xs add documentation to differentiate between SetCurSel and + SetSel + + [Robert May] : 22 Nov 2003 - 1.03 release - Tagged head as Win32-GUI-1_03 Index: ListView.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/ListView.xs,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ListView.xs 3 Aug 2005 21:45:57 -0000 1.9 --- ListView.xs 3 Dec 2005 01:56:31 -0000 1.10 *************** *** 329,334 **** RETVAL - # TODO : ListView_CreateDragImage - ########################################################################### # (@)METHOD:CreateDragImage(index, xcor, ycor) --- 329,332 ---- Index: GUI.h =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.h,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -d -r1.21 -r1.22 *** GUI.h 6 Oct 2005 21:27:40 -0000 1.21 --- GUI.h 3 Dec 2005 01:56:31 -0000 1.22 *************** *** 319,323 **** #define WORD __TEMP_WORD ! #define PERLUD_FREE Perlud_Free(NOTXSCALL perlud); SetWindowLong(hwnd, GWL_USERDATA, (LONG) NULL); /* * Section for the constant definitions. --- 319,323 ---- #define WORD __TEMP_WORD ! #define PERLUD_FREE SetWindowLong(hwnd, GWL_USERDATA, (LONG) NULL); Perlud_Free(NOTXSCALL perlud); /* * Section for the constant definitions. Index: Listbox.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Listbox.xs,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Listbox.xs 16 Oct 2005 08:03:20 -0000 1.4 --- Listbox.xs 3 Dec 2005 01:56:31 -0000 1.5 *************** *** 587,593 **** ########################################################################### ! # (@)METHOD:SetCurSel(index) # (@)METHOD:Select(INDEX) ! # Selects the zero-based INDEX item in the Listbox. LRESULT SetCurSel(handle,index) --- 587,595 ---- ########################################################################### ! # (@)METHOD:SetCurSel(INDEX) # (@)METHOD:Select(INDEX) ! # Selects the zero-based INDEX item in the Listbox. Can only be used ! # with single selection listboxes. For multiple-selection listboxes ! # see SetSel(). LRESULT SetCurSel(handle,index) Index: Readme.html =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Readme.html,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Readme.html 21 Nov 2005 22:33:33 -0000 1.4 --- Readme.html 3 Dec 2005 01:56:31 -0000 1.5 *************** *** 1,205 **** ! <HTML> ! <HEAD> ! <TITLE>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</TITLE> ! <LINK REV="made" HREF="mailto:"> ! </HEAD> ! <BODY> ! <A NAME="__index__"></A> <!-- INDEX BEGIN --> ! <UL> ! <LI><A HREF="#name">NAME</A></LI> ! <LI><A HREF="#description">DESCRIPTION</A></LI> ! <LI><A HREF="#availability">AVAILABILITY</A></LI> ! <LI><A HREF="#installing">INSTALLING</A></LI> ! <UL> ! <LI><A HREF="#activestate activeperl ppms">ActiveState ActivePerl PPMs</A></LI> ! <LI><A HREF="#cygwin">Cygwin</A></LI> ! </UL> ! <LI><A HREF="#building from source">Building from source</A></LI> ! <UL> ! <LI><A HREF="#microsoft visual c++ v6">Microsoft Visual C++ V6</A></LI> ! <LI><A HREF="#mingw and extutils::fakeconfig">MinGW and ExtUtils::FakeConfig</A></LI> ! <LI><A HREF="#cygwin">Cygwin</A></LI> ! </UL> ! <LI><A HREF="#documentation">Documentation</A></LI> ! <UL> ! <LI><A HREF="#pod documentation">POD documentation</A></LI> ! <LI><A HREF="#html documentation">HTML Documentation</A></LI> ! </UL> ! <LI><A HREF="#building your own ppm from source">Building your own PPM from source</A></LI> ! <LI><A HREF="#version">VERSION</A></LI> ! <LI><A HREF="#support">SUPPORT</A></LI> ! <LI><A HREF="#copyright and licence">COPYRIGHT and LICENCE</A></LI> ! </UL> <!-- INDEX END --> ! <HR> ! <P> ! <H1><A NAME="name">NAME</A></H1> ! <P>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</P> ! <P> ! <HR> ! <H1><A NAME="description">DESCRIPTION</A></H1> ! <P>Win32::GUI is a Win32-platform native graphical user interface toolkit for perl. Basically, it's an XS implementation of most of the functions found in user32.dll and gdi32.dll, with an object oriented perl interface and an ! event-based dialog model that mimic the functionality of visual basic.</P> ! <P> ! <HR> ! <H1><A NAME="availability">AVAILABILITY</A></H1> ! <P>This is the README file for Win32::GUI v1.03 ! built on 21 Nov 2005.</P> ! <P>Source and ActiveState Perl PPMs are available from ! <A HREF="http://sourceforge.net/project/showfiles.php?group_id=16572">http://sourceforge.net/project/showfiles.php</A>.</P> ! <P>A cygwin distribution (available through cygwin's setup.exe) is maintained ! by Reini Urban (<A HREF="mailto:ru...@x-...">ru...@x-...</A>)</P> ! <P>If the Win32::GUI version number contains an underscore, then it is an alpha, beta or release candidate distribution. If there is no such underscore, then ! it is a stable release.</P> ! <P> ! <HR> ! <H1><A NAME="installing">INSTALLING</A></H1> ! <P> ! <H2><A NAME="activestate activeperl ppms">ActiveState ActivePerl PPMs</A></H2> ! <P>It is recommended to uninstall any previous version of Win32::GUI before installing a new version. This ensures old documentation is removed correctly. ! From a command prompt run:</P> ! <PRE> ! ppm uninstall Win32-GUI</PRE> ! <P>If you have any packages that are dependent on Win32::GUI you may need to add ! the <CODE>-force</CODE> option to the command line. See your documentation for PPM.</P> ! <P>Unzip the PPM distribution into a local directory. From a command ! prompt in that directory run:</P> ! <PRE> ! ppm install ./Win32-GUI.ppd</PRE> ! <P> ! <H2><A NAME="cygwin">Cygwin</A></H2> ! <P>Runtime requirements:</P> ! <PRE> cygwin perl-5.8.6 ! w32api</PRE> ! <P>Use the cygwin setup.exe tool to locate, download and install ! the perl-Win32-GUI binary package.</P> ! <P>Cygwin port questions to the mailinglist <<A HREF="mailto:cy...@cy...">cy...@cy...</A>></P> ! <P> ! <HR> ! <H1><A NAME="building from source">Building from source</A></H1> ! <P>Unpack the distribution into a local directory, and from a command ! prompt in that directory follow the instructions below.</P> ! <P>These instructions assume that you have already set up your build environment, and can build source distributions. The following ! environments are known to work:</P> ! <P> ! <H2><A NAME="microsoft visual c++ v6">Microsoft Visual C++ V6</A></H2> ! <P>Other versions may work. There are reported issues with VC++ 7 which links with a different C runtime to VC++ 6, and so you may have ! issues running an extension built with VC++ 7 with the ActiveState Perls.</P> ! <PRE> perl Makefle.PL nmake nmake test ! nmake install</PRE> ! <P> ! <H2><A NAME="mingw and extutils::fakeconfig">MinGW and ExtUtils::FakeConfig</A></H2> ! <PRE> perl -MConfig_m Makefile.PL nmake nmake test ! nmake install</PRE> ! <P>Built this way the GUI.dll extension can be very large (~3MB). There is a ! module in the <EM>build_tools</EM> directory that works with <STRONG>Config_m</STRONG> and ! <A HREF="/ExtUtils/FakeConfig.html">Extutils::FakeConfig</A> to set the MinGW compiler flags more optimally. If you want to try this, then replace the first ! command with:</P> ! <PRE> ! perl -Ibuild_tools -MConfig_mO Makefile.PL</PRE> ! <P> ! <H2><A NAME="cygwin">Cygwin</A></H2> ! <P>Build requirements (over and above the runtime requirements above):</P> ! <PRE> cygwin cygutils gcc make ! gzip</PRE> ! <P>Build instructions:</P> ! <P>unpack <EM>perl-Win32-GUI-X.XX-X-src.tar.bz2</EM>. If you use setup to install ! this src package, it will be unpacked under <EM>/usr/src</EM> automatically.</P> ! <PRE> cd /usr/src ! ./perl-Win32-GUI-X.XX-X.sh all</PRE> ! <P>This will create:</P> ! <PRE> /usr/src/perl-Win32-GUI-X.XX-X.tar.bz2 ! /usr/src/perl-Win32-GUI-X.XX-X-src.tar.bz2</PRE> ! <P>Port Notes:</P> ! <P>The dll's must probably be rebased. If a remap error occurs run rebaseall from ! the rebase package. The packaged version is already rebased to my personal settings.</P> ! <P>For a source build from the official source, the standard build process ! should be sufficient:</P> ! <PRE> Perl Makefile.PL make make test ! make install</PRE> ! <P> ! <HR> ! <H1><A NAME="documentation">Documentation</A></H1> ! <P> ! <H2><A NAME="pod documentation">POD documentation</A></H2> ! <P>When building from source the POD documentation is built automatically ! by the make process. It can also be generated by issuing:</P> ! <PRE> ! nmake poddocs;</PRE> ! <P> ! <H2><A NAME="html documentation">HTML Documentation</A></H2> ! <P>HTML documentation is included with the PPM distributions, and installed ! into your ActiveState Perl documentation tree by the install process.</P> ! <P>The HTML documentation can also be generated by issuing:</P> ! <PRE> ! nmake htmldocs;</PRE> ! <P> ! <HR> ! <H1><A NAME="building your own ppm from source">Building your own PPM from source</A></H1> ! <P>You will need <STRONG>tar</STRONG>, <STRONG>gzip</STRONG> and <STRONG>zip</STRONG> utilities on your path. Issue ! the following commands.</P> ! <PRE> perl Makefile.PL (adjust as necessary for your build environment) nmake nmake test ! nmake ppm</PRE> ! <P>This procedure will generate a PPM for you current perl environment, ! including the HTML documentation, ready for installation as above.</P> ! <P> ! <HR> ! <H1><A NAME="version">VERSION</A></H1> ! <P>Documentation for Win32::GUI v1.03 created 21 Nov 2005</P> ! <P>This document is autogenerated by the build process. Edits made here will be lost. ! Edit <EM>docs/GUI/UserGuide/Readme.pod</EM> instead.</P> ! <P> ! <HR> ! <H1><A NAME="support">SUPPORT</A></H1> ! <P>Homepage: <A HREF="http://perl-win32-gui.sourceforge.net/">http://perl-win32-gui.sourceforge.net/</A>.</P> ! <P>For further support join the users mailing list(<CODE>per...@li...</CODE>) from the website ! at <A HREF="http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users">http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users</A>. There is a searchable list archive at <A HREF="http://sourceforge.net/mail/?group_id=16572">http://sourceforge.net/mail/</A>.</P> ! <P> ! <HR> ! <H1><A NAME="copyright and licence">COPYRIGHT and LICENCE</A></H1> ! <P>Copyright (c) 1997..2005 Aldo Calpini. All rights reserved.</P> ! <P>This program is free software; you can redistribute it and/or ! modify it under the same terms as Perl itself.</P> ! </BODY> ! </HTML> --- 1,223 ---- ! <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> ! <html xmlns="http://www.w3.org/1999/xhtml"> ! <head> ! <title>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</title> ! <link rev="made" href="mailto:" /> ! </head> ! <body style="background-color: white"> ! <p><a name="__index__"></a></p> <!-- INDEX BEGIN --> ! <ul> ! <li><a href="#name">NAME</a></li> ! <li><a href="#description">DESCRIPTION</a></li> ! <li><a href="#availability">AVAILABILITY</a></li> ! <li><a href="#installing">INSTALLING</a></li> ! <ul> ! <li><a href="#activestate_activeperl_ppms">ActiveState ActivePerl PPMs</a></li> ! <li><a href="#cygwin">Cygwin</a></li> ! </ul> ! <li><a href="#building_from_source">Building from source</a></li> ! <ul> ! <li><a href="#microsoft_visual_c___v6">Microsoft Visual C++ V6</a></li> ! <li><a href="#mingw_and_extutils__fakeconfig">MinGW and ExtUtils::FakeConfig</a></li> ! <li><a href="#cygwin">Cygwin</a></li> ! </ul> ! <li><a href="#documentation">Documentation</a></li> ! <ul> ! <li><a href="#pod_documentation">POD documentation</a></li> ! <li><a href="#html_documentation">HTML Documentation</a></li> ! </ul> ! <li><a href="#building_your_own_ppm_from_source">Building your own PPM from source</a></li> ! <li><a href="#version">VERSION</a></li> ! <li><a href="#support">SUPPORT</a></li> ! <li><a href="#copyright_and_licence">COPYRIGHT and LICENCE</a></li> ! </ul> <!-- INDEX END --> ! <hr /> ! <p> ! </p> ! <h1><a name="name">NAME</a></h1> ! <p>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</p> ! <p> ! </p> ! <hr /> ! <h1><a name="description">DESCRIPTION</a></h1> ! <p>Win32::GUI is a Win32-platform native graphical user interface toolkit for perl. Basically, it's an XS implementation of most of the functions found in user32.dll and gdi32.dll, with an object oriented perl interface and an ! event-based dialog model that mimic the functionality of visual basic.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="availability">AVAILABILITY</a></h1> ! <p>This is the README file for Win32::GUI v1.03 ! built on 22 Nov 2005.</p> ! <p>Source and ActiveState Perl PPMs are available from ! <a href="http://sourceforge.net/project/showfiles.php?group_id=16572">http://sourceforge.net/project/showfiles.php</a>.</p> ! <p>A cygwin distribution (available through cygwin's setup.exe) is maintained ! by Reini Urban (<a href="mailto:ru...@x-...">ru...@x-...</a>)</p> ! <p>If the Win32::GUI version number contains an underscore, then it is an alpha, beta or release candidate distribution. If there is no such underscore, then ! it is a stable release.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="installing">INSTALLING</a></h1> ! <p> ! </p> ! <h2><a name="activestate_activeperl_ppms">ActiveState ActivePerl PPMs</a></h2> ! <p>It is recommended to uninstall any previous version of Win32::GUI before installing a new version. This ensures old documentation is removed correctly. ! From a command prompt run:</p> ! <pre> ! ppm uninstall Win32-GUI</pre> ! <p>If you have any packages that are dependent on Win32::GUI you may need to add ! the <code>-force</code> option to the command line. See your documentation for PPM.</p> ! <p>Unzip the PPM distribution into a local directory. From a command ! prompt in that directory run:</p> ! <pre> ! ppm install ./Win32-GUI.ppd</pre> ! <p> ! </p> ! <h2><a name="cygwin">Cygwin</a></h2> ! <p>Runtime requirements:</p> ! <pre> cygwin perl-5.8.6 ! w32api</pre> ! <p>Use the cygwin setup.exe tool to locate, download and install ! the perl-Win32-GUI binary package.</p> ! <p>Cygwin port questions to the mailinglist <<a href="mailto:cy...@cy...">cy...@cy...</a>></p> ! <p> ! </p> ! <hr /> ! <h1><a name="building_from_source">Building from source</a></h1> ! <p>Unpack the distribution into a local directory, and from a command ! prompt in that directory follow the instructions below.</p> ! <p>These instructions assume that you have already set up your build environment, and can build source distributions. The following ! environments are known to work:</p> ! <p> ! </p> ! <h2><a name="microsoft_visual_c___v6">Microsoft Visual C++ V6</a></h2> ! <p>Other versions may work. There are reported issues with VC++ 7 which links with a different C runtime to VC++ 6, and so you may have ! issues running an extension built with VC++ 7 with the ActiveState Perls.</p> ! <pre> perl Makefle.PL nmake nmake test ! nmake install</pre> ! <p> ! </p> ! <h2><a name="mingw_and_extutils__fakeconfig">MinGW and ExtUtils::FakeConfig</a></h2> ! <pre> perl -MConfig_m Makefile.PL nmake nmake test ! nmake install</pre> ! <p>Built this way the GUI.dll extension can be very large (~3MB). There is a ! module in the <em>build_tools</em> directory that works with <strong>Config_m</strong> and ! <a href="/ExtUtils/FakeConfig.html">Extutils::FakeConfig</a> to set the MinGW compiler flags more optimally. If you want to try this, then replace the first ! command with:</p> ! <pre> ! perl -Ibuild_tools -MConfig_mO Makefile.PL</pre> ! <p> ! </p> ! <h2><a name="cygwin">Cygwin</a></h2> ! <p>Build requirements (over and above the runtime requirements above):</p> ! <pre> cygwin cygutils gcc make ! gzip</pre> ! <p>Build instructions:</p> ! <p>unpack <em>perl-Win32-GUI-X.XX-X-src.tar.bz2</em>. If you use setup to install ! this src package, it will be unpacked under <em>/usr/src</em> automatically.</p> ! <pre> cd /usr/src ! ./perl-Win32-GUI-X.XX-X.sh all</pre> ! <p>This will create:</p> ! <pre> /usr/src/perl-Win32-GUI-X.XX-X.tar.bz2 ! /usr/src/perl-Win32-GUI-X.XX-X-src.tar.bz2</pre> ! <p>Port Notes:</p> ! <p>The dll's must probably be rebased. If a remap error occurs run rebaseall from ! the rebase package. The packaged version is already rebased to my personal settings.</p> ! <p>For a source build from the official source, the standard build process ! should be sufficient:</p> ! <pre> Perl Makefile.PL make make test ! make install</pre> ! <p> ! </p> ! <hr /> ! <h1><a name="documentation">Documentation</a></h1> ! <p> ! </p> ! <h2><a name="pod_documentation">POD documentation</a></h2> ! <p>When building from source the POD documentation is built automatically ! by the make process. It can also be generated by issuing:</p> ! <pre> ! nmake poddocs;</pre> ! <p> ! </p> ! <h2><a name="html_documentation">HTML Documentation</a></h2> ! <p>HTML documentation is included with the PPM distributions, and installed ! into your ActiveState Perl documentation tree by the install process.</p> ! <p>The HTML documentation can also be generated by issuing:</p> ! <pre> ! nmake htmldocs;</pre> ! <p> ! </p> ! <hr /> ! <h1><a name="building_your_own_ppm_from_source">Building your own PPM from source</a></h1> ! <p>You will need <strong>tar</strong>, <strong>gzip</strong> and <strong>zip</strong> utilities on your path. Issue ! the following commands.</p> ! <pre> perl Makefile.PL (adjust as necessary for your build environment) nmake nmake test ! nmake ppm</pre> ! <p>This procedure will generate a PPM for you current perl environment, ! including the HTML documentation, ready for installation as above.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="version">VERSION</a></h1> ! <p>Documentation for Win32::GUI v1.03 created 22 Nov 2005</p> ! <p>This document is autogenerated by the build process. Edits made here will be lost. ! Edit <em>docs/GUI/UserGuide/Readme.pod</em> instead.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="support">SUPPORT</a></h1> ! <p>Homepage: <a href="http://perl-win32-gui.sourceforge.net/">http://perl-win32-gui.sourceforge.net/</a>.</p> ! <p>For further support join the users mailing list(<code>per...@li...</code>) from the website ! at <a href="http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users">http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users</a>. There is a searchable list archive at <a href="http://sourceforge.net/mail/?group_id=16572">http://sourceforge.net/mail/</a>.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="copyright_and_licence">COPYRIGHT and LICENCE</a></h1> ! <p>Copyright (c) 1997..2005 Aldo Calpini. All rights reserved.</p> ! <p>This program is free software; you can redistribute it and/or ! modify it under the same terms as Perl itself.</p> ! </body> ! </html> |
|
From: Robert M. <rob...@us...> - 2005-12-03 01:56:45
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/UserGuide In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28500/docs/GUI/UserGuide Modified Files: Readme.pod Log Message: Bug fixes (1.03_01) Index: Readme.pod =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/UserGuide/Readme.pod,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Readme.pod 21 Nov 2005 22:33:34 -0000 1.5 --- Readme.pod 3 Dec 2005 01:56:31 -0000 1.6 *************** *** 158,162 **** nmake ppm ! This procedure will generate a PPM for you current perl environment, including the HTML documentation, ready for installation as above. --- 158,162 ---- nmake ppm ! This procedure will generate a PPM for your current perl environment, including the HTML documentation, ready for installation as above. |
|
From: Robert M. <rob...@us...> - 2005-11-22 20:54:57
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30370 Modified Files: CHANGELOG Log Message: 1.03 Release Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.67 retrieving revision 1.68 diff -C2 -d -r1.67 -r1.68 *** CHANGELOG 21 Nov 2005 22:33:33 -0000 1.67 --- CHANGELOG 22 Nov 2005 20:54:45 -0000 1.68 *************** *** 6,9 **** --- 6,12 ---- Win32-GUI ChangeLog =================== + + [Robert May] : 22 Nov 2003 - 1.03 release + - Tagged head as Win32-GUI-1_03 + + [Robert May] : 21 Nov 2003 - 1.03 release candidate - t\05_Timer_*.t change interval test to use milli-seconds using |
|
From: Robert M. <rob...@us...> - 2005-11-21 22:33:52
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1048 Modified Files: CHANGELOG GUI.pm GUI.rc MANIFEST Makefile.PL Readme Readme.html TODO Log Message: Tests and 1.03 release candidate Index: GUI.rc =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.rc,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** GUI.rc 5 Oct 2005 22:20:48 -0000 1.5 --- GUI.rc 21 Nov 2005 22:33:33 -0000 1.6 *************** *** 8,13 **** 1 VERSIONINFO ! FILEVERSION 1,02,02,00 ! PRODUCTVERSION 1,02,02,00 FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL --- 8,13 ---- 1 VERSIONINFO ! FILEVERSION 1,03,00,00 ! PRODUCTVERSION 1,03,00,00 FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL *************** *** 17,24 **** BLOCK "040904E4" { ! VALUE "Comments" , "Win32::GUI Perl module v1.02_02" VALUE "CompanyName" , "Open Source" VALUE "FileDescription" , "perl-win32-gui Perl extension" ! VALUE "FileVersion" , "1.02_02" VALUE "InternalName" , "GUI.dll" VALUE "LegalCopyright" , "Copyright © Aldo Caplini 1997..2005" --- 17,24 ---- BLOCK "040904E4" { ! VALUE "Comments" , "Win32::GUI Perl module v1.03" VALUE "CompanyName" , "Open Source" VALUE "FileDescription" , "perl-win32-gui Perl extension" ! VALUE "FileVersion" , "1.03" VALUE "InternalName" , "GUI.dll" VALUE "LegalCopyright" , "Copyright © Aldo Caplini 1997..2005" *************** *** 26,30 **** VALUE "OriginalFilename" , "GUI.dll" VALUE "ProductName" , "Win32::GUI" ! VALUE "ProductVersion" , "1.02_02" } } --- 26,30 ---- VALUE "OriginalFilename" , "GUI.dll" VALUE "ProductName" , "Win32::GUI" ! VALUE "ProductVersion" , "1.03" } } Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Makefile.PL,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** Makefile.PL 13 Nov 2005 18:57:52 -0000 1.14 --- Makefile.PL 21 Nov 2005 22:33:33 -0000 1.15 *************** *** 2,5 **** --- 2,6 ---- use warnings; + use File::Spec(); use ExtUtils::MakeMaker; use Config; *************** *** 7,13 **** $main::USERESOURCE = 1; $main::BUILDENV = ''; # parse our command line options, removing them from @ARGV so that ! # MakeMaker doesn't warm that they are unrecoginised. my @tmp; foreach (@ARGV) { --- 8,15 ---- $main::USERESOURCE = 1; $main::BUILDENV = ''; + $main::BUILDENV_SETONCMDLINE = 0; # parse our command line options, removing them from @ARGV so that ! # MakeMaker doesn't warn that they are unrecoginised. my @tmp; foreach (@ARGV) { *************** *** 20,23 **** --- 22,26 ---- elsif(/BUILDENV=(.*)/) { $main::BUILDENV = $1; + $main::BUILDENV_SETONCMDLINE = 1; } else { *************** *** 63,67 **** __NOBUILDENV ! print "$_\t($allowed{$_})\n" for (keys %allowed); exit(1); --- 66,70 ---- __NOBUILDENV ! print "$_\t($allowed{$_})\n" for (keys %allowed); exit(1); *************** *** 83,86 **** --- 86,125 ---- print "\n\nBUILDENV=$main::BUILDENV Used build environment is: $allowed{$main::BUILDENV}\n\n"; + # If we got this far, then we have a buildenv and compiler that + # we want to try to use. Check that we can find the compiler, + # and exit with a nice error message if we can't. This stops + # us from failing CPAN Smoke tests on boxes that don't have + # compilers. + if($main::BUILDENV_SETONCMDLINE == 0) { + my @path = File::Spec->path(); + unshift @path, ('', '.'); + + my $found = 0; + foreach my $prog ( map { ( $_, "$_.exe" ) } ($Config{cc}) ) { + foreach my $path ( @path ) { + if( -f File::Spec->catfile( $path, $prog ) ) { + $found=1, last; + } + } + } + + if(!$found) { + print STDERR <<__NOCOMPILER; + + Makefile.PL was unable to find compiler '$Config{cc}' on your path. + To force a build call this script with the additional parameter 'BUILDENV': + + perl Makefile.PL BUILDENV=xxxx + + where xxxx is one of: + __NOCOMPILER + + print "$_\t($allowed{$_})\n" for (keys %allowed); + + + exit(1); + } + } + if($main::USERESOURCE == -1) { $main::USERESOURCE = 0; *************** *** 187,203 **** BINARY_LOCATION => 'Win32-GUI.tar.gz', macro => { ! BUILD_TOOLS => './build_tools', ! INST_DEMO => '$(INST_LIBDIR)/GUI/demos', ! PPMDISTVNAME => '$(DISTVNAME)-PPM-' . substr($Config{version},0,3), ! }, clean => { ! FILES => 'comctrl32.def cygwin.o libcyg.a GUI.res', ! }, realclean => { ! FILES => '$(PPMDISTVNAME) Readme.old Readme.html.old', ! }, depend => { ! distdir => 'readmedocs', ! }, ); --- 226,242 ---- BINARY_LOCATION => 'Win32-GUI.tar.gz', macro => { ! BUILD_TOOLS => './build_tools', ! INST_DEMO => '$(INST_LIBDIR)/GUI/demos', ! PPMDISTVNAME => '$(DISTVNAME)-PPM-' . substr($Config{version},0,3), ! }, clean => { ! FILES => 'comctrl32.def cygwin.o libcyg.a GUI.res', ! }, realclean => { ! FILES => '$(PPMDISTVNAME) Readme.old Readme.html.old', ! }, depend => { ! distdir => 'readmedocs', ! }, ); *************** *** 208,216 **** } - if ($main::BUILDENV eq "mingw") { - #$MakefileArgs{'LIBS'} = [':nosearch -lcomctl32']; - #$MakefileArgs{'DEFINE'} = '-D__MINGW__'; # should really use __MINGW32__, as that's defined by the compiler - } - WriteMakefile( %MakefileArgs ); --- 247,250 ---- Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** GUI.pm 13 Nov 2005 18:57:52 -0000 1.34 --- GUI.pm 21 Nov 2005 22:33:33 -0000 1.35 *************** *** 25,29 **** # STATIC OBJECT PROPERTIES # ! $VERSION = "1.02_03"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) --- 25,29 ---- # STATIC OBJECT PROPERTIES # ! $VERSION = "1.03"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.66 retrieving revision 1.67 diff -C2 -d -r1.66 -r1.67 *** CHANGELOG 13 Nov 2005 18:57:52 -0000 1.66 --- CHANGELOG 21 Nov 2005 22:33:33 -0000 1.67 *************** *** 6,9 **** --- 6,19 ---- Win32-GUI ChangeLog =================== + + [Robert May] : 21 Nov 2003 - 1.03 release candidate + - t\05_Timer_*.t change interval test to use milli-seconds using + Win32::GetTickCount() rather than time(). + -t\01_basic.t add tests for Test::More availability and correct OS. + -t\98_Pod.t new test of POD syntax + - various minor documentation edits to correct POD syntax + -Makefile.PL added test for presence of compiler to stop us failing CPAN + Smoke tests in test environments with no compilers. + - Up version to 1.03 + + [Robert May] : 13 Nov 2005 - Bug fixes and preparing for 1.03 release - Makefile.PL added code to remove Test::More dependence from PPD Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/MANIFEST,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** MANIFEST 13 Nov 2005 18:57:52 -0000 1.10 --- MANIFEST 21 Nov 2005 22:33:33 -0000 1.11 *************** *** 124,127 **** --- 124,128 ---- t/50_Font_GetMetrics.t t/50_Richedit_GetCharFormat.t + t/98_Pod.t TabStrip.xs Textfield.xs Index: Readme =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Readme,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Readme 10 Jul 2005 11:24:29 -0000 1.3 --- Readme 21 Nov 2005 22:33:33 -0000 1.4 *************** *** 14,21 **** AVAILABILITY ! This is the README file for Win32::GUI v1.02 built on 10 Jul 2005. Source and ActiveState Perl PPMs are available from ! <http://sourceforge.net/project/showfiles.php?group_id=16572>. A cygwin distribution (available through cygwin's setup.exe) is --- 14,21 ---- AVAILABILITY ! This is the README file for Win32::GUI v1.03 built on 21 Nov 2005. Source and ActiveState Perl PPMs are available from ! http://sourceforge.net/project/showfiles.php?group_id=16572. A cygwin distribution (available through cygwin's setup.exe) is *************** *** 58,62 **** Cygwin port questions to the mailinglist <cy...@cy...> ! Building from source Unpack the distribution into a local directory, and from a command --- 58,62 ---- Cygwin port questions to the mailinglist <cy...@cy...> ! Building from source Unpack the distribution into a local directory, and from a command *************** *** 67,135 **** environments are known to work: ! 1. Microsoft Visual C++ V6 ! Other versions may work. There are reported issues with VC++ 7 which ! links with a different C runtime to VC++ 6, and so you may have ! issues running an extension built with VC++ 7 with the ActiveState ! Perls. ! perl Makefle.PL ! nmake ! nmake test ! nmake install ! 2. MinGW and ExtUtils::FakeConfig ! perl -MConfig_m Makefile.PL ! nmake ! nmake test ! nmake install ! Built this way the GUI.dll extension can be very large (~3MB). There ! is a module in the build_tools directory that works with Config_m ! and Extutils::FakeConfig to set the MinGW compiler flags more ! optimally. If you want to try this, then replace the first command ! with: ! perl -Ibuild_tools -MConfig_mO Makefile.PL ! 3. Cygwin ! Build requirements (over and above the runtime requirements above): ! cygwin ! cygutils ! gcc ! make ! gzip ! Build instructions: ! unpack perl-Win32-GUI-1.0-2-src.tar.bz2. If you use setup to install ! this src package, it will be unpacked under /usr/src automatically. ! cd /usr/src ! ./perl-Win32-GUI-1.0-2.sh all ! This will create: ! /usr/src/perl-Win32-GUI-1.0-2.tar.bz2 ! /usr/src/perl-Win32-GUI-1.0-2-src.tar.bz2 ! Port Notes: ! The dll's must probably be rebased. If a remap error occurs run ! rebaseall from the rebase package. The packaged version is already ! rebased to my personal settings. ! For a source build from the official source, the standard build ! process should be sufficient: ! Perl Makefile.PL ! make ! make test ! make install ! Documentation - HTML documentation is included with the PPM distributions, and installed - into your ActiveState Perl documentation tree by the install process. When building from source the POD documentation is built automatically by the make process. It can also be generated by issuing: --- 67,136 ---- environments are known to work: ! Microsoft Visual C++ V6 ! Other versions may work. There are reported issues with VC++ 7 which ! links with a different C runtime to VC++ 6, and so you may have issues ! running an extension built with VC++ 7 with the ActiveState Perls. ! perl Makefle.PL ! nmake ! nmake test ! nmake install ! MinGW and ExtUtils::FakeConfig ! perl -MConfig_m Makefile.PL ! nmake ! nmake test ! nmake install ! Built this way the GUI.dll extension can be very large (~3MB). There is ! a module in the build_tools directory that works with Config_m and ! Extutils::FakeConfig to set the MinGW compiler flags more optimally. If ! you want to try this, then replace the first command with: ! perl -Ibuild_tools -MConfig_mO Makefile.PL ! Cygwin ! Build requirements (over and above the runtime requirements above): ! cygwin ! cygutils ! gcc ! make ! gzip ! Build instructions: ! unpack perl-Win32-GUI-X.XX-X-src.tar.bz2. If you use setup to install ! this src package, it will be unpacked under /usr/src automatically. ! cd /usr/src ! ./perl-Win32-GUI-X.XX-X.sh all ! This will create: ! /usr/src/perl-Win32-GUI-X.XX-X.tar.bz2 ! /usr/src/perl-Win32-GUI-X.XX-X-src.tar.bz2 ! Port Notes: ! The dll's must probably be rebased. If a remap error occurs run ! rebaseall from the rebase package. The packaged version is already ! rebased to my personal settings. ! ! For a source build from the official source, the standard build process ! should be sufficient: ! ! Perl Makefile.PL ! make ! make test ! make install ! ! Documentation ! ! POD documentation When building from source the POD documentation is built automatically by the make process. It can also be generated by issuing: *************** *** 137,145 **** nmake poddocs; ! The HTML documentation can be built by issuing: nmake htmldocs; ! Building your own PPM from source perl Makefile.PL (adjust as necessary for your build environment) --- 138,154 ---- nmake poddocs; ! HTML Documentation ! ! HTML documentation is included with the PPM distributions, and installed ! into your ActiveState Perl documentation tree by the install process. ! ! The HTML documentation can also be generated by issuing: nmake htmldocs; ! Building your own PPM from source ! ! You will need tar, gzip and zip utilities on your path. Issue the ! following commands. perl Makefile.PL (adjust as necessary for your build environment) *************** *** 148,158 **** nmake ppm ! You will need tar, gzip and zip utilities on your path. This procedure ! will generate a PPM for you current perl environment, including the HTML ! documentation, ready for installation as above. VERSION ! Documentation for Win32::GUI v1.02 created 10 Jul 2005 This document is autogenerated by the build process. Edits made here --- 157,166 ---- nmake ppm ! This procedure will generate a PPM for you current perl environment, ! including the HTML documentation, ready for installation as above. VERSION ! Documentation for Win32::GUI v1.03 created 21 Nov 2005 This document is autogenerated by the build process. Edits made here *************** *** 161,171 **** SUPPORT ! Homepage: <http://sourceforge.net/projects/perl-win32-gui/>. For further support join the users mailing ! list(per...@li...) from the website at ! <http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users>. ! There is a searchable list archive at ! <http://sourceforge.net/mail/?group_id=16572>. COPYRIGHT and LICENCE --- 169,179 ---- SUPPORT ! Homepage: http://perl-win32-gui.sourceforge.net/. For further support join the users mailing ! list("per...@li...") from the website at ! http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users. There ! is a searchable list archive at ! http://sourceforge.net/mail/?group_id=16572. COPYRIGHT and LICENCE Index: Readme.html =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Readme.html,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Readme.html 10 Jul 2005 11:24:29 -0000 1.3 --- Readme.html 21 Nov 2005 22:33:33 -0000 1.4 *************** *** 1,200 **** ! <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> ! <html xmlns="http://www.w3.org/1999/xhtml"> ! <head> ! <title>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</title> ! <link rev="made" href="mailto:" /> ! </head> ! <body style="background-color: white"> ! <p><a name="__index__"></a></p> <!-- INDEX BEGIN --> ! <ul> ! <li><a href="#name">NAME</a></li> ! <li><a href="#description">DESCRIPTION</a></li> ! <li><a href="#availability">AVAILABILITY</a></li> ! <li><a href="#installing">INSTALLING</a></li> ! <ul> ! <li><a href="#activestate_activeperl_ppms">ActiveState ActivePerl PPMs</a></li> ! <li><a href="#cygwin">Cygwin</a></li> ! <li><a href="#building_from_source">Building from source</a></li> ! <li><a href="#documentation">Documentation</a></li> ! <li><a href="#building_your_own_ppm_from_source">Building your own PPM from source</a></li> ! </ul> ! <li><a href="#version">VERSION</a></li> ! <li><a href="#support">SUPPORT</a></li> ! <li><a href="#copyright_and_licence">COPYRIGHT and LICENCE</a></li> ! </ul> <!-- INDEX END --> ! <hr /> ! <p> ! </p> ! <h1><a name="name">NAME</a></h1> ! <p>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</p> ! <p> ! </p> ! <hr /> ! <h1><a name="description">DESCRIPTION</a></h1> ! <p>Win32::GUI is a Win32-platform native graphical user interface toolkit for perl. Basically, it's an XS implementation of most of the functions found in user32.dll and gdi32.dll, with an object oriented perl interface and an ! event-based dialog model that mimic the functionality of visual basic.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="availability">AVAILABILITY</a></h1> ! <p>This is the README file for Win32::GUI v1.02 ! built on 10 Jul 2005.</p> ! <p>Source and ActiveState Perl PPMs are available from ! <a href="http://sourceforge.net/project/showfiles.php?group_id=16572">http://sourceforge.net/project/showfiles.php</a>.</p> ! <p>A cygwin distribution (available through cygwin's setup.exe) is maintained ! by Reini Urban (<a href="mailto:ru...@x-...">ru...@x-...</a>)</p> ! <p>If the Win32::GUI version number contains an underscore, then it is an alpha, beta or release candidate distribution. If there is no such underscore, then ! it is a stable release.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="installing">INSTALLING</a></h1> ! <p> ! </p> ! <h2><a name="activestate_activeperl_ppms">ActiveState ActivePerl PPMs</a></h2> ! <p>It is recommended to uninstall any previous version of Win32::GUI before installing a new version. This ensures old documentation is removed correctly. ! From a command prompt run:</p> ! <pre> ! ppm uninstall Win32-GUI</pre> ! <p>If you have any packages that are dependent on Win32::GUI you may need to add ! the <code>-force</code> option to the command line. See your documentation for PPM.</p> ! <p>Unzip the PPM distribution into a local directory. From a command ! prompt in that directory run:</p> ! <pre> ! ppm install ./Win32-GUI.ppd</pre> ! <p> ! </p> ! <h2><a name="cygwin">Cygwin</a></h2> ! <p>Runtime requirements:</p> ! <pre> cygwin perl-5.8.6 ! w32api</pre> ! <p>Use the cygwin setup.exe tool to locate, download and install ! the perl-Win32-GUI binary package.</p> ! <p>Cygwin port questions to the mailinglist <<a href="mailto:cy...@cy...">cy...@cy...</a>></p> ! <p> ! </p> ! <h2><a name="building_from_source">Building from source</a></h2> ! <p>Unpack the distribution into a local directory, and from a command ! prompt in that directory follow the instructions below.</p> ! <p>These instructions assume that you have already set up your build environment, and can build source distributions. The following ! environments are known to work:</p> ! <ol> ! <li><strong><a name="item_microsoft_visual_c_2b_2b_v6">Microsoft Visual C++ V6</a></strong><br /> ! </li> ! Other versions may work. There are reported issues with VC++ 7 which links with a different C runtime to VC++ 6, and so you may have ! issues running an extension built with VC++ 7 with the ActiveState Perls. ! <pre> perl Makefle.PL nmake nmake test ! nmake install</pre> ! <p></p> ! <li><strong><a name="item_mingw_and_extutils_3a_3afakeconfig">MinGW and ExtUtils::FakeConfig</a></strong><br /> ! </li> ! <pre> perl -MConfig_m Makefile.PL nmake nmake test ! nmake install</pre> ! <p>Built this way the GUI.dll extension can be very large (~3MB). There is a ! module in the <em>build_tools</em> directory that works with <strong>Config_m</strong> and ! <a href="/ExtUtils/FakeConfig.html">Extutils::FakeConfig</a> to set the MinGW compiler flags more optimally. If you want to try this, then replace the first ! command with:</p> ! <pre> ! perl -Ibuild_tools -MConfig_mO Makefile.PL</pre> ! <li><strong><a name="item_cygwin">Cygwin</a></strong><br /> ! </li> ! Build requirements (over and above the runtime requirements above): ! <pre> cygwin cygutils gcc make ! gzip</pre> ! <p>Build instructions:</p> ! <p>unpack <em>perl-Win32-GUI-1.0-2-src.tar.bz2</em>. If you use setup to install ! this src package, it will be unpacked under <em>/usr/src</em> automatically.</p> ! <pre> cd /usr/src ! ./perl-Win32-GUI-1.0-2.sh all</pre> ! <p>This will create:</p> ! <pre> ! /usr/src/perl-Win32-GUI-1.0-2.tar.bz2 ! /usr/src/perl-Win32-GUI-1.0-2-src.tar.bz2</pre> ! <p>Port Notes:</p> ! <p>The dll's must probably be rebased. If a remap error occurs run rebaseall from ! the rebase package. The packaged version is already rebased to my personal settings.</p> ! <p>For a source build from the official source, the standard build process ! should be sufficient:</p> ! <pre> Perl Makefile.PL make make test ! make install</pre> ! <p></p></ol> ! <p> ! </p> ! <h2><a name="documentation">Documentation</a></h2> ! <p>HTML documentation is included with the PPM distributions, and installed ! into your ActiveState Perl documentation tree by the install process. ! When building from source the POD documentation is built automatically ! by the make process. It can also be generated by issuing:</p> ! <pre> ! nmake poddocs;</pre> ! <p>The HTML documentation can be built by issuing:</p> ! <pre> ! nmake htmldocs;</pre> ! <p> ! </p> ! <h2><a name="building_your_own_ppm_from_source">Building your own PPM from source</a></h2> ! <pre> perl Makefile.PL (adjust as necessary for your build environment) nmake nmake test ! nmake ppm</pre> ! <p>You will need <strong>tar</strong>, <strong>gzip</strong> and <strong>zip</strong> utilities on your path. This procedure ! will generate a PPM for you current perl environment, including the HTML ! documentation, ready for installation as above.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="version">VERSION</a></h1> ! <p>Documentation for Win32::GUI v1.02 created 10 Jul 2005</p> ! <p>This document is autogenerated by the build process. Edits made here will be lost. ! Edit <em>docs/GUI/UserGuide/Readme.pod</em> instead.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="support">SUPPORT</a></h1> ! <p>Homepage: <a href="http://sourceforge.net/projects/perl-win32-gui/">http://sourceforge.net/projects/perl-win32-gui/</a>.</p> ! <p>For further support join the users mailing <code>list(per...@li...)</code> from the website ! at <a href="http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users">http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users</a>. There is a searchable list archive at <a href="http://sourceforge.net/mail/?group_id=16572">http://sourceforge.net/mail/</a>.</p> ! <p> ! </p> ! <hr /> ! <h1><a name="copyright_and_licence">COPYRIGHT and LICENCE</a></h1> ! <p>Copyright (c) 1997..2005 Aldo Calpini. All rights reserved.</p> ! <p>This program is free software; you can redistribute it and/or ! modify it under the same terms as Perl itself.</p> ! </body> ! </html> --- 1,205 ---- ! <HTML> ! <HEAD> ! <TITLE>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</TITLE> ! <LINK REV="made" HREF="mailto:"> ! </HEAD> ! <BODY> ! <A NAME="__index__"></A> <!-- INDEX BEGIN --> ! <UL> ! <LI><A HREF="#name">NAME</A></LI> ! <LI><A HREF="#description">DESCRIPTION</A></LI> ! <LI><A HREF="#availability">AVAILABILITY</A></LI> ! <LI><A HREF="#installing">INSTALLING</A></LI> ! <UL> ! <LI><A HREF="#activestate activeperl ppms">ActiveState ActivePerl PPMs</A></LI> ! <LI><A HREF="#cygwin">Cygwin</A></LI> ! </UL> ! <LI><A HREF="#building from source">Building from source</A></LI> ! <UL> ! ! <LI><A HREF="#microsoft visual c++ v6">Microsoft Visual C++ V6</A></LI> ! <LI><A HREF="#mingw and extutils::fakeconfig">MinGW and ExtUtils::FakeConfig</A></LI> ! <LI><A HREF="#cygwin">Cygwin</A></LI> ! </UL> ! ! <LI><A HREF="#documentation">Documentation</A></LI> ! <UL> ! ! <LI><A HREF="#pod documentation">POD documentation</A></LI> ! <LI><A HREF="#html documentation">HTML Documentation</A></LI> ! </UL> ! ! <LI><A HREF="#building your own ppm from source">Building your own PPM from source</A></LI> ! <LI><A HREF="#version">VERSION</A></LI> ! <LI><A HREF="#support">SUPPORT</A></LI> ! <LI><A HREF="#copyright and licence">COPYRIGHT and LICENCE</A></LI> ! </UL> <!-- INDEX END --> ! <HR> ! <P> ! <H1><A NAME="name">NAME</A></H1> ! <P>Win32::GUI::UserGuide::Readme - Perl-Win32 Graphical User Interface Extension README</P> ! <P> ! <HR> ! <H1><A NAME="description">DESCRIPTION</A></H1> ! <P>Win32::GUI is a Win32-platform native graphical user interface toolkit for perl. Basically, it's an XS implementation of most of the functions found in user32.dll and gdi32.dll, with an object oriented perl interface and an ! event-based dialog model that mimic the functionality of visual basic.</P> ! <P> ! <HR> ! <H1><A NAME="availability">AVAILABILITY</A></H1> ! <P>This is the README file for Win32::GUI v1.03 ! built on 21 Nov 2005.</P> ! <P>Source and ActiveState Perl PPMs are available from ! <A HREF="http://sourceforge.net/project/showfiles.php?group_id=16572">http://sourceforge.net/project/showfiles.php</A>.</P> ! <P>A cygwin distribution (available through cygwin's setup.exe) is maintained ! by Reini Urban (<A HREF="mailto:ru...@x-...">ru...@x-...</A>)</P> ! <P>If the Win32::GUI version number contains an underscore, then it is an alpha, beta or release candidate distribution. If there is no such underscore, then ! it is a stable release.</P> ! <P> ! <HR> ! <H1><A NAME="installing">INSTALLING</A></H1> ! <P> ! <H2><A NAME="activestate activeperl ppms">ActiveState ActivePerl PPMs</A></H2> ! <P>It is recommended to uninstall any previous version of Win32::GUI before installing a new version. This ensures old documentation is removed correctly. ! From a command prompt run:</P> ! <PRE> ! ppm uninstall Win32-GUI</PRE> ! <P>If you have any packages that are dependent on Win32::GUI you may need to add ! the <CODE>-force</CODE> option to the command line. See your documentation for PPM.</P> ! <P>Unzip the PPM distribution into a local directory. From a command ! prompt in that directory run:</P> ! <PRE> ! ppm install ./Win32-GUI.ppd</PRE> ! <P> ! <H2><A NAME="cygwin">Cygwin</A></H2> ! <P>Runtime requirements:</P> ! <PRE> cygwin perl-5.8.6 ! w32api</PRE> ! <P>Use the cygwin setup.exe tool to locate, download and install ! the perl-Win32-GUI binary package.</P> ! <P>Cygwin port questions to the mailinglist <<A HREF="mailto:cy...@cy...">cy...@cy...</A>></P> ! <P> ! <HR> ! <H1><A NAME="building from source">Building from source</A></H1> ! <P>Unpack the distribution into a local directory, and from a command ! prompt in that directory follow the instructions below.</P> ! <P>These instructions assume that you have already set up your build environment, and can build source distributions. The following ! environments are known to work:</P> ! <P> ! <H2><A NAME="microsoft visual c++ v6">Microsoft Visual C++ V6</A></H2> ! <P>Other versions may work. There are reported issues with VC++ 7 which links with a different C runtime to VC++ 6, and so you may have ! issues running an extension built with VC++ 7 with the ActiveState Perls.</P> ! <PRE> perl Makefle.PL nmake nmake test ! nmake install</PRE> ! <P> ! <H2><A NAME="mingw and extutils::fakeconfig">MinGW and ExtUtils::FakeConfig</A></H2> ! <PRE> perl -MConfig_m Makefile.PL nmake nmake test ! nmake install</PRE> ! <P>Built this way the GUI.dll extension can be very large (~3MB). There is a ! module in the <EM>build_tools</EM> directory that works with <STRONG>Config_m</STRONG> and ! <A HREF="/ExtUtils/FakeConfig.html">Extutils::FakeConfig</A> to set the MinGW compiler flags more optimally. If you want to try this, then replace the first ! command with:</P> ! <PRE> ! perl -Ibuild_tools -MConfig_mO Makefile.PL</PRE> ! <P> ! <H2><A NAME="cygwin">Cygwin</A></H2> ! <P>Build requirements (over and above the runtime requirements above):</P> ! <PRE> cygwin cygutils gcc make ! gzip</PRE> ! <P>Build instructions:</P> ! <P>unpack <EM>perl-Win32-GUI-X.XX-X-src.tar.bz2</EM>. If you use setup to install ! this src package, it will be unpacked under <EM>/usr/src</EM> automatically.</P> ! <PRE> cd /usr/src ! ./perl-Win32-GUI-X.XX-X.sh all</PRE> ! <P>This will create:</P> ! <PRE> ! /usr/src/perl-Win32-GUI-X.XX-X.tar.bz2 ! /usr/src/perl-Win32-GUI-X.XX-X-src.tar.bz2</PRE> ! <P>Port Notes:</P> ! <P>The dll's must probably be rebased. If a remap error occurs run rebaseall from ! the rebase package. The packaged version is already rebased to my personal settings.</P> ! <P>For a source build from the official source, the standard build process ! should be sufficient:</P> ! <PRE> Perl Makefile.PL make make test ! make install</PRE> ! <P> ! <HR> ! <H1><A NAME="documentation">Documentation</A></H1> ! <P> ! <H2><A NAME="pod documentation">POD documentation</A></H2> ! <P>When building from source the POD documentation is built automatically ! by the make process. It can also be generated by issuing:</P> ! <PRE> ! nmake poddocs;</PRE> ! <P> ! <H2><A NAME="html documentation">HTML Documentation</A></H2> ! <P>HTML documentation is included with the PPM distributions, and installed ! into your ActiveState Perl documentation tree by the install process.</P> ! <P>The HTML documentation can also be generated by issuing:</P> ! <PRE> ! nmake htmldocs;</PRE> ! <P> ! <HR> ! <H1><A NAME="building your own ppm from source">Building your own PPM from source</A></H1> ! <P>You will need <STRONG>tar</STRONG>, <STRONG>gzip</STRONG> and <STRONG>zip</STRONG> utilities on your path. Issue ! the following commands.</P> ! <PRE> perl Makefile.PL (adjust as necessary for your build environment) nmake nmake test ! nmake ppm</PRE> ! <P>This procedure will generate a PPM for you current perl environment, ! including the HTML documentation, ready for installation as above.</P> ! <P> ! <HR> ! <H1><A NAME="version">VERSION</A></H1> ! <P>Documentation for Win32::GUI v1.03 created 21 Nov 2005</P> ! <P>This document is autogenerated by the build process. Edits made here will be lost. ! Edit <EM>docs/GUI/UserGuide/Readme.pod</EM> instead.</P> ! <P> ! <HR> ! <H1><A NAME="support">SUPPORT</A></H1> ! <P>Homepage: <A HREF="http://perl-win32-gui.sourceforge.net/">http://perl-win32-gui.sourceforge.net/</A>.</P> ! <P>For further support join the users mailing list(<CODE>per...@li...</CODE>) from the website ! at <A HREF="http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users">http://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users</A>. There is a searchable list archive at <A HREF="http://sourceforge.net/mail/?group_id=16572">http://sourceforge.net/mail/</A>.</P> ! <P> ! <HR> ! <H1><A NAME="copyright and licence">COPYRIGHT and LICENCE</A></H1> ! <P>Copyright (c) 1997..2005 Aldo Calpini. All rights reserved.</P> ! <P>This program is free software; you can redistribute it and/or ! modify it under the same terms as Perl itself.</P> ! </BODY> ! </HTML> Index: TODO =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/TODO,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** TODO 13 Nov 2005 18:57:52 -0000 1.13 --- TODO 21 Nov 2005 22:33:33 -0000 1.14 *************** *** 40,44 **** to turn off Win32::GUI warnings. (see -DW32G_NEWWARN) ! - Makefile.PL. Add code to fail at Makefile.PL stage if the chosen compiler ! is not available, and we autodetected from $Config{cc}. This will prevent us getting ! FAILS from the CPAN Smoke test machines that have no compiler. --- 40,45 ---- to turn off Win32::GUI warnings. (see -DW32G_NEWWARN) ! - Get everything to run under strictures and warnings. ! ! - Start to split into smaller, more manageable pieces - hopefully this might make it ! easier to add tests. Look at moving code out of XS and into Perl? |
|
From: Robert M. <rob...@us...> - 2005-11-21 22:33:43
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1048/t Modified Files: 01_basic.t 05_Timer_01_OEM.t 05_Timer_02_NEM.t 05_Timer_03_Interval.t Added Files: 98_Pod.t Log Message: Tests and 1.03 release candidate Index: 01_basic.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/01_basic.t,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** 01_basic.t 3 Aug 2005 21:45:59 -0000 1.2 --- 01_basic.t 21 Nov 2005 22:33:34 -0000 1.3 *************** *** 12,27 **** BEGIN { $| = 1 } # Autoflush - use Test::More tests => 2; - # Perform tests ! # Check tha Win32::GUI load, and bail out of all ! # tests if it doesn't ! BEGIN { ! use_ok('Win32::GUI') ! or print STDOUT "Bail out! Can't load Win32::GUI"; ! }; ! ok($Win32::GUI::VERSION, "Win32::GUI version check"); --- 12,43 ---- BEGIN { $| = 1 } # Autoflush # Perform tests ! # Bail out if we havent got Test::More ! eval "use Test::More"; ! if($@) { ! # As we haven't got Test::More, can't use diag() ! print "#\n# Test::More required to perform any Win32::GUI test\n"; ! chomp $@; ! $@ =~ s/^/# /gm; ! print "$@\n"; ! print "Bail Out! Test::More not available\n"; ! exit(1); ! } + plan( tests => 3 ); ! # Check that we're on windows or cygwin ! # bail out if we're not ! if ( not ($^O =~ /MSwin32|cygwin/i)) { ! diag("\nWin32::GUI can only run on MSWin32 or cygwin, not '$^O'"); ! print "Bail out! Incompatible Operating System\n"; ! } ! pass("Correct OS"); ! ! # Check that Win32::GUI loads, and bail out of all ! # tests if it doesn't ! use_ok('Win32::GUI') or print STDOUT "Bail out! Can't load Win32::GUI"; ! ! ok(defined $Win32::GUI::VERSION, "Win32::GUI version check"); Index: 05_Timer_01_OEM.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/05_Timer_01_OEM.t,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** 05_Timer_01_OEM.t 13 Nov 2005 18:57:52 -0000 1.1 --- 05_Timer_01_OEM.t 21 Nov 2005 22:33:34 -0000 1.2 *************** *** 23,27 **** my @times; - my $t0 = time; my $W = new Win32::GUI::Window( --- 23,26 ---- *************** *** 30,33 **** --- 29,33 ---- isa_ok($W, "Win32::GUI::Window", "\$W"); + my $t0 = Win32::GetTickCount(); my $C = $W->AddTimer('T1', $elapse); isa_ok($C,$class, "\$W->AddTimer creats $class object"); *************** *** 48,58 **** is(scalar(@times), 3, "Timer went off 3 times"); for my $interval (@times) { ! ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate"); } sub T1_Timer { ! my $t1 = time; push @times, ($t1 - $t0); $t0 = $t1; --- 48,59 ---- is(scalar(@times), 3, "Timer went off 3 times"); + my $delta = 150; #ms for my $interval (@times) { ! ok((abs($interval - $elapse) < $delta), "Timer interval(${interval}ms) appropriate"); } sub T1_Timer { ! my $t1 = Win32::GetTickCount(); push @times, ($t1 - $t0); $t0 = $t1; --- NEW FILE: 98_Pod.t --- #!perl -wT # Win32::GUI test suite. # $Id: 98_Pod.t,v 1.1 2005/11/21 22:33:34 robertemay Exp $ # Testing RichEdit::GetCharFormat() use strict; use warnings; BEGIN { $| = 1 } # Autoflush use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Index: 05_Timer_02_NEM.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/05_Timer_02_NEM.t,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** 05_Timer_02_NEM.t 13 Nov 2005 18:57:52 -0000 1.1 --- 05_Timer_02_NEM.t 21 Nov 2005 22:33:34 -0000 1.2 *************** *** 24,28 **** my %params; - my $t0 = time; my $W = new Win32::GUI::Window( --- 24,27 ---- *************** *** 32,35 **** --- 31,35 ---- isa_ok($W, "Win32::GUI::Window", "\$W"); + my $t0 = Win32::GetTickCount(); my $C = $W->AddTimer('T1', $elapse); isa_ok($C,$class, "\$W->AddTimer creats $class object"); *************** *** 50,55 **** is(scalar(@times), 3, "Timer went off 3 times"); for my $interval (@times) { ! ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate"); } @times=(); --- 50,56 ---- is(scalar(@times), 3, "Timer went off 3 times"); + my $delta = 150; #ms for my $interval (@times) { ! ok((abs($interval - $elapse) < $delta), "Timer interval(${interval}ms) appropriate"); } @times=(); *************** *** 64,68 **** $params{name} = shift; ! my $t1 = time; push @times, ($t1 - $t0); $t0 = $t1; --- 65,69 ---- $params{name} = shift; ! my $t1 = Win32::GetTickCount(); push @times, ($t1 - $t0); $t0 = $t1; Index: 05_Timer_03_Interval.t =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/t/05_Timer_03_Interval.t,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** 05_Timer_03_Interval.t 13 Nov 2005 18:57:52 -0000 1.1 --- 05_Timer_03_Interval.t 21 Nov 2005 22:33:34 -0000 1.2 *************** *** 23,32 **** my @times; - my $t0 = time; - my $W = new Win32::GUI::Window( -name => "TestWindow", -onTimer => \&_process_timer, ); my $C = $W->AddTimer('T1', $elapse); --- 23,31 ---- my @times; my $W = new Win32::GUI::Window( -name => "TestWindow", -onTimer => \&_process_timer, ); + my $t0 = Win32::GetTickCount(); my $C = $W->AddTimer('T1', $elapse); *************** *** 37,42 **** is(scalar(@times), 3, "Timer went off 3 times"); for my $interval (@times) { ! ok(($interval <= 1) && ($interval >= 0), "Timer interval(${interval}s) appropriate"); } --- 36,42 ---- is(scalar(@times), 3, "Timer went off 3 times"); + my $delta = 150; #ms for my $interval (@times) { ! ok((abs($interval - $elapse) < $delta), "Timer interval(${interval}ms) appropriate"); } *************** *** 49,58 **** is(scalar(@times), 3, "Timer went off 3 times"); for my $interval (@times) { ! ok(($interval <= 2) && ($interval >= 0), "Timer interval(${interval}s) appropriate"); } sub _process_timer { ! my $t1 = time; push @times, ($t1 - $t0); $t0 = $t1; --- 49,58 ---- is(scalar(@times), 3, "Timer went off 3 times"); for my $interval (@times) { ! ok((abs($interval-($elapse+500)) < $delta), "Timer interval(${interval}ms) appropriate"); } sub _process_timer { ! my $t1 = Win32::GetTickCount(); push @times, ($t1 - $t0); $t0 = $t1; |
|
From: Robert M. <rob...@us...> - 2005-11-21 22:33:41
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/UserGuide In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1048/docs/GUI/UserGuide Modified Files: Readme.pod Log Message: Tests and 1.03 release candidate Index: Readme.pod =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/UserGuide/Readme.pod,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Readme.pod 13 Nov 2005 18:57:52 -0000 1.4 --- Readme.pod 21 Nov 2005 22:33:34 -0000 1.5 *************** *** 106,119 **** Build instructions: ! unpack F<perl-Win32-GUI-1.0-2-src.tar.bz2>. If you use setup to install this src package, it will be unpacked under F</usr/src> automatically. cd /usr/src ! ./perl-Win32-GUI-1.0-2.sh all This will create: ! /usr/src/perl-Win32-GUI-1.0-2.tar.bz2 ! /usr/src/perl-Win32-GUI-1.0-2-src.tar.bz2 Port Notes: --- 106,119 ---- Build instructions: ! unpack F<perl-Win32-GUI-X.XX-X-src.tar.bz2>. If you use setup to install this src package, it will be unpacked under F</usr/src> automatically. cd /usr/src ! ./perl-Win32-GUI-X.XX-X.sh all This will create: ! /usr/src/perl-Win32-GUI-X.XX-X.tar.bz2 ! /usr/src/perl-Win32-GUI-X.XX-X-src.tar.bz2 Port Notes: *************** *** 144,148 **** into your ActiveState Perl documentation tree by the install process. ! The HTML documentation can be built by issuing: nmake htmldocs; --- 144,148 ---- into your ActiveState Perl documentation tree by the install process. ! The HTML documentation can also be generated by issuing: nmake htmldocs; |
|
From: Robert M. <rob...@us...> - 2005-11-21 22:33:41
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Reference In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1048/docs/GUI/Reference Modified Files: Packages_package.tpl Log Message: Tests and 1.03 release candidate Index: Packages_package.tpl =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/docs/GUI/Reference/Packages_package.tpl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Packages_package.tpl 26 Jun 2005 16:41:00 -0000 1.1 --- Packages_package.tpl 21 Nov 2005 22:33:34 -0000 1.2 *************** *** 1,4 **** - =for comment $Id$ - =item L<__W32G_PKGNAME__|__W32G_PKGLINK__> --- 1,3 ---- =item L<__W32G_PKGNAME__|__W32G_PKGLINK__> + =for comment $Id$ |
|
From: Robert M. <rob...@us...> - 2005-11-13 18:58:00
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24631 Modified Files: CHANGELOG GUI.pm GUI.xs GUI_MessageLoops.cpp MANIFEST Makefile.PL TODO Window.xs Log Message: Bug fixes; re-work of WIn32::GUI::Timer; preparing for 1.03 release Index: GUI.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** GUI.xs 5 Oct 2005 22:20:48 -0000 1.45 --- GUI.xs 13 Nov 2005 18:57:52 -0000 1.46 *************** *** 43,60 **** ########################################################################## # (@)METHOD:GetAsyncKeyState(key) ! # Retrieve the status of the specified virtual key. The status ! # specifies whether the key is up, down, or toggled (on, off-- ! # alternating each time the key is pressed). # ! # keyCode -- If a..z0..9, use the ASCII code. Otherwise, use # a virtual key code. Example: VK_SHIFT # # Return 1 if the key is depressed, 0 if it's not. - # LONG GetAsyncKeyState(key) int key CODE: ! RETVAL = GetAsyncKeyState(key) & 1; OUTPUT: RETVAL --- 43,58 ---- ########################################################################## # (@)METHOD:GetAsyncKeyState(key) ! # Retrieve the status of the specified virtual key at the time the function ! # is called. The status specifies whether the key is up or down. # ! # keyCode -- If A..Z0..9, use the ASCII code. Otherwise, use # a virtual key code. Example: VK_SHIFT # # Return 1 if the key is depressed, 0 if it's not. LONG GetAsyncKeyState(key) int key CODE: ! RETVAL = (GetAsyncKeyState(key) & 0x8000) >>16; OUTPUT: RETVAL *************** *** 1627,1630 **** --- 1625,1652 ---- XSRETURN_UNDEF; } + + ########################################################################### + # (@)INTERNAL:GetWindowObject() + # Returns the perl window object from a window handle. If the window handle + # passed is a handle to a window created by Win32::GUI, returns the perl + # object reference, else returns undef. + void + GetWindowObject(handle) + HWND handle + PREINIT: + SV* SvObject; + PPCODE: + if (IsWindow(handle)) { + SvObject = SV_SELF_FROM_WINDOW(handle); + if (SvObject != NULL && SvROK(SvObject)) { + XPUSHs(SvObject); + } + else { + XSRETURN_UNDEF; + } + } + else { + XSRETURN_UNDEF; + } ########################################################################### Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Makefile.PL,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** Makefile.PL 5 Oct 2005 22:20:49 -0000 1.13 --- Makefile.PL 13 Nov 2005 18:57:52 -0000 1.14 *************** *** 234,237 **** --- 234,248 ---- } + # Remove the Test-More dependency from the PPD file, as it is not + # a requirement for a binary distribution + sub ppd { + my $inherited = shift->SUPER::ppd(@_); + #perl 5.6 + $inherited =~ s/qq\{\\t\\t<DEPENDENCY NAME=.*Test-More.*?\}\.//s; + #perl 5.8 + $inherited =~ s/^.*DEPENDENCY.*Test-More.*$//m; + return $inherited; + } + # In the following here-doc fragments, ensure that command lines are indented with TAB # and not space for gnu-make compatibility (cygwin) Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** GUI.pm 5 Oct 2005 22:20:48 -0000 1.33 --- GUI.pm 13 Nov 2005 18:57:52 -0000 1.34 *************** *** 25,29 **** # STATIC OBJECT PROPERTIES # ! $VERSION = "1.02_02"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) --- 25,29 ---- # STATIC OBJECT PROPERTIES # ! $VERSION = "1.02_03"; # For MakeMaker $XS_VERSION = $VERSION; # For dynaloader $VERSION = eval $VERSION; # For Perl (see perldoc perlmodstyle) *************** *** 2612,2622 **** # The triggered NEM event is defined as -onTimer => sub{} method of the parent window. package Win32::GUI::Timer; - @ISA = qw(Win32::GUI); ########################################################################### ! # (@)METHOD:new Win32::GUI::Timer(PARENT, NAME, ELAPSE) # Creates a new timer in the PARENT window named NAME that will # trigger its Timer() event after ELAPSE milliseconds. # Can also be called as PARENT->AddTimer(NAME, ELAPSE). sub new { my $class = shift; --- 2612,2632 ---- # The triggered NEM event is defined as -onTimer => sub{} method of the parent window. package Win32::GUI::Timer; ########################################################################### ! # (@)METHOD:new Win32::GUI::Timer(PARENT, [NAME, [ELAPSE]]) # Creates a new timer in the PARENT window named NAME that will # trigger its Timer() event after ELAPSE milliseconds. # Can also be called as PARENT->AddTimer(NAME, ELAPSE). + # + # If NAME is not supplied, then an internal name will be allocated. + # + # ELAPSE must by an integer greater than or equal to zero. If ELAPSE + # is 0, then the timer object is created, but the timer will be disabled. + # You can then start the timer by calling the L<Interval()|/Interval> method + # and setting ELAPSE to a non-zero number. If ELASPE is not supplied, then + # 0 will be used. + # + # Note: Different OS versions might change too low or large intervals for ELAPSE + # to more appropriate values. E.g. > 0x7fffffff or < 10 sub new { my $class = shift; *************** *** 2629,2643 **** # Get a new Id ! $id = $Win32::GUI::TimerIdCounter; ! $Win32::GUI::TimerIdCounter++; # Force a name if havent. $name = "_Timer".$id unless defined $name; ! $elapse = 10 unless defined $elapse; my $self = {}; bless($self, $class); ! # add $self->{name} $self->{-id} = $id; $self->{-name} = $name; --- 2639,2658 ---- # Get a new Id ! $id = $Win32::GUI::TimerIdCounter++; # Force a name if havent. $name = "_Timer".$id unless defined $name; ! $elapse = 0 unless defined $elapse; ! ! # check $elapse ! if($elapse != int($elapse) or $elapse < 0) { ! warn qq(ELAPSE must be an integer greater than or equal to 0, not "$elapse". Using ELAPSE=0.); ! $elapse = 0; ! } my $self = {}; bless($self, $class); ! # store object propeties $self->{-id} = $id; $self->{-name} = $name; *************** *** 2645,2658 **** $self->{-interval} = $elapse; ! # Store name in timers hash $window->{-timers}->{$id} = $name; # Add Timer into parent hash. $window->{$name} = $self; - # Only if perl is circular ref-safe - if ($] > 5.006) { - $self->{-window} = \$window; - } ! Win32::GUI::SetTimer($window, $id, $elapse); return $self; --- 2660,2669 ---- $self->{-interval} = $elapse; ! # Store name in parent's timers hash $window->{-timers}->{$id} = $name; # Add Timer into parent hash. $window->{$name} = $self; ! Win32::GUI::SetTimer($window, $id, $elapse) if $elapse > 0; return $self; *************** *** 2662,2692 **** # (@)METHOD:Interval(ELAPSE) # Get or set the periodic timer interval. Unit: ms ! # When setting a new interval, the existing timer is reseted. # ! # Note: Different OS versions might change too low or large intervals to more ! # appropriate values. E.g. > 0x7fffffff or < 10 sub Interval { my $self = shift; ! my $interval = shift; ! if(defined $interval) { ! if (!$interval) { # match Win32::GUI::Tutorial::Part4 ! $self->Kill(); ! } else { ! Win32::GUI::SetTimer($self->{-handle}, $self->{-id}, $interval); ! $self->{-interval} = $interval; ! } } else { ! return $self->{-interval}; } } ########################################################################### ! # (@)METHOD:Kill() # Remove the periodic timer event. # ! # To use system resources efficiently, applications should DESTROY or Kill # timers that are no longer necessary. sub Kill { ! Win32::GUI::Timer::DESTROY(shift); } --- 2673,2729 ---- # (@)METHOD:Interval(ELAPSE) # Get or set the periodic timer interval. Unit: ms ! # When setting a new interval, any existing timer is reset. When setting ! # returns the previous interval. # ! # Setting ELAPSE to 0 suspends the timer (i.e. it will not fire timer events). ! # The timer can be restarted later by setting ELAPSE to a positive value. ! # ! # Note: Different OS versions might change too low or large intervals for ELAPSE ! # to more appropriate values. E.g. > 0x7fffffff or < 10 sub Interval { my $self = shift; ! my $elapse = shift; ! ! #Get ! return $self->{-interval} unless defined $elapse; ! ! my $previous = $self->{-interval}; ! # check $elapse ! if($elapse != int($elapse) or $elapse < 0) { ! warn qq(ELAPSE must be an integer greater than or equal to 0, not "$elapse". Using previous value($previous ms)); ! $elapse = $previous; ! } ! $self->{-interval} = $elapse; ! if ($elapse > 0) { # match Win32::GUI::Tutorial::Part4 ! Win32::GUI::SetTimer($self->{-handle}, $self->{-id}, $elapse); } else { ! Win32::GUI::KillTimer($self->{-handle}, $self->{-id}); } + + return $previous; } ########################################################################### ! # (@)METHOD:Kill([REMOVE=0]) # Remove the periodic timer event. # ! # Kill() with no parameters, or a False parameter suspends the timer, ! # exactly as $timer->Interval(0); In this case it return the previous ! # interval. ! # ! # Kill() with a True parameter will stop and remove all traces of the timer. ! # To use system resources efficiently, applications should Kill(1) # timers that are no longer necessary. sub Kill { ! my $self = shift; ! my $remove = shift; ! ! if($remove) { ! $self->DESTROY(); ! } ! else { ! return $self->Interval(0); ! } ! return undef; } *************** *** 2695,2712 **** sub DESTROY { my $self = shift; - if ( defined $self && - defined $self->{-handle} && - defined $self->{-id} ) { - # Kill timer - Win32::GUI::KillTimer($self->{-handle}, $self->{-id}); ! if (defined $self->{-window}) { ! my $window = ${$self->{-window}}; ! # Remove id from timers hash if not yet triggered ! delete $window->{-timers}->{$self->{-id}} ! if ref($window) and defined $window->{-timers}->{$self->{-id}}; ! # Remove name from parent ! delete $window->{$self->{-name}} if defined $window; ! } } } --- 2732,2748 ---- sub DESTROY { my $self = shift; ! # Kill timer ! Win32::GUI::KillTimer($self->{-handle}, $self->{-id}); ! ! # We put this code to tidy up the parent here, rather than ! # in Timer->Kill(1), so that we still tidy up, even in the ! # unlikely event of someone doing PARENT->{Timer name} = undef; ! my $window = Win32::GUI::GetWindowObject($self->{-handle}); ! if(defined $window) { ! # Remove id from -timers hash ! delete $window->{-timers}->{$self->{-id}}; ! # Remove name from parent ! delete $window->{$self->{-name}}; } } Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.65 retrieving revision 1.66 diff -C2 -d -r1.65 -r1.66 *** CHANGELOG 16 Oct 2005 08:03:19 -0000 1.65 --- CHANGELOG 13 Nov 2005 18:57:52 -0000 1.66 *************** *** 6,9 **** --- 6,25 ---- Win32-GUI ChangeLog =================== + + [Robert May] : 13 Nov 2005 - Bug fixes and preparing for 1.03 release + - Makefile.PL added code to remove Test::More dependence from PPD + - GUI_MessageLoops.cpp, Window.xs change all mouse related handlers to + use GET_X_LPARAM and GET_Y_LPARAM rather than HIWORD and LOWORD + (Tracker: 1262098) + - GUI.xs added INTERNAL function GetWindowObject to get the perl window + object from a window handle + - GUI.pm, t\05_Timer*.t, docs\GUI\Tutorial\Part4.pod - re-wrote + Win32::GUI::Timer implementation and updated docs to make it all + consistent, and to make destruction happen correctly. Added full tests + for the package. + - GUI.xs fixed GetAsyncKeyState(), which was checking the wrong bit of + window's return value. Updated documentation. + - MANIFEST updated with new samples and new tests + - GUI.pm upped version to 1.02_03 + + [Jeremy White] : Bug fix - not enough space malloc'ed for strings - Combobox.xs: added 1 to safemalloc Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/MANIFEST,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** MANIFEST 4 Aug 2005 22:57:34 -0000 1.9 --- MANIFEST 13 Nov 2005 18:57:52 -0000 1.10 *************** *** 68,71 **** --- 68,72 ---- MANIFEST.SKIP MDI.xs + META.yml MonthCal.xs NotifyIcon.xs *************** *** 82,86 **** --- 83,89 ---- samples/EventModel.pl samples/GetOpenFileName.pl + samples/guiperl.ico samples/harrow.cur + samples/listview_drag_drop.pl samples/MDI.pl samples/MonthCal.pl *************** *** 88,91 **** --- 91,110 ---- samples/Region.pl samples/SplashScreen.pl + samples/Tutorial_Part1_hello1.pl + samples/Tutorial_Part1_hello2.pl + samples/Tutorial_Part1_hello3.pl + samples/Tutorial_Part1_hello4.pl + samples/Tutorial_Part1_hello5.pl + samples/Tutorial_Part1_hello6.pl + samples/Tutorial_Part2_framework.pl + samples/Tutorial_Part3_DialogBox.pl + samples/Tutorial_Part4_NotifyIcon.pl + samples/Tutorial_Part4_StatusBar.pl + samples/Tutorial_Part4_timer.pl + samples/Tutorial_Part5_modalWindow.pl + samples/Tutorial_Part5_popupWindow1.pl + samples/Tutorial_Part5_popupWindow2.pl + samples/Tutorial_Part5_twoWindows.pl + samples/Tutorial_Part9_noDosWindow.pl Splitter.xs StatusBar.xs *************** *** 96,100 **** t/05_AcceleratorTable.t t/05_Menu.t ! t/05_Timer.t t/06_Cursor.t t/06_Icon.t --- 115,123 ---- t/05_AcceleratorTable.t t/05_Menu.t ! t/05_Timer_01_OEM.t ! t/05_Timer_02_NEM.t ! t/05_Timer_03_Interval.t ! t/05_Timer_04_Kill.t ! t/05_Timer_05_DESTROY.t t/06_Cursor.t t/06_Icon.t Index: Window.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Window.xs,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Window.xs 3 Aug 2005 21:45:58 -0000 1.9 --- Window.xs 13 Nov 2005 18:57:52 -0000 1.10 *************** *** 396,401 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL1, "LButtonDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 396,401 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL1, "LButtonDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 408,413 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL2, "LButtonUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 408,413 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL2, "LButtonUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 420,425 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL3, "RButtonDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 420,425 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL3, "RButtonDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 432,437 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL4, "RButtonUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 432,437 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_CONTROL4, "RButtonUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); Index: TODO =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/TODO,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** TODO 1 Oct 2005 23:02:39 -0000 1.12 --- TODO 13 Nov 2005 18:57:52 -0000 1.13 *************** *** 11,15 **** - Documentation: - - review and update the tutorial - revise and correct FAQ - any TBD sections --- 11,14 ---- *************** *** 41,46 **** to turn off Win32::GUI warnings. (see -DW32G_NEWWARN) - - Tutorial docs: code all the examples, and make sure they work before each release. - - Makefile.PL. Add code to fail at Makefile.PL stage if the chosen compiler is not available, and we autodetected from $Config{cc}. This will prevent us getting --- 40,43 ---- Index: GUI_MessageLoops.cpp =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI_MessageLoops.cpp,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** GUI_MessageLoops.cpp 1 Oct 2005 18:00:39 -0000 1.14 --- GUI_MessageLoops.cpp 13 Nov 2005 18:57:52 -0000 1.15 *************** *** 332,336 **** case WM_MOUSEMOVE: /* ! * (@)EVENT:MouseMouve() * (@)APPLIES_TO:* */ --- 332,336 ---- case WM_MOUSEMOVE: /* ! * (@)EVENT:MouseMove() * (@)APPLIES_TO:* */ *************** *** 347,352 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDOWN, "MouseDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 347,352 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDOWN, "MouseDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 358,363 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEUP, "MouseUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 358,363 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEUP, "MouseUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 369,374 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDBLCLK, "MouseDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 369,374 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDBLCLK, "MouseDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 380,385 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDOWN, "MouseRightDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 380,385 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDOWN, "MouseRightDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 391,396 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEUP, "MouseRightUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 391,396 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEUP, "MouseRightUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 402,407 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDBLCLK, "MouseRightDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 402,407 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDBLCLK, "MouseRightDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 413,418 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDOWN, "MouseMiddleDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 413,418 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDOWN, "MouseMiddleDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 424,429 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEUP, "MouseMiddleUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 424,429 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEUP, "MouseMiddleUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 435,440 **** */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDBLCLK, "MouseMiddleDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 435,440 ---- */ PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDBLCLK, "MouseMiddleDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 525,528 **** --- 525,534 ---- /* * (@)EVENT:Timer() + * Sent when a Win32::GUI::Timer object reaches its ELAPSEd time. + * For OEM the event is names $name_Timer. + * For NEM the subroutine called is set with the parent window's + * -onTimer option. There are 2 arguments passed to the NEM event handler: + * the first is the parent window object, and the second is the timer's + * name. * (@)APPLIES_TO:* */ *************** *** 830,835 **** case WM_LBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDOWN, "MouseDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 836,841 ---- case WM_LBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDOWN, "MouseDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 837,842 **** case WM_LBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEUP, "MouseUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 843,848 ---- case WM_LBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEUP, "MouseUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 844,849 **** case WM_LBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDBLCLK, "MouseDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 850,855 ---- case WM_LBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_LMOUSEDBLCLK, "MouseDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 851,856 **** case WM_RBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDOWN, "MouseRightDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 857,862 ---- case WM_RBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDOWN, "MouseRightDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 858,863 **** case WM_RBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEUP, "MouseRightUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 864,869 ---- case WM_RBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEUP, "MouseRightUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 865,870 **** case WM_RBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDBLCLK, "MouseRightDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 871,876 ---- case WM_RBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_RMOUSEDBLCLK, "MouseRightDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 872,877 **** case WM_MBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDOWN, "MouseMiddleDown", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 878,883 ---- case WM_MBUTTONDOWN: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDOWN, "MouseMiddleDown", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 879,884 **** case WM_MBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEUP, "MouseMiddleUp", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 885,890 ---- case WM_MBUTTONUP: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEUP, "MouseMiddleUp", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); *************** *** 886,891 **** case WM_MBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDBLCLK, "MouseMiddleDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, LOWORD(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, HIWORD(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); --- 892,897 ---- case WM_MBUTTONDBLCLK: PerlResult = DoEvent(NOTXSCALL perlud, PERLWIN32GUI_NEM_MMOUSEDBLCLK, "MouseMiddleDblClick", ! PERLWIN32GUI_ARGTYPE_LONG, GET_X_LPARAM(lParam), ! PERLWIN32GUI_ARGTYPE_LONG, GET_Y_LPARAM(lParam), PERLWIN32GUI_ARGTYPE_LONG, wParam, -1); |
