chres.pl

# chres.pl - change the resolution of the screen
#
# This script was written by Aldo Calpini (dada@perl.it) in 2001.
# It is released into the public domain.  You may use it freely, however,
# if you make any modifications and redistribute, please list your name
# and describe the changes. This script is distributed without any warranty,
# express or implied.

use Win32::API 0.20;
use Getopt::Mixed;

my $VERSION = '0.51';

# the required APIs
my $EnumDisplaySettings = new Win32::API("user32", "EnumDisplaySettings", "PNP", "N");
my $ChangeDisplaySettings = new Win32::API("user32", "ChangeDisplaySettings", "PN", "N");
my $CreateDC      = new Win32::API("gdi32", "CreateDC",      "PPPP", "N");
my $GetDeviceCaps = new Win32::API("gdi32", "GetDeviceCaps", "NN",   "N");
my $DeleteDC      = new Win32::API("gdi32", "DeleteDC",      "N",    "V");

# process command line options
Getopt::Mixed::getOptions qw(
    help h>help ?>help
    quiet q>quiet
    test t>test
    list l>list
    info i>info
    permanent p>permanent
    global g>global
    reset r>reset
    x=i
    y=i
    colordepth=s c>colordepth
    frequency=i f>frequency
);

# beautify list for BPPs
my %colors = (
    4  => "16 Colors",
    8  => "256 Colors",
    16 => "High Color",
    24 => "True Color",
    32 => "True Color",
);

$opt_colordepth = color2bpp($opt_colordepth) if $opt_colordepth;

# process non-options on command line
$doing = "x";
while (@ARGV) {
    $argv = shift @ARGV;
    if ($doing eq "x") {
        if ($argv =~ /(\d+)x(\d+)/i) {
            $opt_x = $1;
            $opt_y = $2;
            $doing = "colordepth";
        }
        else {
            $opt_x = $argv;
            $doing = "y";
        }
    }
    elsif ($doing eq "y") {
        $opt_y = $argv;
        $doing = "colordepth";
    }
    elsif ($doing eq "colordepth") {
        $opt_colordepth = color2bpp($argv);
        $doing          = "frequency";
    }
    elsif ($doing eq "frequency") {
        $opt_frequency = $argv;
        $doing         = "skip";
    }
}

if ($opt_test) {
    $flag = 0x02;
}
elsif ($opt_permanent) {
    $flag = 0x01;
}
elsif ($opt_global) {
    $flag = 0x08;
}
else {
    $flag = 0;
}

if ($opt_help) {
    display_help();
    exit();
}

if ($opt_reset) {
    $res = $ChangeDisplaySettings->Call(0, 0);
    print "Default mode restored.\n" unless $opt_quiet;
    exit($res);
}

if ($opt_info) {
    ($X, $Y, $BPP, $HZ) = getres();
    printf "%dx%d %s (%d Bit) %dHz\n", $X, $Y, $colors{$BPP}, $BPP, $HZ unless $opt_quiet;
    exit();
}

if ($opt_list) {
    exit(list_modes($opt_x, $opt_y, $opt_colordepth, $opt_frequency));
}

if (    not defined $opt_x
    and not defined $opt_y
    and not defined $opt_colordepth
    and not defined $opt_frequency)
{
    if (not $opt_quiet) {
        print "Nothing to do.\n";
        print "Type $0 --help for more information.\n";
    }
    exit();
}

$res = chres($opt_x, $opt_y, $opt_colordepth, $opt_frequency, $flag);

unless ($opt_quiet) {
    if ($res == 0) {
        if   ($opt_test) { print "Test successful.\n"; }
        else             { print "Mode changed.\n"; }
    }
    if ($res == 1) { print "The computer must be restarted.\n"; }
    if ($res == -1) {
        print "The display driver failed the specified graphics mode.\n";
    }
    if ($res == -2) { print "The graphics mode is not supported.\n"; }
    if ($res == -3) { print "Unable to write settings to the registry.\n"; }
    if ($res == -4) { print "Invalid parameters.\n"; }
    if ($res == -5) { print "Invalid parameters.\n"; }
}
exit($res);

sub chres {
    my ($wanted_X, $wanted_Y, $wanted_BPP, $wanted_HZ, $flags) = @_;

    $flags = 0 unless defined $flags;

    my ($actual_X, $actual_Y, $actual_BPP, $actual_HZ) = @_;
    if (   not defined $wanted_X
        or not defined $wanted_X
        or not defined $wanted_BPP
        or not defined $wanted_HZ)
    {
        ($actual_X, $actual_Y, $actual_BPP, $actual_HZ) = getres();
    }

    my $wanted;
    $wanted = ((defined $wanted_X) ? $wanted_X : $actual_X);
    $wanted .= "," . ((defined $wanted_Y)   ? $wanted_Y   : $actual_Y);
    $wanted .= "," . ((defined $wanted_BPP) ? $wanted_BPP : $actual_BPP);
    $wanted .= "," . ((defined $wanted_HZ)  ? $wanted_HZ  : $actual_HZ);

    my $devmode = init_devmode();
    my $newmode = undef;
    my $i       = 0;
    my $res     = $EnumDisplaySettings->Call(0, $i, $devmode);
    while ($res != 0) {
        ($BPP, $X, $Y, undef, $HZ) = unpack("x104 LLLLL", $devmode);
        $mode = "$X,$Y,$BPP,$HZ";
        if ($mode eq $wanted) {
            $newmode = $devmode;
            last;
        }
        $res = $EnumDisplaySettings->Call(0, ++$i, $devmode);
    }

    if (defined $newmode) {
        $res = $ChangeDisplaySettings->Call($newmode, $flags);
    }
    else {
        $res = -2;
    }
    return $res;
}

sub getres {
    my $hdc = $CreateDC->Call("DISPLAY", 0, 0, 0);
    if (!$hdc) {
        return undef;
    }
    my $HORZRES   = 8;
    my $VERTRES   = 10;
    my $BITSPIXEL = 12;
    my $VREFRESH  = 116;

    my $X   = $GetDeviceCaps->Call($hdc, $HORZRES);
    my $Y   = $GetDeviceCaps->Call($hdc, $VERTRES);
    my $BPP = $GetDeviceCaps->Call($hdc, $BITSPIXEL);
    my $HZ  = $GetDeviceCaps->Call($hdc, $VREFRESH);

    $DeleteDC->Call($hdc);
    return ($X, $Y, $BPP, $HZ);
}

sub list_modes {
    my ($wanted_X, $wanted_Y, $wanted_BPP, $wanted_HZ) = @_;

    my $modes   = 0;
    my $devmode = init_devmode();
    my $i       = 0;
    my $res     = $EnumDisplaySettings->Call(0, $i, $devmode);
    while ($res != 0) {
        ($BPP, $X, $Y, undef, $HZ) = unpack("x104 LLLLL", $devmode);

        if (    (not defined $wanted_X or $wanted_X == $X)
            and (not defined $wanted_Y   or $wanted_Y == $Y)
            and (not defined $wanted_BPP or $wanted_BPP == $BPP)
            and (not defined $wanted_HZ  or $wanted_HZ == $HZ))
        {
            printf "%dx%d %s (%d Bit) %dHz\n", $X, $Y, $colors{$BPP}, $BPP, $HZ
                unless $opt_quiet;
            $modes++;
        }
        $res = $EnumDisplaySettings->Call(0, ++$i, $devmode);
    }
    print "No matching graphics modes.\n" if not $opt_quiet and $modes == 0;
    return $modes;
}

sub init_devmode {
    return pack(
        "B" x 32 . "SSSSLsssssssssssss" . "B" x 32 . "SLLLLL",
        (0 x 32),    # dmDeviceName
        0,           # dmSpecVersion
        0,           # dmDriverVersion
        124,         # dmSize
        0,           # dmDriverExtra
        0,           # dmFields
        0,           # dmOrientation
        0,           # dmPaperSize
        0,           # dmPaperLength
        0,           # dmPaperWidth
        0,           # dmScale
        0,           # dmCopies
        0,           # dmDefaultSource
        0,           # dmPrintQuality
        0,           # dmColor
        0,           # dmDuplex
        0,           # dmYResolution
        0,           # dmTTOption
        0,           # dmCollate
        (0 x 32),    # dmFormName
        0,           # dmLogPixels
        0,           # dmBitsPerPel
        0,           # dmPelsWidth
        0,           # dmPelsHeight
        0,           # dmDisplayFlags
        0,           # dmDisplayFrequency
    );
}

sub color2bpp {
    my ($arg) = shift;
    $arg = lc $arg;
    my %table = (
        1     => 1,
        2     => 2,
        16    => 4,
        256   => 8,
        65000 => 16,
        '64k' => 16,
        '65k' => 16,
        high  => 16,
        '16m' => 24,
        true  => 32,
    );
    if ($arg =~ /^(\d+)b$/) {
        return $1;
    }
    elsif (exists $table{$arg}) {
        return $table{$arg};
    }
}

sub display_help {

    print qq(
$0 version $VERSION, (c) 2001 Aldo Calpini <dada\@perl.it>

usage: $0 [OPTIONS] [NNNxNNN] [COLORS] [FREQ]

OPTIONS:
    --help              shows this help
    --x NNN             width, in pixels
    --y NNN             height, in pixels
    --colordepth COLORS color depth (see below)
    --frequency NNN     vertical refresh rate, in Hz (only WinNT/2000)
    --quiet             does not display information on STDOUT
    --reset             reset the screen to the default mode
    --info              isplay the current mode and exit
    --list              list the available modes. can be combined with
                        --x, --y, --colordepth and --frequency, for 
                        example: '--x 1024 --list' lists all the
                        modes with width of 1024 pixels
    --test              test the given mode without making changes
    --permanent         make change permanent (for the current user)
    --global            make change permanent and global (for all
                        users) (only WinNT/2000)

all options can be given in the short form too (eg. -t for --test,
-h for --help, -x for --x and so on).

COLORS:
    recognized values are:
        1, 2, 1b              >   2 colors (1 bpp)
        16, 4b                =>  16 colors (4 bpp)
        256, 8b               =>  256 colors (8 bpp)
        65000, 64k, high, 16b =>  65536 colors (16 bpp)
        16m, true, 32b        =>  16 millions colors (32 bpp)

the --x, --y, --colordepth and --frequency options can also be
given on command line without introduction, but in this case
order must be respected. for example, to change to a 800x600
screen resolution:
    $0 800x600
or  $0 800 600

to change to 800x600, 32bpp, 85Hz:
    $0 800 600 32 85
    
);
}

=head1 NAME

chres - CHange RESolution

=head1 DESCRIPTION

Change the resolution of the screen on a Windows machine.
Launch the script with the --help option for a detailed
description of the usage.

=head1 README

Change the resolution of the screen on a Windows machine.

=head1 PREREQUISITES

This script requires C<Win32::API 0.20> and C<Getopt::Mixed>.

=pod OSNAMES

MSWin32

=pod SCRIPT CATEGORIES

Win32
Win32/Utilities

=head1 AUTHOR

Aldo Calpini (dada@perl.it).

=cut