powered by simpleCommunicator - 2.0.38     © 2025 Programmizd 02
Форумы / PHP, Perl, Python [игнор отключен] [закрыт для гостей] / Perl. Разноцвестный ListView
5 сообщений из 5, страница 1 из 1
Perl. Разноцвестный ListView
    #39940071
yurikz
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Как сделать отдельные items разным цветом?

На просторах инета нашел пример который у меня к сожалению не работает
(perl 5, version 28, subversion 0 (v5.28.0) built for MSWin32-x64-multi-thread)

Код: php
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
use warnings;
use strict;


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 
}




ошибка "Use of uninitialized value in unpack"
...
Рейтинг: 0 / 0
Perl. Разноцвестный ListView
    #39940125
Фотография volodin661
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
yurikz,
попробуй заменить спецификатор "L" на "P" в функции pack

Код: php
1.
pack("P",$lParam) 
...
Рейтинг: 0 / 0
Perl. Разноцвестный ListView
    #39940132
Фотография volodin661
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В общем не будет это работать.

( Нашёл я этот код и вот что там сказано:

автор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)



)
...
Рейтинг: 0 / 0
Perl. Разноцвестный ListView
    #39940240
yurikz
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
volodin661
В общем не будет это работать.


К сожалению - да, этот код не работает.
Я думал может кто-то знает другие варианты
...
Рейтинг: 0 / 0
Perl. Разноцвестный ListView
    #39940808
White Owl
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Есть Tcl::Tk. Достаточно полный враппер над Tk. Не особо красиво и современно, но устойчиво.

Для Qt есть несколько пакетов, но как-то они все замерзли... Есть версии для Qt3, и Qt4. Но для Qt5 рабочих пакетов я не видел. Что-то как-то забыло перл-общество об этом фрейморке.

Есть враппер над WxWidgets - тоже мертвенький и кривенький.


А вот для Питона есть хороший враппер Qt5. Как пример, calibre целиком написана на нем.


Но вообще-то, мир отходит от десктопа. А для веба, в связке perl+javascript очень даже вкусные вещи делать получается :)
...
Рейтинг: 0 / 0
5 сообщений из 5, страница 1 из 1
Форумы / PHP, Perl, Python [игнор отключен] [закрыт для гостей] / Perl. Разноцвестный ListView
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]