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 => [EMAIL PROTECTED], -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, [EMAIL PROTECTED]); $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 => [EMAIL PROTECTED], -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 => [EMAIL PROTECTED], -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.)