The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl -w
use strict;

my $file = shift or die "No file specified";

my $twip = shift;

frm2pl($file, $twip);

sub frm2pl {
    my($file, $twip) = @_;
    my $doing = "nothing";
    my @words;
    my ($one, $two, $three);
    my $FormName;
    my $LINE;
    $twip = 15 unless $twip;
    
    print "\nuse Win32::GUI;\n\n";

    if(open(FRM, $file)) {
        while($LINE = <FRM>) {
            chomp $LINE;
            $LINE =~ s/^\s*//;
            $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 => \"$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), " => ", int($three / $twip), ",\n";
                    } elsif(index("_VISIBLE", uc($one)) > 0 and $two eq "=") {
                        print "\t-visible => ", $three, ",\n";
                    } elsif(uc($one) eq "CAPTION" and $two eq "=") {
                        print "\t-text => quoteforperl((split(/\s*=\s*/, $LINE, 2))[1]),\n";
                    }
                }
            }

        }
        close(FRM);
        if($FormName) {
            print "\n\$$FormName->Show;\n";
            print "Win32::GUI::Dialog();\n\n";
        }

        print <<_END_;

sub ${FormName}_Terminate {
    return -1;
}

_END_

    } else {
        warn "Can't open file $file: $!\n";
        return 0;
    }
    return 1;

sub print_ctl {
    my($ctl) = @_;
    print ");\n" if $doing eq "form";
    print "\$three = \$$FormName->Add$ctl(\n";
    print "\t-name => \"$three\",\n";
    $doing = $ctl;
}


}

sub quoteforperl {
    my($what) = @_;
    $what =~ s/\$/\\\$/g;
    $what =~ s/\@/\\\@/g;
    $what =~ s/\%/\\\%/g;
    return $what;
}