使用Perl Gtk2来写GUI图形用户界面 - Chinaunix

#! /usr/bin/perl -w
use strict;
use Gtk2 '-init';
use Glib qw/TRUE FALSE/;
use Gtk2::SimpleList;
#Declare our columns
use constant C_MARKUP => 0;
use constant C_PIXBUF => 1;
#Declare our IDENDTIFIER ID's
use constant ID_ICONVIEW => 48;
use constant ID_LABEL => 49;
use constant ID_URI => 50;
#Add a tooltip object
my $tooltips = Gtk2::Tooltips->new();
#standard window creation, placement, and signal connecting
my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_border_width(5);
$window->set_position('center_always');
#add and show the vbox
$window->add(&ret_vbox);
$window->show();
#our main event-loop
Gtk2->main();
sub ret_vbox {
my $vbox = Gtk2::VBox->new(FALSE,5);
my $h_paned = Gtk2::HPaned->new();
my $v_paned = Gtk2::VPaned->new();
#get the iconview
$v_paned->pack1(create_iconview(),TRUE,FALSE);
#get the simple list where everything will be dropped into
$v_paned->pack2(create_simple_list(),TRUE,FALSE);
$h_paned->pack1($v_paned,TRUE,FALSE);
#create an eventbox to accept drag actions
my $event_box = Gtk2::EventBox->new();
my $label_drag_me = Gtk2::Label->new("Now Stanley,\nDO NOT drag this item");
$event_box->add($label_drag_me);
#Try and convince the user otherwise
$tooltips->set_tip ($event_box,
'No way! You have to drag it at least once!'.
'Drag it, and drop it into the bottom list'
);
#Setting up the Gtk2::Event Box instead of the Gtk2::Label, enabling it as
#a drag source
$event_box->drag_source_set (
['button1_mask', 'button3_mask'],
['copy'],
{
'target' => 'text/plain',
'flags' => [],
'info' => ID_LABEL,
},
);
my $text_to_drag = '"Well there\'s another nice mess you\'ve gotten me into."';
#set up the data which needs to be fed to the drag destination (drop)
$event_box->signal_connect ('drag-data-get' => \&source_drag_data_get,$text_to_drag );
$h_paned->pack2($event_box,TRUE,FALSE);
$vbox->add($h_paned);
$vbox->show_all();
return $vbox;
}
sub create_iconview {
#---------------------------------------------------
#Creates an Iconview in a ScrolledWindow. This -----
#Iconview has the ability to drag items off it -----
#---------------------------------------------------
my $icon_string= undef;
my $tree_model = create_iconview_model();
my $icon_view = Gtk2::IconView->new_with_model($tree_model);
$icon_view->set_markup_column(C_MARKUP);
$icon_view->set_pixbuf_column(C_PIXBUF);
#Enable the Gtk2::IconView as a drag source
$icon_view->drag_source_set (
['button1_mask', 'button3_mask'],
['copy'],
{
'target' => 'STRING',
'flags' => [],
'info' => ID_ICONVIEW,
},
);
#This is a nice to have. It changes the drag icon to that of the
#icon which are now selected and dragged (single selection mode)
$icon_view->signal_connect('drag-begin' => sub {
$icon_view->selected_foreach ( sub{
my $iter =$tree_model->get_iter($_[1]);
#set the text and pixbuf
my $icon_pixbuf = $tree_model->get_value($iter,C_PIXBUF);
$icon_string = $tree_model->get_value($iter,C_MARKUP);
$icon_view->drag_source_set_icon_pixbuf ($icon_pixbuf);
} );
});
#set up the data which needs to be fed to the drag destination (drop)
$icon_view->signal_connect ('drag-data-get' => sub { source_drag_data_get(@_,$icon_string) } );
#Standard scrolledwindow to allow growth
my $sw = Gtk2::ScrolledWindow->new(undef,undef);
$sw->set_policy('never','automatic');
$sw->add($icon_view);
$sw->set_border_width(6);
$sw->set_size_request(600,150);
return $sw;
}
sub create_iconview_model {
#----------------------------------------------------
#The Iconview needs a Gtk2::Treemodel implementation-
#containing at least a Glib::String and -------------
#Gtk2::Gdk::Pixbuf type. The first is used for the --
#text of the icon, and the last for the icon self----
#Gtk2::ListStore is ideal for this ------------------
#----------------------------------------------------
my $list_store = Gtk2::ListStore->new(qw/Glib::String Gtk2::Gdk::Pixbuf/);
#******************************************************
#we populate the Gtk2::ListStore with Gtk2::Stock icons
#******************************************************
my $icon_factory = Gtk2::IconFactory->new();
foreach my $val(sort Gtk2::Stock->list_ids){
#get the iconset from the icon_factory
my $iconset = $icon_factory->lookup_default($val);
#try and extract the icon from it
# my $pixbuf = $iconset->render_icon(Gtk2::Style->new(),'none','normal','dnd',undef);
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file("rdp.png");
#if there was a valid icon in the iconset, add it
if( defined $pixbuf ){
my $iter = $list_store->append;
$list_store->set (
$iter,
C_MARKUP, "$val",
C_PIXBUF, $pixbuf,
);
}
}
return $list_store;
}
sub create_simple_list {
#---------------------------------------------------
#Creates a simple list with pixbuf and markup -----
#columns make this list the drop target for various-
#drag sources --------------------------------------
#---------------------------------------------------
my $slist = Gtk2::SimpleList->new ('' => 'pixbuf', '' => 'markup');
$slist->set_rules_hint(TRUE);
$slist->set_headers_visible(FALSE);
#Also suggest to try Nautilus
$tooltips->set_tip ($slist,
'Drag a few files from Nautilus '.
'and drop it here'
);
#Create a target table to receive drops
my @target_table = (
{'target' => 'STRING', 'flags' => [], 'info' => ID_ICONVIEW },
{'target' => "text/uri-list",'flags' => [], 'info' => ID_URI },
{'target' => "text/plain", 'flags' => [], 'info' => ID_LABEL },
);
#make this the drag destination (drop) for various drag sources
$slist->drag_dest_set('all', ['copy'], @target_table);
#do a callback as soon as drag data is received
$slist->signal_connect ('drag-data-received' => \&target_drag_data_received,$slist );
#Standard scrolledwindow to allow growth
my $sw = Gtk2::ScrolledWindow->new(undef,undef);
$sw->set_policy('never','automatic');
$sw->add($slist);
$sw->set_border_width(6);
$sw->set_size_request(600,150);
return $sw;
}
sub target_drag_data_received {
#---------------------------------------------------
#Extract the data which was set up during the -----
#'drag-data-get' event which fired just before -----
#the 'drag-data-received' event. Also checks which--
#source supplied the data, and handle accordingly----
#---------------------------------------------------
my ($widget, $context, $x, $y, $data, $info, $time,$slist) = @_;
my $icon_factory = Gtk2::IconFactory->new();
if ($info eq ID_LABEL){
my $iconset = $icon_factory->lookup_default('gtk-no');
my $pixbuf = $iconset->render_icon(Gtk2::Style->new(),'none','normal','menu',undef);
push @{$slist->{data}}, [ $pixbuf, $data->data ];
}
if ($info eq ID_URI){
my $iconset = $icon_factory->lookup_default('gtk-yes');
my $pixbuf = $iconset->render_icon(Gtk2::Style->new(),'none','normal','menu',undef);
foreach ($data->get_uris){
push @{$slist->{data}},
[ $pixbuf, ''.$_.'' ];
}
}
if ($info eq ID_ICONVIEW){
my $no_markup = $data->data;
$no_markup =~ s/<[^>]*>//g;
my $iconset = $icon_factory->lookup_default($no_markup);
my $pixbuf = $iconset->render_icon(Gtk2::Style->new(),'none','normal','menu',undef);
push @{$slist->{data}}, [ $pixbuf, $data->data ];
}
$context->finish (0, 0, $time);
}
sub source_drag_data_get {
#---------------------------------------------------
#This sets up the data of the drag source. It is ---
#required before the 'drag-data-received' event ----
#fires which can be used to extract this data ------
#---------------------------------------------------
my ($widget, $context, $data, $info, $time,$string) = @_;
$data->set_text($string,-1);
}

复制代码