RE: [perl-win32-gui-users] listview text color

[Robert May]

Glenn W Munroe wrote:

I'm afraid the short answer is "no" (as far as I'm aware)--at least not
using the latest Win32::GUI release. Someone asked this a year or so ago and
I looked into it, eventually coming up with a tremendous hack (using hooks)
to get it to work. Since then, the XS code has changed and the hack doesn't
even work any more. Having said that, I don't think it would be *too*
difficult to get it to work again, but it would involve modifying the
listview XS code. In case you're interested, I've included the code as a
guide (it worked a couple of releases ago, but the Hook call now fails). Jez
White and Chris Wearn have done some work on the listview code recently;
maybe they have some ideas too...

Glenn

Glenn,

I fixed this up to work with the CVS release of Win32::GUI some time ago.  Now
that we have a V1.02 release that it will run against it's time to share it back
with you and the list.  The fundamental problem was that Hook()ing WM_NOTIFY
messages was broken in Win32::GUI v1.0

With your permission I'd like to add this as a sample to the project?

Regards,

Rob.

#!perl -w
use strict;
use warnings;

use Win32::API;
use Win32::GUI 1.02;

# Some constants not defined in Win32::GUI
# These definitions will get inlined by the complier,
# and work with older versions of perl than 'use constant'
sub WM_NOTIFY           {0x4E};
sub NM_CUSTOMDRAW       {-12};

sub CDRF_NEWFONT        {2};
sub CDRF_NOTIFYITEMDRAW {32};
sub CDDS_PREPAINT       {1};
sub CDDS_ITEMPREPAINT   {65537};

sub CLR_RED             {0x0000FF};
sub CLR_GREEN           {0x00FF00};
sub CLR_BLUE            {0xFF0000};
sub CLR_WHITE           {0xFFFFFF};
sub CLR_BLACK           {0x000000};

# Win32::API call that we want, defined the old way for maximum backwards
# compatability with Win32::API
my $CopyMemory = Win32::API->new("kernel32", "RtlMoveMemory", "NPI", "V")
         or die "Can't find CopyMemory";

my $mw = Win32::GUI::Window->new(
 -text => "Colour ListView",
 -size => [ 200, 200 ],
 -pos  => [ 200, 200 ],
);

sub mw_Terminate { return -1 }

my $lv = $mw->AddListView(
 -pos  => [ 0, 0 ],
 -size => [ 190, 125 ],
);

$lv->InsertColumn(
 -index => 0,
 -text  => "Item",
);

$lv->ColumnWidth(0,180);

$lv->InsertItem(-text => "One");
$lv->InsertItem(-text => "Two");
$lv->InsertItem(-text => "Three");
$lv->InsertItem(-text => "Four");

$lv->TextColor(CLR_RED);

$lv->Hook(NM_CUSTOMDRAW, \&lv_CustomDraw);

$mw->Show;
Win32::GUI::Dialog();
exit(0);

sub lv_CustomDraw
{
 my ($object, $wParam, $lParam, $type, $msgcode) = @_;

 return if $type != WM_NOTIFY;
 return if $msgcode != NM_CUSTOMDRAW;

 my ($dwDrawStage, $dwItemSpec)=
     unpack("x12Ix20i", unpack("P40", pack("L",$lParam)));

 if ($dwDrawStage==CDDS_PREPAINT) {
   $object->Result(CDRF_NOTIFYITEMDRAW);
 }
 elsif ($dwDrawStage==CDDS_ITEMPREPAINT) {
   my $clrText;

   if    ($dwItemSpec==1) {
     $clrText=pack("II",CLR_WHITE,CLR_BLUE);
   }
   elsif ($dwItemSpec==2) {
     $clrText=pack("II",CLR_GREEN,CLR_BLACK);
   }
   else {
     return;
   }

   $CopyMemory->Call($lParam+48, $clrText, 8);
   $object->Result(CDRF_NEWFONT);
 }

 return 0;  # return 0 essential, otherwise forced Result is ignored
}
__END__