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
|
|
From: Robert M. <rob...@us...> - 2006-06-11 16:35:13
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562 Modified Files: Changes DIBitmap.pm DIBitmap.xs Makefile.PL TYPEMAP Added Files: DIBitmapRC.PL TODO Removed Files: DIBitmap.html MANIFEST Readme Log Message: Merge DIBitmap into core distribution Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/Makefile.PL,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile.PL 2 Nov 2005 08:41:17 -0000 1.1 --- Makefile.PL 11 Jun 2006 16:34:33 -0000 1.2 *************** *** 1,32 **** use ExtUtils::MakeMaker; ! # See lib/ExtUtils/MakeMaker.pm for details of how to influence ! # the contents of the Makefile that is written. ! WriteMakefile( ! 'NAME' => 'Win32::GUI::DIBitmap', ! 'VERSION_FROM' => 'DIBitmap.pm', ! 'XS' => { 'DIBitmap.xs' => 'DIBitmap.cpp' }, ! 'LIBS' => ['Msvcprt.lib'], # e.g., '-lm' ! 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' ! 'INC' => '', # e.g., '-I/usr/include/other' ! 'MYEXTLIB' => 'extlib/FreeImage.lib', ! ($] ge '5.005') ! ? ( ! 'AUTHOR' => 'ROCHER Laurent (lr...@cp...)', ! 'ABSTRACT' => 'Add new load/save image format and some image manipulation', ! ) ! : (), ); ! sub MY::xs_c { ! ' ! .xs.c: ! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c ! .xs.cpp: ! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp ! '; } --- 1,85 ---- + #!perl -w + use strict; + use warnings; + + # Makefile.PL for Win32::GUI::DIBitmap + # $Id$ + + use 5.006; + use Config; use ExtUtils::MakeMaker; ! use File::Find(); ! my @demos; ! File::Find::find(sub { push @demos, $File::Find::name if $File::Find::name =~ /\.(pl|zip|bmp|png|tga|jpg)$/ }, 'demos'); ! ! my %config = ( ! NAME => 'Win32::GUI::DIBitmap', ! VERSION_FROM => 'DIBitmap.pm', ! ABSTRACT_FROM => 'DIBitmap.pm', ! AUTHOR => 'ROCHER Laurent (lr...@cp...)', ! PL_FILES => {'DIBitmapRC.PL' => '$(BASEEXT).rc', }, ! OBJECT => '$(BASEEXT)$(OBJ_EXT) $(BASEEXT).res', ! LIBS => ['-lmsvcprt'], ! MYEXTLIB => 'extlib/FreeImage.lib', ! macro => {RC => 'rc.exe', ! RCFLAGS => '', ! INST_DEMODIR => '$(INST_LIB)/Win32/GUI/demos/$(BASEEXT)', ! DEMOS => "@demos", }, ! clean => {FILES => '*.rc *.res', }, ); + # if building using gcc (MinGW or cygwin) use windres + # as the resource compiler + # and the MinGW C++ standard library + if($Config{cc} =~ /gcc/i) { + $config{macro}->{RC} = 'windres'; + $config{macro}->{RCFLAGS} = '-O coff -o $*.res'; + $config{LIBS} = [':nosearch -lstdc++']; + $config{MYEXTLIB} = 'extlib/libFreeImage-mingw.a'; + if( $^O =~ /cygwin/i ) { + $config{MYEXTLIB} = 'extlib/libFreeImage-cygwin.a'; + } + } ! # Can't build with MinGW (yet). ! if($Config{cc} =~ /gcc/i and $^O !~ /cygwin/i ) { ! print <<__EXPLAIN; ! At this time Win32::GUI::DIBitmap cannot be build using MinGW. ! Win32::GUI::DIBitmap will be skipped during the current build process. ! __EXPLAIN ! ExtUtils::MakeMaker::WriteEmptyMakefile(NAME => 'Win32::GUI::DIBitmap'); ! } ! else { ! WriteMakefile(%config); ! } ! package MY; ! ! # Add rule for .rc to .res conversion ! # Add rules to install demo scripts ! sub postamble { ! return <<'__POSTAMBLE'; ! ! # Win32::GUI::DIBitmap RC section ! ! .rc.res: ! $(RC) $(RCFLAGS) $< ! ! # Win32::GUI::DIBitmap demo script section ! ! pure_all :: demo_to_blib ! $(NOECHO) $(NOOP) ! ! demo_to_blib: $(DEMOS) ! $(NOECHO) $(MKPATH) $(INST_DEMODIR) ! $(CP) $? $(INST_DEMODIR) ! $(NOECHO) $(TOUCH) demo_to_blib ! ! clean :: ! -$(RM_F) demo_to_blib ! ! __POSTAMBLE } --- DIBitmap.html DELETED --- Index: DIBitmap.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/DIBitmap.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** DIBitmap.pm 2 Nov 2005 08:41:17 -0000 1.1 --- DIBitmap.pm 11 Jun 2006 16:34:32 -0000 1.2 *************** *** 1,149 **** package Win32::GUI::DIBitmap; use strict; ! use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); use Carp 'croak','carp'; require Exporter; require DynaLoader; - require AutoLoader; [...1662 lines suppressed...] ! =item L<Win32::GUI|Win32::GUI> ! ! =item L<http://freeimage.sourceforge.net/> ! ! =back =head1 AUTHOR ! Laurent Rocher (lr...@cp...) ! =head1 COPYRIGHT AND LICENCE ! Copyright 2003 by Laurent Rocher (lr...@cp...). ! ! This program is free software; you can redistribute it and/or modify it ! under the same terms as Perl itself. ! ! See L<http://www.perl.com/perl/misc/Artistic.html> =cut --- MANIFEST DELETED --- --- NEW FILE: DIBitmapRC.PL --- #!perl -w use strict; use warnings; use ExtUtils::MakeMaker; # $Id: DIBitmapRC.PL,v 1.1 2006/06/11 16:34:32 robertemay Exp $ # perl script to produce the RC file for # Win32::GUI::DIBitmap create Resource # file with a VERSIONINFO section # The variables: my %info = ( Version => MM->parse_version('DIBitmap.pm'), Dllname => 'DIBitmap.dll', Years => '2003..2006', Win32GUIVersion => MM->parse_version('../GUI.pm'), ); # Open the target file if ( @ARGV > 0 ) { my $file = $ARGV[0]; open(my $fh, '>', $file) or die qq(Failed to open '$file': $!); select $fh; } { my $fileVersion = $info{Version}; $fileVersion .= "_00" unless $fileVersion =~ m/_/; $info{FileVersion} = sprintf("%02d,%02d,%02d,00", $fileVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); my $prodVersion = $info{Win32GUIVersion}; $prodVersion .= "_00" unless $prodVersion =~ m/_/; $info{ProductVersion} = sprintf("%02d,%02d,%02d,00", $prodVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); } print <<"__RC"; #include "Winver.h" 1 VERSIONINFO FILEVERSION $info{FileVersion} PRODUCTVERSION $info{ProductVersion} FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL { BLOCK "StringFileInfo" { BLOCK "040904E4" { VALUE "Comments" , "Win32::GUI::DIBitmap, part of the perl Win32::GUI module. Includes code from the freeimage project http://freeimage.sourceforge.net/" VALUE "CompanyName" , "perl-win32-gui.sourceforge.net" VALUE "FileDescription" , "Win32::GUI::DIBitmap perl extension" VALUE "FileVersion" , "$info{Version}" VALUE "InternalName" , "$info{Dllname}" VALUE "LegalCopyright" , "Copyright © Laurent Rocher $info{Years}" VALUE "LegalTrademarks" , "GNU and Artistic licences" VALUE "OriginalFilename" , "$info{Dllname}" VALUE "ProductName" , "Win32::GUI perl extension" VALUE "ProductVersion" , "$info{Win32GUIVersion}" } } BLOCK "VarFileInfo" { VALUE "Translation", 0x0409, 0x04E4 } } __RC exit(0); __END__ Index: Changes =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/Changes,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Changes 2 Nov 2005 08:41:17 -0000 1.1 --- Changes 11 Jun 2006 16:34:32 -0000 1.2 *************** *** 1,90 **** Revision history for Perl extension FreeImage. ! 0.15 28 / 11 / 2004 ! - Use FreeImage 3.5.1 (GIF support and LZW compression, improvements, bug fix, ...) ! - New Win32::GUI::DIBitmap method ! -> GetFIFMimeType ! -> ConvertTo4Bits ! 0.14 21 / 02 / 2004 ! - Use FreeImage 3.2.0 ! - New Win32::GUI::DIBitmap method ! -> Image internal format ! -> Pixel and and Background methods ! + SetPixel ! + GetPixel ! + HasBackgroundColor ! + GetBackgroundColor ! + SetBackgroundColor ! -> Conversion with new internal type ! -> Chanel processing ! + GetComplexChannel ! + SetComplexChannel ! 0.13 08 / 12 / 2003 ! - Correct memory leak in NewFromWindow, newFromDC [Thank to Steve Pick] ! 0.12 17 / 11 / 2003 ! - Use FreeImage 3.0.4 ! 0.11 11 / 11 / 2003 ! - Use FreeImage 3.0.3 ! 0.10 28 / 10 / 2003 ! - Use FreeImage 3.0.2 ! 0.09 24 / 10 / 2003 ! - Use FreeImage 3.0.1 ! 0.08 28 / 09 / 2003 ! - Use FreeImage 3.0.0 ! - New format : XBM, XPM ! - New Win32::GUI::DIBitmap method ! -> Conversion ! + Threshold : Convert to 1 bit ! + Dither : Convert to 1 bit ! -> Color manipulation ! + AdjustGamma ! + AdjustBrightness ! + AdjustContrast ! + Invert : Invert effect ! + GetHistogram : Get Color histogram ! -> Chanel processing ! + GetChannel ! + SetChannel ! -> Copy/Paste ! + Copy ! + Paste ! -> Rotation / flipping ! + Rotate : Create a rotated Bitmap (>= 8 bits only) ! + RotateEx : Create a rotated/translated Bitmap (>= 8 bits only) ! + FlipVerticaly : Flip Verticaly effect ! + FlipHorizontaly : Flip Horizontaly effect ! -> UpSampling / DownSampling ! + Rescale : Create a rescaled Bitmap (32 bits only) ! - New TIFF save format option. ! - New sample : read image from zipfile. ! 0.07 24 / 04 / 2003 ! - New Win32::GUI::DIBitmap method ! + newFromGD ! + CopyFromGD, CopyToGD : Must have Same Size and BPP. ! - UPDATE 1 : Add switch for old GD version ! - UPDATE 2 : Correct upside down bitmap bug ! 0.06 28 / 05 / 2002 ! - Use FreeImage 2.5.3 ! - Add FreeImage Multipaging interface ! 0.05 14 / 01 / 2002 ! - Use FreeImage 2.5.0 ! - Add FreeImage Multipaging interface (experimental in this release) ! - New Win32::GUI::DIBitmap method ! + Clone ! + AlphaCopyToDC ! + AlphaStrechToDC ! 0.04 29 / 10 / 2001 ! - Use FreeImage 2.4.2 ! - Fix bug in jpeg plug-in ! 0.03 18 / 08 / 2001 ! - Correct Bug when capture screen if display isn't in 32 bits ! - Add new function GetColorType ! - ColorQuantize work if image isn't in 24 bits ! - Add more Documentation ! 0.02 15 / 08 / 2001 ! - Use FreeImage 2.4.1 ! - Some little change ! 0.01 21 / 03 / 2001 ! - original version; created by h2xs 1.19 ! - First build Win32::GUI::DIBitmap --- 1,112 ---- Revision history for Perl extension FreeImage. ! 0.16 25/05/2006 [Robert May] ! - merge into Win32::GUI core distribution ! - new build process ! - fixed to build with C compiler (rather than requiring C++) ! - added basic tests ! 0.15 28/11/2004 ! - Use FreeImage 3.5.1 ! -> GIF support ! -> LZW compression ! -> other improvements, bug fix, ... ! - New Win32::GUI::DIBitmap method ! -> GetFIFMimeType ! -> ConvertTo4Bits ! ! 0.14 21/02/2004 ! - Use FreeImage 3.2.0 ! - New Win32::GUI::DIBitmap method ! -> Image internal format ! -> Pixel and and Background methods ! + SetPixel ! + GetPixel ! + HasBackgroundColor ! + GetBackgroundColor ! + SetBackgroundColor ! -> Conversion with new internal type ! -> Chanel processing ! + GetComplexChannel ! + SetComplexChannel ! ! 0.13 08/12/2003 ! - Correct memory leak in NewFromWindow, newFromDC [Thank to Steve Pick] ! ! 0.12 17/11/2003 ! - Use FreeImage 3.0.4 ! ! 0.11 11/11/2003 ! - Use FreeImage 3.0.3 ! ! 0.10 28/10/2003 ! - Use FreeImage 3.0.2 ! ! 0.09 24/10/2003 ! - Use FreeImage 3.0.1 ! ! 0.08 28/09/2003 ! - Use FreeImage 3.0.0 ! - New format : XBM, XPM ! - New Win32::GUI::DIBitmap method ! -> Conversion ! + Threshold : Convert to 1 bit ! + Dither : Convert to 1 bit ! -> Color manipulation ! + AdjustGamma ! + AdjustBrightness ! + AdjustContrast ! + Invert : Invert effect ! + GetHistogram : Get Color histogram ! -> Chanel processing ! + GetChannel ! + SetChannel ! -> Copy/Paste ! + Copy ! + Paste ! -> Rotation / flipping ! + Rotate : Create a rotated Bitmap (>= 8 bits only) ! + RotateEx : Create a rotated/translated Bitmap (>= 8 bits only) ! + FlipVerticaly : Flip Verticaly effect ! + FlipHorizontaly : Flip Horizontaly effect ! -> UpSampling / DownSampling ! + Rescale : Create a rescaled Bitmap (32 bits only) ! - New TIFF save format option. ! - New sample : read image from zipfile. ! ! 0.07 24/04/2003 ! - New Win32::GUI::DIBitmap method ! + newFromGD ! + CopyFromGD, CopyToGD : Must have Same Size and BPP. ! - UPDATE 1 : Add switch for old GD version ! - UPDATE 2 : Correct upside down bitmap bug ! ! 0.06 28/05/2002 ! - Use FreeImage 2.5.3 ! - Add FreeImage Multipaging interface ! ! 0.05 14/01/2002 ! - Use FreeImage 2.5.0 ! - Add FreeImage Multipaging interface (experimental in this release) ! - New Win32::GUI::DIBitmap method ! + Clone ! + AlphaCopyToDC ! + AlphaStrechToDC ! ! 0.04 29/10/2001 ! - Use FreeImage 2.4.2 ! - Fix bug in jpeg plug-in ! ! 0.03 18/08/2001 ! - Correct Bug when capture screen if display isn't in 32 bits ! - Add new function GetColorType ! - ColorQuantize work if image isn't in 24 bits ! - Add more Documentation ! ! 0.02 15/08/2001 ! - Use FreeImage 2.4.1 ! - Some little change ! ! 0.01 21/03/2001 ! - original version; created by h2xs 1.19 ! - First build Win32::GUI::DIBitmap --- Readme DELETED --- Index: DIBitmap.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/DIBitmap.xs,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** DIBitmap.xs 2 Nov 2005 08:41:17 -0000 1.1 --- DIBitmap.xs 11 Jun 2006 16:34:32 -0000 1.2 *************** *** 3,6 **** --- 3,8 ---- /**********************************************************************/ + /* $Id$ */ + #include "EXTERN.h" #include "perl.h" *************** *** 236,239 **** --- 238,242 ---- int constant (char * name, int arg) { + errno = 0; switch(*name) { *************** *** 386,389 **** --- 389,393 ---- CONSTANT(XPM_DEFAULT); } + errno = EINVAL; return 0; } *************** *** 395,398 **** --- 399,404 ---- MODULE = Win32::GUI::DIBitmap PACKAGE = Win32::GUI::DIBitmap + PROTOTYPES: ENABLE + ################################################################## # # *************** *** 865,869 **** cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits ); if (dib == NULL) XSRETURN_EMPTY; --- 871,875 ---- cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits, 0, 0, 0 ); if (dib == NULL) XSRETURN_EMPTY; *************** *** 938,942 **** cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits ); if (dib == NULL) { --- 944,948 ---- cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits, 0, 0, 0 ); if (dib == NULL) { *************** *** 1024,1028 **** cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits ); if (dib == NULL) { --- 1030,1034 ---- cClrBits = 24; ! dib = FreeImage_Allocate (bmp.bmWidth, bmp.bmHeight, cClrBits, 0, 0, 0 ); if (dib == NULL) { *************** *** 1835,1838 **** --- 1841,1845 ---- { + UINT i, j; BITMAPINFOHEADER BMI; BYTE * pBits; *************** *** 1876,1880 **** // Modify background image ! for (UINT j = 0; j < h; j++) { --- 1883,1887 ---- // Modify background image ! for (j = 0; j < h; j++) { *************** *** 1882,1886 **** BYTE * pDest = &pBits [j * w * 4]; ! for (UINT i = 0; i < w; i++) { --- 1889,1893 ---- BYTE * pDest = &pBits [j * w * 4]; ! for (i = 0; i < w; i++) { *************** *** 2038,2047 **** if (ret != GDI_ERROR) { ! for (UINT j = 0; j < hd; ++j) { LPBYTE pbDestRGB = (LPBYTE)&((DWORD*)pDestBits)[j * wd]; LPBYTE pbSrcRGB = (LPBYTE)&((DWORD*)pSrcBits) [j * wd]; ! for (UINT i = 0; i < wd; ++i) { pbDestRGB[0] = (pbDestRGB[0] * (255-pbSrcRGB[3]) + pbSrcRGB[0] * pbSrcRGB[3])>>8; --- 2045,2056 ---- if (ret != GDI_ERROR) { ! UINT j; ! for (j = 0; j < hd; ++j) { + UINT i; LPBYTE pbDestRGB = (LPBYTE)&((DWORD*)pDestBits)[j * wd]; LPBYTE pbSrcRGB = (LPBYTE)&((DWORD*)pSrcBits) [j * wd]; ! for (i = 0; i < wd; ++i) { pbDestRGB[0] = (pbDestRGB[0] * (255-pbSrcRGB[3]) + pbSrcRGB[0] * pbSrcRGB[3])>>8; *************** *** 2843,2847 **** Win32::GUI::MDIBitmap mdib CODE: ! FreeImage_CloseMultiBitmap(mdib); # --- 2852,2856 ---- Win32::GUI::MDIBitmap mdib CODE: ! FreeImage_CloseMultiBitmap(mdib, 0); # --- NEW FILE: TODO --- - Upgrade to FreeImage 3.8.0 - Build and include static gcc lib (LibFreeImage.a?) so that we can build with MinGW/cygwin - more tests - test12.pl crashes during LockPage. Find out why. Index: TYPEMAP =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/TYPEMAP,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TYPEMAP 2 Nov 2005 08:41:17 -0000 1.1 --- TYPEMAP 11 Jun 2006 16:34:33 -0000 1.2 *************** *** 1,12 **** TYPEMAP LPCTSTR T_PV - LPCSTR T_PV - LPTSTR T_PV - DWORD T_IV UINT T_IV BOOL T_IV FREE_IMAGE_FORMAT T_IV FREE_IMAGE_QUANTIZE T_IV - FREE_IMAGE_COLOR_TYPE T_IV FREE_IMAGE_DITHER T_IV FREE_IMAGE_FILTER T_IV --- 1,10 ---- + # Typemap for Win32::GUI::DIBitmap + # $Id$ TYPEMAP LPCTSTR T_PV UINT T_IV BOOL T_IV FREE_IMAGE_FORMAT T_IV FREE_IMAGE_QUANTIZE T_IV FREE_IMAGE_DITHER T_IV FREE_IMAGE_FILTER T_IV *************** *** 25,38 **** 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); ################################################################################ OUTPUT T_HANDLE ! sv_setiv($arg, (IV) $var); ! --- 23,36 ---- T_HANDLE if(SvROK($arg)) { ! SV** out=hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0); ! if(out != NULL) ! $var = INT2PTR($type,SvIV(*out)); else $var = NULL; } else ! $var = INT2PTR($type,SvIV($arg)); ################################################################################ OUTPUT T_HANDLE ! sv_setiv($arg, PTR2IV($var)); |
|
From: Robert M. <rob...@us...> - 2006-06-11 16:35:12
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/extlib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562/extlib Modified Files: Readme.txt Added Files: libfreeimage-cygwin.a Log Message: Merge DIBitmap into core distribution --- NEW FILE: libfreeimage-cygwin.a --- (This appears to be a binary file; contents omitted.) Index: Readme.txt =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/extlib/Readme.txt,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Readme.txt 2 Nov 2005 08:41:17 -0000 1.1 --- Readme.txt 11 Jun 2006 16:34:39 -0000 1.2 *************** *** 1,9 **** Download FreeImage source code at http://freeimage.sourceforge.net/ - Build the FreeImage static lib with MSVC project. - Copy the FreeImage.lib and FreeImage.h in the extlib directory. ! Run : - perl Makefile.pl - nmake - nmake install --- 1,21 ---- + Building the Static FreeImage libraries (correct as at FreeImage 3.8.0) + Download FreeImage source code at http://freeimage.sourceforge.net/ ! For VC6: ! - Build the FreeImage static lib with MSVC project. ! - Copy the FreeImage.lib and FreeImage.h in the extlib directory. ! ! For Mingw: ! - I've not managed to build FreeImage under mingw yet (although it is supposed ! to be possible) ! ! For Cygwin: ! - Download Makefile.cygwin from http://freeimage.cvs.sourceforge.net/freeimage/FreeImage/ ! - Build the static lib (make -fMakefile.cygwin) ! - Copy the libFreeImage.a and FreeImage.h in the extlib directory, renaming ! libfreeimage.a to libfreeimage-cygwin.a ! ! ! |
|
From: Robert M. <rob...@us...> - 2006-06-11 16:34:51
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562/t Added Files: 01_load.t 02_new.t 98_pod.t 99_pod_coverage.t Log Message: Merge DIBitmap into core distribution --- NEW FILE: 99_pod_coverage.t --- #!perl -wT # Win32::GUI::DIBitmap test suite. # $Id: 99_pod_coverage.t,v 1.1 2006/06/11 16:34:48 robertemay Exp $ # Check the POD covers all method calls use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; plan skip_all => "Pod Coverage tests for Win32::GUI::DIBitmap done by core" if $ENV{W32G_CORE}; all_pod_coverage_ok( { also_private => [ qr/^constant$/ ] } ); --- NEW FILE: 02_new.t --- #!perl -wT # Win32::GUI::DIBitmap test suite # $Id: 02_new.t,v 1.1 2006/06/11 16:34:48 robertemay Exp $ # # - check we can create a new DIBitmap object use strict; use warnings; BEGIN { $| = 1 } # Autoflush use Test::More tests => 2; use Win32::GUI(); use Win32::GUI::DIBitmap(); my $W = Win32::GUI::Window->new(); can_ok('Win32::GUI::DIBitmap', 'new'); my $S = Win32::GUI::DIBitmap->newFromWindow($W); isa_ok($S, 'Win32::GUI::DIBitmap', 'Correct object type created'); --- NEW FILE: 98_pod.t --- #!perl -wT # Win32::GUI::DIBitmap test suite. # $Id: 98_pod.t,v 1.1 2006/06/11 16:34:48 robertemay Exp $ # Check that our pod documentation has valid syntax 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 $@; plan skip_all => "Pod tests for Win32::GUI::DIBitmap done by core" if $ENV{W32G_CORE}; all_pod_files_ok(); --- NEW FILE: 01_load.t --- #!perl -wT # Win32::GUI::DIBitmap test suite # $Id: 01_load.t,v 1.1 2006/06/11 16:34:47 robertemay Exp $ # # - check pre-requsites # - check module loads # - check module has a version use strict; use warnings; BEGIN { $| = 1 } # Autoflush # Pre-requisites: 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::Grid test\n"; chomp $@; $@ =~ s/^/# /gm; print "$@\n"; print "Bail Out! Test::More not available\n"; exit(1); } plan( tests => 3 ); # Pre-requisites: Check that we're on windows or cygwin # bail out if we're not if ( not ($^O =~ /MSwin32|cygwin/i)) { diag("\nWin32::GUI::DIBitmap can only run on MSWin32 or cygwin, not '$^O'"); print "Bail out! Incompatible Operating System\n"; } pass("Correct OS: $^O"); # Check that Win32::GUI::DIBitmap loads, and bail out of all # tests if it doesn't use_ok('Win32::GUI::DIBitmap') or print STDOUT "Bail out! Can't load Win32::GUI::DIBitmap"; # Check that Win32::GUI::DIBitmap has a version ok(defined $Win32::GUI::DIBitmap::VERSION, "Win32::GUI::DIBitmap version check"); |
|
From: Robert M. <rob...@us...> - 2006-06-11 16:34:50
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/samples/bmp In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562/samples/bmp Removed Files: 1.bmp 1.png 1.tga 2.bmp 2.png 2.tga 3.bmp 3.png 3.tga 4.bmp 4.png 4.tga 5.bmp 5.png 5.tga Zapotec.JPG Zapotec.bmp small.tga Log Message: Merge DIBitmap into core distribution --- 1.bmp DELETED --- --- 4.bmp DELETED --- --- small.tga DELETED --- --- 4.tga DELETED --- --- 2.bmp DELETED --- --- Zapotec.JPG DELETED --- --- 1.tga DELETED --- --- 5.bmp DELETED --- --- 2.png DELETED --- --- 3.png DELETED --- --- 5.tga DELETED --- --- 2.tga DELETED --- --- Zapotec.bmp DELETED --- --- 4.png DELETED --- --- 5.png DELETED --- --- 3.tga DELETED --- --- 1.png DELETED --- --- 3.bmp DELETED --- |
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/samples In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562/samples Removed Files: INFO2.PL Zapotec.zip demo.pl demo2.pl info.pl piv.pl test1.pl test10.pl test11.pl test12.pl test13.pl test14.pl test15.pl test2.pl test3.pl test4.pl test5.pl test6.pl test7.pl test8.pl test9.pl zipimage.PL Log Message: Merge DIBitmap into core distribution --- test11.pl DELETED --- --- info.pl DELETED --- --- test4.pl DELETED --- --- test1.pl DELETED --- --- test13.pl DELETED --- --- Zapotec.zip DELETED --- --- test2.pl DELETED --- --- test7.pl DELETED --- --- demo2.pl DELETED --- --- test8.pl DELETED --- --- zipimage.PL DELETED --- --- test10.pl DELETED --- --- test5.pl DELETED --- --- test12.pl DELETED --- --- INFO2.PL DELETED --- --- test14.pl DELETED --- --- test9.pl DELETED --- --- test3.pl DELETED --- --- demo.pl DELETED --- --- test15.pl DELETED --- --- piv.pl DELETED --- --- test6.pl DELETED --- |
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15562/demos Added Files: 1.bmp 1.png 1.tga 2.bmp 2.png 2.tga 3.bmp 3.png 3.tga 4.bmp 4.png 4.tga 5.bmp 5.png 5.tga Zapotec.bmp Zapotec.jpg Zapotec.zip demo.pl demo2.pl info.pl info2.pl piv.pl small.tga test1.pl test10.pl test11.pl test12.pl test13.pl test14.pl test15.pl test2.pl test3.pl test4.pl test5.pl test6.pl test7.pl test8.pl test9.pl zipimage.pl Log Message: Merge DIBitmap into core distribution --- NEW FILE: 1.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test11.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromBitmap # - CopyToDC # - AlphaCopyToDC # - AlphaStretchToDC use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap(); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", ) or die "new Window"; my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; my $dibalpha = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/small.tga") or die "newFromFile"; print "Transparent : ", $dibalpha->IsTransparent(), "\n"; print "BPP : ", $dibalpha->GetBPP(), "\n"; $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; $dib->StretchToDC($dc, 10, 10, $width - 20, $height - 20); $dibalpha->CopyToDC($dc); $dibalpha->AlphaCopyToDC($dc, 200); $dibalpha->AlphaStretchToDC($dc, 0, 200, 260, 200 ); $dc->Validate(); return 1; } --- NEW FILE: info.pl --- #!perl -w use strict; use warnings; use Win32::GUI::DIBitmap(); print "FreeImage Version: ", Win32::GUI::DIBitmap::GetVersion(), "\n"; print Win32::GUI::DIBitmap::GetCopyright(), "\n"; my $count = Win32::GUI::DIBitmap::GetFIFCount(); print "Format\tReading\tWriting\tDescription\n"; for (my $fif = 0; $fif < $count; $fif++) { my $format = Win32::GUI::DIBitmap::GetFormatFromFIF($fif); my $desc = Win32::GUI::DIBitmap::FIFDescription($fif); my $read = Win32::GUI::DIBitmap::FIFSupportsReading($fif) ? "Y" : "N"; my $write = Win32::GUI::DIBitmap::FIFSupportsWriting($fif) ? "Y" : "N"; my $export = ""; $export .= " 1" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 1)); $export .= " 4" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 4)); $export .= " 8" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 8)); $export .= " 16" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 16)); $export .= " 24" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 24)); $export .= " 32" if (Win32::GUI::DIBitmap::FIFSupportsExportBPP($fif, 32)); $export = " [Export =$export]" unless ($export eq ""); print "$format\t$read\t$write\t$desc$export\n"; } --- NEW FILE: test4.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromFile # - ConvertToBitmap use FindBin(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::DIBitmap; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; my ($width, $height) = ($W->GetClientRect)[2..3]; my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.jpg") or die "Load zapotec.jpg"; my $hbitmap = $dib->ConvertToBitmap(); undef $dib; # $hbitmap = new Win32::GUI::Bitmap('bmp/zapotec.bmp') or die ("new Bitmap"); $W->AddLabel ( -pos => [0 , 0], -size => [$width, $height], -bitmap => $hbitmap, -name => "Bitmap", ); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Resize { $W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight); } sub Window_Terminate { -1; } --- NEW FILE: 5.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 1.tga --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 3.tga --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test1.pl --- #perl -w use strict; use warnings; # # Test standalone : # # Functions Test : # - GetVersion # - GetCopyright # - GetFIFCount # - GetFormatFromFIF # - GetFIFFromFormat # - FIFExtensionList # - FIFDescription # - FIFRegExpr # - FIFSupportsWriting # - FIFSupportsReading # - new # - SaveToFile use Win32::GUI::DIBitmap; print Win32::GUI::DIBitmap::GetVersion(), "\n"; print Win32::GUI::DIBitmap::GetCopyright(), "\n"; my $count = Win32::GUI::DIBitmap::GetFIFCount(); print "count = $count\n"; for (my $i = 0; $i < $count; $i++) { my $format = Win32::GUI::DIBitmap::GetFormatFromFIF($i); my $fif = Win32::GUI::DIBitmap::GetFIFFromFormat($format); my $ext = Win32::GUI::DIBitmap::FIFExtensionList($fif); my $desc = Win32::GUI::DIBitmap::FIFDescription($fif); my $reg = Win32::GUI::DIBitmap::FIFRegExpr($fif); $reg = 'UNDEF' unless defined $reg; my $read = Win32::GUI::DIBitmap::FIFSupportsReading($fif); my $write = Win32::GUI::DIBitmap::FIFSupportsWriting($fif); print "$i : Format = $format FIF = $fif Extention = $ext Description = $desc RegExp = $reg Reading = $read Writing = $write\n"; } my $dib = new Win32::GUI::DIBitmap (100,100,24,255,255,255); for (my $i = 0; $i < $count; $i++) { my ($ext, $misc) = split /,/, Win32::GUI::DIBitmap::FIFExtensionList($i), 2; my $f = "res$i.$ext"; my $res = $dib->SaveToFile($f, $i); print "save $f = $res\n"; unlink $f; } --- NEW FILE: test13.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI and GD # # Functions Test : # - newFromGD # - CopyFromGD # - StretchToDC BEGIN { eval "use GD"; die "GD module required to run this test file" if $@; } use Win32::GUI(); use Win32::GUI::DIBitmap(); # create a new image my $im = new GD::Image(100,100); # allocate some colors my $white = $im->colorAllocate(255,255,255); my $black = $im->colorAllocate(0,0,0); my $red = $im->colorAllocate(255,0,0); my $blue = $im->colorAllocate(0,0,255); my $green = $im->colorAllocate(0,255,0); # make the background transparent and interlaced $im->transparent($white); $im->interlaced('true'); # Put a black frame around the picture $im->rectangle(0,0,99,99,$black); # Draw a blue oval $im->arc(50,50,95,75,0,360,$blue); $im->string(gdSmallFont,2,10,"Top",$black); # And fill it with red $im->fill(50,50,$red); my $color = 0; # Allocate a DIBitmap and copy GD image (no inflate/deflate) my $dib = newFromGD Win32::GUI::DIBitmap ($im) or die "newFromData"; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -pos => [100, 100], -size => [200, 230], -name => "Window", ) or die "new Window"; $W->AddButton ( -name => "BtnColor", -pos => [0, 0], -size => [200, 20], -text => "Change Color !!!" ) or die "new AddButton"; $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Resize { my ($width, $height) = ($W->GetClientRect)[2..3]; $W->BtnColor->Resize($width, 20); Paint(); } sub Window_Activate { Paint(); } sub Paint { my ($width, $height) = ($W->GetClientRect)[2..3]; my $dc = new Win32::GUI::DC ($W); $dib->StretchToDC($dc, 0, 30, $width, $height - 30); } sub BtnColor_Click { # Change color if ($color) { $im->fill(50,50,$red); print "Color change to red \n"; } else { $im->fill(50,50,$green); print "Color change to green\n"; } # Copy GD data only (no allocation, no inflate/deflate) $dib->CopyFromGD($im); $color = 1 - $color; Paint(); } --- NEW FILE: Zapotec.zip --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 4.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test2.pl --- #!perl -w use strict; use warnings; # # Test standalone : Load and save in different format # # Functions Test : # - GetVersion # - GetCopyright # - newFromFile # - SaveToFile # use FindBin(); use File::Path; use Win32::GUI::DIBitmap; print Win32::GUI::DIBitmap::GetVersion(), "\n"; print Win32::GUI::DIBitmap::GetCopyright(), "\n"; my $dir_in = $FindBin::Bin; print "Scanning $dir_in\n"; chdir $dir_in; opendir (my $dh, '.') or die "error opendir"; my @Fichier = grep { -f $_ } readdir ($dh); closedir ($dh); print "Found files: @Fichier\n"; my $dir_out = "$dir_in/test2_dir"; print "Writing to $dir_out\n"; mkpath($dir_out); my $i = 0; foreach my $fichier (@Fichier) { $i ++; my $dib = Win32::GUI::DIBitmap->newFromFile ($fichier); if (defined $dib) { my $f = "$dir_out/$i.bmp"; print "$fichier -> $f\n"; $dib->SaveToFile($f); undef $dib; } } print "Press any key\n"; <>; rmtree($dir_out); --- NEW FILE: test7.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromBitmap # - StretchToDC use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", ) or die "new Window"; my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; $dib->StretchToDC($dc, 10, 10, $width - 20, $height - 20); $dib->StretchToDC($dc); $dib->StretchToDC($dc, 0, ($height / 2) - 30, 50, 50); $dib->StretchToDC($dc, 0, $height - 50 , 50, 50, 20, 20, 20, 20); $dc->Validate(); return 1; } --- NEW FILE: 2.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: demo2.pl --- #!perl -w ####################################################################### # # Perl Image Viewer # ####################################################################### use strict; use warnings; use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap(); my @PIVReadFilter; my $PIVDirectory; my $PIVDib; PIVInit (); my $Menu = Win32::GUI::MakeMenu( "&File" => "File", " > &Open..." => "FileOpen", " > -" => 0, " > &Directory..." => "FileDirectory", " > -" => 0, " > E&xit" => "FileExit", ); my $Window = new Win32::GUI::Window ( -name => "Window", -title => "Perl Image Viewer Demo", -pos => [100, 100], -size => [400, 400], -menu => $Menu, ); $Window->AddGraphic ( -name => "Graphic", -pos => [0, 0], -size => [$Window->ScaleWidth,$Window->ScaleHeight], ); $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); ####################################################################### # # PIV Functions # ####################################################################### sub PIVInit { # # Init PIVLoadFilter and PIVSaveFilter # my %ReadFilter; my $count = Win32::GUI::DIBitmap::GetFIFCount(); my $list = ""; for (my $fif = 0; $fif < $count; $fif++) { my $ext = Win32::GUI::DIBitmap::FIFExtensionList($fif); my $desc = Win32::GUI::DIBitmap::FIFDescription($fif); my $read = Win32::GUI::DIBitmap::FIFSupportsReading($fif); my $write = Win32::GUI::DIBitmap::FIFSupportsWriting($fif); $desc .= " (*." . join (',*.', split ( ',', $ext)) . ")"; $ext = "*." . join (';*.', split ( ',', $ext)); if (Win32::GUI::DIBitmap::FIFSupportsReading($fif)) { $ReadFilter {$desc} = $ext; $list .= ";$ext"; } } push @PIVReadFilter, "All PIV Files", $list; foreach my $i (sort keys %ReadFilter) { push @PIVReadFilter, $i, $ReadFilter{$i}; } # # init PIVDirectory # $PIVDirectory = $FindBin::Bin; $PIVDirectory =~ tr/\//\\/; } sub PIVAdjustDisplay { if (defined $PIVDib) { my $w = $Window->Width - $Window->ScaleWidth; my $h = $Window->Height - $Window->ScaleHeight; $Window->Resize ($PIVDib->Width + $w, $PIVDib->Height + $h); } } sub PIVFinish { undef $PIVDib; return -1; } ####################################################################### # # Window Event # ####################################################################### sub Window_Terminate { return PIVFinish(); } sub Window_Resize { $Window->Graphic->Resize ($Window->ScaleWidth, $Window->ScaleHeight); } ####################################################################### # # Graphic Event # ####################################################################### sub Graphic_Paint { my $DC = $Window->Graphic->GetDC(); if (defined $PIVDib) { $PIVDib->CopyToDC($DC); } $DC->Validate(); } ####################################################################### # # File Menu # ####################################################################### sub FileOpen_Click { my $ret = Win32::GUI::GetOpenFileName( -title => "Open Image File", -filter => \@PIVReadFilter, -directory => $PIVDirectory, ); if ($ret) { undef $PIVDib; $PIVDib = newFromFile Win32::GUI::DIBitmap ($ret); PIVAdjustDisplay (); } elsif (Win32::GUI::CommDlgExtendedError()) { Win32::GUI::MessageBox (0, "ERROR : ".Win32::GUI::CommDlgExtendedError(), "GetOpenFileName Error"); } } sub FileDirectory_Click { my $ret = Win32::GUI::BrowseForFolder ( -title => "Select default directory", -directory => $PIVDirectory, -folderonly => 1, ); $PIVDirectory = $ret if ($ret); return 0; } sub FileExit_Click { return PIVFinish(); } --- NEW FILE: test8.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI and GD # # Functions Test : # - newFromData # - StretchToDC BEGIN { eval "use GD"; die "GD module required for this script" if $@; } use Win32::GUI(); use Win32::GUI::DIBitmap; # create a new image my $im = new GD::Image(100,100); # allocate some colors my $white = $im->colorAllocate(255,255,255); my $black = $im->colorAllocate(0,0,0); my $red = $im->colorAllocate(255,0,0); my $blue = $im->colorAllocate(0,0,255); # make the background transparent and interlaced $im->transparent($white); $im->interlaced('true'); # Put a black frame around the picture $im->rectangle(0,0,99,99,$black); # Draw a blue oval $im->arc(50,50,95,75,0,360,$blue); # And fill it with red $im->fill(50,50,$red); my $dib = newFromData Win32::GUI::DIBitmap ($im->png) or die "newFromData"; undef $im; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -pos => [100, 100], -size => [200, 200], -name => "Window", ) or die "new Window"; $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; $dib->StretchToDC($dc, 0, 0, $width, $height); $dc->Validate(); return 1; } --- NEW FILE: 3.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 5.png --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test10.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromWindow # - SaveToFile use FindBin(); use File::Path; use Win32::GUI(); use Win32::GUI::DIBitmap(); my $out_dir = "$FindBin::Bin/test10_dir"; mkpath($out_dir); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test : newFromWindow", -pos => [100, 100], -size => [300, 200], -name => "Window", ) or die "new Window"; $W->AddButton ( -name => "Capture1", -text => "Click here for capture this button", -pos => [20, 40], ); $W->AddButton ( -name => "Capture2", -text => "Click here for capture this window", -pos => [20, 80], ); $W->AddButton ( -name => "Capture3", -text => "Click here for capture the screen", -pos => [20, 120], ); $W->Show(); Win32::GUI::Dialog(); rmtree($out_dir); exit(0); sub Capture1_Click { my $dib = newFromWindow Win32::GUI::DIBitmap ($W->Capture1) or die "newFromWindow"; $dib->SaveToFile ("$out_dir/button.bmp"); } sub Capture2_Click { my $dib = newFromWindow Win32::GUI::DIBitmap ($W) or die "newFromWindow"; $dib->SaveToFile ("$out_dir/window_1.bmp"); $dib = newFromWindow Win32::GUI::DIBitmap ($W, 1) or die "newFromWindow"; $dib->SaveToFile ("$out_dir/window_2.bmp"); } sub Capture3_Click { my $hwnd = Win32::GUI::GetDesktopWindow(); my $dib = newFromWindow Win32::GUI::DIBitmap ($hwnd) or die "newFromWindow"; $dib->SaveToFile ("$out_dir/screen.bmp"); $dib->SaveToFile ("$out_dir/screen.png"); $dib->SaveToFile ("$out_dir/screen.jpg"); $dib->SaveToFile ("$out_dir/screen.tif"); } --- NEW FILE: test5.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromBitmap # - ConvertToBitmap # - ConvertTo24Bits # - SaveToFile with fif and flag use FindBin(); use File::Path; use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::DIBitmap; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; my ($width, $height) = ($W->GetClientRect)[2..3]; my $hbitmap = new Win32::GUI::Bitmap("$FindBin::Bin/zapotec.bmp") or die ("new Bitmap"); my $dib = newFromBitmap Win32::GUI::DIBitmap ($hbitmap) or die "newFromBitmap"; undef $hbitmap; $hbitmap = $dib->ConvertToBitmap() or die "ConvertToBitmap"; my $out_dir = "test5_dir"; mkpath($out_dir); $dib->SaveToFile ("$out_dir/1.jpg", FIF_JPEG, JPEG_QUALITYSUPERB ) or die "SaveToFile"; $dib->SaveToFile ("$out_dir/2.jpg", FIF_JPEG, JPEG_QUALITYGOOD ) or die "SaveToFile"; $dib->SaveToFile ("$out_dir/3.jpg", FIF_JPEG, JPEG_QUALITYNORMAL ) or die "SaveToFile"; $dib->SaveToFile ("$out_dir/4.jpg", FIF_JPEG, JPEG_QUALITYAVERAGE) or die "SaveToFile"; $dib->SaveToFile ("$out_dir/5.jpg", FIF_JPEG, JPEG_QUALITYBAD ) or die "SaveToFile"; undef $dib; $W->AddLabel ( -pos => [0 , 0], -size => [$width, $height], -bitmap => $hbitmap, -name => "Bitmap", ); $W->Show(); Win32::GUI::Dialog(); rmtree($out_dir); exit(0); sub Window_Resize { $W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight); } sub Window_Terminate { -1; } --- NEW FILE: Zapotec.jpg --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 2.png --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 3.png --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 5.tga --- (This appears to be a binary file; contents omitted.) --- NEW FILE: 1.png --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test12.pl --- #!perl -w use strict; use warnings; die "This sample crashes perl when calling FreeImage_LockPage"; $|=1; #autoflush # # Test with Win32::GUI and Multi-Page system # # Functions Test : # - newFromFile # - AppendPage # - GetPageCount # - LockPage # - UnlockPage # - GetLockedPageNumbers use FindBin(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::DIBitmap; # Create a MDIB bitmap my $mdib = new Win32::GUI::MDIBitmap ("mdib.tiff", FIF_TIFF,) or die "new"; for my $i (1..5) { my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/$i.bmp") or die "Failed reading $i.bmp"; $mdib->AppendPage ($dib); } #undef $mdib; # Load a MDIB bitmap #$mdib = newFromFile Win32::GUI::MDIBitmap ("mdib.tiff") or die "newFromFile"; print "Number of pages :", $mdib->GetPageCount(), "\n"; my $i = 0; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; my ($width, $height) = ($W->GetClientRect)[2..3]; $W->AddButton ( -name => "Button", -text => "Next", -pos => [0 , 0], ); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Button_Click { $i = $i + 1; $i = 0 if ($i >= $mdib->GetPageCount()); print "Current page :", $i, "\n"; $W->InvalidateRect(0); } sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; print "Locking page $i\n"; my $dib = $mdib->LockPage($i); print "Locked\n"; #print $mdib->GetLockedPageNumbers(), "\n"; #$dib->AlphaCopyToDC($dc, 50, 50); #$dib->CopyToDC($dc, 50, 50); #$dib->SaveToFile ("test.bmp"); print "UnLocking\n"; $mdib->UnlockPage($dib); print "UnLocked\n"; $dc->Validate(); return 1; } --- NEW FILE: zipimage.pl --- #!perl -w use strict; use warnings; # # Load image from a zip file. # use FindBin(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::DIBitmap(); use Archive::Zip(); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap load from a zipfile", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; my ($width, $height) = ($W->GetClientRect)[2..3]; # Open Zipfile my $zip = Archive::Zip->new( "$FindBin::Bin/zapotec.zip" ) or die "ZipFile"; # Open image file in zipfile my $member = $zip->memberNamed( 'Zapotec.JPG' ) or die "member ZipFile"; # Load data image in memory my $data = $member->contents(); # Load data immage in a dibbitmap my $dib = newFromData Win32::GUI::DIBitmap ($data) or die "Load zapotec.jpg"; my $hbitmap = $dib->ConvertToBitmap(); undef $member; undef $zip; undef $data; undef $dib; $W->AddLabel ( -pos => [0 , 0], -size => [$width, $height], -bitmap => $hbitmap, -name => "Bitmap", ); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Resize { $W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight); } --- NEW FILE: info2.pl --- #!perl -w use strict; use warnings; # Check save bit support. # 16-32 bits JPEG automaticly converted in SaveToFile # 16 bits PNG automaticly converted in SaveToFile use Win32::GUI::DIBitmap(); print "FreeImage ", Win32::GUI::DIBitmap::GetVersion(), "\n"; my $count = Win32::GUI::DIBitmap::GetFIFCount(); print "Format\tWriting info\n"; my $dib1 = new Win32::GUI::DIBitmap (100,100,1); my $dib4 = new Win32::GUI::DIBitmap (100,100,4); my $dib8 = new Win32::GUI::DIBitmap (100,100,8); my $dib16 = new Win32::GUI::DIBitmap (100,100,16); my $dib24 = new Win32::GUI::DIBitmap (100,100,24); my $dib32 = new Win32::GUI::DIBitmap (100,100,32); my $f = "tmp"; for (my $fif = 0; $fif < $count; $fif++) { my $format = Win32::GUI::DIBitmap::GetFormatFromFIF($fif); #my $desc = Win32::GUI::DIBitmap::FIFDescription($fif); if (Win32::GUI::DIBitmap::FIFSupportsWriting($fif)) { my $write = ''; $write .= "1 " if ( $dib1->SaveToFile($f, $fif) ); unlink $f; $write .= "4 " if ( $dib4->SaveToFile($f, $fif) ); unlink $f; $write .= "8 " if ( $dib8->SaveToFile($f, $fif) ); unlink $f; $write .= "16 " if ( $dib16->SaveToFile($f, $fif) ); unlink $f; $write .= "24 " if ( $dib24->SaveToFile($f, $fif) ); unlink $f; $write .= "32 " if ( $dib32->SaveToFile($f, $fif) ); unlink $f; print "$format\t$write\n"; } } --- NEW FILE: test14.pl --- #!perl -w use strict; use warnings; # # Test some effects # use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap; my $Menu = Win32::GUI::Menu->new( "&Effect" => "Effect", " > &Restore" => "EffectRestore", " > -" => 0, " > Dither" => "EffectDither", " > Threshold (50)" => "EffectThreshold", " > -" => 0, " > AdjustGamma (0.5)" => "EffectAdjustGamma1", " > AdjustGamma (1.5)" => "EffectAdjustGamma2", " > AdjustBrightness (-50)" => "EffectAdjustBrightness1", " > AdjustBrightness (50)" => "EffectAdjustBrightness2", " > AdjustContrast (-50)" => "EffectAdjustContrast1", " > AdjustContrast (50)" => "EffectAdjustContrast2", " > Invert" => "EffectInvert", " > -" => 0, " > Copy" => "EffectCopy", " > Paste" => "EffectPaste", " > -" => 0, " > Rotate(45)" => "EffectRotate", " > RotateEx(45, 10, 10, 10, 10, 1)" => "EffectRotateEx", " > FlipHorizontal" => "EffectFlipHorizontal", " > FlipVertical" => "EffectFlipVertical", " > -" => 0, " > Rescale (W+10, H+10)" => "EffectRescaleUp", " > Rescale (W-10, H-10)" => "EffectRescaleDown", " > -" => 0, " > E&xit" => "EffectExit", ); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", -menu => $Menu, ) or die "new Window"; my $G = Win32::GUI::Graphic->new ($W, -name => "Graphic", -pos => [0, 0], -size => [$W->ScaleWidth,$W->ScaleHeight], ); my $dib; EffectRestore_Click(); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Resize { $G->Resize ($W->ScaleWidth, $W->ScaleHeight); } sub Graphic_Paint { my $dc = $G->GetDC(); my ($width, $height) = ($G->GetClientRect)[2..3]; $dib->StretchToDC($dc, 0, 0, $width, $height) if defined $dib; $dc->Validate(); } sub EffectExit_Click { return -1; } sub EffectRestore_Click { $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; $dib = $dib->ConvertTo32Bits(); $G->InvalidateRect(1); } sub EffectDither_Click { $dib = $dib->Dither() if defined $dib; $G->InvalidateRect(1); } sub EffectThreshold_Click { $dib = $dib->Threshold(50) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustGamma1_Click { $dib->AdjustGamma(0.5) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustGamma2_Click { $dib->AdjustGamma(1.5) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustBrightness1_Click { $dib->AdjustBrightness(-50) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustBrightness2_Click { $dib->AdjustBrightness(50) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustContrast1_Click { $dib->AdjustContrast(-50) if defined $dib; $G->InvalidateRect(1); } sub EffectAdjustContrast2_Click { $dib->AdjustContrast(50) if defined $dib; $G->InvalidateRect(1); } sub EffectInvert_Click { $dib->Invert() if defined $dib; $G->InvalidateRect(1); } sub EffectCopy_Click { if (defined $dib and $dib->Width > 20 and $dib->Height > 20) { $dib = $dib->Copy(10,10,$dib->Width-10,$dib->Height-10) or die "Copy"; } $G->InvalidateRect(1); } sub EffectPaste_Click { if (defined $dib and $dib->Width > 20 and $dib->Height > 20) { my $dib2 = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; $dib2 = $dib2->Copy(10,10,30,30); $dib->Paste($dib2, 10, 10, 500); } $G->InvalidateRect(1); } sub EffectFlipHorizontal_Click { $dib->FlipHorizontal() if defined $dib; $G->InvalidateRect(1); } sub EffectFlipVertical_Click { $dib->FlipVertical() if defined $dib; $G->InvalidateRect(1); } sub EffectRotate_Click { $dib = $dib->Rotate(45) or die "Rotate" if defined $dib; $G->InvalidateRect(1); } sub EffectRotateEx_Click { $dib = $dib->RotateEx(45,10,10,10,10,1) or die "RotateEx" if defined $dib; $G->InvalidateRect(1); } sub EffectRescaleUp_Click { $dib = $dib->Rescale($dib->Width+10,$dib->Height+10) or die "Rescale" if defined $dib; $G->InvalidateRect(1); } sub EffectRescaleDown_Click { if (defined $dib and $dib->Width > 20 and $dib->Height > 20) { $dib = $dib->Rescale($dib->Width-10,$dib->Height-10) or die "Rescale"; } $G->InvalidateRect(1); } --- NEW FILE: test9.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromDC # - SaveToFile use FindBin(); use File::Path; use Win32::GUI(); use Win32::GUI::DIBitmap; my $out_dir = "$FindBin::Bin/test9_dir"; mkdir($out_dir); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test: NewFromDC", -pos => [100, 100], -size => [300, 200], -name => "Window", ) or die "new Window"; $W->AddButton ( -name => "Capture1", -text => "Click here for capture this button", -pos => [20, 40], ); $W->AddButton ( -name => "Capture2", -text => "Click here for capture this window", -pos => [20, 80], ); $W->AddButton ( -name => "Capture3", -text => "Click here for capture the screen", -pos => [20, 120], ); $W->Show(); Win32::GUI::Dialog(); rmtree($out_dir); exit(0); sub Capture1_Click { my $dc = new Win32::GUI::DC ($W); my $dib = newFromDC Win32::GUI::DIBitmap ($dc, $W->Capture1->Left, $W->Capture1->Top, $W->Capture1->Width(), $W->Capture1->Height()) or die "newFromDC"; $dib->SaveToFile ("$out_dir/button.bmp"); } sub Capture2_Click { my $dc = new Win32::GUI::DC ($W); my $dib = newFromDC Win32::GUI::DIBitmap ($dc) or die "newFromDC"; $dib->SaveToFile ("$out_dir/window.bmp"); } sub Capture3_Click { #my $dc = new Win32::GUI::DC ('DISPLAY'); my $dc = new Win32::GUI::DC (); my $dib = newFromDC Win32::GUI::DIBitmap ($dc) or die "newFromDC"; $dib->SaveToFile ("$out_dir/screen.bmp"); } --- NEW FILE: small.tga --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test3.pl --- #!perl -w use strict; use warnings; # # Test standalone : # # Functions Test : # - newFromFile # - GetFIFCount # - FIFSupportsWriting # - FIFSupportsReading # - SaveToData # - newFromData # - SaveToFile use findBin(); use Win32::GUI::DIBitmap; my $dib = Win32::GUI::DIBitmap->newFromFile ("$FindBin::Bin/zapotec.jpg") or die "Load zapotec.jpg"; $dib = $dib->ConvertTo24Bits(); for (my $i = 0; $i < Win32::GUI::DIBitmap::GetFIFCount(); $i++) { if (Win32::GUI::DIBitmap::FIFSupportsWriting($i) && Win32::GUI::DIBitmap::FIFSupportsReading($i) && Win32::GUI::DIBitmap::FIFSupportsExportBPP($i, 24) && $i != 7 && $i != 8 && $i != 11 && $i != 12 && $i != 14 && $i != 15 && $i != 17) { my $format = Win32::GUI::DIBitmap::GetFormatFromFIF($i); print "Test format = $format\n"; my $data = $dib->SaveToData($i) or die " SaveToData $i $format"; my $dib2 = Win32::GUI::DIBitmap->newFromData($data) or die " newFromData $i $format"; #$dib2->SaveToFile($i.'.bmp') or die "SaveToFile dib2 $i $format"; undef $dib2; undef $data; } } --- NEW FILE: demo.pl --- #!perl -w use strict; use warnings; use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap(); my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -pos => [100, 100], -size => [400, 400], -name => "Window", ); my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/Zapotec.jpg"); my $hbitmap = $dib->ConvertToBitmap(); undef $dib; $W->AddButton( -pos => [100, 100], -size => [200, 200], -bitmap => $hbitmap, -name => "Button", -visible => 1, ); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Terminate { -1 } --- NEW FILE: 4.tga --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Zapotec.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: test15.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # use FindBin(); use Win32::GUI(); use Win32::GUI::DIBitmap; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", ) or die "new Window"; my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; my $bcolor = $dib->HasBackgroundColor(); print "hascolor = $bcolor\n"; my $color = $dib->GetPixel(10,10); print "Color = $color\n"; $dib->SetPixel(10, 10, 255); $color = $dib->GetPixel(10,10); print "Color = $color\n"; $dib = $dib->ConvertTo24Bits(); print "hascolor = $bcolor\n"; my @color = $dib->GetPixel(11,10); print "Color = @color\n"; $dib->SetPixel(11, 10, 255, 0, 0); @color = (0, 255, 0); $dib->SetPixel(12, 10, @color); @color = (0, 0, 255); $dib->SetPixel(13, 10, \@color); $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; $dib->StretchToDC($dc, 0, 0, $width, $height); $dc->Validate(); return 1; } --- NEW FILE: 4.png --- (This appears to be a binary file; contents omitted.) --- NEW FILE: piv.pl --- #!perl -w ####################################################################### # # Perl Image Viewer # ####################################################################### use strict; use warnings; use FindBin(); use Win32::GUI qw(MB_ICONQUESTION MB_ICONINFORMATION MB_YESNOCANCEL); use Win32::GUI::DIBitmap; my @PIVReadFilter; my @PIVSaveFilter; my $PIVDirectory; my $PIVDib; my $PIVFile = ""; PIVInit (); my $Menu = Win32::GUI::MakeMenu( "&File" => "File", " > &Open..." => "FileOpen", " > -" => 0, " > &Save" => "FileSave", " > &Save As..." => "FileSaveAs", " > -" => 0, " > &Directory..." => "FileDirectory", " > -" => 0, " > E&xit" => "FileExit", "&Image" => "Image", " > &Properties..." => "ImageProperties", " > -" => 0, " > &Convert" => "ImageConvert", " >> &8bits" => "ImageConvert8bits", " >> &16bits" => "ImageConvert16bits", " >> &24bits" => "ImageConvert24bits", " >> &32bits" => "ImageConvert32bits", " > -" => 0, " > Color &Quantize" => "ImageColor", " >> Methode WUQUANT" => "ImageColor1", " >> Methode NNQUANT" => "ImageColor2", "&Help" => "Help", " > &About PIV" => "HelpAbout", ); my $Window = new Win32::GUI::Window( -name => "Window", -title => "Perl Image Viewer", -pos => [100, 100], -size => [400, 400], -menu => $Menu, ); $Window->AddGraphic( -name => "Graphic", -pos => [0, 0], -size => [$Window->ScaleWidth,$Window->ScaleHeight], ); my $WProp = new Win32::GUI::DialogBox( -title => "Image Properties", -left => 110, -top => 110, -width => 400, -height => 150, -name => "WProp", ); $WProp->AddLabel ( -name => "pFile", -text => "File :", -pos => [10, 25], -size => [$WProp->ScaleWidth()-20, 20], ); $WProp->AddLabel ( -name => "pWidth", -pos => [10, 25], -size => [280, 20] -text => "Width :", -pos => [10, 50], -size => [200, 20] ); $WProp->AddLabel ( -name => "pHeight", -text => "Height :", -pos => [10, 75], -size => [200, 20] ); $WProp->AddLabel ( -name => "pBPP", -text => "BPP :", -pos => [10, 100], -size => [200, 20] ); $WProp->AddButton ( -name => "WPropClose", -text => "Close", -pos => [$WProp->ScaleWidth()-50, $WProp->ScaleHeight()-30], ); PIVMenu(); $Window->Show(); Win32::GUI::Dialog(); ####################################################################### # # PIV Functions # ####################################################################### sub PIVInit { # # Init PIVLoadFilter and PIVSaveFilter # my %ReadFilter; my %SaveFilter; my $count = Win32::GUI::DIBitmap::GetFIFCount(); my $list = ""; for (my $fif = 0; $fif < $count; $fif++) { my $ext = Win32::GUI::DIBitmap::FIFExtensionList($fif); my $desc = Win32::GUI::DIBitmap::FIFDescription($fif); my $read = Win32::GUI::DIBitmap::FIFSupportsReading($fif); my $write = Win32::GUI::DIBitmap::FIFSupportsWriting($fif); $desc .= " (*." . join (',*.', split ( ',', $ext)) . ")"; $ext = "*." . join (';*.', split ( ',', $ext)); if (Win32::GUI::DIBitmap::FIFSupportsReading($fif)) { $ReadFilter {"$desc"} = $ext; $list .= ";$ext"; } if (Win32::GUI::DIBitmap::FIFSupportsWriting($fif)) { $SaveFilter {"$desc"} = $ext; } } push @PIVReadFilter, "All PIV Files", $list; foreach my $i (sort keys %ReadFilter) { push @PIVReadFilter, $i, $ReadFilter{$i}; } foreach my $i (sort keys %SaveFilter) { push @PIVSaveFilter, $i, $SaveFilter{$i}; } # # init PIVDirectory # $PIVDirectory = $FindBin::Bin; $PIVDirectory =~ tr/\//\\/; } sub PIVMenu { if (defined $PIVDib) { $Menu->{ImageProperties}->Enabled(1); $Menu->{ImageConvert}->Enabled(1); my $bpp = $PIVDib->GetBPP(); $Menu->{ImageColor}->Enabled($bpp == 24); $Menu->{ImageConvert8bits}->Enabled($bpp != 8); $Menu->{ImageConvert16bits}->Enabled($bpp != 16); $Menu->{ImageConvert24bits}->Enabled($bpp != 24); $Menu->{ImageConvert32bits}->Enabled($bpp != 32); $Menu->{FileSave}->Enabled(1); $Menu->{FileSaveAs}->Enabled(1); } else { $Menu->{ImageProperties}->Enabled(0); $Menu->{ImageConvert}->Enabled(0); $Menu->{ImageColor}->Enabled(0); $Menu->{FileSave}->Enabled(0); $Menu->{FileSaveAs}->Enabled(0); } } sub PIVAdjustDisplay { if (defined $PIVDib) { my $w = $Window->Width - $Window->ScaleWidth; my $h = $Window->Height - $Window->ScaleHeight; $Window->Resize ($PIVDib->Width + $w, $PIVDib->Height + $h); } } sub PIVFinish { undef $PIVDib; return -1; } ####################################################################### # # Window Event # ####################################################################### sub Window_Terminate { return PIVFinish(); } sub Window_Resize { $Window->Graphic->Resize($Window->ScaleWidth, $Window->ScaleHeight); } ####################################################################### # # Graphic Event # ####################################################################### sub Graphic_Paint { my $DC = $Window->Graphic->GetDC(); if (defined $PIVDib) { # $PIVDib->CopyToDC($DC); $PIVDib->AlphaCopyToDC($DC); } $DC->Validate(); } ####################################################################### # # File Menu # ####################################################################### sub FileOpen_Click { my $ret = Win32::GUI::GetOpenFileName( -title => "Open Image File", -filter => \@PIVReadFilter, -directory => $PIVDirectory, ); if ($ret) { undef $PIVDib; $PIVDib = newFromFile Win32::GUI::DIBitmap ($ret); $PIVFile = $ret; PIVAdjustDisplay (); PIVAdjustDisplay (); PIVMenu(); } elsif (Win32::GUI::CommDlgExtendedError()) { Win32::GUI::MessageBox (0, "ERROR : ".Win32::GUI::CommDlgExtendedError(), "GetOpenFileName Error"); } } sub FileSave_Click { my $ret = Win32::GUI::MessageBox (0, "Overwrite existing file ?", "About",MB_ICONQUESTION | MB_YESNOCANCEL); if ($ret == 6) { $ret = $PIVDib->SaveToFile ($PIVFile); unless ($ret) { Win32::GUI::MessageBox (0, "ERROR : SaveToFile failed\r\nDoes the save format you selected support the BPP of the current image?", "Save Error"); } } elsif ($ret == 7) { FileSaveAs_Click(); } } sub FileSaveAs_Click { my $ret = Win32::GUI::GetSaveFileName( -title => "Save Image File As", -filter => \@PIVSaveFilter, -directory => $PIVDirectory, ); if ($ret) { print "$ret\n"; $PIVFile = $ret; $ret = $PIVDib->SaveToFile ($PIVFile); unless ($ret) { Win32::GUI::MessageBox (0, "ERROR : SaveToFile failed\r\nDoes the save format you selected support the BPP of the current image?", "Save Error"); } } elsif (Win32::GUI::CommDlgExtendedError()) { Win32::GUI::MessageBox (0, "ERROR : ".Win32::GUI::CommDlgExtendedError(), "GetSaveFileName Error"); } } sub FileDirectory_Click { my $ret = Win32::GUI::BrowseForFolder ( -title => "Select default directory", -directory => $PIVDirectory, -folderonly => 1, ); $PIVDirectory = $ret if ($ret); return 0; } sub FileExit_Click { return PIVFinish(); } ####################################################################### # # Image Menu # ####################################################################### sub ImageProperties_Click { if (defined $PIVDib) { $Window->Disable(); $WProp->pFile->Text("File : ".$PIVFile); $WProp->pWidth->Text("Width : ".$PIVDib->Width()); $WProp->pHeight->Text("Height : ".$PIVDib->Height()); $WProp->pBPP->Text("BPP,Colors useds,Color type : ".$PIVDib->GetBPP(). ",".$PIVDib->GetColorsUsed(). ",".$PIVDib->GetColorType()); $WProp->Show(); } } sub ImageConvert8bits_Click { $PIVDib = $PIVDib->ConvertTo8Bits(); Graphic_Paint(); PIVMenu(); } sub ImageConvert16bits_Click { $PIVDib = $PIVDib->ConvertTo16Bits555(); Graphic_Paint(); PIVMenu(); } sub ImageConvert24bits_Click { $PIVDib = $PIVDib->ConvertTo24Bits(); Graphic_Paint(); PIVMenu(); } sub ImageConvert32bits_Click { $PIVDib = $PIVDib->ConvertTo32Bits(); Graphic_Paint(); PIVMenu(); } sub ImageColor1_Click { $PIVDib = $PIVDib->ColorQuantize(FIQ_WUQUANT); Graphic_Paint(); PIVMenu(); } sub ImageColor2_Click { $PIVDib = $PIVDib->ColorQuantize(FIQ_NNQUANT); Graphic_Paint(); PIVMenu(); } ####################################################################### # # Help Menu # ####################################################################### sub HelpAbout_Click { Win32::GUI::MessageBox (0, "Perl Image Viewer 1.0 by Laurent Rocher", "About",MB_ICONINFORMATION); } ####################################################################### # # Image Properties # ####################################################################### sub WPropClose_Click { $WProp->Hide(); $Window->Enable(); $Window->SetForegroundWindow(); } --- NEW FILE: test6.pl --- #!perl -w use strict; use warnings; # # Test with Win32::GUI # # Functions Test : # - newFromBitmap # - CopyToDC use FindBin(); use Win32::GUI qw(); use Win32::GUI::DIBitmap; my $W = new Win32::GUI::Window ( -title => "Win32::GUI::DIBitmap test", -left => 100, -top => 100, -width => 400, -height => 400, -name => "Window", ) or die "new Window"; my $dib = newFromFile Win32::GUI::DIBitmap ("$FindBin::Bin/zapotec.bmp") or die "newFromFile"; $W->Show(); Win32::GUI::Dialog(); exit(0); sub Window_Paint { my $dc = shift; my ($width, $height) = ($W->GetClientRect)[2..3]; #$dc = new Win32::GUI::DC ($W); $dib->CopyToDC($dc); $dib->CopyToDC($dc, ($width / 2) - 30, ($height / 2) - 30 , 60, 60); $dib->CopyToDC($dc, $width - 50, $height - 50, 50, 50, 20, 10); $dc->Validate(); return 1; } --- NEW FILE: 2.tga --- (This appears to be a binary file; contents omitted.) |
|
From: Robert M. <rob...@us...> - 2006-06-11 16:29:40
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13408/demos Log Message: Directory /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/demos added to the repository |
|
From: Robert M. <rob...@us...> - 2006-06-11 16:28:52
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12838/t Log Message: Directory /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DIBitmap/t added to the repository |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:48:02
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088 Modified Files: AxWindow.pm AxWindow.xs Changes Makefile.PL TYPEMAP Added Files: AxWindowRC.PL TODO Removed Files: AxWindow.html MANIFEST README Log Message: Merge AxWindow into core distribution --- NEW FILE: AxWindowRC.PL --- #!perl -w use strict; use warnings; use ExtUtils::MakeMaker; # $Id: AxWindowRC.PL,v 1.1 2006/06/11 15:46:49 robertemay Exp $ # perl script to produce the RC file for # Win32::GUI::AxWindow create Resource # file with a VERSIONINFO section # The variables: my %info = ( Version => MM->parse_version('AxWindow.pm'), Dllname => 'AxWindow.dll', Years => '2003..2006', Win32GUIVersion => MM->parse_version('../GUI.pm'), ); # Open the target file if ( @ARGV > 0 ) { my $file = $ARGV[0]; open(my $fh, '>', $file) or die qq(Failed to open '$file': $!); select $fh; } { my $fileVersion = $info{Version}; $fileVersion .= "_00" unless $fileVersion =~ m/_/; $info{FileVersion} = sprintf("%02d,%02d,%02d,00", $fileVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); my $prodVersion = $info{Win32GUIVersion}; $prodVersion .= "_00" unless $prodVersion =~ m/_/; $info{ProductVersion} = sprintf("%02d,%02d,%02d,00", $prodVersion =~ m/^(.*)\.([^_]*)_?(.*)$/); } print <<"__RC"; #include "Winver.h" 1 VERSIONINFO FILEVERSION $info{FileVersion} PRODUCTVERSION $info{ProductVersion} FILEOS VOS__WINDOWS32 FILETYPE VFT_DLL { BLOCK "StringFileInfo" { BLOCK "040904E4" { VALUE "Comments" , "Win32::GUI::AxWindow, part of the perl Win32::GUI module." VALUE "CompanyName" , "perl-win32-gui.sourceforge.net" VALUE "FileDescription" , "Win32::GUI::AxWindow perl extension" VALUE "FileVersion" , "$info{Version}" VALUE "InternalName" , "$info{Dllname}" VALUE "LegalCopyright" , "Copyright © Laurent Rocher $info{Years}" VALUE "LegalTrademarks" , "GNU and Artistic licences" VALUE "OriginalFilename" , "$info{Dllname}" VALUE "ProductName" , "Win32::GUI perl extension" VALUE "ProductVersion" , "$info{Win32GUIVersion}" } } BLOCK "VarFileInfo" { VALUE "Translation", 0x0409, 0x04E4 } } __RC exit(0); __END__ Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/Makefile.PL,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile.PL 1 Nov 2005 12:32:28 -0000 1.1 --- Makefile.PL 11 Jun 2006 15:46:51 -0000 1.2 *************** *** 1,34 **** use ExtUtils::MakeMaker; ! # See lib/ExtUtils/MakeMaker.pm for details of how to influence ! # the contents of the Makefile that is written. ! WriteMakefile( ! 'NAME' => 'Win32::GUI::AxWindow', ! 'VERSION_FROM' => 'AxWindow.pm', # finds $VERSION ! 'XS' => { 'AxWindow.xs' => 'AxWindow.cpp' }, ! 'LIBS' => ['atl.lib'], # e.g., '-lm' ! 'INC' => '', # e.g., '-I/usr/include/other' ! ($] eq '5.00503') ! ? ( ! 'DEFINE' => '-DPERL_5005', # e.g., '-DHAVE_SOMETHING' ! ) : ( ! 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' ! ), ! ($] ge '5.005') ! ? ( ! 'AUTHOR' => 'ROCHER Laurent (ro...@cl...)', ! 'ABSTRACT' => 'Add ActiveX Control Hosting in Win32::GUI', ! ) ! : (), ); ! sub MY::xs_c { ! ' ! .xs.c: ! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c ! .xs.cpp: ! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp ! '; } --- 1,88 ---- + #!perl -w + use strict; + use warnings; + + # Makefile.PL for Win32::GUI::AxWindow + # $Id$ + + use 5.006; + use Config; use ExtUtils::MakeMaker; ! use File::Find(); ! ! my @demos; ! File::Find::find(sub { push @demos, $File::Find::name if $File::Find::name =~ /\.(pl|pm|avi)$/ }, 'demos'); ! ! my %config = ( ! NAME => 'Win32::GUI::AxWindow', ! VERSION_FROM => 'AxWindow.pm', ! ABSTRACT_FROM => 'AxWindow.pm', ! AUTHOR => 'ROCHER Laurent (lr...@cp...)', ! PL_FILES => {'AxWindowRC.PL' => '$(BASEEXT).rc', }, ! XS => {'AxWindow.xs' => 'AxWindow.cpp' }, ! OBJECT => '$(BASEEXT)$(OBJ_EXT) $(BASEEXT).res', ! LIBS => ['-latl'], ! macro => {RC => 'rc.exe', ! RCFLAGS => '', ! INST_DEMODIR => '$(INST_LIB)/Win32/GUI/demos/$(BASEEXT)', ! DEMOS => "@demos", }, ! clean => {FILES => '*.rc *.res', }, ); ! # if building using gcc (MinGW or cygwin) use windres ! # as the resource compiler ! # and the MinGW C++ standard library ! if($Config{cc} =~ /gcc/i) { ! $config{macro}->{RC} = 'windres'; ! $config{macro}->{RCFLAGS} = '-O coff -o $*.res'; ! $config{LIBS} = [':nodefault -lcomctl32 -lmsvcp60']; ! } ! # Can only build with mscv. ! if($Config{cc} !~ /cl/i) { ! print <<__EXPLAIN; ! Win32::GUI::AxWindow can only be built using MSVC, not '$Config{cc}', ! as it depends on the Microsoft Active Template Library (ATL). ! Win32::GUI::AxWindow will be skipped during the current build process. ! __EXPLAIN ! ExtUtils::MakeMaker::WriteEmptyMakefile(NAME => 'Win32::GUI::AxWindow'); ! } ! else { ! WriteMakefile(%config); ! } ! ! package MY; ! ! sub xs_c { ! my $inherited = shift->SUPER::xs_c(@_); ! $inherited =~ s/\.c/.cpp/g; ! return $inherited; ! } ! ! # Add rule for .rc to .res conversion ! # Add rules to install demo scripts ! sub postamble { ! return <<'__POSTAMBLE'; ! ! # Win32::GUI::DIBitmap RC section ! ! .rc.res: ! $(RC) $(RCFLAGS) $< ! ! # Win32::GUI::DIBitmap demo script section ! ! pure_all :: demo_to_blib ! $(NOECHO) $(NOOP) ! ! demo_to_blib: $(DEMOS) ! $(NOECHO) $(MKPATH) $(INST_DEMODIR) ! $(CP) $? $(INST_DEMODIR) ! $(NOECHO) $(TOUCH) demo_to_blib ! ! clean :: ! -$(RM_F) demo_to_blib ! ! __POSTAMBLE } Index: AxWindow.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/AxWindow.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** AxWindow.pm 1 Nov 2005 12:32:28 -0000 1.1 --- AxWindow.pm 11 Jun 2006 15:46:48 -0000 1.2 *************** *** 1,22 **** package Win32::GUI::AxWindow; ! use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); ! use Win32::GUI; ! require Exporter; ! require DynaLoader; ! require AutoLoader; ! @ISA = qw(Exporter DynaLoader Win32::GUI::Window); ! # Items to export into callers namespace by default. Note: do not export ! # names by default without a very good reason. Use EXPORT_OK instead. ! # Do not simply export all your public functions/methods/constants. ! @EXPORT = qw(); ! $VERSION = '0.07'; ! bootstrap Win32::GUI::AxWindow $VERSION; ! # Preloaded methods go here. # Initialise --- 1,22 ---- package Win32::GUI::AxWindow; ! # $Id$ ! use strict; ! use warnings; ! use Carp; ! use Win32::GUI qw(WS_CHILD WS_CLIPCHILDREN WS_VISIBLE WS_TABSTOP ! WS_HSCROLL WS_VSCROLL WS_DISABLED); ! require DynaLoader; ! our @ISA = qw(DynaLoader Win32::GUI::Window); ! our $VERSION = 0.08; ! my $XS_VERSION = $VERSION; ! $VERSION = eval $VERSION; ! ! bootstrap Win32::GUI::AxWindow $XS_VERSION; # Initialise *************** *** 30,35 **** } - # Autoload methods go after =cut, and are processed by the autosplit program. - # # new : Create a new ActiveX Window --- 30,33 ---- *************** *** 144,148 **** 1; __END__ - # Below is the stub of documentation for your module. You better edit it! =head1 NAME --- 142,145 ---- *************** *** 152,183 **** =head1 SYNOPSIS ! use Win32::GUI; use Win32::GUI::AxWindow; # Main Window ! $Window = new Win32::GUI::Window ( ! -name => "Window", ! -title => "Win32::GUI::AxWindow test", ! -post => [100, 100], ! -size => [400, 400], ); # Add a WebBrowser AxtiveX ! $Control = new Win32::GUI::AxWindow ( ! -parent => $Window, ! -name => "Control", ! -control => "Shell.Explorer.2", ! # -control => "{8856F961-340A-11D0-A96B-00C04FD705A2}", ! -pos => [0, 0], ! -size => [400, 400], ); # Register some event $Control->RegisterEvent("StatusTextChange", ! sub { ! $self = shift; ! $eventid = shift; ! print "Event : ", @_, "\n"; ! } ); # Call Method --- 149,179 ---- =head1 SYNOPSIS ! use Win32::GUI(); use Win32::GUI::AxWindow; # Main Window ! $Window = new Win32::GUI::Window( ! -name => "Window", ! -title => "Win32::GUI::AxWindow test", ! -pos => [100, 100], ! -size => [400, 400], ); # Add a WebBrowser AxtiveX ! $Control = new Win32::GUI::AxWindow ( ! -parent => $Window, ! -name => "Control", ! -control => "Shell.Explorer", ! -pos => [0, 0], ! -size => [400, 400], ); # Register some event $Control->RegisterEvent("StatusTextChange", ! sub { ! $self = shift; ! $eventid = shift; ! print "Event : ", @_, "\n"; ! } ); # Call Method *************** *** 190,217 **** # Main window event handler - sub Window_Terminate { - - return -1; - } - sub Window_Resize { ! ! if (defined $Window) { ! ($width, $height) = ($Window->GetClientRect)[2..3]; ! $Control->Move (0, 0); ! $Control->Resize ($width, $height); ! } } - =head1 DESCRIPTION =head2 AxWindow =item C<new> (...) ! Create a new ActiveX window. ! options : -parent => parent window (Required) --- 186,208 ---- # Main window event handler sub Window_Resize { ! if (defined $Window) { ! ($width, $height) = ($Window->GetClientRect)[2..3]; ! $Control->Move (0, 0); ! $Control->Resize ($width, $height); ! } } =head1 DESCRIPTION =head2 AxWindow + =over + =item C<new> (...) ! Create a new ActiveX window. ! options : -parent => parent window (Required) *************** *** 225,239 **** -control => clisd (see below) (Required). ! clsid is a string identifier to create the control. ! Must be formatted in one of the following ways: ! - A ProgID such as "MSCAL.Calendar.7" ! - A CLSID such as "{8E27C92B-1264-101C-8A2F-040224009C02}" ! - A URL such as "http://www.microsoft.com" ! - A reference to an Active document such as 'file://Documents/MyDoc.doc' ! - A fragment of HTML such as "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>" ! Note "MSHTML:" must precede the HTML fragment so that it is designated as being an MSHTML stream. ! styles: -visible => 0/1 --- 216,232 ---- -control => clisd (see below) (Required). ! C<clsid> is a string identifier to create the control. ! Must be formatted in one of the following ways: ! - A ProgID such as "MSCAL.Calendar.7" ! - A CLSID such as "{8E27C92B-1264-101C-8A2F-040224009C02}" ! - A URL such as "http://www.microsoft.com" ! - A reference to an Active document such as 'file://Documents/MyDoc.doc' ! - A fragment of HTML such as "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>" ! Note that "MSHTML:" must precede the HTML fragment so that it is designated as ! being an MSHTML stream. ! ! styles: -visible => 0/1 *************** *** 245,352 **** -exstyle, -exaddstyle, -expushstyle, -exremstyle, -expopstyle ! Default style is : WS_CHILD | WS_VISIBLE | WS_TABSTOP | WS_CLIPCHILDREN =item C<Release> () ! If have crash when exiting, call this function before all the window are destroy (before Win32::GUI::Dialog(); exit). ! Generaly, call this function in the Window_Terminate handle. =head2 Property =item C<EnumPropertyID> () ! Return a list of all the Property ID of the control. =item C<EnumPropertyName> () ! Return a list of all the Property name of the control. =item C<GetPropertyInfo> (ID_or_Name) ! Return a hash with information about the Property from ID or Name. ! Hash entry : ! -Name => Property Name. ! -ID => Property ID. ! -VarType => Property Type (Variant type). ! -EnumValue => A formated string of enum value ( enum1=value1,enum2=value2,... ). ! -ReadOnly => Indicate if a property can only be read. ! -Description => Property Description. ! -Prototype => Prototype =item C<GetProperty> (ID_or_Name, [index, ...]) ! Get property value. ! For indexed property, add index list. =item C<SetProperty> (ID_or_Name, [index, ...], value) ! Set property value ! For indexed property, add index list before value. =head2 Method =item C<EnumMethodID> () ! Return a list of all the Method ID of the control. =item C<EnumMethodName> () ! Return a list of all the Method name of the control. =item C<GetMethodInfo> (ID_Name) ! Return a hash with information about the Method from ID or Name. ! Hash entry : ! -Name => Method Name. ! -ID => Method ID. ! -Description => Method Description. ! -Prototype => Method Prototype. =item C<CallMethod> (ID_or_Name, ...) ! Invoke a method of an ActiveX control. =head2 Event =item C<EnumEventID> () ! Return a list of all the Event ID of the control. =item C<EnumEventName> () ! Return a list of all the Event Name of the control. =item C<GetEventInfo> (ID_or_Name) ! Return a hash with information about the Event from ID or Name. ! Hash entry : ! -Name => Method Name. ! -ID => Method ID. ! -Description => Method Description. ! -Prototype => Method Prototype. =item C<RegisterEvent> (ID_or_Name, Callback) ! Associate a Callback for an ActiveX Event. =head2 Win32::OLE =item C<GetOLE> () ! Return a Win32::OLE object of Hosted ActiveX Control. ! You MUST add use Win32::OLE in your script. =head1 AUTHOR ! Laurent Rocher (lr...@cp...) ! HomePage :http://perso.club-internet.fr/rocherl/Win32GUI.html =head1 SEE ALSO ! Win32::GUI =cut --- 238,387 ---- -exstyle, -exaddstyle, -expushstyle, -exremstyle, -expopstyle ! Default style is : C<WS_CHILD | WS_VISIBLE | WS_TABSTOP | WS_CLIPCHILDREN> =item C<Release> () ! If you have a crash when exiting, call this function before all the ! windows are destroyed (i.e. before C<Win32::GUI::Dialog();> exits). ! Generaly, call this function in the Window_Terminate event handler. ! ! =back =head2 Property + =over + =item C<EnumPropertyID> () ! Return a list of all the Property IDs of the control. =item C<EnumPropertyName> () ! Return a list of all the Property names of the control. =item C<GetPropertyInfo> (ID_or_Name) ! Return a hash with information about the Property from C<ID_or_Name>. ! Hash entry : ! ! -Name => Property Name. ! -ID => Property ID. ! -VarType => Property Type (Variant type). ! -EnumValue => A formated string of enum value ( enum1=value1,enum2=value2,... ). ! -ReadOnly => Indicate if a property can only be read. ! -Description => Property Description. ! -Prototype => Prototype =item C<GetProperty> (ID_or_Name, [index, ...]) ! Get property value. ! For indexed property, add index list. =item C<SetProperty> (ID_or_Name, [index, ...], value) ! Set property value ! For indexed property, add index list before value. ! ! =back =head2 Method + =over + =item C<EnumMethodID> () ! Return a list of all the Method IDs of the control. =item C<EnumMethodName> () ! Return a list of all the Method names of the control. =item C<GetMethodInfo> (ID_Name) ! Return a hash with information about the Method from ID or Name. ! Hash entry : ! ! -Name => Method Name. ! -ID => Method ID. ! -Description => Method Description. ! -Prototype => Method Prototype. =item C<CallMethod> (ID_or_Name, ...) ! Invoke a method of an ActiveX control. ! ! =back =head2 Event + =over + =item C<EnumEventID> () ! Return a list of all the Event IDs of the control. =item C<EnumEventName> () ! Return a list of all the Event Names of the control. =item C<GetEventInfo> (ID_or_Name) ! Return a hash with information about the Event from C<ID_or_Name>. ! Hash entry : ! ! -Name => Method Name. ! -ID => Method ID. ! -Description => Method Description. ! -Prototype => Method Prototype. =item C<RegisterEvent> (ID_or_Name, Callback) ! Associate a Callback for an ActiveX Event. ! ! =back =head2 Win32::OLE + =over + =item C<GetOLE> () ! Return a Win32::OLE object of Hosted ActiveX Control. ! You MUST add C<use Win32::OLE;> in your script. ! ! =back =head1 AUTHOR ! Laurent Rocher (lr...@cp...) =head1 SEE ALSO ! L<Win32::GUI|Win32::GUI> L<http://perl-win32-gui.sourceforge.net/> ! ! =head1 DEPENDENCIES ! ! This module requires these other modules and libraries: ! ! =over ! ! =item Win32::GUI ! ! =item Active Template Library (ATL) ! ! =back ! ! =head1 COPYRIGHT AND LICENCE ! ! Copyright 2003 by Laurent Rocher (lr...@cp...). ! ! This program is free software; you can redistribute it and/or modify it ! under the same terms as Perl itself. ! ! See L<http://www.perl.com/perl/misc/Artistic.html> =cut --- NEW FILE: TODO --- - It would be nice if you were trying to create a control using an AxtiveX object that does not exist on the running PC that you got a control failure rather than a Shell.Explorer control showing an error. For eaxmple running the MSFlexGrid demo on a PC that does not have a registered version of msflxgrd.ocx, results in a window showing an IE Error, at it the underlying framework has fallen back to using 'MSFlexGridLib.MSFlexGrid' as a URL ('http://MSFlexGridLib.MSFlexGrid/', which, of course, does not exist). See InfoControl.pl example for a fairly heavy-handed way to do it. - Investigate why SetProperty('uiMode' ...) doesn't work in WMPlayer.pl demo. Is this a bug with AxWindow? - Complete the 'Uncomplete' demos. Make DHtmlEdit.pm and MsFlexGrid.pm installed modules? --- MANIFEST DELETED --- Index: AxWindow.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/AxWindow.xs,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** AxWindow.xs 1 Nov 2005 12:32:28 -0000 1.1 --- AxWindow.xs 11 Jun 2006 15:46:49 -0000 1.2 *************** *** 3,6 **** --- 3,8 ---- /**********************************************************************/ + /* $Id$ */ + #include <atlbase.h> *************** *** 17,48 **** /*====================================================================*/ - #ifdef PERL_5005 - #define __TEMP_WORD WORD - #endif - #include "EXTERN.h" #include "perl.h" #include "XSUB.h" - // Activate for ActiveState PERL_5005 - - #ifdef PERL_5005 - - #ifndef SvPV_nolen - #define SvPV_nolen(sv) SvPV(sv, PL_na) - #endif - - #ifndef call_sv - #define call_sv perl_call_sv - #endif - - #undef XST_mPV - #define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv((char *)v,0))) - - #undef WORD - #define WORD __TEMP_WORD - - #endif - /*====================================================================*/ /* Internal function */ --- 19,26 ---- *************** *** 182,186 **** m_vtReturn = VT_BYREF | pfd->elemdescFunc.tdesc.lptdesc->vt; ! // Init parametre structure call if (m_iParams != 0) { --- 160,164 ---- m_vtReturn = VT_BYREF | pfd->elemdescFunc.tdesc.lptdesc->vt; ! // Init parameter structure call if (m_iParams != 0) { *************** *** 1020,1024 **** call_sv(m_Events[n]->GetCallback(), G_EVAL | G_DISCARD); ! // Output parametre for (i = pdispparams->cArgs - 1; i >= 0; --i) --- 998,1002 ---- call_sv(m_Events[n]->GetCallback(), G_EVAL | G_DISCARD); ! // Output parameter for (i = pdispparams->cArgs - 1; i >= 0; --i) *************** *** 1037,1041 **** case VT_UI1: ! pArg->bVal = SvIV(svref[i]); break; --- 1015,1019 ---- case VT_UI1: ! pArg->bVal = (BYTE)SvIV(svref[i]); break; *************** *** 1043,1047 **** case VT_UI2: ! pArg->iVal = SvIV(svref[i]); break; --- 1021,1025 ---- case VT_UI2: ! pArg->iVal = (SHORT)SvIV(svref[i]); break; *************** *** 1051,1070 **** case VT_UINT: ! pArg->lVal = SvIV(svref[i]); break; case VT_R4 : ! pArg->fltVal = SvNV(svref[i]); break; case VT_R8 : ! pArg->dblVal = SvNV(svref[i]); break; case VT_BOOL: ! pArg->boolVal = SvIV(svref[i]); break; --- 1029,1048 ---- case VT_UINT: ! pArg->lVal = (LONG)SvIV(svref[i]); break; case VT_R4 : ! pArg->fltVal = (FLOAT)SvNV(svref[i]); break; case VT_R8 : ! pArg->dblVal = (DOUBLE)SvNV(svref[i]); break; case VT_BOOL: ! pArg->boolVal = (VARIANT_BOOL)SvIV(svref[i]); break; *************** *** 1072,1076 **** case VT_BYREF | VT_UI1: ! *pArg->pbVal = SvIV(svref[i]); break; --- 1050,1054 ---- case VT_BYREF | VT_UI1: ! *pArg->pbVal = (BOOL)SvIV(svref[i]); break; *************** *** 1078,1082 **** case VT_BYREF | VT_UI2: ! *pArg->piVal = SvIV(svref[i]); break; --- 1056,1060 ---- case VT_BYREF | VT_UI2: ! *pArg->piVal = (SHORT)SvIV(svref[i]); break; *************** *** 1086,1105 **** case VT_BYREF | VT_UINT: ! *pArg->piVal = SvIV(svref[i]); break; case VT_BYREF | VT_R4 : ! *pArg->pfltVal = SvNV(svref[i]); break; case VT_BYREF | VT_R8 : ! *pArg->pdblVal = SvNV(svref[i]); break; case VT_BYREF | VT_BOOL : ! *pArg->pboolVal = SvIV(svref[i]); break; --- 1064,1083 ---- case VT_BYREF | VT_UINT: ! *pArg->plVal = (LONG)SvIV(svref[i]); break; case VT_BYREF | VT_R4 : ! *pArg->pfltVal = (FLOAT)SvNV(svref[i]); break; case VT_BYREF | VT_R8 : ! *pArg->pdblVal = (DOUBLE)SvNV(svref[i]); break; case VT_BYREF | VT_BOOL : ! *pArg->pboolVal = (VARIANT_BOOL)SvIV(svref[i]); break; *************** *** 1650,1653 **** --- 1628,1633 ---- MODULE = Win32::GUI::AxWindow PACKAGE = Win32::GUI::AxWindow + PROTOTYPES: ENABLE + ################################################################## # # *************** *** 1790,1794 **** } else ! XSRETURN_UNDEF; # --- 1770,1774 ---- } else ! XSRETURN_EMPTY; # *************** *** 1810,1814 **** } else ! XSRETURN_UNDEF; # --- 1790,1794 ---- } else ! XSRETURN_EMPTY; # *************** *** 1852,1856 **** else { ! XSRETURN_UNDEF; } --- 1832,1836 ---- else { ! XSRETURN_EMPTY; } *************** *** 1883,1887 **** } else ! XSRETURN_UNDEF; # --- 1863,1867 ---- } else ! XSRETURN_EMPTY; # *************** *** 1903,1907 **** } else ! XSRETURN_UNDEF; # --- 1883,1887 ---- } else ! XSRETURN_EMPTY; # *************** *** 1957,1961 **** else { ! XSRETURN_UNDEF; } --- 1937,1941 ---- else { ! XSRETURN_EMPTY; } *************** *** 1992,1996 **** PPCODE: ! // A methode if (type == DISPATCH_METHOD) { --- 1972,1976 ---- PPCODE: ! // A method if (type == DISPATCH_METHOD) { *************** *** 2527,2531 **** } else ! XSRETURN_UNDEF; # --- 2507,2511 ---- } else ! XSRETURN_EMPTY; # *************** *** 2549,2553 **** } else ! XSRETURN_UNDEF; --- 2529,2533 ---- } else ! XSRETURN_EMPTY; *************** *** 2583,2587 **** else { ! XSRETURN_UNDEF; } --- 2563,2567 ---- else { ! XSRETURN_EMPTY; } *************** *** 2598,2601 **** --- 2578,2582 ---- CMethod * method = NULL; CODE: + RETVAL = 0; if(SvIOK(ID_Name)) RETVAL = container->EventMap()->RegisterEvent(ST(0), (DISPID) SvIV(ID_Name), callback); --- README DELETED --- Index: Changes =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/Changes,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Changes 1 Nov 2005 12:32:28 -0000 1.1 --- Changes 11 Jun 2006 15:46:50 -0000 1.2 *************** *** 1,45 **** ! Revision history for Perl extension AxWindow. 0.07 03/02/2004 ! - Correct GetOLE() method when using PAR and PerlApp. 0.06 28/09/2003 ! - Rewrite creation method (Remove AttachControl method). ! - No more need to call Release Method before exit. ! - Correct bug in GetPropertyInfo with VARTYPE property. ! - Correct -heigth option. ! - Update and add samples. 0.05 15/10/2002 ! - Add GetOLE method (return a Win32::OLE object of Hosted ActiveX Control). ! - Add TestOle.pl Sample. 0.04 14/09/2002 ! - Add indexed property support. ! - Change code organisation (Invoke method, CProperty child of CMethod). ! - Add MSFlexGrid Sample. 0.03 30/05/2002 ! - Add VARTYPE property support. ! - Add output parameter for event support. ! - Accept control without event. ! - Correct DHTMLEdit.pm wrapper class. 0.02 25/03/2002 ! - Correct ReadOnly value for Properties. ! - Add =value for Enum string list for Properties. ! - Test ReadOnly attribut in SetProperty. ! - SetProperty handle Enum property by value or string constant. ! - Add a Release method for clean ActiveX reference before window destroy. ! - Manage VT_USERDEFINED as enum in CallMethod. ! - Add some documentation (sorry for my english ;-). ! - Add DHTML Edit sample (basic and a wrapper class). 0.01 22/03/2002 ! - original version; created by h2xs 1.19 ! - ActiveX control information (Properties, Metods, Events). ! - Set/Get property. ! - Call a Method. ! - Event Support. ! - Support of basic variant type. --- 1,53 ---- + Revision history for Perl extension Win32::GUI::AxWindow. ! 0.08 27/05/2006 ! - Merge into Win32::GUI core build ! - new build process (re-write Makefile.PL) ! - tidy documentation ! - tidy and correct demos ! - Introduce sub-classes: ! - Methods that return lists now use XSRETURN_EMPTY rather than ! XSRETURN_UNDEF when there is nothing to return 0.07 03/02/2004 ! - Correct GetOLE() method when using PAR and PerlApp. 0.06 28/09/2003 ! - Rewrite creation method (Remove AttachControl method). ! - No more need to call Release Method before exit. ! - Correct bug in GetPropertyInfo with VARTYPE property. ! - Correct -heigth option. ! - Update and add samples. 0.05 15/10/2002 ! - Add GetOLE method (return a Win32::OLE object of Hosted ActiveX Control). ! - Add TestOle.pl Sample. 0.04 14/09/2002 ! - Add indexed property support. ! - Change code organisation (Invoke method, CProperty child of CMethod). ! - Add MSFlexGrid Sample. 0.03 30/05/2002 ! - Add VARTYPE property support. ! - Add output parameter for event support. ! - Accept control without event. ! - Correct DHTMLEdit.pm wrapper class. 0.02 25/03/2002 ! - Correct ReadOnly value for Properties. ! - Add =value for Enum string list for Properties. ! - Test ReadOnly attribut in SetProperty. ! - SetProperty handle Enum property by value or string constant. ! - Add a Release method for clean ActiveX reference before window destroy. ! - Manage VT_USERDEFINED as enum in CallMethod. ! - Add some documentation (sorry for my english ;-). ! - Add DHTML Edit sample (basic and a wrapper class). 0.01 22/03/2002 ! - original version; created by h2xs 1.19 ! - ActiveX control information (Properties, Metods, Events). ! - Set/Get property. ! - Call a Method. ! - Event Support. ! - Support of basic variant type. Index: TYPEMAP =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/TYPEMAP,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TYPEMAP 1 Nov 2005 12:32:28 -0000 1.1 --- TYPEMAP 11 Jun 2006 15:46:52 -0000 1.2 *************** *** 1,32 **** TYPEMAP CContainer* T_CONTAINER HWND T_HANDLE - HMENU T_HANDLE - HICON T_HANDLE - HCURSOR T_HANDLE - HBITMAP T_HANDLE - HFONT T_HANDLE - HGDIOBJ T_HANDLE - HIMAGELIST T_HANDLE - HDC T_HANDLE - HBRUSH T_HANDLE - HPEN T_HANDLE - HTREEITEM T_IV - LONG T_IV LPCTSTR T_PV - LPTSTR T_PV DWORD T_IV - UINT T_IV BOOL T_IV - WPARAM T_IV - LPARAM T_IV - LRESULT T_IV - HINSTANCE T_IV - COLORREF T_COLOR - LPCSTR T_PV - HENHMETAFILE T_IV - FLOAT T_FLOAT - LPVOID T_PV - HACCEL T_IV ################################################################################ --- 1,9 ---- + #$Id$ TYPEMAP CContainer* T_CONTAINER HWND T_HANDLE LPCTSTR T_PV DWORD T_IV BOOL T_IV ################################################################################ *************** *** 34,45 **** 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($arg); T_CONTAINER $var = ($type) SvIV(*(hv_fetch((HV*)SvRV($arg), \"-CContainer\", 11, 0))); --- 11,22 ---- T_HANDLE if(SvROK($arg)) { ! SV** out=hv_fetch((HV*)SvRV($arg), \"-handle\", 7, 0); ! if(out != NULL) ! $var = INT2PTR($type,SvIV(*out)); else $var = NULL; } else ! $var = INT2PTR($type,SvIV($arg)); ! T_CONTAINER $var = ($type) SvIV(*(hv_fetch((HV*)SvRV($arg), \"-CContainer\", 11, 0))); *************** *** 47,53 **** ################################################################################ OUTPUT - T_HANDLE - sv_setiv($arg, (IV) $var); - T_COLOR - sv_setiv($arg, (IV) $var); - --- 24,25 ---- --- AxWindow.html DELETED --- |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:47:39
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088/t Added Files: 01_load.t 02_new.t 98_pod.t 99_pod_coverage.t Log Message: Merge AxWindow into core distribution --- NEW FILE: 99_pod_coverage.t --- #!perl -wT # Win32::GUI::AxWindow test suite. # $Id: 99_pod_coverage.t,v 1.1 2006/06/11 15:47:25 robertemay Exp $ # Check the POD covers all method calls use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; plan skip_all => "Pod Coverage tests for Win32::GUI::AxWindow done by core" if $ENV{W32G_CORE}; # REM: I'm not sure whether Invoke and GetMethodID are intended to be public # or not, so making them private for now all_pod_coverage_ok( { also_private => [ qr/^Invoke$/, qr/^GetMethodID$/, ], } ); --- NEW FILE: 02_new.t --- #!perl -wT # Win32::GUI::AxWindow test suite # $Id: 02_new.t,v 1.1 2006/06/11 15:47:24 robertemay Exp $ # # - check we can create a new AxWindow object use strict; use warnings; BEGIN { $| = 1 } # Autoflush use Test::More tests => 2; use Win32::GUI(); use Win32::GUI::AxWindow(); my $W = Win32::GUI::Window->new(); can_ok('Win32::GUI::AxWindow', 'new'); my $S = Win32::GUI::AxWindow->new( -name => 'AxWindow', -parent => $W, -control => "Shell.Explorer.2", ); isa_ok($S, 'Win32::GUI::AxWindow', 'Correct object type created'); --- NEW FILE: 98_pod.t --- #!perl -wT # Win32::GUI::AxWindow test suite. # $Id: 98_pod.t,v 1.1 2006/06/11 15:47:24 robertemay Exp $ # Check that our pod documentation has valid syntax 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 $@; plan skip_all => "Pod tests for Win32::GUI::AxWindow done by core" if $ENV{W32G_CORE}; all_pod_files_ok(); --- NEW FILE: 01_load.t --- #!perl -wT # Win32::GUI::AxWindow test suite # $Id: 01_load.t,v 1.1 2006/06/11 15:47:21 robertemay Exp $ # # - check pre-requsites # - check module loads # - check module has a version use strict; use warnings; BEGIN { $| = 1 } # Autoflush # Pre-requisites: 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::Grid test\n"; chomp $@; $@ =~ s/^/# /gm; print "$@\n"; print "Bail Out! Test::More not available\n"; exit(1); } plan( tests => 3 ); # Pre-requisites: Check that we're on windows or cygwin # bail out if we're not if ( not ($^O =~ /MSwin32|cygwin/i)) { diag("\nWin32::GUI::DIBitmap can only run on MSWin32 or cygwin, not '$^O'"); print "Bail out! Incompatible Operating System\n"; } pass("Correct OS: $^O"); # Check that Win32::GUI::AxWindow loads, and bail out of all # tests if it doesn't use_ok('Win32::GUI::AxWindow') or print STDOUT "Bail out! Can't load Win32::GUI::AxWindow"; # Check that Win32::GUI::AxWindow has a version ok(defined $Win32::GUI::AxWindow::VERSION, "Win32::GUI::AxWindow version check"); |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:47:26
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos/UnComplete In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088/demos/UnComplete Added Files: DHtmlEdit.pm DHtmlEditor.pl Google.pl MsFlexGrid.pm Log Message: Merge AxWindow into core distribution --- NEW FILE: DHtmlEditor.pl --- # perl -w # # Hosting DHtmlEdit and use wrapper package # # use Cwd; use Win32::GUI; use DHtmlEdit; my $HtmlFile = ""; my $Directory = cwd; # main menu my $Menu = Win32::GUI::MakeMenu( "&File" => "File", " > &New..." => "FileNew", " > &Open..." => "FileOpen", " > -" => 0, " > &Save" => "FileSave", " > Save &As..." => "FileSaveAs", " > -" => 0, " > &Print" => "FilePrint", " > -" => 0, " > &Directory..." => "FileDirectory", " > -" => 0, " > E&xit" => "FileExit", "&Edit" => "Edit", " > &Undo" => "EditUndo", " > &Redo" => "EditRedo", " > -" => 0, " > Cu&t" => "EditCut", " > &Copy" => "EditCopy", " > &Paste" => "EditPaste", " > -" => 0, " > &Select All" => "EditSelectAll", " > &Delete" => "EditDelete", " > -" => 0, " > &Find " => "EditFind", "&Format" => "Format", " > &Bold" => "FormatBold", " > &Italic" => "FormatItalic", " > &Underline" => "FormatUnderline", " > &Font..." => "FormatFont", " > -" => 0, " > Justify &Left" => "FormatJustifyLeft", " > Justify &Center" => "FormatJustifyCenter", " > Justify &Right" => "FormatJustifyRight", " > -" => 0, " > &Indent" => "FormatIndent", " > &Outdent" => "FormatOutdent", "&Insert" => "Insert", " > &HyperLink..." => "InsertHyperLink", " > &Image..." => "InsertImage", " > -" => 0, " > &OrderList" => "InsertOrderList", " > &UnOrderList" => "InsertUnOrderList", " > -" => 0, " > &Unlink" => "InsertUnlink", "&Help" => "Help", " > &About" => "HelpAbout", ); # main Window $Window = new Win32::GUI::Window ( -name => "Window", -title => "Win32::GUI::AxWindow test", -pos => [100, 100], -size => [400, 400], -menu => $Menu, ) or die "new Window"; # Create AxWindow $Control = new Win32::GUI::DHtmlEdit ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], ) or die "new Control"; # Method call $Control->DocumentHTML('<HTML><BODY><B>Hello World !!!</B></BODY></HTML>'); # Event handler $Control->OnDisplayChanged ( "Event_DisplayChanged" ); # Event loop $Window->Show(); Win32::GUI::Dialog(); sub Event_DisplayChanged { my $self = shift; # Check Edit menu if ($Control->QueryUndo() == 3) { $Menu->{EditUndo}->Enabled(1); } else { $Menu->{EditUndo}->Enabled(0); } if ($Control->QueryRedo() == 3) { $Menu->{EditRedo}->Enabled(1); } else { $Menu->{EditRedo}->Enabled(0); } if ($Control->QueryCut() == 3) { $Menu->{EditCut}->Enabled(1); } else { $Menu->{EditCut}->Enabled(0); } if ($Control->QueryCopy() == 3) { $Menu->{EditCopy}->Enabled(1); } else { $Menu->{EditCopy}->Enabled(0); } if ($Control->QueryPaste() == 3) { $Menu->{EditPaste}->Enabled(1); } else { $Menu->{EditPaste}->Enabled(0); } if ($Control->QuerySelectAll() == 3) { $Menu->{EditSelectAll}->Enabled(1); } else { $Menu->{EditSelectAll}->Enabled(0); } if ($Control->QueryDelete() == 3) { $Menu->{EditDelete}->Enabled(1); } else { $Menu->{EditDelete}->Enabled(0); } } # Finish method sub Finish { # Change after last save. if ($Control->IsDirty()) { FileSave_Click(); } return -1; } # Main window event handler sub Window_Terminate { return Finish (); } sub Window_Resize { if (defined $Window) { ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Move (0, 0); $Control->Resize ($width, $height); } } ####################################################################### # # File Menu # ####################################################################### # New sub FileNew_Click { $Control->NewDocument (); $HtmlFile = ""; } # Open sub FileOpen_Click { my $ret = Win32::GUI::GetOpenFileName( -title => "Open html File", -filter => [ "Html Document (*.htm, *.html)" => "*.htm;*.html", "All files", "*.*", ], -directory => $Directory, ); if ($ret) { $HtmlFile = $ret; $Control->LoadDocument ($HtmlFile); } elsif (Win32::GUI::CommDlgExtendedError()) { Win32::GUI::MessageBox (0, "ERROR : ".Win32::GUI::CommDlgExtendedError(), "GetOpenFileName Error"); } } # Save sub FileSave_Click { unless ($HtmlFile eq "") { my $ret = Win32::GUI::MessageBox (0, "Overwrite existing file ?", "Save",MB_ICONQUESTION | MB_YESNOCANCEL); if ($ret == 6) { $ret = $Control->SaveDocument ($HtmlFile); unless ($ret) { Win32::GUI::MessageBox (0, "ERROR : SaveDocument ", "Save Error"); } } elsif ($ret == 7) { FileSaveAs_Click(); } } else { FileSaveAs_Click(); } } # SaveAs sub FileSaveAs_Click { my $ret = Win32::GUI::GetSaveFileName( -title => "Save html File As", -filter => ["Html Document (*.htm, *.html)" => "*.htm;*.html"], -directory => $Directory, ); if ($ret) { $HtmlFile = $ret; $ret = $Control->SaveDocument ($HtmlFile); unless ($ret) { Win32::GUI::MessageBox (0, "ERROR : SaveDocument ", "Save Error"); } } elsif (Win32::GUI::CommDlgExtendedError()) { Win32::GUI::MessageBox (0, "ERROR : ".Win32::GUI::CommDlgExtendedError(), "GetSaveFileName Error"); } } # Print sub FilePrint_Click { $ret = $Control->PrintDocument (1); } # Directory sub FileDirectory_Click { my $ret = Win32::GUI::BrowseForFolder ( -title => "Select default directory", -directory => $Directory, -folderonly => 1, ); $Directory = $ret if ($ret); } # Exit sub FileExit_Click { return Finish(); } ####################################################################### # # Edit Menu # ####################################################################### sub EditUndo_Click { $Control->Undo(); } sub EditRedo_Click { $Control->Redo(); } sub EditCut_Click { $Control->Cut(); } sub EditCopy_Click { $Control->Copy(); } sub EditPaste_Click { $Control->Paste(); } sub EditSelectAll_Click { $Control->SelectAll(); } sub EditDelete_Click { $Control->Delete(); } sub EditFind_Click { $Control->FindText(); } ####################################################################### # # Format Menu # ####################################################################### sub FormatBold_Click { $Control->Bold(); } sub FormatItalic_Click { $Control->Italic(); } sub FormatUnderline_Click { $Control->Underline(); } sub FormatFont_Click { $Control->Font(); } sub FormatJustifyLeft_Click { $Control->JustifyLeft(); } sub FormatJustifyCenter_Click { $Control->JustifyCenter(); } sub FormatJustifyRight_Click { $Control->JustifyRight(); } sub FormatIndent_Click { $Control->Indent(); } sub FormatOutdent_Click { $Control->Outdent(); } ####################################################################### # # Insert Menu # ####################################################################### sub InsertHyperLink_Click { $Control->HyperLink(); } sub InsertImage_Click { $Control->Image(); } sub InsertOrderList { $Control->OrderList(); } sub InsertUnOrderList { $Control->UnOrderList(); } sub InsertUnlink_Click { $Control->Unlink(); } ####################################################################### # # Help Menu # ####################################################################### sub HelpAbout_Click { Win32::GUI::MessageBox (0, "Perl Html Editor 0.1 by Laurent Rocher", "About",MB_ICONINFORMATION); } --- NEW FILE: MsFlexGrid.pm --- # # Win32::GUI::MsFlexGrid: wrapper package for MsFlexGrid ActiveX # by Laurent Rocher. # # use strict; use vars qw(@ISA $VERSION); use Carp 'croak','carp'; use Win32::GUI::AxWindow; @ISA = qw(Win32::GUI::AxWindow Exporter); $VERSION = "1.0"; BEGIN { use Exporter(); use vars qw(@EXPORT); [...1680 lines suppressed...] # VARIANT_BOOL RightToLeft() / void RightToLeft([in] VARIANT_BOOL rhs) # Determines text display direction and control visual appearance on a bidirectional system. sub RightToLeft { croak("Usage: VARIANT_BOOL RightToLeft() / void RightToLeft([in] VARIANT_BOOL rhs)") if (@_ != 1 && @_ != 2); my ($self, $value) = @_; if (defined $value) { return $self->SUPER::SetProperty (0xfffffd9d, $value); } else { return $self->SUPER::GetProperty (0xfffffd9d); } } 1; __END__ --- NEW FILE: DHtmlEdit.pm --- # # Win32::GUI::DHtmlEdit : wrapper package for DHtmlEdit ActiveX # by Laurent Rocher. # # TODO : Check ExecuteCommand (Some commande have parameters) # TODO : Check QueryStatus (Usefull for all) # package Win32::GUI::DHtmlEdit; use strict; use vars qw(@ISA $VERSION); use Carp 'croak','carp'; use Win32::GUI::AxWindow; @ISA = qw(Win32::GUI::AxWindow Exporter); $VERSION = "1.0"; [...1363 lines suppressed...] my ($self, $callback) = @_; $self->RegisterEvent ("onblur", $callback); } # # onreadystatechange # sub OnReadyStateChange { croak("Usage: OnReadyStateChange (CallBack)") if (@_ != 2); my ($self, $callback) = @_; $self->RegisterEvent ("onreadystatechange", $callback); } 1; --- NEW FILE: Google.pl --- # perl -w # # Hosting WebBrowser # - Create a WebBrowser control and get a Win32::OLe handler. # - Navigate on Google.fr # - When document loaded (DoucmentComplete event), set Win32::GUI::AxWindow in serach edit then submit # If Google Html page change, must change Item index. # use Cwd; use Win32::GUI; use Win32::OLE; use Win32::GUI::AxWindow; # main Window $Window = new Win32::GUI::Window ( -title => "Win32::GUI::AxWindow and Win32::OLE", -pos => [100, 100], -size => [400, 400], -name => "Window", ) or die "new Window"; # Create AxWindow with a webbrowser $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 100], -size => [400, 300], -control => "Shell.Explorer.2", ) or die "new Control"; # Register Event $Control->RegisterEvent ("DocumentComplete", "DocumentComplete_Event" ); # Get Ole object $OLEControl = $Control->GetOLE(); # Navigate to google $Control->CallMethod("Navigate", 'http://www.google.fr/'); # Event loop $Window->Show(); Win32::GUI::Dialog(); # Event handler sub DocumentComplete_Event { # print $OLEControl->{LocationUrl}, "\n"; return unless $OLEControl->{LocationUrl} eq 'http://www.google.fr/'; print "Search Win32::GUI::AXWindow\n"; my $all = $OLEControl->{Document}->{all}; # List all HTML TAG # for $i (0..$all->length) { # my $item = $all->item($i); # print "$i = ", $item->outerHTML , "\n\n"; # } # Input text my $inputText = $all->item(49); $inputText->{value} = "Win32::GUI::AxWindow"; # Submit my $Submit = $all->item(55); $Submit->click; } # Main window event handler sub Window_Terminate { # Release all before destroy window undef $OLEControl; # $Control->Release(); return -1; } sub Window_Resize { if (defined $Window) { ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Move (0, 0); $Control->Resize ($width, $height); } } |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:47:22
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088/demos Added Files: DHtmlEdit.pl InfoControl.pl MShtml.pl Movie.avi MovieControl.pl MsFlexGrid.pl SCGrid.pl TestOLE.pl WMPControl.pl WebBrowser.pl WebBrowser2.pl Log Message: Merge AxWindow into core distribution --- NEW FILE: MsFlexGrid.pl --- #!perl -w use strict; use warnings; # # Hosting MsFlexGrid : Test Indexed properties # You need a computer with a registered version of MSFlxgrd.ocx # (e.g. with a VC++ installation) to run this demo # # Sadly if you don't have a registered version of msflxgrd.ocx # you don't get a control creation failure, but an IE window # showing an error, as the underlying framework assumes that # "MSFlexGridLib.MSFlexLib" is a URL to try any load! # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window ( -title => "Win32::GUI::AxWindow test", -pos => [100, 100], -size => [400, 400], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => 'MSFlexGridLib.MSFlexGrid', ) or die "new Control"; # Test Enum property set by string value # $Control->SetProperty("ScrollBars", "flexScrollBarNone"); # $Control->SetProperty("GridLines", "flexGridInset"); $Control->SetProperty("Rows", 5); $Control->SetProperty("Cols", 5); #$Control->SetProperty("TextMatrix", 1, 2, "Hello!!!"); #my $r = $Control->GetProperty("Rows"); #my $c = $Control->GetProperty("Cols"); #my $t = $Control->GetProperty("TextMatrix", 1, 2); #print "Rows = $r, Cols = $c, TextMatrix(1,2) = $t\n"; # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Resize ($width, $height); } } --- NEW FILE: Movie.avi --- (This appears to be a binary file; contents omitted.) --- NEW FILE: WebBrowser.pl --- #!perl -w use strict; use warnings; # # Hosting a WebBrowser # Create a WebBrowser and register an event. # Enumerate Property, Methods and Events and create a Html file. # Load Html file in WebBrowser. # use File::Temp(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = Win32::GUI::Window->new( -title => "Win32::GUI::AxWindow WebBrowser", -pos => [100, 100], -size => [400, 400], -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => "Shell.Explorer.2", # -control => "{8856F961-340A-11D0-A96B-00C04FD705A2}", ) or die "new Control"; # Register Event $Control->RegisterEvent("StatusTextChange", sub { my($self,$id, @args) = @_; print "Event : ", @args, "\n"; } ); # Enum Property info my $tmp = File::Temp->new(SUFFIX => ".html"); print "writing to file: $tmp\n"; print $tmp "<html>\n"; print $tmp "<head><title>AxWindow WebBrowser Properties</title></head>\n"; print $tmp "<body><hr /><h1>Properties</h1><hr />\n"; foreach my $id ($Control->EnumPropertyID()) { my %property = $Control->GetPropertyInfo ($id); print $tmp "<p>\n"; foreach my $key (keys %property) { print $tmp "<b>$key</b> = $property{$key}<br />\n"; } print $tmp "</p>\n"; } # Enum Method info print $tmp "<hr /><h1>Methods</h1><hr />\n"; foreach my $id ($Control->EnumMethodID()) { my %method = $Control->GetMethodInfo ($id); print $tmp "<p>\n"; foreach my $key (keys %method) { print $tmp "<b>$key</b> = $method{$key}<br />\n"; } print $tmp "</p>\n"; } # Enum Event info print $tmp "<hr /><h1>Events</h1><hr />\n"; foreach my $id ($Control->EnumEventID()) { my %event = $Control->GetEventInfo ($id); print $tmp "<p>\n"; foreach my $key (keys %event) { print $tmp "<b>$key</b> = $event{$key}<br />\n"; } print $tmp "</p>\n"; } print $tmp "</body></html>\n"; # Method call my $path = "file://$tmp"; # print $path, "\n"; $Control->CallMethod("Navigate", $path); # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Resize ($width, $height); } } --- NEW FILE: DHtmlEdit.pl --- #!perl -w use strict; use warnings; # # Hosting DHtmlEdit basic # You can't do much with it! See DHtmlEditor.pl # for a better sample (using Win32::GUI::DHtmlEdit) # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window( -name => "Window", -title => "Win32::GUI::AxWindow test", -pos => [100, 100], -size => [400, 400], -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => "DHTMLEdit.DHTMLEdit", #-control => "{2D360200-FFF5-11D1-8D03-00A0C959BC0A}", ) or die "new Control"; # Method call $Control->CallMethod("NewDocument"); # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Terminate { # Print Html Text print $Control->GetProperty("DocumentHTML"); return -1; } sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Move(0, 0); $Control->Resize($width, $height); } } --- NEW FILE: MovieControl.pl --- #!perl -w use strict; use warnings; # # Hosting Movie Control (A movie player control see # http://www.viscomsoft.com/movieplayer.htm) # # A 30-day trial licence of the control is available from # the above site. # use FindBin(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window ( -title => "Movie Control Test", -pos => [100, 100], -size => [200, 200], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Add a play button $Window->AddButton( -name => "Button", -text => 'Play', -pos => [10,10], ); # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, $Window->Button->Height()+20], -width => $Window->ScaleWidth(), -height => $Window->ScaleHeight()-$Window->Button->Height()-20, # -control => "{F4A32EAF-F30D-466D-BEC8-F4ED86CAF84E}", -control => "MOVIEPLAYER.MoviePlayerCtrl.1", ) or die "new Control"; # Load Avi file $Control->SetProperty("FileName", "$FindBin::Bin/movie.avi"); # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $height = $height - $Window->Button->Height() - 20; #$Control->Resize ($width, $height); $Control->CallMethod("ResizeControl", $width, $height); } } sub Button_Click { # Start Avi player $Control->CallMethod("Play"); } --- NEW FILE: SCGrid.pl --- #!perl -w use strict; use warnings; # # Hosting SCGrid (A freeware Grid ActiveX see : http://www.scgrid.com/) # Download SCGridLite from http://www.scgrid.com/ # - Extract SCGrid.ocx and put it somewhere # - from the command prompt: regsvr32 <path_to>\SCGrid.ocx # - (uninstall regsvr32 /u <path_to>\SCGrid.ocx, and delete SCGrid.ocx) # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window ( -title => "Win32::GUI::AxWindow test", -pos => [100, 100], -size => [400, 400], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => "prjSCGrid.SCGrid", ) or die "new Control"; # Redraw Off $Control->SetProperty("Redraw", 0); # Create 1 Fixed col and Row $Control->SetProperty("FixedRows", 1); $Control->SetProperty("FixedCols", 1); # Create 5 col and Row $Control->SetProperty("Rows", 5); $Control->SetProperty("Cols", 5); # Adjust grid on column $Control->SetProperty("AdjustLast", "scColumn"); # Add Resize column mode $Control->SetProperty("ResizeMode", "scColumn"); # Fill Cell for my $C (0..4) { for my $R (0..4) { $Control->SetProperty("Text", $R, $C, "Cell ($R, $C)"); } } # Fill Fixed Rows $Control->SetProperty("Text", -1, -1, " "); for my $R (0..4) { $Control->SetProperty("Text", $R, -1, "$R"); } #$Control->CallMethod("AdjustWidth", -1, -32767); # Force optional value # Fill Fixed Cols and adjust size for my $C (0..4) { $Control->SetProperty("Text", -1, $C, "FixedCol($C)"); #$Control->CallMethod("AdjustWidth", $C, -32767); # Force optional value } # Enable draw mode $Control->SetProperty("Redraw", 1); # Some property get my $r = $Control->GetProperty("Rows"); my $c = $Control->GetProperty("Cols"); my $t = $Control->GetProperty("Text", 1, 2); print "Rows = $r, Cols = $c, Text(1,2) = $t\n"; # Event loop $Window->Show(); Win32::GUI::Dialog(); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Move (0, 0); $Control->Resize ($width, $height); } } --- NEW FILE: TestOLE.pl --- #!perl -w use strict; use warnings; # # Host with AxWindow and manipulate with Win32::OLE # - Use GetOLE # - Call method # - Write in a HTML document # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::OLE(); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window ( -title => "Win32::GUI::AxWindow and Win32::OLE", -pos => [100, 100], -size => [600, 600], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # A button my $Button = $Window->AddButton ( -name => "Button", -pos => [0, 25], -size => [600, 50], -text => "Click me !!!", ); # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 100], -size => [600, 500], -control => "Shell.Explorer.2", ) or die "new Control"; # Get Ole object my $OLEControl = $Control->GetOLE(); # $OLEControl->Navigate("about:blank"); # Clear control $OLEControl->Navigate("http://www.google.com/"); # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Button Event sub Button_Click { $OLEControl->{Document}->{body}->insertAdjacentHTML("BeforeEnd","Click !!!"); #print "HTML = ", $OLEControl->{Document}->{body}->innerHTML, "\n"; return 0; } # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Button->Width($width); $Control->Resize($width, $height-100); } } --- NEW FILE: WebBrowser2.pl --- #!perl -w use strict; use warnings; # # Hosting a WebBrowser # Create a WebBrowser and register an event. # Enumerate Property, Methods and Events and display in WebBrowser. # Same demo as WebBrowser.pl, but using OLE to avoid the temp file. # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); use Win32::OLE(); # main Window my $Window = Win32::GUI::Window->new( -title => "Win32::GUI::AxWindow WebBrowser", -pos => [100, 100], -size => [400, 400], -name => "Window", -pushstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => "Shell.Explorer.2", ) or die "new Control"; # Enum Property info my $html = ""; $html .= "<html>\n"; $html .= "<head><title>AxWindow WebBrowser Properties</title></head>\n"; $html .= "<body><hr /><h1>Properties</h1><hr />\n"; foreach my $id ($Control->EnumPropertyID()) { my %property = $Control->GetPropertyInfo ($id); $html .= "<p>\n"; foreach my $key (keys %property) { $html .= "<b>$key</b> = $property{$key}<br />\n"; } $html .= "</p>\n"; } # Enum Method info $html .= "<hr /><h1>Methods</h1><hr />\n"; foreach my $id ($Control->EnumMethodID()) { my %method = $Control->GetMethodInfo ($id); $html .= "<p>\n"; foreach my $key (keys %method) { $html .= "<b>$key</b> = $method{$key}<br />\n"; } $html .= "</p>\n"; } # Enum Event info $html .= "<hr /><h1>Events</h1><hr />\n"; foreach my $id ($Control->EnumEventID()) { my %event = $Control->GetEventInfo ($id); $html .= "<p>\n"; foreach my $key (keys %event) { $html .= "<b>$key</b> = $event{$key}<br />\n"; } $html .= "</p>\n"; } $html .= "</body></html>\n"; # Load blank page $Control->CallMethod("Navigate", "about:blank"); # write the HTML to the page $Control->GetOLE()->{Document}->write($html); # free memory undef $html; # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Resize ($width, $height); } } --- NEW FILE: InfoControl.pl --- #!perl -w use strict; use warnings; # # Application to display control information, demosntrating AxWindow # usage for Webbrowser, as well as providing useful information for # anyone wanting to use other controls # # If you're randomly browsing controls, don't be surprised to find some # that crash perl. # # Select an AxtiveX Object from the dropdown ... # # Author: Robert May # use Win32::GUI qw(WS_CLIPCHILDREN WS_EX_CLIENTEDGE); use Win32::GUI::AxWindow(); use Win32::OLE(); use Win32::TieRegistry(); # Info about the currently inspected control my %INFO; # main Window my $mw = new Win32::GUI::Window ( -name => "MW", -title => "Win32::GUI::AxWindow Control Navigator", -size => [600,400], -addstyle => WS_CLIPCHILDREN, -onResize => \&mwResize, ) or die "new Window"; $mw->Center(); $mw->AddLabel( -name => "PROGID_Prompt", -pos => [10,13], -height => 20, -text => "Select PROGID :", ) or die "new Label"; $mw->AddCombobox( -name => "PROGID", -top => 10, -left => $mw->PROGID_Prompt->Left()+$mw->PROGID_Prompt->Width()+10, -size => [300,200], -vscroll => 1, -onChange => \&loadInfo, -dropdownlist => 1, ) or die "new Combobox"; $mw->AddTreeView( -name => 'TV', -top => $mw->PROGID_Prompt->Height()+20, -width => 180, -height => $mw->ScaleHeight()-$mw->PROGID_Prompt->Height()-20, -rootlines => 1, -lines => 1, -buttons => 1, -onNodeClick => \&dispInfo, ) or die "new TreeView"; Win32::GUI::AxWindow->new( -parent => $mw, -control => "Shell.Explorer", -name => 'BW', -left => $mw->TV->Left() + $mw->TV->Width()+5, -top => $mw->PROGID_Prompt->Height()+20, -width => $mw->ScaleWidth()-$mw->TV->Width()-5, -height => $mw->ScaleHeight()-$mw->PROGID_Prompt->Height()-20, -addexstyle => WS_EX_CLIENTEDGE, ) or die "new AxWindow"; # Load a blank page $mw->BW->CallMethod("Navigate", "about:blank"); $mw->Show(); $mw->Disable(); # Ref to list of controls my $controls = getInstalledControls(); exit(0) if not defined $controls; # Abort #Populate combo selection $mw->PROGID->Add(sort {lc $a cmp lc $b} @{$controls}); $mw->Enable(); $mw->BringWindowToTop(); Win32::GUI::Dialog(); $mw->Hide(); undef $mw; exit(0); sub mwResize { my $win = shift; my ($width, $height) = ($win->GetClientRect())[2..3]; $win->TV->Height($height-$win->TV->Top()); $win->BW->Width($width-$win->BW->Left()); $win->BW->Height($height-$win->BW->Top()); return 1; } sub loadInfo { Update_Treeview($mw->TV); return 1; } sub Update_Treeview { my $tv = shift; # reset information %INFO = (); $tv->DeleteAllItems(); Display(""); $INFO{progid} = $mw->PROGID->Text(); $INFO{progid} =~ s/\s.*$//; # Determine if we can create the object: # This is pretty heavy handed, but I can't think of a better # way to prevent us falling back on Shell.Explorer if we can't # load the requested ActiveX object { my $oleobj; { local $SIG{__WARN__} = sub {}; $oleobj = Win32::OLE->new($INFO{progid}); } if (not defined $oleobj) { Display("<p style='color:red;'>ERROR creating $INFO{progid} (OLE)</p>"); return 0; } } # Create invisible AxWindow control my $C = new Win32::GUI::AxWindow( -parent => $mw, -name => "Control", -control => $INFO{progid}, ); if (not defined $C) { Display("<p style='color:red;'>ERROR creating $INFO{progid} (Control)</p>"); return 0; } # Get Property info foreach my $id ($C->EnumPropertyID()) { my %property = $C->GetPropertyInfo($id); $INFO{Properties}->{$property{-Name}} = \%property; } # Get Method info foreach my $id ($C->EnumMethodID()) { my %method = $C->GetMethodInfo($id); $INFO{Methods}->{$method{-Name}} = \%method; } # Get Event info foreach my $id ($C->EnumEventID()) { my %event = $C->GetEventInfo ($id); $INFO{Events}->{$event{-Name}} = \%event; } # Update the tree view # Insert the nodes for my $pnode_text qw(Properties Methods Events) { next if not defined $INFO{$pnode_text}; my $pnode = $tv->InsertItem(-text => $pnode_text); for my $prop_name (sort keys %{$INFO{$pnode_text}}) { $tv-> InsertItem( -parent => $pnode, -text => $prop_name, ); } } return 1; } sub dispInfo { my ($tv, $node) = @_; my $pnode = $tv->GetParent($node); # Don't do anything for the top level nodes return 1 if $pnode == 0; my %pitem_info = $tv->GetItem($pnode); my $type = $pitem_info{-text}; my %item_info = $tv->GetItem($node); my $name = $item_info{-text}; my $info = $INFO{$type}->{$name}; my $html; if ($type eq "Properties") { $html = property_html($info); } elsif ($type eq "Methods") { $html = method_html($info); } elsif ($type eq "Events") { $html = event_html($info); } else { $html = "<p>Unknown type: $type (you shouldn't see this)</p>"; } Display($html); return 1; } sub Display{ my $html = shift; # Clear the document window and send the new contents # Ask Microsoft why they don't support the # document.clear method $mw->BW->GetOLE()->{Document}->open("about:bank", "_self"); $mw->BW->GetOLE()->{Document}->write($html); $mw->BW->GetOLE()->{Document}->close(); } sub property_html { my $prop = shift; my $html = "<h2>Property: $prop->{-Name}</h2>"; $html .= "<p>$prop->{-Description}</p>"; $html .= "<table>"; $html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>"; $html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>"; $html .= "<tr><td>VarType:</td><td>$prop->{-VarType}</td></tr>"; $html .= "<tr><td>Readonly:</td><td>".($prop->{-ReadOnly}?"Yes":"No")."</td></tr>"; $html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>"; $html .= "</table>"; my $enumstr = $prop->{-EnumValue}; if (length($enumstr) > 0) { $html .= "<h3>Enumerated values</h3>"; $html .= "<table border='1' cellspacing='0'>"; for my $pair (split /,/, $enumstr) { my ($name, $value) = split /=/, $pair; $html .= "<tr><td>$name</td><td>$value</td></tr>"; } $html .= "</table>"; } return $html; } sub method_html { my $prop = shift; my $html = "<h2>Method: $prop->{-Name}</h2>"; $html .= "<p>$prop->{-Description}</p>"; $html .= "<table>"; $html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>"; $html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>"; $html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>"; $html .= "</table>"; return $html; } sub event_html { my $prop = shift; my $html = "<h2>Event: $prop->{-Name}</h2>"; $html .= "<p>$prop->{-Description}</p>"; $html .= "<table>"; $html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>"; $html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>"; $html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>"; $html .= "</table>"; return $html; } # Enumerate registry key HKCR\CLSID. All classes with a 'Control' # subkey are ActiveX controls sub getInstalledControls { my $abort = 0; LoadingWindow::Show($mw); my @controls = (); my $clsidkey = Win32::TieRegistry->new( "HKEY_CLASSES_ROOT/CLSID/", { Access => "KEY_READ", Delimiter => '/', } ); my $r = $clsidkey->TiedRef(); LoadingWindow::SetRange(scalar keys %$r); while(my ($key, $value) = each %$r) { $abort = LoadingWindow::Step(); last if $abort; # next, unless we have an ActiveX control next unless ref($value) and exists $value->{Control}; my $ProgID = $value->{ProgID}->{'/'}; # Some controls appear to have an empty name next unless defined $ProgID and length $ProgID > 0; my $VIProgID = $value->{VersionIndependentProgID}->{'/'}; $ProgID .= " ($VIProgID)" if defined $VIProgID and length $VIProgID > 0; push @controls, $ProgID; } LoadingWindow::Close(); return $abort ? undef : \@controls; } # package to wrap the progress bar that we show while # loading stuff from the registry package LoadingWindow; our ($win,$terminate); # Initialise and show the progress bar mini-window sub Show { my $parent = shift; $terminate = 0; $win = Win32::GUI::Window->new( -parent => $parent, -title => "Loading ...", -size => [200,50], -toolwindow => 1, -onTerminate => sub {$terminate = 1; 1;}, ) or die "new Lwindow"; $win->Center($parent); $win->AddProgressBar( -name => 'PB', -size => [$win->ScaleWidth(),$win->ScaleHeight()], -smooth => 1, ) or die "new Lprogress"; $win->PB->SetStep(1); $win->Show(); Win32::GUI::DoEvents(); return 1; } # Set the max ranges of the progress bar # (to the number of itertations of the # loop we will do) sub SetRange { $win->PB->SetRange(0, shift) if $win; return 1; } # Step the progress bar. Return 1 if we expect # the caller to abort sub Step { return 1 if $terminate; $win->PB->StepIt() if $win; Win32::GUI::DoEvents(); return 0; } # Hide the min-window, and free any resources # it is using; prepare for it to be used again sub Close { if($win) { Win32::GUI::DoEvents(); $win->Hide(); Win32::GUI::DoEvents(); undef $win; undef $terminate; } return 1; } --- NEW FILE: WMPControl.pl --- #!perl -w use strict; use warnings; # # Hosting Windows Media Player # Needs WMP 7 and above (different object model to WMP 6.4) # use FindBin(); use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); use Win32::OLE(); # main Window my $Window = new Win32::GUI::Window ( -title => "Movie Control Test", -pos => [100, 100], -size => [200, 200], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Add a play button $Window->AddButton( -name => "Button", -text => 'Play', -pos => [10,10], ); # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, $Window->Button->Height()+20], -width => $Window->ScaleWidth(), -height => $Window->ScaleHeight()-$Window->Button->Height()-20, -control => "WMPlayer.OCX", ) or die "new Control"; # Don't autostart the video clip when we load it $Control->GetOLE()->settings->{autoStart} = 0; # Remove all ui widgets - just have the video window # For some reason SetProperty doesn't seem to wrok - use OLE instead #$Control->SetProperty("uiMode", "none"); $Control->GetOLE()->{uiMode} = "none"; # Stretch Video to video window #$Control->GetOLE()->{stretchToFit} = 1; $Control->SetProperty("stretchToFit", 1); # Load the Avi file $Control->SetProperty("URL", "$FindBin::Bin/Movie.avi"); # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $height = $height - $Window->Button->Height() - 20; $Control->Resize ($width, $height); } } sub Button_Click { # Play the AVI file $Control->GetOLE()->{controls}->play(); return 1; } --- NEW FILE: MShtml.pl --- #!perl -w use strict; use warnings; # # MSHTML : Load static HTML data # # use Win32::GUI qw(WS_CLIPCHILDREN); use Win32::GUI::AxWindow(); # main Window my $Window = new Win32::GUI::Window ( -title => "Win32::GUI::AxWindow MSHTML demo", -pos => [100, 100], -size => [400, 400], -name => "Window", -addstyle => WS_CLIPCHILDREN, ) or die "new Window"; # Create AxWindow my $Control = new Win32::GUI::AxWindow ( -parent => $Window, -name => "Control", -pos => [0, 0], -size => [400, 400], -control => "MSHTML:<body>This is a line of text</body>", ) or die "new Control"; # Event loop $Window->Show(); Win32::GUI::Dialog(); $Window->Hide(); exit(0); # Main window event handler sub Window_Resize { if (defined $Window) { my ($width, $height) = ($Window->GetClientRect)[2..3]; $Control->Resize ($width, $height); } } |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:47:11
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/Samples/UnComplete In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088/Samples/UnComplete Removed Files: MsFlexGrid.pm Log Message: Merge AxWindow into core distribution --- MsFlexGrid.pm DELETED --- |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:47:10
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/Samples In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22088/Samples Removed Files: DHtmlEdit.pl DHtmlEdit.pm DHtmlEditor.pl Google.pl Info.bat InfoControl.pl MShtml.pl Movie.avi MovieControl.pl MsFlexGrid.pl SCGrid.pl TestOLE.pl WebBrowser.pl Log Message: Merge AxWindow into core distribution --- MsFlexGrid.pl DELETED --- --- Movie.avi DELETED --- --- WebBrowser.pl DELETED --- --- DHtmlEdit.pm DELETED --- --- DHtmlEdit.pl DELETED --- --- MovieControl.pl DELETED --- --- SCGrid.pl DELETED --- --- TestOLE.pl DELETED --- --- DHtmlEditor.pl DELETED --- --- InfoControl.pl DELETED --- --- MShtml.pl DELETED --- --- Info.bat DELETED --- --- Google.pl DELETED --- |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:44:04
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos/UnComplete In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20488/UnComplete Log Message: Directory /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos/UnComplete added to the repository |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:43:43
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20447/demos Log Message: Directory /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/demos added to the repository |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:43:10
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/t In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19934/t Log Message: Directory /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-AxWindow/t added to the repository |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:33:20
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DropFiles In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15275/Win32-GUI-DropFiles Modified Files: Makefile.PL Log Message: correct typo Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-DropFiles/Makefile.PL,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Makefile.PL 7 May 2006 11:06:18 -0000 1.2 --- Makefile.PL 11 Jun 2006 15:33:14 -0000 1.3 *************** *** 22,26 **** RCFLAGS => '', INST_DEMODIR => '$(INST_LIB)/Win32/GUI/demos/$(BASEEXT)', ! DEMOS => 'demos/DropFilesDemo.pl' }, clean => {FILES => '*.rc *.res', }, --- 22,26 ---- RCFLAGS => '', INST_DEMODIR => '$(INST_LIB)/Win32/GUI/demos/$(BASEEXT)', ! DEMOS => 'demos/DropFilesDemo.pl', }, clean => {FILES => '*.rc *.res', }, |
|
From: Robert M. <rob...@us...> - 2006-06-11 15:30:42
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14429 Modified Files: GridLayout.pm Log Message: Corrected documented order of constructor parameters Index: GridLayout.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GridLayout.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** GridLayout.pm 26 Jun 2005 16:40:59 -0000 1.6 --- GridLayout.pm 11 Jun 2006 15:30:37 -0000 1.7 *************** *** 276,280 **** =over 4 ! =item new Win32::GUI::GridLayout(WIDTH, HEIGHT, COLS, ROWS, XPAD, YPAD) =item apply Win32::GUI::GridLayout(WINDOW, COLS, ROWS, XPAD, YPAD) --- 276,280 ---- =over 4 ! =item new Win32::GUI::GridLayout(COLS, ROWS, WIDTH, HEIGHT, XPAD, YPAD) =item apply Win32::GUI::GridLayout(WINDOW, COLS, ROWS, XPAD, YPAD) |
|
From: Robert M. <rob...@us...> - 2006-06-01 19:46:24
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7193/Win32-GUI-Constants Modified Files: Constants.PL Tags.pm Log Message: Enhanced resouce loaing for Icons/Bitmaps and Cursors Index: Constants.PL =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants/Constants.PL,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Constants.PL 16 May 2006 18:57:26 -0000 1.2 --- Constants.PL 1 Jun 2006 19:46:12 -0000 1.3 *************** *** 957,961 **** # ID for bitmaps (Toolbars) - #TODO DOT TO HERE IDB_STD_SMALL_COLOR 0 IDB_STD_LARGE_COLOR 1 --- 957,960 ---- *************** *** 971,976 **** IDC_CROSS 32515 IDC_UPARROW 32516 - IDC_SIZE 32640 - IDC_ICON 32641 IDC_SIZENWSE 32642 IDC_SIZENESW 32643 --- 970,973 ---- *************** *** 994,997 **** --- 991,1055 ---- IDI_INFORMATION 32516 # IDI_ASTERISK + # Win32::GUI Icon + IDI_DEFAULTICON 102 + + # Win32::GUI Cursors + IDC_HSPLIT 103 + IDC_VSPLIT 104 + + # OEM Cursor IDs + OCR_NORMAL 32512 + OCR_IBEAM 32513 + OCR_WAIT 32514 + OCR_CROSS 32515 + OCR_UP 32516 + OCR_SIZENWSE 32642 + OCR_SIZENESW 32643 + OCR_SIZEWE 32644 + OCR_SIZENS 32645 + OCR_SIZEALL 32646 + OCR_NO 32648 + OCR_HAND 32649 + OCR_APPSTARTING 32650 + + # OEM Bitmap IDs + OBM_CLOSE 32754 + OBM_UPARROW 32753 + OBM_DNARROW 32752 + OBM_RGARROW 32751 + OBM_LFARROW 32750 + OBM_REDUCE 32749 + OBM_ZOOM 32748 + OBM_RESTORE 32747 + OBM_REDUCED 32746 + OBM_ZOOMD 32745 + OBM_RESTORED 32744 + OBM_UPARROWD 32743 + OBM_DNARROWD 32742 + OBM_RGARROWD 32741 + OBM_LFARROWD 32740 + OBM_MNARROW 32739 + OBM_COMBO 32738 + OBM_UPARROWI 32737 + OBM_DNARROWI 32736 + OBM_RGARROWI 32735 + OBM_LFARROWI 32734 + OBM_SIZE 32766 + OBM_BTSIZE 32761 + OBM_CHECK 32760 + OBM_CHECKBOXES 32759 + OBM_BTNCORNERS 32758 + + # OEM Icon IDs + OIC_SAMPLE 32512 + OIC_HAND 32513 + OIC_QUES 32514 + OIC_BANG 32515 + OIC_NOTE 32516 + OIC_WINLOGO 32517 + OIC_WARNING 32515 # OIC_BANG + OIC_ERROR 32513 # OIC_HAND + OIC_INFORMATION 32516 # OIC_NOTE + # Listbox styles LBS_NOTIFY 0x0001 Index: Tags.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants/Tags.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Tags.pm 16 May 2006 18:57:26 -0000 1.2 --- Tags.pm 1 Jun 2006 19:46:12 -0000 1.3 *************** *** 82,96 **** accelerator => [ qw( ^VK_ ) ], animation => [ qw( ^ACS_ ) ], ! bitmap => [ qw() ], brush => [ qw() ], button => undef, class => [ qw( ^COLOR_ ^CS_ ) ], combobox => [ qw( ^CBS_ ^CBES_ ) ], ! cursor => [ qw( ^IDC_ ) ], datetime => [ qw( ^DTS_ ) ], dc => undef, font => [ qw() ], header => [ qw( ^HDS_ ) ], ! icon => [ qw( ^IDI_ ) ], imagelist => [ qw( ^ILC_ ^ILD_ ^ILS_ ^CLR_NONE$ ^CLR_DEFAULT$ ^IMAGE_ ) ], label => [ qw( ^IMAGE_ ) ], --- 82,96 ---- accelerator => [ qw( ^VK_ ) ], animation => [ qw( ^ACS_ ) ], ! bitmap => [ qw( ^OBM_ ) ], brush => [ qw() ], button => undef, class => [ qw( ^COLOR_ ^CS_ ) ], combobox => [ qw( ^CBS_ ^CBES_ ) ], ! cursor => [ qw( ^IDC_ ^OCR_ ) ], datetime => [ qw( ^DTS_ ) ], dc => undef, font => [ qw() ], header => [ qw( ^HDS_ ) ], ! icon => [ qw( ^IDI_ ^OIC_ ) ], imagelist => [ qw( ^ILC_ ^ILD_ ^ILS_ ^CLR_NONE$ ^CLR_DEFAULT$ ^IMAGE_ ) ], label => [ qw( ^IMAGE_ ) ], |
|
From: Robert M. <rob...@us...> - 2006-06-01 19:46:18
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7193 Modified Files: CHANGELOG GUI.pm GUI.xs Log Message: Enhanced resouce loaing for Icons/Bitmaps and Cursors Index: GUI.xs =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.xs,v retrieving revision 1.57 retrieving revision 1.58 diff -C2 -d -r1.57 -r1.58 *** GUI.xs 16 May 2006 18:57:25 -0000 1.57 --- GUI.xs 1 Jun 2006 19:46:11 -0000 1.58 *************** *** 1448,1451 **** --- 1448,1452 ---- #my $hourglass=Win32::GUI::LoadCursor(32514); # + #NOTE: it is better to use Win32::GUI::Cursor->new(ID); void LoadCursor(ID) *************** *** 1482,1487 **** # (@)INTERNAL:LoadImage(FILENAME, [TYPE, X, Y, FLAGS]) HBITMAP ! LoadImage(filename,iType=IMAGE_BITMAP,iX=0,iY=0,iFlags=LR_LOADFROMFILE) ! LPCTSTR filename UINT iType int iX --- 1483,1488 ---- # (@)INTERNAL:LoadImage(FILENAME, [TYPE, X, Y, FLAGS]) HBITMAP ! LoadImage(filename,iType=IMAGE_BITMAP,iX=0,iY=0,iFlags=LR_DEFAULTCOLOR) ! SV *filename UINT iType int iX *************** *** 1490,1509 **** PREINIT: HINSTANCE moduleHandle; ! HBITMAP bitmap; CODE: moduleHandle = GetModuleHandle(NULL); ! // Attempt to load from current EXE: ! bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, filename, iType, iX, iY, LR_DEFAULTCOLOR); ! // Try OEM ressource ! /* Can't use filename (a string pointer) as a resource id - should be able to use ! * a filename like '#1' to get resource from EXE - TODO: test this ! if(bitmap == NULL) { ! bitmap = (HBITMAP) LoadImage((HINSTANCE) NULL, MAKEINTRESOURCE(filename), iType, iX, iY, LR_DEFAULTCOLOR); } ! */ ! if(bitmap == NULL) { ! // Ok, that failed. So attempt to load from file: ! bitmap = (HBITMAP) LoadImage((HINSTANCE) NULL, filename, iType, iX, iY, iFlags); } RETVAL = bitmap; OUTPUT: --- 1491,1554 ---- PREINIT: HINSTANCE moduleHandle; ! HBITMAP bitmap = NULL; CODE: + /* Try to find the resource in the current EXE */ moduleHandle = GetModuleHandle(NULL); ! ! /* If filename looks like a string, attempt to load from current EXE: */ ! if((bitmap ==NULL) && SvPOK(filename) && !(iFlags & LR_LOADFROMFILE)) { ! bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, ! SvPV_nolen(filename), iType, iX, iY, iFlags); } ! ! /* If filename looks like a number, try it as a resource id from the current EXE */ ! if((bitmap == NULL) && SvIOK(filename) && !(iFlags & LR_LOADFROMFILE)) { ! bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, ! MAKEINTRESOURCE(SvIV(filename)), iType, iX, iY, iFlags); } + + /* Try to find the resource from GUI.dll */ + moduleHandle = GetModuleHandle("GUI.dll"); + + /* If filename looks like a string, try it as a resource name from GUI.dll */ + if((bitmap == NULL) && SvPOK(filename) && !(iFlags & LR_LOADFROMFILE)) { + bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, + SvPV_nolen(filename), iType, iX, iY, iFlags); + } + + /* If filename looks like a number, try it as a resource id from GUI.dll */ + if((bitmap == NULL) && SvIOK(filename) && !(iFlags & LR_LOADFROMFILE)) { + bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, + MAKEINTRESOURCE(SvIV(filename)), iType, iX, iY, iFlags); + } + + /* Try to load from file or as an OEM resource */ + moduleHandle = NULL; + + /* if filename looks like a string, try it as a file name */ + if((bitmap == NULL) && SvPOK(filename)) { + bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, + SvPV_nolen(filename), iType, iX, iY, iFlags|LR_LOADFROMFILE); + } + + /* If filename looks like a number, try it as an OEM resource id */ + if((bitmap == NULL) && SvIOK(filename) && !(iFlags & LR_LOADFROMFILE)) { + bitmap = (HBITMAP) LoadImage((HINSTANCE) moduleHandle, + MAKEINTRESOURCE(SvIV(filename)), iType, iX, iY, iFlags); + } + + /* Finally, if it looks like a number, try it as a pre-defined resource */ + if((bitmap == NULL) && SvIOK(filename)) { + if(iType == IMAGE_BITMAP) { + bitmap = LoadBitmap(NULL, MAKEINTRESOURCE(SvIV(filename))); + } + else if (iType == IMAGE_ICON) { + bitmap = LoadIcon(NULL, MAKEINTRESOURCE(SvIV(filename))); + } + else if (iType == IMAGE_CURSOR) { + bitmap = LoadCursor(NULL, MAKEINTRESOURCE(SvIV(filename))); + } + } + RETVAL = bitmap; OUTPUT: Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** GUI.pm 30 May 2006 18:20:57 -0000 1.45 --- GUI.pm 1 Jun 2006 19:46:11 -0000 1.46 *************** *** 366,369 **** --- 366,378 ---- # You can eventually specify your desired size for the image with X and # Y and pass some FLAGS to the underlying LoadImage API (at your own risk) + # + # If FILENAME is a string, then it is first tried as a resource + # name, then a filename. If FILENAME is a number it is tried + # as a resource identifier. + # + # Resources are searched for in the current exe (perl.exe unless + # you have packed your application using perl2exe, PAR or similar), + # then in the Win32::GUI GUI.dll, and finally as an OEM resource + # identifier sub new { my $class = shift; *************** *** 372,375 **** --- 381,385 ---- my $handle = Win32::GUI::LoadImage(@_); + # TODO: this gives us a bitmap object, even if we ask for a cursor! if($handle) { $self->{-handle} = $handle; *************** *** 390,393 **** --- 400,412 ---- # (@)METHOD:new Win32::GUI::Icon(FILENAME) # Creates a new Icon object reading from FILENAME. + # + # If FILENAME is a string, then it is first tried as a resource + # name, then a filename. If FILENAME is a number it is tried + # as a resource identifier. + # + # Resources are searched for in the current exe (perl.exe unless + # you have packed your application using perl2exe, PAR or similar), + # then in the Win32::GUI GUI.dll, and finally as an OEM resource + # identifier sub new { my $class = shift; *************** *** 426,429 **** --- 445,457 ---- # (@)METHOD:new Win32::GUI::Cursor(FILENAME) # Creates a new Cursor object reading from FILENAME. + # + # If FILENAME is a string, then it is first tried as a resource + # name, then a filename. If FILENAME is a number it is tried + # as a resource identifier. + # + # Resources are searched for in the current exe (perl.exe unless + # you have packed your application using perl2exe, PAR or similar), + # then in the Win32::GUI GUI.dll, and finally as an OEM resource + # identifier sub new { my $class = shift; Index: CHANGELOG =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/CHANGELOG,v retrieving revision 1.84 retrieving revision 1.85 diff -C2 -d -r1.84 -r1.85 *** CHANGELOG 16 May 2006 19:18:30 -0000 1.84 --- CHANGELOG 1 Jun 2006 19:46:11 -0000 1.85 *************** *** 6,9 **** --- 6,21 ---- Win32-GUI ChangeLog =================== + + [Robert May] : 01 June 2006 - Icon/Cursor/Bitmap enhancement + --- Win32::GUI core --- + - GUI.xs,GUI.pm enhanced LoadImage to search more files for + resources, and to allow passing a resource ID. Update + documentation for Icon, Cursor and Bitmap constructors + to reflect additions. + - samples/standard_images.pl add sample that allows browsing of + all the standard resources. + --- Win32::GUI::Constants --- + - Constants.PL add IDI_, IDC_, OBM_, OCR_ and OIC_ constants + to load pre-defined resources. + + [Robert May] : 16 May 2006 - More Win32::GUI::Constants --- Win32::GUI core --- |
|
From: Robert M. <rob...@us...> - 2006-05-30 18:21:12
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20384 Modified Files: GUI.pm Log Message: Don't let subclasses of Win32::GUI inherit Win32::GUI::import Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.44 retrieving revision 1.45 diff -C2 -d -r1.44 -r1.45 *** GUI.pm 18 May 2006 19:40:36 -0000 1.44 --- GUI.pm 30 May 2006 18:20:57 -0000 1.45 *************** *** 47,50 **** --- 47,53 ---- my @imports = @_; + # Don't let this import() get inherited + return unless $pkg eq 'Win32::GUI'; + # use Win32::GUI; currently exports a load of constants for # backwards compatibility with earlier Win32::GUI versions. |
|
From: Robert M. <rob...@us...> - 2006-05-18 19:40:42
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23518/Win32-GUI-Constants Modified Files: Constants.pm Log Message: Fix Win32::GUI::constant() to support old calling method for WIN32__GUI__ constants Index: Constants.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants/Constants.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Constants.pm 17 May 2006 22:15:02 -0000 1.3 --- Constants.pm 18 May 2006 19:40:36 -0000 1.4 *************** *** 259,263 **** *{"${callpkg}::$sym"} = \&{"${pkg}::$sym"} if $export; &{"${pkg}::$sym"} if $inline; # force AUTOLOAD ! eval "sub Win32::GUI::$sym();" if $compatibility_win32_gui; } --- 259,263 ---- *{"${callpkg}::$sym"} = \&{"${pkg}::$sym"} if $export; &{"${pkg}::$sym"} if $inline; # force AUTOLOAD ! eval "sub Win32::GUI::$sym();" if $compatibility_win32_gui; } |
|
From: Robert M. <rob...@us...> - 2006-05-18 19:40:40
|
Update of /cvsroot/perl-win32-gui/Win32-GUI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23518 Modified Files: GUI.pm Log Message: Fix Win32::GUI::constant() to support old calling method for WIN32__GUI__ constants Index: GUI.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/GUI.pm,v retrieving revision 1.43 retrieving revision 1.44 diff -C2 -d -r1.43 -r1.44 *** GUI.pm 17 May 2006 21:13:27 -0000 1.43 --- GUI.pm 18 May 2006 19:40:36 -0000 1.44 *************** *** 43,48 **** # The default exports are deprecated, and will be removed in the future sub import { - my ($callpkg, $file, $line) = caller; my $pkg = shift; my @imports = @_; --- 43,48 ---- # The default exports are deprecated, and will be removed in the future sub import { my $pkg = shift; + my $callpkg = caller; my @imports = @_; *************** *** 55,62 **** use warnings; warnings::warnif 'deprecated', ! "use Win32::GUI; is currently exporting constants into ". "the callers scope. This functionality is deprecated. ". ! "Use 'use Win32::GUI();' or list your required exports explicitly instead. ". ! "Used at $file line $line.\n"; @imports = qw(:compatibility_win32_gui); } --- 55,62 ---- use warnings; warnings::warnif 'deprecated', ! "'use Win32::GUI;' is currently exporting constants into ". "the callers scope. This functionality is deprecated. ". ! "Use 'use Win32::GUI();' or list your required exports ". ! "explicitly instead."; @imports = qw(:compatibility_win32_gui); } *************** *** 88,96 **** sub constant { my $constant = shift; - my ($callpkg, $file, $line) = caller; use warnings; warnings::warnif 'deprecated', "Use of Win32::GUI::constant() is deprecated. ". ! "Use Win32::GUI::Constants::constant() instead. ". ! "Used at $file line $line.\n"; require Win32::GUI::Constants; return Win32::GUI::Constants::constant($constant); --- 88,100 ---- sub constant { my $constant = shift; use warnings; + if($constant =~ /^WIN32__GUI__/) { + warnings::warnif 'deprecated', "Use of Win32::GUI::constant() is deprecated. ". + "Use Win32::GUI::_constant() instead for WIN32__GUI__* constants."; + return Win32::GUI::_constant($constant); + } + warnings::warnif 'deprecated', "Use of Win32::GUI::constant() is deprecated. ". ! "Use Win32::GUI::Constants::constant() instead."; require Win32::GUI::Constants; return Win32::GUI::Constants::constant($constant); *************** *** 114,119 **** use warnings; warnings::warnif 'deprecated', ! "Use of '$AUTOLOAD' is deprecated. Use 'Win32::GUI::Constants::$constant' instead. ". ! "Used at $file line $line.\n"; goto &$AUTOLOAD; } --- 118,122 ---- use warnings; warnings::warnif 'deprecated', ! "Use of '$AUTOLOAD' is deprecated. Use 'Win32::GUI::Constants::$constant' instead."; goto &$AUTOLOAD; } |
|
From: Robert M. <rob...@us...> - 2006-05-17 22:15:10
|
Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23602/Win32-GUI-Constants Modified Files: Constants.pm Log Message: Fix for backwards compatibility with CONSTNAME barewords Index: Constants.pm =================================================================== RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-Constants/Constants.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Constants.pm 17 May 2006 21:14:54 -0000 1.2 --- Constants.pm 17 May 2006 22:15:02 -0000 1.3 *************** *** 109,112 **** --- 109,113 ---- my $autoload = 0; my $oops = 0; + my $compatibility_win32_gui = 0; =head1 PRAGMATA *************** *** 197,205 **** next; } ! # :compatibility_win32_gui has very special semantics if ! # the calling package is Win32::GUI for backwards compatibility ! if (($spec eq 'compatibility_win32_gui') and (caller eq 'Win32::GUI')) { ! $pkg = 'Win32::GUI'; ! } } elsif ($spec =~ m:^/(.*)/$:){ --- 198,206 ---- next; } ! # :compatibility_win32_gui has very special semantics if ! # the calling package is Win32::GUI for backwards compatibility ! if (($spec eq 'compatibility_win32_gui') and (caller eq 'Win32::GUI')) { ! $compatibility_win32_gui = 1; ! } } elsif ($spec =~ m:^/(.*)/$:){ *************** *** 214,218 **** } ! #XXX warn "Import ".($remove ? "del":"add").": @names " if $Verbose; if ($remove) { --- 215,219 ---- } ! warn "Import ".($remove ? "del":"add").": @names " if $Verbose; if ($remove) { *************** *** 236,241 **** # export @imports to caller's namespace if($Verbose) { ! #XXX my $t = join(", ", sort @imports) . "\n" . scalar(@imports) . " symbols being "; ! my $t = scalar(@imports) . " symbols being "; $t .= "imported into $callpkg from $pkg " if $export; $t .= "and " if $export and $inline; --- 237,241 ---- # export @imports to caller's namespace if($Verbose) { ! my $t = join(", ", sort @imports) . "\n" . scalar(@imports) . " symbols being "; $t .= "imported into $callpkg from $pkg " if $export; $t .= "and " if $export and $inline; *************** *** 259,262 **** --- 259,263 ---- *{"${callpkg}::$sym"} = \&{"${pkg}::$sym"} if $export; &{"${pkg}::$sym"} if $inline; # force AUTOLOAD + eval "sub Win32::GUI::$sym();" if $compatibility_win32_gui; } |
