#!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; }