----- Original Message -----
From: "Perl Help" <perlhel...@gmail.com>
To: <perl-win32-users@listserv.ActiveState.com>
Sent: Friday, March 27, 2009 7:00 AM
Subject: Reset in ANSIColor sets the background to black
> Hi,
>
> My current DOS background color is white with Black text. I use ANSIColor
> module to print error messages in Red color. I use the Color command and I
> face two issues:
>
> 1. The Red color error message text thats printed on DOS has black
> background, instead of white only.
> 2. On typing CLS the background color changes to black and text color
> changes to white.
>
> What is my Expectation:
> 1. On prinitng the text in red color should not have the background color
> black but use the current DOS background color(White in my case).
>
> 2. On doing CLS on DOS, the dos should maintain its background color(White
> in my case) rather then setting it to default black background color.
>
> My Code:
> use Win32::Console::ANSI;
> use Term::ANSIColor;
> print color "Bold Red";
> print "ERROR_MSG = xyz";
> print color 'reset';
>
> Any help is much appreciated.
You might also look at Win32::Console and Win32::ANSIScreen. Between those
modules and the ones you've already loaded you might be able to get the job
done.
For example, with Win32::Console, you can get the current color attributes:
use warnings;
use Win32::Console;
$c = new Win32::Console STD_OUTPUT_HANDLE;
$c->Alloc();
$attr = $c->Attr();
print $attr, "\n";
Faik, you can also get the current attributes using Win32::Console::ANSI -
but I couldn't quickly see from the documentation how that could be done.
But Win32::Console::ANSI seems to clobber the handle (I had difficulty
finding a way to reset the colors back to the original), and I got sick of
trying to find a way to get it all to work nicely. In the end, I re-invented
the wheel using Inline::C and it works fine:
#####################################
use warnings;
use strict;
use Inline C => Config =>
BUILD_NOISY => 1;
use Inline C => <<'EOC';
SV * get_handle() {
return newSVuv((HANDLE)GetStdHandle(STD_OUTPUT_HANDLE));
}
SV * get_attr(SV * h) {
CONSOLE_SCREEN_BUFFER_INFO Info;
if(!GetConsoleScreenBufferInfo((HANDLE)SvUV(h), &Info))
croak("Error obtaining current attributes");
return newSVuv(Info.wAttributes);
}
void set_attr(SV * h, SV * attr) {
if(!SetConsoleTextAttribute((HANDLE)SvUV(h), (WORD)SvUV(attr)))
croak("Error setting attributes");
}
EOC
use constant {
FOREGROUND_BLUE => 1,
FOREGROUND_GREEN => 2,
FOREGROUND_RED => 4,
FOREGROUND_INTENSITY => 8,
BACKGROUND_BLUE => 16,
BACKGROUND_GREEN => 32,
BACKGROUND_RED => 64,
BACKGROUND_INTENSITY => 128};
$| = 1;
my $h = get_handle();
my $current = get_attr($h);
my $current_background = $current & (BACKGROUND_RED | BACKGROUND_BLUE
| BACKGROUND_GREEN | BACKGROUND_INTENSITY);
# $current_foreground not needed in this script
my $current_foreground = $current & (FOREGROUND_RED | FOREGROUND_BLUE
| FOREGROUND_GREEN | FOREGROUND_INTENSITY);
# Set $message to intense red on current background
my $message = FOREGROUND_RED | FOREGROUND_INTENSITY |
$current_background;
set_attr($h, $message);
print "ERROR_MSG = xyz";
# Restore original foreground/background colours.
set_attr($h, $current);
print "\n All Done\n";
#####################################
Of course, you'll need a compiler and make utility. Running 'ppm install
MinGW' will take care of that for you - it will provide you with the MinGW
port of gcc and dmake. Then install Inline::C using that compiler and make
utility, and away you go. (Don't 'ppm install Inline-C'.)
Cheers,
Rob
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
