Hi Rob,
I am facing another problem with this code. When I call the function twice
in the same script, it throws me the following error:
Error Msg: Test[This is in Red color as expected for the first function
call]
Use of uninitialized value in bitwise and (&) at test.pl line 12.
My Script is :
#########33 START #########3
use strict;
use warnings;
use Win32::Console;
ErrorMsg('Test');
ErrorMsg('Test');
sub ErrorMsg {
my $error = shift;
my $console = Win32::Console->new(STD_OUTPUT_HANDLE);
my $CurrentConsoleColor = $console->Attr;
my $BackgroundColor = $CurrentConsoleColor &
(BACKGROUND_RED|BACKGROUND_BLUE|BACKGROUND_GREEN|BACKGROUND_INTENSITY);
# This sets the text color on DOS in red with intensity
$console->Attr(FOREGROUND_RED|FOREGROUND_INTENSITY|$BackgroundColor);
print "\nError Msg: $error \n";
$console->Attr($CurrentConsoleColor);
}
############3 END ################
I tried to delete the handle to the console but then I do not get any output
at all.
Also, in actual world my sub ErrorMsg is defined in a .pm file and this
function is called by multiple scripts and I can not get handle to win32
console in script and pass it to the module due to some project
restrictions. ALso, this error happens because I am trying to call my
$console = Win32::Console->new(STD_OUTPUT_HANDLE) twice in the same script.
Is there a way I can still call it twice in the same script?
Any help is much appreciated.
Thanks,
Jai!
On Sat, Mar 28, 2009 at 12:26 PM, Perl Help <[email protected]> wrote:
> Hi Rob,
>
> Thanks for your help. This is what I exactly wanted. Since, I just
> needed to print error message in red color and then set the text color
> back to original irrespective of the background. The following code
> works perfect:
>
> use strict;
> use warnings;
> use Win32::Console;
>
> my $console = Win32::Console->new(STD_OUTPUT_HANDLE);
> my $CurrentConsoleColor = $console->Attr;
> my $BackgroundColor = $CurrentConsoleColor &
> (BACKGROUND_RED|BACKGROUND_BLUE|BACKGROUND_GREEN|BACKGROUND_INTENSITY);
> print "\nPrior to error: \n";
> # This sets the text color on DOS in red with intensity
> $console->Attr(FOREGROUND_RED|FOREGROUND_INTENSITY|$BackgroundColor);
> print "\nError Msg: xyz \n";
> $console->Attr($CurrentConsoleColor);
> print "\nAfter error\n";
>
>
>
> On 3/28/09, Sisyphus <[email protected]> wrote:
> >
> > ----- Original Message -----
> > From: "Perl Help" <[email protected]>
> > To: <[email protected]>
> > 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
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
