> Here's a quick hack of Aldo's frm2pl.pl with the ClientHeight,
> ClientLeft, etc. stuff fixed. It also generates skeleton event procedures
> for each control. Feel free to add all the fancy stuff ;o)
> [[ VBFRM2PL.PL : 4389 in VBFRM2PL.PL ]]
> SThetaan O'Halpin
Thanks, I've tried it and it gives much better results :-)
There is one thing though.
It failed for me because it didn't understand the comments that may
be present even in the form desing description !
If all you want is to strip these comments all you need to do is to
add
$LINE =~ s/^([^"]*(?:"[^"]*")*[^"]*)'(.*)$/$1/;
between the two $LINE =~ s/... statements on lines 87 and 88.
If you want to include the comments in the generated code you need to
do a few more changes. I attach the modified script.
All added or modified lines are taged by #<???>
Jenda
================ [EMAIL PROTECTED] ================
The phenomenon of UFO doesn't say anything about
the presence of intelligence in the space.
It just shows how rare is it here on the earth.
A.C.Clarke
#
# vbfrm2pl.pl
#
# Adapted from Aldo Calpini's frm2pl.pl
#
#!perl -w
use strict;
my %controls;
my $StandardHeader = "\nuse Win32::GUI;\n\n";
my $TitleBarHeight = 405;
my $file = shift or die "No file specified";
my $twip = shift;
frm2pl($file, $twip);
#
# Generic events (all controls)
#
my @events = qw(
Click
RightClick
DblClick
DblRightClick
GotFocus
LostFocus
);
#
# Set up default handlers
# Don't do anything - just trace to STDERR
#
for my $ctl (sort keys %controls)
{
print "#\n# $ctl\t$controls{$ctl}\n#\n";
for my $event (@events)
{
eventproc($ctl, $event);
}
if($controls{$ctl} eq 'Textfield')
{
eventproc($ctl, 'Change');
}
}
sub eventproc
{
my $ctl = shift;
my $event = shift;
print <<EOD;
sub ${ctl}_${event}
{
print STDERR "${ctl}_${event}\\n";
return 1;
}
EOD
}
#
#
#
sub frm2pl
{
my($file, $twip) = @_;
my $doing = "nothing";
my @words;
my ($one, $two, $three, $four); #<???>
my $FormName;
my $LINE;
$twip = 15 unless $twip;
print $StandardHeader;
if(open(FRM, $file))
{
while($LINE = <FRM>)
{
#
chomp $LINE;
$LINE =~ s/^\s*//;
$LINE =~ s/^([^"]*(?:"[^"]*")*[^"]*)'(.*)$/$1/;$four = $2;
#<???>
$LINE =~ s/\s*$//;
($one, $two, $three) = split(/\s+/, $LINE, 3);
if($one =~ /^BEGIN$/i)
{
if($two =~ /^VB\.FORM$/i)
{
$FormName = $three;
print "\$$FormName = new
Win32::GUI::Window(\n";
print "\t-name\t=> \"$FormName\",\n";
$doing = "form";
}
elsif($two =~ /^VB\.COMMANDBUTTON$/i)
{
print_ctl("Button");
}
elsif($two =~ /^VB\.TEXTBOX$/i)
{
print_ctl("Textfield");
}
elsif($two =~ /^VB\.CHECKBOX$/i)
{
print_ctl("Checkbox");
}
elsif($two =~ /^VB\.LABEL$/i)
{
print_ctl("Label");
}
elsif($two =~ /^VB\.LISTBOX$/i)
{
print_ctl("Listbox");
}
elsif($two =~ /^VB\.OPTIONBUTTON$/i)
{
print_ctl("RadioButton");
}
elsif($two =~ /^COMCTLLIB\.TREEVIEW$/i)
{
print_ctl("TreeView");
}
elsif($two =~ /^COMCTLLIB\.IMAGELIST/i)
{
print_ctl("ImageList");
}
elsif($two =~ /^COMCTLLIB\.STATUSBAR/i)
{
print_ctl("StatusBar");
}
else
{
print ");\n" if $doing ne "nothing";
$doing = "nothing";
}
}
else
{
if($doing ne "nothing")
{
if($one =~ /^END$/i)
{
print ");\n";
$doing = "nothing";
}
elsif(index("_LEFTTOPWIDTHHEIGHT", uc($one)) >
0 and $two eq "=")
{
print "\t-", lc($one), "\t=> ",
int($three / $twip), ",\n";
}
elsif($one =~ /Client(Left|Top|Width|Height)/
and $two eq "=")
{
#
# VB stores only the Client area size,
so we have to use that
# plus the height of the title bar
(405) to get real height
#
my ($temp) = $one =~
m/Client(Left|Top|Width|Height)/;
print "\t-", lc($temp), "\t=> ",
int(($three + (uc($temp) eq 'HEIGHT' ? $TitleBarHeight : 0))/ $twip), ",\n";
#
# NOTE: Width does not come out right
yet - seems to lose a little in translation
#
}
elsif(index("_VISIBLE", uc($one)) > 0 and $two
eq "=")
{
print "\t-visible\t=> ", $three, ",\n";
}
elsif(index("_CAPTIONTEXT", uc($one)) > 0 and
$two eq "=")
{
print "\t-text\t=> ",
quoteforperl((split(/\s*=\s*/, $LINE, 2))[1]), ",\n";
}
#
# Text boxes
#
elsif(uc($one) eq "PASSWORDCHAR" and $two eq
"=")
{
print "\t-password\t=> 1,\n";
}
else #<???>
{ #<???>
undef $four; #<???>
} #<???>
} else { #<???>
undef $four; #<???>
} #<???>
}
print "\t\t# $four\n" if $four; #<???>
}
close(FRM);
if($FormName)
{
print "\n\$$FormName->Show;\n";
print "Win32::GUI::Dialog();\n\n";
}
eventproc($FormName, 'Activate');
eventproc($FormName, 'Deactivate');
eventproc($FormName, 'Resize');
print <<_END_;
sub ${FormName}_Terminate
{
print STDERR "${FormName}_Terminate\n";
return -1;
}
_END_
}
else
{
warn "Can't open file $file: $!\n";
return 0;
}
return 1;
sub print_ctl
{
my($ctl) = @_;
$controls{$three} = $ctl;
print ");\n" if $doing eq "form";
print "\$$three = \$$FormName->Add$ctl(\n";
print "\t-name\t=> \"$three\",\n";
$doing = $ctl;
}
}
sub quoteforperl
{
my($what) = @_;
$what =~ s/\$/\\\$/g;
$what =~ s/\@/\\\@/g;
$what =~ s/\%/\\\%/g;
return $what;
}
