论坛徽章:: 0

电梯直达

1楼 [收藏(0)] [报告]

发表于 2009-09-15 18:26 |只看该作者 |倒序浏览

#!/usr/bin/perl

use strict;
use threads;
use Win32::GUI ();

my $main = Win32::GUI::Window->new(
    -name       => 'Main',
    -width    => 510,
    -height    => 150,
    -text       => "窗口",
    -maxsize    => [ 510, 150 ],
    -minsize    => [ 510, 150 ],
    -maximizebox => 0,
);

$main->AddTextfield(
    -name    => "Text_Informa",
    -left    => 10,
    -top    => 30,
    -width    => 483,
    -height => 70,
    -multiline => 1,
);

$main->AddButton(
    -name => 'btnNewthread',
    -text => '新线程',
    -pos  => [ 430, 1 ],
);

my $ni;
my $Menus = Win32::GUI::Menu->new(
    "Item Menu"    => "Item",
    "> 最小化到托盘" => { -name => "mint", -onClick => \&hidwindow },
    "> 退出"       => { -name => "Exitprogram", -onClick => \&exit_win },
);
my $icon = new Win32::GUI::Icon('ico.ico');
my $thread1;

eval { main(); };
Win32::GUI::MessageBox(0, "错误: $@", "错误") if ($@);
exit(0);

sub main {

    $ni = $main->AddNotifyIcon(
        -name          => "NI",
        -icon          => $icon,
        -tip          => "托盘名字",
        -balloon       => 1,
        -balloon_tip    => "托盘提示信息",
        -balloon_title => "托盘名字",
        -balloon_timeout => "1000",
        -balloon_icon => 'info',
        -onClick       => sub {

        },
        -onRightClick => sub {
            $main->TrackPopupMenu($Menus->{Item}, Win32::GUI::GetCursorPos());
            return 1;
        },
    );

    $main->Show();
    Win32::GUI::Dialog();
    return (1);

}

sub exit_win {
    $main->Hide();
    $ni->Remove();
    undef $main;
    undef $ni;
    exit(0);
}

sub hidwindow {
    if ($main->IsVisible()) {
        $main->Hide();
    }
    else {
        $main->Enable();
        $main->Show();
    }
}

sub newthread {
    $main->{Text_Informa}->Append("新线程工作区\n");
    threads->exit();
}

sub Main_Terminate {
    exit_win();
}

sub Main_Minimize {
    $main->Hide();
    $main->Disable();
}

sub btnNewthread_Click {
    $main->{Text_Informa}->Append("新线程\n");

    # 以下方式,程序会出错,中断

    #my $thr = new threads(\&newthread);

    #$thr->detach();

    # 以下方式,每操作一次 "新线程" 内存就不断上升,每次上升1至2M内存.

    $thread1 = new threads(\&newthread);
    $thread1->detach();
}

新建线程之一:

my $thr = new threads(\&newthread);
$thr->detach();

如果没有点击"新线程"按钮之前,托盘上的图标和功能是正常的,但一点击"新线程"(生成一个新的线程)后程序就出错了,错误信息如下:

C:\>perl test.pl
Attempt to free non-existent shared string 'NI', Perl interpreter: 0x1aa4dc4 at C:/Usr/site/lib/Win32/GUI.pm line 3458 during global destruction.
Unbalanced string table refcount: (1) for "" during global destruction.
Unbalanced string table refcount: (1) for "DELETE" during global destruction.

复制代码

跟着程序就中断了.

新建线程之二:

$thread1 = new threads(\&newthread);
$thread1->detach();

这种方式 Win32::GUI::NotifyIcon 生成的托盘图标可以用了,但是每操作一次 "新线程" 内存就不断上升,每次上升1至2M内存.

结果:要么程序用不了,要么就让内存不断上升,那也不是办法啊...

C:\>perl -v
This is perl, v5.8.8 built for MSWin32-x86-multi-thread
(with 18 registered patches, see perl -V for more detail)
Copyright 1987-2007, Larry Wall
Binary build 822 [280952] provided by ActiveState [url]http://www.ActiveState.com[/url]
Built Jul 31 2007 19:34:48

复制代码

C:\>C:\Perl510\bin\perl -v
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 2 registered patches, see perl -V for more detail)
Copyright 1987-2009, Larry Wall
Binary build 1006 [291086] provided by ActiveState [url]http://www.ActiveState.com[/url]
Built Aug 24 2009 13:48:26

复制代码

两个版本的perl都测试过,结果一样.

系统: xp sp2

经过多次测试,都没结果,也google过,也没找到相关的信息.请求帮忙,有什么办法可以解决?谢谢!

google到一篇文章:
http://www.nabble.com/Re:-Is-Win32::GUI::NotifyIcon-thread-safe--td22125085.html

[ 本帖最后由 freeand 于 2009-9-15 21:03 编辑 ]