Update of /cvsroot/perl-win32-gui/Win32-GUI/samples
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7815/samples
Added Files:
CustomDraw.pl
Log Message:
Reini Urban changes
--- NEW FILE: CustomDraw.pl ---
#!perl
# CustomDraw example. Reini Urban 2006
use Win32::GUI;
use Win32::GUI::CustomDraw;
use FindBin;
use File::Basename;
use POSIX qw(strftime);
$NEM = 1;
$OLD_CUSTOMDRAW = 0;
sub CLR_RED {0x0000FF};
sub CLR_GREEN {0x00FF00};
sub CLR_BLUE {0xFF0000};
sub CLR_WHITE {0xFFFFFF};
sub CLR_BLACK {0x000000};
sub CLR_GREY {0x888888};
$W = new Win32::GUI::Window(
-title => "Win32::GUI::CustomDraw test",
-left => 100,
-top => 100,
-width => 400,
-height => 650,
-name => "W",
-dropfiles => 1,
) or print_and_die("new Window");
my @listview_opts =
(-name =>'List',
-list => 0,
-report => 1,
-pos => [0, 0],
-height => $W->ScaleHeight - 35,
-width => $W->ScaleWidth,
-fullrowselect => 1,
);
push @listview_opts, (-onCustomDraw => \&List_CustomDraw) if $NEM;
$List = $W->AddListView(@listview_opts);
$List->View(1);
$W->AddButton(-name => 'Exit', -text => "Exit", -width => 60);
$W->AddStatusBar(-name => 'Status', -text => "", -width => $W->ScaleWidth - 65);
my $filewidth = $List->GetStringWidth("typicalfilename.pl") + 5;
$List->InsertColumn(-align => 'left',
-text => 'File',
-subitem => 1,
-width => $filewidth);
$List->InsertColumn(-align => 'left',
-text => 'No',
-subitem => 2,
-width => 25);
$List->InsertColumn(-align => 'left',
-text => 'Line',
-subitem => 3,
-width => $List->Width() - (22 + 25 + $filewidth));
$List->Hook(NM_CUSTOMDRAW, \&List_CustomDraw_Hook) if $OLD_CUSTOMDRAW;
$List->SetFocus();
$W->Show;
W_Resize();
$List->Clear();
$W->Status->Text("filling list ...");
$W->Status->Update;
opendir(DIR, $FindBin::Bin);
while (my $file = readdir DIR) {
my $path = $FindBin::Bin . "\\" . $file;
next unless ((-f $path) and ($path =~ /\.pl$/));
add_file($path, $file);
last if $List->Count > 2000; # 2000 max
}
closedir DIR;
$W->Status->Text("Add files with Drag & Drop");
$return = $W->Dialog();
print "Dialog: $return\n";
sub add_file {
my ($path, $file) = @_;
$file = basename($path) unless $file;
open F, "< $path";
$W->Status->Text("reading $file ...");
$W->Status->Update;
my $i = 1;
while (my $line = <F>) {
next if $line =~ /^\s*$/;
next if $line =~ /^\s*#/;
chomp $line;
my $item = $List->Count();
$List->InsertItem(-item => $item, -text => $file);
$List->Item($item)->SubItem(1)->Text($i);
$List->Item($item)->SubItem(2)->Text(substr($line,0,255));
$List->EnsureVisible($item);
last if $i++ > 200; # max 200 lines per file
}
close F;
}
sub List_CustomDraw {
my ($win, $ctrl) = @_;
if ($opts{debug} and !$opts{debug_ctrl}) {
$opts{debug_ctrl}++;
use Devel::Peek;
Dump $win;
Dump $ctrl, 20;
}
my $drawstage = $ctrl->{-drawstage};
my $item = $ctrl->{-item};
if ($drawstage == CDDS_PREPAINT) {
return CDRF_NOTIFYITEMDRAW;
}
elsif ($drawstage == CDDS_ITEMPREPAINT) {
my $line = $List->Item($item)->SubItem(2)->Text();
if ($line =~ /^sub\s+/) { # whole line
$ctrl->TextColor(CLR_WHITE);
$ctrl->BackColor(CLR_GREY);
} elsif ($line =~ /^use\s+/) {
return CDRF_NOTIFYSUBITEMDRAW;
} elsif ($line =~ /die / or $line =~ /croak /) {
return CDRF_NOTIFYSUBITEMDRAW;
} else {
return CDRF_DODEFAULT;
}
}
elsif ($drawstage == (CDDS_ITEMPREPAINT | CDDS_SUBITEM)
and ($ctrl->{-subitem} == 2)) {
my $line = $List->Item($item)->SubItem(2)->Text();
if ($line =~ /^sub\s+/) {
} elsif ($line =~ /^use\s+/) {
$ctrl->TextColor(CLR_BLUE);
} elsif ($line =~ /die / or $line =~ /croak /) {
$ctrl->TextColor(CLR_RED);
} else {
return CDRF_DODEFAULT;
}
return CDRF_NEWFONT;
}
return CDRF_DODEFAULT;
}
# the old method via Hook
sub List_CustomDraw_Hook {
my ($object, $wParam, $lParam, $type, $msgcode) = @_;
return if $type != WM_NOTIFY;
return if $msgcode != NM_CUSTOMDRAW;
if ($opts{debug} and !$opts{debug_ctrl}) {
$opts{debug_ctrl}++;
use Devel::Peek;
Dump $win;
Dump $ctrl, 20;
}
my ($drawstage, $item)=
unpack("x12Ix20i", unpack("P40", pack("L", $lParam)));
if ($drawstage == CDDS_PREPAINT) {
return CDRF_NOTIFYITEMDRAW;
}
elsif ($drawstage == CDDS_ITEMPREPAINT) {
my $line = $List->Item($item)->SubItem(2)->Text();
if ($line =~ /^sub\s+/) { # whole line
substr($lParam,48,8,pack("II",CLR_WHITE,CLR_GREY));
$object->Result(CDRF_NEWFONT);
} elsif ($line =~ /^use\s+/) {
$object->Result(CDRF_NOTIFYSUBITEMDRAW);
} elsif ($line =~ /die / or $line =~ /croak /) {
$object->Result(CDRF_NOTIFYSUBITEMDRAW);
} else {
$object->Result(CDRF_DODEFAULT);
}
return 0;
}
elsif ($drawstage == (CDDS_ITEMPREPAINT | CDDS_SUBITEM)
and ($ctrl->{-subitem} == 2)) {
my $line = $List->Item($item)->SubItem(2)->Text();
my $clrText;
if ($line =~ /^sub\s+/) {
} elsif ($line =~ /^use\s+/) {
$clrText = pack("II",CLR_BLUE,CLR_WHITE);
} elsif ($line =~ /die / or $line =~ /croak /) {
$clrText = pack("II",CLR_RED,CLR_WHITE);
} else {
$object->Result(CDRF_DODEFAULT);
return 0;
}
substr($lParam,48,8,$clrText);
$object->Result(CDRF_NEWFONT);
return 0;
}
return 0;
}
sub print_and_die {use POSIX qw(strftime);
my($text) = @_;
my $err = Win32::GetLastError();
die "$text: Error $err\n";
}
sub W_DropFiles {
my $drop = shift;
for (@{$drop->DragQueryFiles()}) { add_file($_); }
}
sub W_Resize {
my $dx = $List->Width - $List->ColumnWidth(2);
$List->Width($W->ScaleWidth);
$List->Height($W->ScaleHeight() - $W->Status->Height);
$List->ColumnWidth(2, $List->Width - $dx);
$W->Status->Top($W->Height - $W->Status->Height - 2);
$W->Exit->Top($W->ScaleHeight - $W->Status->Height - 1);
$W->Exit->Left($W->ScaleWidth - 61);
$W->Redraw(-1);
$W->Exit->Redraw(-1);
return 0;
}
sub Exit_Click { -1 };
