Update of /cvsroot/perl-win32-gui/Win32-GUI-DIBitmap/samples
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32157/samples
Added 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:
Added to repository
--- NEW FILE: test11.pl ---
#perl -w
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromBitmap
# - CopyToDC
# - AlphaCopyToDC
# - AlphaStretchToDC
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
$dib = newFromFile Win32::GUI::DIBitmap ('bmp/zapotec.bmp') or die
"newFromFile";
$dibalpha = newFromFile Win32::GUI::DIBitmap ('bmp/small.tga') or die
"newFromFile";
print "transparent : ", $dibalpha->IsTransaparent(), "\n";
print "BPP : ", $dibalpha->GetBPP(), "\n";
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$dc = new Win32::GUI::DC ($W);
$dib->StretchToDC($dc, 10, 10, $width - 20, $height - 20);
$dibalpha->CopyToDC($dc);
$dibalpha->AlphaCopyToDC($dc, 200);
$dibalpha->AlphaStretchToDC($dc, 0, 200, 260, 200 );
}
--- NEW FILE: info.pl ---
#perl -w
use Win32::GUI::DIBitmap;
print Win32::GUI::DIBitmap::GetVersion(), "\n";
print Win32::GUI::DIBitmap::GetCopyright(), "\n";
$count = Win32::GUI::DIBitmap::GetFIFCount();
print "Format\tReading\tWriting\tDescription\n";
for ($fif = 0; $fif < $count; $fif++) {
$format = Win32::GUI::DIBitmap::GetFormatFromFIF($fif);
$desc = Win32::GUI::DIBitmap::FIFDescription($fif);
$read = "N";
$read = "Y" if (Win32::GUI::DIBitmap::FIFSupportsReading($fif));
$write = "N";
$write = "Y" if (Win32::GUI::DIBitmap::FIFSupportsWriting($fif));
$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
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromFile
# - ConvertToBitmap
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
($width, $height) = ($W->GetClientRect)[2..3];
$dib = newFromFile Win32::GUI::DIBitmap ("bmp/zapotec.jpg") or die "Load
zapotec.jpg";
$hbitmap = $dib->ConvertToBitmap();
undef $dib;
# $hbitmap = new Win32::GUI::Bitmap('bmp/zapotec.bmp') or die ("new Bitmap");
$BITMAP = $W->AddLabel (
-pos => [0 , 0],
-size => [$width, $height],
-bitmap => $hbitmap,
-name => "Bitmap",
-visible => 1,
);
$BITMAP->SetImage ($hbitmap);
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
$W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight);
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
--- NEW FILE: test1.pl ---
#perl -w
#
# 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";
$count = Win32::GUI::DIBitmap::GetFIFCount();
print "count = $count\n";
for ($i = 0; $i < $count; $i++) {
$format = Win32::GUI::DIBitmap::GetFormatFromFIF($i);
$fif = Win32::GUI::DIBitmap::GetFIFFromFormat($format);
$ext = Win32::GUI::DIBitmap::FIFExtensionList($fif);
$desc = Win32::GUI::DIBitmap::FIFDescription($fif);
$reg = Win32::GUI::DIBitmap::FIFRegExpr($fif);
$read = Win32::GUI::DIBitmap::FIFSupportsReading($fif);
$write = Win32::GUI::DIBitmap::FIFSupportsWriting($fif);
print "$i : Format = $format FIF = $fif Extention = $ext Description = $desc
RegExp = $reg Reading = $read Writing = $write\n";
}
$dib = new Win32::GUI::DIBitmap (100,100,24,255,255,255);
for ($i = 0; $i < $count; $i++) {
($ext, $misc) = split /,/, Win32::GUI::DIBitmap::FIFExtensionList($i), 2;
$f = "res$i.$ext";
$res = $dib->SaveToFile($f, $i);
print "save $f = $res\n";
unlink $f;
}
--- NEW FILE: test13.pl ---
#perl -w
#
# Test with Win32::GUI and GD
#
# Functions Test :
# - newFromGD
# - CopyFromGD
# - StretchToDC
use GD;
use Win32::GUI;
use Win32::GUI::DIBitmap;
# create a new image
$im = new GD::Image(100,100);
# allocate some colors
$white = $im->colorAllocate(255,255,255);
$black = $im->colorAllocate(0,0,0);
$red = $im->colorAllocate(255,0,0);
$blue = $im->colorAllocate(0,0,255);
$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);
$color = 0;
# Allocate a DIBitmap and copy GD image (no inflate/deflate)
$dib = newFromGD Win32::GUI::DIBitmap ($im) or die "newFromData";
$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();
sub Window_Resize {
($width, $height) = ($W->GetClientRect)[2..3];
$W->BtnColor->Resize($width, 20);
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$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: test2.pl ---
#perl -w
#
# Test standalone : Load and save in different format
#
# Functions Test :
# - GetVersion
# - GetCopyright
# - newFromFile
# - SaveToFile
#
use Cwd;
use Win32::GUI::DIBitmap;
print Win32::GUI::DIBitmap::GetVersion(), "\n";
print Win32::GUI::DIBitmap::GetCopyright(), "\n";
$dir_in = cwd();
$dir_in .= "/bmp/";
$dir_in =~ tr/\//\\/;
$dir_out = cwd();
$dir_out .= "/";
$dir_out =~ tr/\//\\/;
chdir $dir_in;
opendir (REP, $dir_in) or die "error opendir";
@Fichier = grep { -f $_ } readdir (REP);
closedir (REP);
$i = 0;
foreach $fichier (@Fichier) {
$i ++;
print $dir_in.$fichier, "\n";
$dib = Win32::GUI::DIBitmap->newFromFile ($dir_in.$fichier);
if (defined $dib) {
$f = $dir_out.$i.".bmp";
$dib->SaveToFile($f);
undef $dib;
}
}
--- NEW FILE: test7.pl ---
#perl -w
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromBitmap
# - StretchToDC
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
$dib = newFromFile Win32::GUI::DIBitmap ('bmp/zapotec.bmp') or die
"newFromFile";
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$dc = new Win32::GUI::DC ($W);
$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);
}
--- NEW FILE: demo2.pl ---
#perl -w
#######################################################################
#
# Perl Image Viewer
#
#######################################################################
use strict;
use Cwd;
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 (
Win32::GUI::Graphic->new ($Window,
-name => "Graphic",
-pos => [0, 0],
-size => [$Window->ScaleWidth,$Window->ScaleHeight],
);
$Window->Show();
Win32::GUI::Dialog();
#######################################################################
#
# PIV Functions
#
#######################################################################
sub PIVInit {
#
# Init PIVLoadFilter and PIVSaveFilter
#
my %ReadFilter;
my $count = Win32::GUI::DIBitmap::GetFIFCount();
my $liste = "";
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;
$liste .= ";$ext";
}
}
$ReadFilter {"All PIV Files"} = $liste;
foreach my $i (sort keys %ReadFilter) {
push @PIVReadFilter, $i, $ReadFilter{$i};
}
#
# init PIVDirectory
#
$PIVDirectory = cwd();
$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);
}
sub FileExit_Click {
return PIVFinish();
}
--- NEW FILE: test8.pl ---
#perl -w
#
# Test with Win32::GUI and GD
#
# Functions Test :
# - newFromData
# - StretchToDC
use GD;
use Win32::GUI;
use Win32::GUI::DIBitmap;
# create a new image
$im = new GD::Image(100,100);
# allocate some colors
$white = $im->colorAllocate(255,255,255);
$black = $im->colorAllocate(0,0,0);
$red = $im->colorAllocate(255,0,0);
$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);
$dib = newFromData Win32::GUI::DIBitmap ($im->png) or die "newFromData";
undef $im;
$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();
sub Window_Resize {
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$dc = new Win32::GUI::DC ($W);
$dib->StretchToDC($dc, 0, 0, $width, $height);
}
--- NEW FILE: zipimage.PL ---
#perl -v
#
# Load image from a zip file.
#
use Win32::GUI;
use Win32::GUI::DIBitmap;
use Archive::Zip;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap load from a zipfile",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
($width, $height) = ($W->GetClientRect)[2..3];
# Open Zipfile
$zip = Archive::Zip->new( 'zapotec.zip' ) or die "ZipFile";
# Open image file in zipfile
$member = $zip->memberNamed( 'Zapotec.JPG' ) or die "member ZipFile";
# Load data image in memory
$data = $member->contents();
# Load data immage in a dibbitmap
$dib = newFromData Win32::GUI::DIBitmap ($data) or die "Load zapotec.jpg";
$hbitmap = $dib->ConvertToBitmap();
undef $member;
undef $zip;
undef $data;
undef $dib;
$BITMAP = $W->AddLabel (
-pos => [0 , 0],
-size => [$width, $height],
-bitmap => $hbitmap,
-name => "Bitmap",
-visible => 1,
);
$BITMAP->SetImage ($hbitmap);
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
$W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight);
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
--- NEW FILE: test10.pl ---
#perl -w
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromWindow
# - SaveToFile
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test : newFromWindow",
-pos => [100, 100],
-size => [200, 200],
-name => "Window",
) or die "new Window";
$button = $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();
sub Window_Terminate {
-1
}
sub Capture1_Click {
my $dib = newFromWindow Win32::GUI::DIBitmap ($button) or die "newFromWindow";
$dib->SaveToFile ('button0.bmp');
}
sub Capture2_Click {
my $dib = newFromWindow Win32::GUI::DIBitmap ($W) or die "newFromWindow";
$dib->SaveToFile ('window0.bmp');
$dib = newFromWindow Win32::GUI::DIBitmap ($W, 1) or die "newFromWindow";
$dib->SaveToFile ('window1.bmp');
}
sub Capture3_Click {
my $hwnd = Win32::GUI::GetDesktopWindow();
my $dib = newFromWindow Win32::GUI::DIBitmap ($hwnd) or die "newFromWindow";
$dib->SaveToFile ('screen.bmp');
$dib->SaveToFile ('screen.png');
$dib->SaveToFile ('screen.jpg');
$dib->SaveToFile ('screen.tif');
}
--- NEW FILE: test5.pl ---
#perl -w
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromBitmap
# - ConvertToBitmap
# - ConvertTo24Bits
# - SaveToFile with fif and flag
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
($width, $height) = ($W->GetClientRect)[2..3];
$hbitmap = new Win32::GUI::Bitmap('bmp/zapotec.bmp') or die ("new Bitmap");
$dib = newFromBitmap Win32::GUI::DIBitmap ($hbitmap) or die "newFromBitmap";
undef $hbitmap;
$hbitmap = $dib->ConvertToBitmap() or die "ConvertToBitmap";
$dib->SaveToFile ("test5_1.jpg", FIF_JPEG, JPEG_QUALITYSUPERB ) or die
"SaveToFile";
$dib->SaveToFile ("test5_2.jpg", FIF_JPEG, JPEG_QUALITYGOOD ) or die
"SaveToFile";
$dib->SaveToFile ("test5_3.jpg", FIF_JPEG, JPEG_QUALITYNORMAL ) or die
"SaveToFile";
$dib->SaveToFile ("test5_4.jpg", FIF_JPEG, JPEG_QUALITYAVERAGE) or die
"SaveToFile";
$dib->SaveToFile ("test5_5.jpg", FIF_JPEG, JPEG_QUALITYBAD ) or die
"SaveToFile";
undef $dib;
$BITMAP = $W->AddLabel (
-pos => [0 , 0],
-size => [$width, $height],
-bitmap => $hbitmap,
-name => "Bitmap",
-visible => 1,
);
$BITMAP->SetImage ($hbitmap);
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
$W->Bitmap->Resize($W->ScaleWidth, $W->ScaleHeight);
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
--- NEW FILE: test12.pl ---
#perl -w
#
# Test with Win32::GUI and Multi-Page system
#
# Functions Test :
# - newFromFile
# - AppendPage
# - GetPageCount
# - LockPage
# - UnlockPage
# - GetLockedPageNumbers
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
($width, $height) = ($W->GetClientRect)[2..3];
# Create a MDIB bitmap
$mdib = new Win32::GUI::MDIBitmap ("mdib.tiff", FIF_TIFF,) or die "new";
for $i (1..5) {
my $dib = newFromFile Win32::GUI::DIBitmap ("bmp/$i.bmp");
$mdib->AppendPage ($dib);
}
undef $mdib;
# Load a MDIB bitmap
$mdib = newFromFile Win32::GUI::MDIBitmap ("mdib.tiff") or die "newFromFile";
print "Nb page :", $mdib->GetPageCount(), "\n";
my $i = 0;
$Button = $W->AddButton (
-name => "Button",
-text => "Next",
-visible => 1,
-pos => [0 , 0],
);
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Button_Click {
$i = $i + 1;
$i = 0 if ($i >= $mdib->GetPageCount());
print "Current page :", $i, "\n";
Paint();
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$dc = new Win32::GUI::DC ($W);
my $dib = $mdib->LockPage($i);
print $mdib->GetLockedPageNumbers(), "\n";
$dib->AlphaCopyToDC($dc, 50, 50);
$dib->SaveToFile ("test.bmp");
$mdib->UnlockPage($dib);
}
--- NEW FILE: INFO2.PL ---
# perl -v
#
# Chech 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";
$count = Win32::GUI::DIBitmap::GetFIFCount();
print "Format\tWriting info\n";
$dib1 = new Win32::GUI::DIBitmap (100,100,1);
$dib4 = new Win32::GUI::DIBitmap (100,100,4);
$dib8 = new Win32::GUI::DIBitmap (100,100,8);
$dib16 = new Win32::GUI::DIBitmap (100,100,16);
$dib24 = new Win32::GUI::DIBitmap (100,100,24);
$dib32 = new Win32::GUI::DIBitmap (100,100,32);
$f = "tmp";
for ($fif = 0; $fif < $count; $fif++) {
$format = Win32::GUI::DIBitmap::GetFormatFromFIF($fif);
$desc = Win32::GUI::DIBitmap::FIFDescription($fif);
if (Win32::GUI::DIBitmap::FIFSupportsWriting($fif)) {
$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
#
# Test some effects
#
use strict;
use Win32::GUI;
use Win32::GUI::DIBitmap;
my $Menu = Win32::GUI::MakeMenu(
"&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();
sub Window_Terminate {
return -1;
}
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 ('bmp/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 ('bmp/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
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromDC
# - SaveToFile
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test: NewFromDC",
-pos => [100, 100],
-size => [200, 200],
-name => "Window",
) or die "new Window";
$button = $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();
sub Window_Terminate {
-1
}
sub Capture1_Click {
my $dc = new Win32::GUI::DC ($W);
my $dib = newFromDC Win32::GUI::DIBitmap ($dc, 20, 40, $button->Width(),
$button->Height()) or die "newFromDC";
$dib->SaveToFile ('button.bmp');
}
sub Capture2_Click {
my $dc = new Win32::GUI::DC ($W);
my $dib = newFromDC Win32::GUI::DIBitmap ($dc) or die "newFromDC";
$dib->SaveToFile ('window.bmp');
}
sub Capture3_Click {
my $dc = new Win32::GUI::DC ('DISPLAY');
my $dib = newFromDC Win32::GUI::DIBitmap ($dc) or die "newFromDC";
$dib->SaveToFile ('screen.jpg');
}
--- NEW FILE: test3.pl ---
#perl -w
#
# Test standalone :
#
# Functions Test :
# - newFromFile
# - GetFIFCount
# - FIFSupportsWriting
# - FIFSupportsReading
# - SaveToData
# - newFromData
# - SaveToFile
use Win32::GUI::DIBitmap;
$dib = Win32::GUI::DIBitmap->newFromFile ("bmp/zapotec.jpg") or die "Load
zapotec.jpg";
$dib = $dib->ConvertTo24Bits();
for ($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) {
$format = Win32::GUI::DIBitmap::GetFormatFromFIF($i);
print "Test format = $format\n";
$data = $dib->SaveToData($i) or die " SaveToData $i $format";
$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 Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-pos => [100, 100],
-size => [400, 400],
-name => "Window",
);
$dib = newFromFile Win32::GUI::DIBitmap ('bmp\Zapotec.jpg');
$hbitmap = $dib->ConvertToBitmap();
undef $dib;
$W->AddButton (
-pos => [100, 100],
-size => [200, 200],
-bitmap => $hbitmap,
-name => "Button",
-visible => 1,
);
$W->Show();
Win32::GUI::Dialog();
sub Window_Terminate { -1 }
--- NEW FILE: test15.pl ---
#perl -w
#
# Test with Win32::GUI
#
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
$dib = newFromFile Win32::GUI::DIBitmap ('bmp/zapotec.bmp') or die
"newFromFile";
$bcolor = $dib->HasBackgroundColor();
print "hascolor = $bcolor\n";
$color = $dib->GetPixel(10,10);
$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";
@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();
sub Window_Resize {
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($width, $height) = ($W->GetClientRect)[2..3];
$dc = new Win32::GUI::DC ($W);
$dib->StretchToDC($dc, 0, 0, $width, $height);
}
--- NEW FILE: piv.pl ---
#perl -v
#######################################################################
#
# Perl Image Viewer
#
#######################################################################
use strict;
use Cwd;
use Win32::GUI;
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 (
Win32::GUI::Graphic->new ($Window,
-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 => 200,
-name => "WProp",
);
$WProp->AddLabel (
-name => "pFile",
-text => "File :",
-pos => [10, 25],
-size => [280, 20]
);
$WProp->AddLabel (
-name => "pWidth",
-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 => [125, 125],
);
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 $liste = "";
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;
$liste .= ";$ext";
}
if (Win32::GUI::DIBitmap::FIFSupportsWriting($fif)) {
$SaveFilter {"$desc"} = $ext;
}
}
# $ReadFilter {"All PIV Files"} = $liste;
push @PIVReadFilter, "All PIV Files", $liste;
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 = cwd();
$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 ", "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) {
$PIVFile = $ret;
$ret = $PIVDib->SaveToFile ($PIVFile);
unless ($ret) {
Win32::GUI::MessageBox (0, "ERROR : SaveToFile ", "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);
}
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
#
# Test with Win32::GUI
#
# Functions Test :
# - newFromBitmap
# - CopyToDC
use Win32::GUI;
use Win32::GUI::DIBitmap;
$W = new Win32::GUI::Window (
-title => "Win32::GUI::DIBitmap test",
-left => 100,
-top => 100,
-width => 400,
-height => 400,
-name => "Window",
) or die "new Window";
$dib = newFromFile Win32::GUI::DIBitmap ('bmp/zapotec.bmp') or die
"newFromFile";
$W->Show();
Win32::GUI::Dialog();
sub Window_Resize {
Paint();
}
sub Window_Activate {
Paint();
}
sub Window_Terminate {
$W->PostQuitMessage(0);
}
sub Paint {
($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);
}
