大家论坛

 找回密码
 注册
查看: 19496|回复: 21

[推荐] 使用Perl Gtk2来写GUI图形用户界面

[复制链接]

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
发表于 2010-3-24 18:00 | 显示全部楼层 |阅读模式
Perl的强大,很多人都不知道,今天我们公司一个很强的写程序的人跑到我这边拿起perl的书看了看,很惊奇的问"Perl还能写网页?".其实perl除了脚本还能做很多事情,比如可以很方便的使用Gtk2来写GUI.但这方面的文章很少,也很不系统,下面这个是我看到网上一个非常不错的教程,共享给大家,希望一起进步.

大家可以使用Glade来帮助开发界面,Glade是可以让你用拖拽的方式来给GTK这些组件进行布局的.它是针对GTK+工具箱与GNOME桌面开发环境的快速图形界面开发工具.用Glade设计的用户接口以XML的文件形式保存.只要Perl中读入,就能读出GUI的界面.节约我们大量时间.Glade使用的c库,所以程序使用Glade产生界面性能还是相当不错的.还有一点很重要,就是他是一个通用平台的.Gtk2写出的软件是可以在linux和windows上都运行的.

Perl-Gtk2.这个可以做些什么啦?可以做的多啦,一个最最简单的文字浏览器; 一个jabber、msn、irc、甚至qq的客户端....

在Ubuntu中安装glade的方法为:

sudo apt-get install glade-3

这样在"应用程序"->"编程"中就能见到glade啦.

使用Gtk2-perl开发GUI的优势

由于Gtk2-perl是Gtk+与Perl的混合体,所以Gtk2-perl的优势一部分来源于Gtk+另一部分则是来源于perl的能力。

1.首先Gtk2-perl是跨平台的。已知的Gtk2-perl可运行的平台有win32,Linux(包含各种版本的Linux,如 redhat,debian,gentoo等等),freebsd。Gtk2-perl的跨平台能力来自于 Gtk+ 本身是一个跨多平台的工具包,而Perl 也是跨平台的语言。Gtk+的mac版本的移植工作已经做的不错,我们能在苹果的电脑上使用Gtk2-perl。

Gtk2-perl 的这种跨平台能力在Gui开发工具中并不多见,同样著名的跨平台开发工具还有Qt,一个C++ 的Gui开发工具包,其功能也十分强大,主页:http://www.trolltech.com/,不过Qt对于其他语言的移植很差。SDL,一个C的多媒体开发工具包,主页:http://www.libsdl.org,不过SDL偏重于游戏的开发,在SDL内并没有提供窗体的支持,也就是说你无法调用现成的api来生成默认windows风格的程序。其他较著名的 Gui 开发工具包还有微软的 GDI+,由于是私有公司开发的原因,GDI+开发的程序是只能在win32平台下运行。(还有directx和opengl,这两者都是3D图形的开发工具包,现在还大多用于游戏的开发,普通应用程序并不使用它们)。

2.其次,Gtk2-perl的程序可以基本不用改动便可在多个平台运行。这对于程序员来说意味着写一遍程序,就可以顾及到所有的流行平台,这大大降低了程序员的后续工作量,提高了程序的生命力。Gtk2-perl 程序由于是 perl 脚本,甚至省去了在这些平台的编译工作,相对于 Qt 编写的程序还要在各个平台再进行重新编译,在编译过程中还可能出现某些由于平台的差异而产生的编译问题(这里有朋友可能要说我不想暴露源码,那你可以试试 perl 的某些包装源码的模块比如 par,但是笔者认为即使从经济角度出发这样做的意义也不大)。只要你在编写 Gtk2-perl 程序前注意到某些平台的不同之处,对于某些特殊的应用有专门的代码处理就可以很方便的实现跨平台的能力,例如,在 X11 下使用与 X11 相关的调用,这时就要指明只有在 Xserver 存在时才能这么用。

3.用Gtk2-perl编写Gui程序可以不必关心内存的分配情况,而将自己的主要精力放在程序的实现上。这样的能力来源于Perl。由于Perl语言先天的特性,它为你管理好了内存,所以你不必在意这些。

4.Gtk2-perl改进了一些Gtk+的用法,让用户在编写Gtk2-perl的程序时更加方便。原来在gtk中的纯c的写法,在Gtk2-perl中变成了面向对象的写法,使人们更容易理解。
原来在Gtk+中的new函数只是简单的建立一个新的功能,在Gtk2-perl 中我们可以让new函数带多个变量,来进一步的设定这个功能。
这些能力都是由于perl的优势,在移植Gtk+到Gtk2-perl时,充分考虑到了开发者的需求,让Gtk2-perl的程序更加的perlish。

5.用Gtk2-perl可以有几千个成熟的perl模块来调用。这些模块覆盖了各种功能,有了这些模块,你的编程速度将大大加快。例如。一个最最简单的文字浏览器:
  1. use Gtk2;
  2. use LWP::Simple;
  3. use HTML::Parser; ## 使用perl内置的html分析模块
  4. use strict;
  5. use Encode qw/encode decode/;
  6. Gtk2 -> init;
  7. my $win = Gtk2::Window -> new ;
  8. $win -> set_title( decode(' euc-cn ' , '最简单的Web文字浏览器' ) );
  9. $win -> set_size_request ( 320,240 );
  10. $win -> signal_connect ( destroy => sub{ Gtk2 -> main_quit; } );
  11. my $buffer = Gtk2::TextBuffer -> new ;  ##添加一个textbuffer控件,负责文字的储存
  12. my $textview = Gtk2::TextView -> new ;  ## 添加一个textview控件,负责文字的显示
  13. $textview -> set_editable ( 0 );  ##设置这个textview控件的属性可编辑
  14. $textview -> set_wrap_mode ( 'GTK_WRAP_WORD_CHAR' );  ##设置这个textview空间的按照字符与字的模式自动换行
  15. $textview -> set_buffer ( $buffer );  ##设置textview控件的缓冲为我们刚建立的$buffer
  16. $win -> add ( $textview );  ##在$win窗体中添加这个textview控件
  17. my $p = HTML::Parser -> new( api_version => 3 , text_h => [ \&text , "text" ] );  
  18. ##建立一个新的Html内容解析模块,并设定只解析文字,遇到文字时执行text子程序
  19. my $content = get ( 'http://www.alexe.cn' );  ##输入你想要的web网址
  20. $p -> parse ( $content );  ##解析取回的 html 格式的 web 内容
  21. $win -> show_all;  ##显示窗口中的所有元素
  22. Gtk2 -> main;  ##开始主循环
  23. sub text {
  24. my ( $text ) = @_;
  25. $text = ~s/^\n||^\r\n//mg;  ##将解析来的文字内容去除一些多于的空行
  26. $buffer -> insert_at_cursor ( $text );  ##将这些文字逐一叠加在 $buffer 缓冲中
  27. }
复制代码
这个小程序每次只能显示一个网址的文字,而且显示的文字的格式并没有整理。在文章的尾部我提供了一个更为完整的例子,这个例子 230 多行代码,也只能显示 html 中的文字与超级连接,而且还有一些 bug。但是希望通过这个例子让大家了解 Gtk2-perl,一个 gui 程序原来也可以这么简单。大家有兴趣可以下载参考一下。

6.Gtk2-perl采用了gui编程中的先进思想。例如:事件驱动模型,绘图上下文系统等等。这些都是从过去的gui编程模型中总结出来的。这些能力是由于gtk+的最初设计。gtk+的设计理念也是综合了当今最先进的gui工具包的设计理念而形成的。

7.Gtk2-perl也可以使用所见即所得的gui界面设计工具,glade。主页:http://glade.gnome.org/。使用glade可以直接生成C源代码或者生成xml格式界面文件,这种界面文件可以直接被Gtk2-perl通过Gtk2::GladeXML(可以在 Gtk2-perl 的主页上找到)导入使用。这样Gtk2-perl的界面设计速度也可以大大的提高。

基本概念

下面,我们开始介绍一些在 Gtk2-perl 编程中一定要理解的基本概念。有了对这些概念的理解,你才可以轻易的进行更深入的学习。这些概念并不仅仅适用于 Gtk2-perl 的编程,很多概念也适用于大多数的 gui 编程。

1) 事件驱动模型

事件驱动模型可以算作是 GUI 编程中最为重要的概念之一了。平时,我们运行的一般程序都是采用典型的批量处理模式以线性的方式运行所有的命令。然而,一个交互式的用户界面程序必须随时准备运行任何一个操作:一个用户可能正漫步于菜单上,然后按下任何他想要的按钮,或者用户正在一个文字输入栏输入文字,或者他忽然切换到其他程序然后又再切换回来完成刚才他没做完的事情。总之,程序必须随时响应用户触发的事件,这就叫做"事件驱动"。可以说,如果没有事件驱动模型,我们就无法实现用户的自由操作,不理解事件驱动模型,我们就无法开始 Gtk2-perl 的编程。

事件驱动模型一般有这样的特点:
  • 归纳出基本的元素,例如:对于用户所有可能的动作事先要做出归纳总结。
  • 一个事件驱动程序一般都有一个处于中心地位的事件队列处理部分和一个事件队列。当一个事件发生时就向事件队列添加一项。事件队列处理部分则不断地处理事件队列中的各种事件,而且每处理一个事件时都要通知对这个事件感兴趣的子程序。

我们来更加具体的解释一下:当用户点击一个按钮的时候,一个按钮事件就被添加到事件队列中,随着事件队列的不断被处理,轮到我们添加的按钮事件时,事件队列处理部分就会开始处理这个事件,同时通知任何对这个事件感兴趣的子程序。

在 Gtk2-perl 中,事件驱动的逻辑实现是在内部完成的。我们只需要理解这个概念就可以了。

2) 主循环系统

所谓的主循环系统就是上面我们介绍的事件队列处理系统的一部分。由于我们需要无限的等待用户的输入事件,所以我们必须建立一个循环,这个循环可以不断的读出用户的输入事件,并处理这些事件,在这个循环中我们还要处理一些其他的事情,例如等待 socket 数据到来等等,这就是主循环系统。主循环系统有时要处理事件,但是在大多数时候,主循环一般会处于空闲状态。在空闲状态下,主循环系统释放 cpu 等计算机资源,等待新的事件到来。一个好的 GUI 系统,空闲时间的分配是十分重要的。为了随时能够响应用户的输入,必须有足够的空闲等待用户的输入。如果大量的资源都被占用,那么用户的输入将得不到及时地响应,用户对于这个 GUI 系统将会十分失望。

在 Gtk2-perl 中,Gtk2 -> main 语句代表着开始主循环。

顺便一提:Gtk2 -> init 语句代表 Gtk2-perl 程序的初始化,在任何 Gtk2-perl 程序中,我们都必须先初始化,初始化完成后我们才可以开始编写与 Gtk+ 相关的语句。

3) 信号系统

信号系统也是事件驱动模型中的一部分。所谓信号系统就是当某一件事情(例如,用户的某个操作动作)发生的时候我们就会得到一个信号,然后我们按照事先规定好的如何处理这种信号的方法来处理这个信号。

在 Gtk2-perl 中,我们的信号系统有两种,一种是底层的通用信号系统,一种是每个控件特殊的信号系统。

底层的通用信号都有自己的唯一独立名称,总共有 30 多种。这些信号一般是用在自定义的控件中,例如:现有的控件没有能达到你的需要,你想自己的编写一个特殊目的的控件,这时要用到的信号系统就是底层的通用信号。

每个控件的独立信号系统,随着控件的不同而不同,例如:按钮 button 控件可以有自己的信号系统,当 'pressed' 信号发生时证明用户正在按下这个按钮;而文字 textview 控件也有自己的信号系统,当我们在文字控件中移动光标时,我们就可以触发 move-cursor 信号。信号系统的基本原则是必须明确声明信号才能生效。换句话说就是如果对于某个信号你没有事先声明要捕获这个信号,那么系统将不会理会这个信号。即使是最简单的关闭窗口信号,如果没有事先声明,系统也不会理会,就像我们上面的 Helloworld.pl 中的一定要添加 $win -> signal_connect ( destroy => sub {Gtk2 -> main_quit } );这句话,否则点击关闭窗口的按钮将不起作用。这一点对于最初接触 GUI 编程的朋友一定要注意。信号系统的一般用法是:$widget -> signal_connect ('signal' , sub{do…} );这里 $widget 一般是指 GUI 程序中的某个窗体,在这里我们看到,我们在某个$widget 上添加信号捕获,当某个 signal 发生时,我们就去执行 sub{ do…. } 的子程序。

4) 绘图上下文

所谓的绘图上下文就是用来封装绘图属性的,所有的绘图操作都要用绘图上下文来作为自己的参数。简单点说就是绘图上下文就是一个包含了所有的绘图属性的对象(例如:背景的色彩,一条线的宽度等等),然后将这个绘图上下文作为你要绘制图像的参数来输入从而决定这个图像如何绘制。

绘图上下文的优势在于:通过使用绘图上下文将各种绘图属性的集中在几个对象,可以大大的减少重复的绘图属性的设定,从而让一个绘图上下文为多个不同的绘图来作为参数。更加准确的说,这种优势是为了减少程序中的重复编写与输入,提高程序的编写与运行效率。

绘图上下文的基本用法:$gc = Gtk2::Gdk::GC -> new ( $drawable , $values=undef )

5) Gtk2-perl 的内部控件

现代 GUI 编程的一个特点就是提供大量的易用控件给开发者,每个控件都可以完成某个特定的功能(例如:显示一段文字或允许用户输入一段文字等等),这样使得开发者在开发一个 GUI 程序时可以用这些控件来组装成一个 GUI 程序。这很类似于我们现在的 html 格式的 web 制作,在我们制作一个网页时,就是利用了很多现成的 html 标签然后组合到一起形成完整的 html 网页。这种相似性甚至可以在很多微小的方面得到验证,例如将这些控件正确的布局时都要用到表格这样的控件。

在 Gtk2-perl 中提供的控件相当丰富,我们单单来看看这些控件的大类:
  • Windows:这个控件大类是负责最基本的 GUI 窗口,例如:主窗体控件,简单对话框的控件。
  • Display Widgets:这个控件类是负责基本显示的,例如:文字显示控件,图片显示控件。
  • Buttons and Toggles:负责各种类型的按钮,如基本按钮,check 类型的,radio 类型的。
  • Numeric/Text Data Entry:负责数字与文字的单行输入。
  • Multiline Text Editor:负责文字多行输入的控件。
  • Tree, List and Icon Grid Widgets:负责树形列表式、简单列表式或图标表格式的显示。
  • Menus, Combo Box, Toolbar:负责菜单、组合单元、工具栏。
  • Action-based menus and toolbars:负责基于动作的菜单与工具栏
  • Selectors (File/Font/Color/Input Devices) :负责文件、字体、颜色、输入设备的选择界面,这就是我们在打开文件或选择字体时所使用的那个通用的界面。
  • Layout Containers:负责各个控件的布局,让你可以很容易的在一个窗口上布置各个空间。
  • Ornaments:负责控件显示时的周围装饰,例如在各个控件间的分割条等
  • Scrolling:负责滚动条,用来将一些无法用一屏显示的控件中的内容滚动的显示。
  • Miscellaneous:负责其他剩余的事情,如显示一个箭头的控件,日历控件,一个绘画区域的控件等等。
  • Abstract Base Classes:负责抽象的控件,这些控件一般是基本控件的父类。
  • Cross-process Embedding:负责两个进程间的通讯。
  • Special-purpose features:负责某些特殊目的,例如:绘制曲线的控件,绘制标尺的控件。

所有的这些控件他们一般都有面向对象的特征,也就是存在父类与子类。父类一般是几个相似控件的一个集合。每个子类都可以使用父类的函数。这样使我们使用起这些控件更为方便,这也是 Gtk2-perl 的一个优势吧。
When I'm on Windows, I use Strawberry Perl.
回复

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:02 | 显示全部楼层
正文

写几篇总结简单介绍一下 Gtk2-Perl 的几种常用的组件。方便大家,自己也可以经常翻翻,以免忘记了。

1. 安装
2. 解析 helloworld 程序
3. 组件排布系统
4. Label
5. Button
6. Dialog
7. Tree View
8. 下拉菜单
9. Entry
10. Glade
11. 本地化

更新至12楼,全。

Gtk2-Perl 1.安装

Tk 应该是目前 Perl 最主要的图形界面库。由于 Windows 下的 ActivePerl 把 Tk 作为其中的一个模块一起发布,所以 Tk 在各个操作系统中不存在安装上的难题。但是不可否认的是,如果用 Tk 来写具有复杂界面的程序是一件很痛苦的事。而且 Tk 虽然可以显示中文,但是无法输入中文,这可能是 Tk 的一个致命缺点。与此相反,Gtk2-Perl 没有前面所说的这些缺点,而且 Gtk2-Perl 无论从组件的丰富程度和美观角度,还是从编写代码的容易程度都较 Tk 都有很大优势。虽然 Gtk2-Perl 正处于开发阶段,但是可以预计将来很大比率的图形界面程序都会使用 Gtk2-Perl 来实现。

Gtk2-Perl 虽然没有 Tk 安装那么方便,但是也不会非常困难。首先介绍一下,Windows 下 Gtk2-Perl 的安装。

当你安装了 ActivePerl,你可以用 PPM 安装 Gtk2-Perl 的 ppm 包。在命令行中使用下面的命令安装:

C:\Temp> ppm install http://gtk2-perl.sourceforge.net/win32/ppm/Glib.ppd
C:\Temp> ppm install http://gtk2-perl.sourceforge.net/win32/ppm/Gtk2.ppd

(这是官方网站上给出的方法,经过测试,可能会遇到 ExtUtils 其中一个模块无法安装的错误。所以保险的做法还是下载那个 ALL-Gtk2-Perl-20050208.tgz,解压缩后,一个个用 ppm 安装即可。)

Gtk2-Perl 需要 Gtk runtime environment 来运行。它可以从下面的网址下载得到:

http://gimp-win.sourceforge.net/stable.html

在 linux 下安装更简单,如果有 apt 包管理系统,只要安装 gtk-perl 相关的包即可:

sudo aptitude install libglib-perl libgtk2-perl

也可以直接从 cvs 得到源文件来安装:

cvs -d:pserver:anonymous@gtk2-perl.cvs.sourceforge.net:/cvsroot/gtk2-perl login
cvs -z3 -d:pserver:anonymous@gtk2-perl.cvs.sourceforge.net:/cvsroot/gtk2-perl co -P modulename

提示密码后直接按回车。modulename 可以是 gtk2-perl-xs,这样会下载所有的源文件和文档。也可以是 gtk2-perl-xs/Gtk2 或者 gtk2-perl-xs/Glib 等等,这样只下载其中的一部分。下载完之后进行文件夹,用通常的办法安装:

perl Makefile.PL
make
make test
make install

可能需要先安装 Glib,再安装 Gtk2(我是先用 apt 安装好了,所以不能测试了)。

如果安装成功,我们就可以用 helloworld 程序来测试一下(源程序请用 utf8 编码保存):
  1. #!/usr/bin/perl -w
  2. # helloworld.pl --- Test the gtk2-perl whether works
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. use Encode qw(decode);
  6. my $window = Gtk2::Window->new('toplevel');
  7. $window->set_title('Hello World!');
  8. $window->set_position('center_always');
  9. $window->set_size_request(300, 200);
  10. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  11. my $label = Gtk2::Label->new(decode('utf8', '你好!'));
  12. $window->add($label);
  13. $window->show_all();
  14. Gtk2->main;
复制代码
Hello World!

Hello World!

在 windows 上运行时可能会遇到这样一些问题:

   1. 如果提示不能导入 Glib.dll,请确认 Gtk 运行环境的 bin 目录是系统环境变量 PATH 中,没有的话要加到这个环境变量中。
   2. 如果出现找不到 signal_connect 方法的错误,需要修改 Gtk2.pm 文件,在里面加上一句:

push @Gtk2::Object::ISA, 'Glib::Object';

错误 1 可能的提示如下:

Can't load 'C:/Perl/site/lib/auto/Glib/Glib.dll' for module Glib: load_file:找不到指定的模块。 at C:/Perl/lib/DynaLoader.pm line 230.
at C:/Perl/site/lib/Gtk2.pm line 30

错误 2 可能的提示如下:

Can't locate object method "signal_connect" via package "Gtk2::Window" at helloworld.pl line 9.

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:03 | 显示全部楼层
Gtk2-Perl 2.解析 helloworld 程序
让我们一句一句分析这个 helloworld 程序。
  1. use Gtk2 '-init';
  2. use Glib qw(TRUE FALSE);
  3. use Encode qw(decode);
  4. my $window = Gtk2::Window->new('toplevel');
  5. $window->set_title('Hello World!');
  6. $window->set_position('center_always');
  7. $window->set_size_request(300, 200);
  8. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  9. my $label = Gtk2::Label->new(decode('utf8', '你好!'));
  10. $window->add($label);
  11. $window->show_all();
  12. Gtk2->main;
复制代码
第一行导入 Gtk2 模块。这是 perl 程序通常都需要的步骤。-init 参数相当于调用了 C 库中的 gtk_init 函数。它会作一些必须的初始化工作,并解析需要的命令行参数。只有在主程序中要使用 -init 参数,模块中不要使用这个参数。

第二行导入 Glib 模块。一般来说不导入这个模块也是可以的,TRUE 和 FALSE 只是两个常数,可以从 Glib.pm 中看到它们的定义,分别是 1 和 !1,在代码中可以用 1 和 0 代替。但是还是建议导入这两个常数,尽量让代码可读性更好。

第三行导入 Encode 模块。如果要和多字节字符打交道,这个模块是必不可少的。 Gtk2 和 perl 一样,使用的是 unicode。在界面上显示的字符都必须是 utf8 编码的。需要注意的是,Gtk2 的字符串和 perl 内部字符串是一致的,非 ASCII 字符串是带 utf8 flag 的。所以直接从 utf8 编码的文件中读取的字符串是无法正确显示的,需要用 decode('utf8', $str) 才行。

第四行新建一个 Gtk2::Window 对象。Gtk2::Window 的 new 带一个参数,它的类型是 GtkWindowType,它在 c 中是以一个 enum 类型定义的,只能有两个值:'popup' 和 'toplevel'。几乎所有的窗口都是 toplevel 类型的,popup 一般用于创建其它组件,比如菜单,tooltip 等等。

第 5, 6, 7 行都是设置窗口的属性。每个组件都有属性,在 POD 文档里会列出来。每一种属性都有一定的权限,比如是否可读,是否可写。如果可读则可以用 get_ATTR 方法来得到属性值,如果可写就可以用 set_ATTR 来设置属性。这里窗口的 title 属性用于设置窗口的标题栏文字。position 用于设置窗口的初始位置。set_size_request 用于设置窗口的大小。

第 8 行让窗口在关闭时退出 Gtk2 的主循环。如果不加入这个回调函数,在窗口关闭后程序不会自动退出。你可能要自己杀死这个进程或者发送 INT 信号。所以主窗口一般都要加上这个回调函数。GObject 在执行某些操作时会发出一些信号,用户可以在发出信号时调用某些函数,称为回调函数。下面这个程序是一个很简单的模拟程序:
  1. #!/usr/bin/perl -w
  2. # simsig.pl --- Simulate signal connect
  3. package Object;
  4. sub new {
  5.     my $_class = shift;
  6.     my $class = ref $_class || $_class;
  7.     my $self = {
  8.         '__callback__' => {},
  9.     };

  10.     bless $self, $class;
  11.     return $self;
  12. }

  13. sub signal_emit {
  14.     my $self = shift;
  15.     my $signal = shift;
  16.     my $callbacks = $self->{'__callback__'}{$signal};
  17.     my $done = 0;
  18.     my $i = 0;
  19.     while ( $i<=$#$callbacks && !$done ) {
  20.         $done = $callbacks->[$i]->($self);
  21.         $i++;
  22.     }
  23. }

  24. sub signal_connect {
  25.     my $self = shift;
  26.     my $signal = shift;
  27.     my $callback = shift;
  28.     push @{$self->{'__callback__'}{$signal}}, $callback;
  29. }

  30. sub set_value {
  31.     my $self = shift;
  32.     $self->{value} = shift;
  33.     $self->signal_emit('changed');
  34.     return $self->{value};
  35. }

  36. sub get_value {
  37.     my $self = shift;
  38.     return $self->{value};
  39. }

  40. package main;

  41. my $obj = Object->new();
  42. $obj->signal_connect(
  43.     'changed' => sub {
  44.         my $self = shift;
  45.         print "Now I'm ", $self->get_value(), "\n";
  46.         return 0;
  47.     },
  48. );
  49. $obj->signal_connect(
  50.     'changed' => sub {
  51.         my $self = shift;
  52.         print "I get the signal also.\n";
  53.         return 0;
  54.     },
  55. );
  56. $obj->set_value('foo');
复制代码
需要注意的信号的回调函数的返回值是很重要的,如果返回值测试是真值,则其它回调函数则不会再调用了。所以通常情况下,回调函数都要返回一个假值。

第 9 行创建了一个标签。并在标签上显示了汉字。

第 10 行显示主窗口。组件创建后默认是不显示出来的,只有使用 show 函数,这个组件才会显示。show_all 函数是让这个组件所有的子组件都显示出来。

第 11 行让程序进入主循环。事件驱动编程和一般程序一个最大的不同可能就在主循环。事件驱动的程序一般都处于一个主循环中,程序始终在等待事件的产生,比如用户输入,设备响应等等。当程序得到一个输入信号,程序就会按定义好的方法对这个信号进行响应。

Gtk2 的文档可以从官方网站是在线浏览。也可以用 apt 安装 libgtk2-perl-doc。要得到更新的文档,可以自己从 CVS 得到,不过所有文件都是自动生成的,所以,需要有编译环境才能产生。

文档的结构包括这么几个部分:

   1. HIERARCHY 显示类的继承关系
   2. 简要说明
   3. METHODS 类方法
   4. PROPERTIES 类的属性,可以通过 set 和 get 函数访问或修改
   5. SIGNALS 可用的信号类型
   6. ENUMS AND FLAGS 参数的类型说明

查找起来还是很方便的。如果实在没有函数说明,可以直接参考 Gtk+ Reference manual,它是 Gtk2 最全面,也是最权威的文档。

除了 POD 文档之外,有几个比较好的文档:

   1. Gtk2-Perl Study Guide
   2. GTK2-Perl Tutorial
   3. Gtk2 Tutorial for C
   4. GTK+ Reference Manual

第四个也可以用 apt 安装 libgtk2.0-doc 得到。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:04 | 显示全部楼层
Gtk2-Perl 3.组件排布系统

如果你用过 Tk 写程序,一定会很容易接受 Gtk2 的组件排布系统。和 Tk 里的容器不同,可以分成两类,一类只能容纳一个组件,一类可以容纳多个组件。前者比如 Gtk2::Window,Gtk2::Button 等等,它们都是 Gtk2::Bin 的子类。后者比如 Gtk2::Box 和 Gtk2::Table,也是通常在 Gtk2::Bin 类型的组件中加入多个组件所使用的方法。

Gtk2::Box 又可以分为 Gtk2::VBox 和 Gtk2::HBox。V 代表垂直(Vertical), H 代表水平(Horizontal)。也就是说使用 Box 组件只能在一个方向上排列组件。组合使用 VBox 和 HBox 就能达到任意一种排布效果。由于这两种容器在使用上几乎没有任何区别,这里以 VBox 为例,说明它的使用方法。

使用 new 函数创建一个 VBox:

Gtk2::HBox->new($homogeneous, $spacing)

$homogeneous 的意思是相同的,也就是说如果这个参数为真值,则 VBox 里所有的组件大小都是相同的。$spacing 是各个组件之间的空隔大小。

向一个 VBox 加入一个新组件,可以用 pack_end 和 pack_start 方法:

$box->pack_end ($child, $expand, $fill, $padding)
$box->pack_start ($child, $expand, $fill, $padding)

这两个函数加入组件的位置和方向是不同的,一个是从顶部加入,一个是从底部加入,一个是由上往下的顺序加入,一个是由下往上的顺序加入:
  1. #!/usr/bin/perl -w
  2. # pack-demo.pl --- Demostrate Gtk pack system
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);

  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });

  7. my $vbox = Gtk2::VBox->new(FALSE, 5);
  8. $vbox->pack_start($_, FALSE, FALSE, 5) for widgets('start');
  9. $vbox->pack_end($_, FALSE, FALSE, 5) for widgets('end');
  10. $vbox->show_all();
  11. $window->add($vbox);
  12. $window->show();
  13. Gtk2->main;

  14. sub widgets {
  15.     my $method = shift;
  16.     my $label = Gtk2::Label->new('Label using ' . $method);
  17.     my $but = Gtk2::Button->new('Button using ' . $method);
  18.     return ($label, $but);
  19. }
复制代码
Pack Demo

pack_start 函数参数 $expand 表示如果有多余的空间时,是否要把这个空间分配给这个组件。$fill 表示如果由 $expand 选项得到的多余的空间是作为 padding 的空间还是用这个组件填充所有空间,所以 $fill 选项只有在$expand 为真是才有效。$padding 是这个组件和其它组件之间的空隔大小。下面这个程序可以看出这些选项的作用。
  1. #!/usr/bin/perl -w
  2. # pack-demo2.pl --- Demostrate Gtk pack system
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);

  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });

  7. my $vbox = Gtk2::VBox->new(FALSE, 5);
  8. my @box_ops = (
  9.     [FALSE, 5],
  10.     [TRUE, 5],
  11. );
  12. my @pack_ops = (
  13.     [FALSE, FALSE, 5],
  14.     [TRUE, FALSE, 5],
  15.     [TRUE, TRUE, 5]
  16. );
  17. foreach my $bop ( @box_ops ) {
  18.     my $frame = Gtk2::Frame->new("Gtk2::HBox->new(" .
  19.                                 ($bop->[0] ? 'TRUE' : 'FALSE') . ", 5)");
  20.     my $vbox1 = Gtk2::VBox->new(FALSE, 5);
  21.     $frame->add($vbox1);
  22.     foreach my $op ( @pack_ops ) {
  23.         my $hbox = Gtk2::HBox->new(@$bop);
  24.         $hbox->pack_start(Gtk2::Button->new("pack_start("), @$op);
  25.         $hbox->pack_start(Gtk2::Button->new($op->[0]?'TRUE':'FALSE'), @$op);
  26.         $hbox->pack_start(Gtk2::Button->new($op->[1]?'TRUE':'FALSE'), @$op);
  27.         $hbox->pack_start(Gtk2::Button->new($op->[2]), @$op);
  28.         $hbox->pack_start(Gtk2::Button->new(")"), @$op);
  29.         $vbox1->pack_start($hbox, FALSE, FALSE, 5);
  30.     }
  31.     my $hbox = Gtk2::HBox->new(@$bop);
  32.     foreach ( qw/add= packstart( TRUE TRUE 5)/) {
  33.         $hbox->add(Gtk2::Button->new($_));
  34.     }
  35.     $vbox1->pack_start($hbox, FALSE, FALSE, 5);
  36.     $vbox->add($frame);
  37. }

  38. $vbox->show_all();
  39. $window->add($vbox);
  40. $window->show();
  41. Gtk2->main;
复制代码
Pack Demo 2

上面的例子中还使用的 add 函数。这是从 Gtk2::Container 中继承的方法,它相当于使用缺省参数的 pack_start 函数。

Gtk2::Table 是以表格的形式排布组件。它的 new 函数参数如下:

Gtk2::Table->new($rows, $columns, $homogeneous)

加入一个组件到 Table 里使用 attach 或者 attach_defaults 方法:

$table->attach($child, $left, $right, $top, $bottom, $xoptions, $yoptions, $xpadding, $ypadding)
$table->attach_defaults($child, $left, $right, $top, $bottom)

从参数上来看,attach_defaults 是使用缺省参数的 attach 函数。其中 $left, $right, $top, $bottom 分别对应表格中的左右上下边界。比如以下面方式摆放的组件效果如图所示:

$table->attach_defaults($label, 0, 2, 0, 1);
$table->attach_defaults($button1, 0, 1, 1, 2);
$table->attach_defaults($label, 1, 2, 1, 2);

       0          1             2
     0 +------------------------+
       |                        |
       |        Label           |
       |                        |
     1 +----------+-------------+
       |          |             |
       |  button1 |   button2   |
     2 +----------+-------------+

$xoptions 和 $yoptions 类似于 pack_start 中的 $fill 选项,它可选值有 'expand', 'shrink', 'fill'。$xpadding 和 $ypadding 是与其它容器的空隔。 attach_defaults 的 options 为 ['expand', 'fill'],padding 值为 0。

最后需要注意一点是,一个组件只能加入到一个容器中,如果加到多个容器中就会出错。

当界面比较复杂时,自己在源程序中排布界面无论是写还是维护都是一件很头疼的事。Glade 可以说是改变了这种状态,它使得程序员从自己编写图形界面的代码中解脱出来。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:06 | 显示全部楼层
Gtk2-Perl 4.Label

Label 是一个很简单的组件。先看看怎样生成一个 Label。
  1. #!/usr/bin/perl -w
  2. # label-demo1.pl --- Demonstrate Widget Label
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. $window->set_size_request(300, 300);
  8. my $vbox = Gtk2::VBox->new(FALSE, 4);
  9. my $label = Gtk2::Label->new("This a simple label");
  10. $vbox->add($label);
  11. $vbox->show_all();
  12. $window->add($vbox);
  13. $window->show();
  14. Gtk2->main;
复制代码
为了方便加入其它组件,我在 $window 里加入一个 VBox。

Label 一个最重要的属性是 align。我使用 VScale 和 HScale 来演示一个 align 的效果:
  1. #!/usr/bin/perl -w
  2. # label-demo2.pl --- Demonstrate text align in Label
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. $window->set_size_request(300, 300);
  8. my $table = Gtk2::Table->new(2, 2, FALSE);
  9. my $label = Gtk2::Label->new("This a simple label");
  10. $table->attach_defaults($label, 1, 2, 0, 1);
  11. # 用 VScale 控制 Label 的 yalign
  12. my $vsb = Gtk2::VScale->new_with_range(0, 1, 0.05);
  13. $vsb->signal_connect(
  14.     'value-changed' => sub {
  15.         my $vsb = shift;
  16.         my @align = $label->get_alignment();
  17.         $label->set_alignment($align[0], $vsb->get_value());
  18.         return FALSE;
  19.     });
  20. $vsb->set_value(0.5);
  21. $table->attach_defaults($vsb, 0, 1, 0, 1);
  22. # 用 HScale 控制 Label 的 xalign
  23. my $hsb = Gtk2::HScale->new_with_range(0, 1, 0.05);
  24. $hsb->signal_connect(
  25.     'value-changed' => sub {
  26.         my $hsb = shift;
  27.         my @align = $label->get_alignment();
  28.         $label->set_alignment($hsb->get_value(), $align[1]);
  29.         return FALSE;
  30.     });
  31. $hsb->set_value(0.5);
  32. $table->attach_defaults($hsb, 1, 2, 1, 2);
  33. $table->show_all();
  34. $window->add($table);
  35. $window->show();
  36. Gtk2->main;
复制代码
Label 另一个比较重要的属性是 justify, 它可以改变文字的对齐方式:
  1. #!/usr/bin/perl -w
  2. # label-demo3.pl --- Demonstrate justify in Label
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. $window->set_size_request(300, 300);
  8. my $vbox = Gtk2::VBox->new(FALSE, 4);
  9. my $label = Gtk2::Label->new(
  10.     "This a simple label:\n" .
  11.         "hello world!"
  12.     );
  13. $vbox->add($label);
  14. my $combo = Gtk2::ComboBox->new_text();
  15. map { $combo->append_text($_) } qw(left right center fill);
  16. $combo->set_active(0);
  17. $combo->signal_connect(
  18.     'changed' => sub {
  19.         my $box = shift;
  20.         print "Set justified ", $box->get_active_text, "\n";
  21.         $label->set_justify($box->get_active_text);
  22.         return FALSE;
  23.     });
  24. $vbox->pack_start($combo, FALSE, FALSE, 4);
  25. $vbox->show_all();
  26. $window->add($vbox);
  27. $window->show();
  28. Gtk2->main;
复制代码
还可以改变 Label 的角度:
  1. #!/usr/bin/perl -w
  2. # label-demo4.pl --- Demonstrate text angle in Label
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. $window->set_size_request(300, 300);
  8. my $vbox = Gtk2::VBox->new(FALSE, 4);
  9. my $label = Gtk2::Label->new(
  10.     "This a simple label:\n" .
  11.         "hello world!"
  12.     );
  13. $vbox->add($label);
  14. # 用 HScale 控制 Label 的角度
  15. my $hsb = Gtk2::HScale->new_with_range(0, 360, 1);
  16. $hsb->signal_connect(
  17.     'value-changed' => sub {
  18.         my $hsb = shift;
  19.         $label->set_angle($hsb->get_value());
  20.         return FALSE;
  21.     });
  22. $vbox->pack_start($hsb, FALSE, FALSE, 4);
  23. $vbox->show_all();
  24. $window->add($vbox);
  25. $window->show();
  26. Gtk2->main;
复制代码
改变角度时有一点需要注意,由于 Label 在不同角度时的大小是不同的,所以会引起窗口的大小改变。所以如果有必要,需要用 set_size_request 函数为 label 先分配足够的空间。

Gtk2 使用 Pango 管理字体,所以可以用 set_markup 用标签创建格式化的文本。
  1. #!/usr/bin/perl -w
  2. # text-markup.pl --- Demonstrate text markup
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. my $sw = Gtk2::ScrolledWindow->new();
  8. $sw->set_size_request (600, 400);
  9. $sw->set_policy ('automatic', 'automatic');
  10. our $label = Gtk2::Label->new();
  11. my %markup = (
  12.     b => '<b>bold</b>',
  13.     big => '<big>big</big>',
  14.     i => '<i>italic</i>',
  15.     s => '<s>Strikethrough</s>',
  16.     sub => 'subscript<sub>[sub]</sub>',
  17.     sup => 'superscript<sup>[sup]</sup>',
  18.     small => '<small>small</small>',
  19.     tt => '<tt>Monospace font</tt>',
  20.     u => '<u>underline</u>'
  21. );
  22. my %escapes = map {$_ => Glib::Markup::escape_text($markup{$_})} keys %markup;
  23. my %attrs = (
  24.     # font_desc => [],
  25.     # font_family => [],
  26.     size => [qw/xx-small x-small small medium large x-large xx-large/],
  27.     style => [qw/normal oblique italic/],
  28.     weight => [qw/ultralight light normal bold ultrabold heavy/],
  29.     variant => [qw/normal smallcaps/],
  30.     stretch => ['ultracondensed', 'extracondensed', 'condensed',
  31.                 'semicondensed', 'normal', 'semiexpanded', 'expanded',
  32.                 'extraexpanded', 'ultraexpanded'],
  33.     foreground => ['red', 'blue'],
  34.     background => ['red', 'blue'],
  35.     underline => ['single', 'double', 'low', 'none'],
  36.     underline_color => [['underline', 'single'],'red', 'blue'],
  37.     rise => [-10, 10],
  38.     strikethrough => ['true', 'false'],
  39.     strikethrough_color => [['strikethrough', 'true'],'red', 'blue'],
  40. );
  41. my $markup = qq(<span foreground="blue" size="x-large"><b>Some common markups</b></span>\n)
  42.     . join("\n", map { $markup{$_} . "\t" . $escapes{$_} } sort keys %markup)
  43. . qq(\n<span foreground="blue" size="x-large"><b>General markup can setup by span tag</b></span>:\n)
  44.     . join("\n",
  45.            map {
  46.                my $attr = $_;
  47.                my $tag = "span";
  48.                my @values = @{$attrs{$_}};
  49.                if ( ref $values[0] ) {
  50.                    my $extra = shift @values;
  51.                    $tag .= qq( $extra->[0]="$extra->[1]");
  52.                }
  53.                qq(<span size="large" foreground="salmon" weight="bold">$attr</span>\n) .
  54.                    join("\n",
  55.                         map {
  56.                             my $markup = qq(<$tag $attr="$_">$_</span>);
  57.                             $markup . "\t" . Glib::Markup::escape_text($markup)
  58.                         } @values )
  59.                } sort keys %attrs);
  60. print $markup;
  61. $label->set_markup($markup);
  62. $sw->add_with_viewport($label);
  63. $sw->show_all();
  64. $window->add($sw);
  65. $window->show();
  66. Gtk2->main;
复制代码
Label 还可以用 set_text_with_mnemonic 设置,这样可以用快捷键激活一个 Widget(这个 Widget 会发出 mnemonic_activate 信号)。通常可以和 Entry 一起使用,这是一个例子:
  1. #!/usr/bin/perl -w
  2. # mnemonic.pl --- Demonstrate text mnemonic
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. my $vbox = Gtk2::VBox->new(FALSE, 4);
  8. my $frame = Gtk2::Frame->new("A simple form");
  9. my $table = Gtk2::Table->new(2, 2, FALSE);
  10. my $name_label = Gtk2::Label->new();
  11. $table->attach_defaults($name_label, 0, 1, 0, 1);
  12. my $name_entry = Gtk2::Entry->new();
  13. $table->attach_defaults($name_entry, 1, 2, 0, 1);
  14. $name_label->set_text_with_mnemonic("_Name: ");
  15. $name_label->set_mnemonic_widget($name_entry);
  16. my $email_label = Gtk2::Label->new();
  17. $table->attach_defaults($email_label, 0, 1, 1, 2);
  18. my $email_entry = Gtk2::Entry->new();
  19. $table->attach_defaults($email_entry, 1, 2, 1, 2);
  20. $email_label->set_text_with_mnemonic("_Email: ");
  21. $email_label->set_mnemonic_widget($email_entry);
  22. $frame->add($table);
  23. $vbox->add($frame);
  24. my $but = Gtk2::Button->new_from_stock('gtk-ok');
  25. $but->signal_connect(
  26.     'clicked' => sub {
  27.         print "Name: ", $name_entry->get_text(), "\n";
  28.         print "Email: ", $email_entry->get_text(), "\n";
  29.         return FALSE;
  30.     });
  31. $vbox->pack_start($but, FALSE, FALSE, 4);
  32. $vbox->show_all();
  33. $window->add($vbox);
  34. $window->show();
  35. Gtk2->main();
复制代码
通过用 Alt+N 和 Alt+E 可以很方便的在不同的 Entry 之间切换。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:07 | 显示全部楼层
Gtk2-Perl 5.Button

按钮和它的子类包括:
  • Gtk2::Button
  • Gtk2::ToggleButton
  • Gtk2::CheckButton

Button 是 Bin 的子类,也就是说 Button 中仅可以容纳一个组件。通常使用带一个字符串参数 new 函数是把一个 Label 加入到 Button 中。比较高版本的 Gtk2-Perl 可以用 set_image 设置一个按钮的图标。

ToggleButton 和 CheckButton 只是外观上不一样,在使用上没有差别。

下面这个例子说明了按钮通常的使用方法:
  1. #!/usr/bin/perl -w
  2. # button.pl --- Demonstrate button
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);

  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. my $vbox = Gtk2::VBox->new(FALSE,5);

  8. # 最简单的按钮
  9. my $but1 = Gtk2::Button->new('_Bye');
  10. $but1->signal_connect('clicked' => sub { Gtk2->main_quit });
  11. $vbox->add($but1);
  12. # 带一个图标的按钮
  13. my $but2 = Gtk2::Button->new('_Exit');
  14. my $image = Gtk2::Image->new_from_file("../../images/gtkperl/gnu-keys.png");
  15. $but2->set_image($image);
  16. $but2->signal_connect('clicked' => sub { Gtk2->main_quit });
  17. $vbox->add($but2);
  18. # 预定义的按钮
  19. my $but3 = Gtk2::Button->new_from_stock('gtk-quit');
  20. $but3->signal_connect('clicked' => sub { Gtk2->main_quit });
  21. $vbox->add($but3);
  22. # 能改变鼠标图象的按钮
  23. my $hand_cursor = Gtk2::Gdk::Cursor->new ('hand2');
  24. my $but4 = Gtk2::Button->new('Click me');
  25. $but4->signal_connect(
  26.     'enter' => sub {
  27.         my $but = shift;
  28.         $but->window->set_cursor($hand_cursor);
  29.         return FALSE;
  30.     });
  31. $but4->signal_connect(
  32.     'leave' => sub {
  33.         my $but = shift;
  34.         $but->window->set_cursor(undef);
  35.     });
  36. $vbox->add($but4);
  37. # ToggleButton
  38. my $hbox1 = Gtk2::HBox->new(FALSE, 4);
  39. my $tbut = Gtk2::ToggleButton->new("_Toggle");
  40. $hbox1->add($tbut);
  41. my $label1 = Gtk2::Label->new();
  42. $hbox1->add($label1);
  43. my $toggle_action = sub {
  44.     my $tbut = shift;
  45.     $label1->set_label(
  46.         'The button is ' . ( $tbut->get_active() ? 'active' : 'inactive')
  47.     );
  48.     return FALSE;
  49. };
  50. $tbut->signal_connect( 'toggled' => $toggle_action );
  51. ## 使 $label1 改变
  52. &$toggle_action($tbut);
  53. $vbox->add($hbox1);
  54. # CheckButton
  55. my $hbox2 = Gtk2::HBox->new(FALSE, 4);
  56. my $cbut = Gtk2::CheckButton->new("_Check");
  57. $hbox2->add($cbut);
  58. my $label2 = Gtk2::Label->new();
  59. $hbox2->add($label2);
  60. $cbut->signal_connect(
  61.     'toggled' => sub {
  62.         my $cbut = shift;
  63.         $label2->set_label(
  64.             'The button is ' . ( $cbut->get_active() ? 'active' : 'inactive')
  65.         );
  66.         return FALSE;
  67.     });
  68. $cbut->set_active(TRUE);
  69. $vbox->add($hbox2);
  70. $vbox->show_all();
  71. $window->add($vbox);
  72. $window->show();
  73. Gtk2->main();
复制代码
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:08 | 显示全部楼层
Gtk2-Perl 6.Dialog

对话框通常用于显示提示信息或者得到用户的响应。

Dialog 和 Window 是一种类型,可以作为 Toplevel 的窗口。一个 Dialog 可以分成上下两个部分。上面是一个 VBox,可以容纳用户自定义的组件。下面是 action_area,可以放置 Button。它们用 HSeparator 分开。

Dialog 的 new 函数参数如下:

Gtk2::Dialog->new ($title, $parent_window, $flags, buttons)

$title 是对话框的标题,$parent_window 是对话框的父窗口。$flags 可以是三种类型:modal, destroy-with-parent, no-separator。后面两种很好理解,分别是指让对话框和父窗口一起关闭和在对话框中不显示 HSeparator。modal 是指使其它窗口不响应用户输入,也可以用 Dialog 的 set_modal 方法设置。一般设置了 modal,就不需要 destroy-with-parent,因为父窗口得不用户的响应,也就关闭不了了。如果要指定多个 flags,可以将 $flags 设置为包含这些 flags 的数组引用。

buttons 是将要显示的按钮。它是由 button-text => response-id 这样的值对组成。button-text 也可以是一个 stock_id,response-id 只能是 Gtk2::ResponseType。

使用 run 方法可以获得用户的一次 response。所谓获得一次 response 就是指用户点击了其中的一个按钮。下面是一个例子:
  1. #!/usr/bin/perl -w
  2. # dialog1.pl --- Simple dialog
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);

  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->set_position('center_always');
  7. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });

  8. my $vbox = Gtk2::VBox->new(FALSE,5);
  9. my $but = Gtk2::Button->new("_Show the Dialog");
  10. $but->signal_connect('clicked' => \&show_dialog);
  11. my $label = Gtk2::Label->new("Wait for your response");
  12. $vbox->add($but);
  13. $vbox->add($label);
  14. $vbox->show_all();
  15. $window->add($vbox);
  16. $window->show();
  17. show_dialog($but);
  18. Gtk2->main;

  19. sub show_dialog {
  20.     my $but = shift;
  21.     my $top = $but->get_toplevel;
  22.     my $dia = Gtk2::Dialog->new(
  23.         'Choose ', $top,
  24.         'modal',
  25.         'gtk-ok' => 'ok',
  26.         '_Give up' => 'cancel',
  27.     );
  28.     my $vbox = $dia->vbox;
  29.     my $dia_label = Gtk2::Label->new("What do you choose?");
  30.     $vbox->add($dia_label);
  31.     $vbox->show_all();
  32.     my $response = $dia->run();
  33.     # run 并不代表对话框关闭
  34.     $dia->destroy();
  35.     $label->set_label('Your answer is "' . $response . '"');
  36.     return FALSE;
  37. }
复制代码
前面这个例子也可以用 Dialog 的 response 信号:
  1. sub show_dialog {
  2.     my $but = shift;
  3.     my $top = $but->get_toplevel;
  4.     my $dia = Gtk2::Dialog->new(
  5.         'Choose ', $top,
  6.         'modal',
  7.         'gtk-ok' => 'ok',
  8.         '_Give up' => 'cancel',
  9.     );
  10.     my $vbox = $dia->vbox;
  11.     my $dia_label = Gtk2::Label->new("What do you choose?");
  12.     $vbox->add($dia_label);
  13.     $vbox->show_all();
  14.     $dia->signal_connect(
  15.         'response' => sub {
  16.             my ($dia, $response_id) = @_;
  17.             if ( grep {$response_id eq $_} qw/ok cancel/ ) {
  18.                 $label->set_label('Your answer is "' . $response_id . '"');
  19.                 $dia->destroy;
  20.             }
  21.             return FALSE;
  22.         });
  23.     $dia->show();
  24.     return FALSE;
  25. }
复制代码
再介绍几种特殊的对话框:

Gtk2::Dialog
|- Gtk2::AboutDialog
|- Gtk2::ColorSelectionDialog
|- Gtk2::FileChooserDialog
|- Gtk2::FileSelection
|- Gtk2::FontSelectionDialog
|- Gtk2::InputDialog
|- Gtk2::MessageDialog
`- Gtk2::RecentChooserDialog

MessageDialog 比较简单,它是带消息类型图标的对话框。虽然也可以很容易用 Dialog 产生相同的 MessageDialog,但是它比较方便,而且界面一致。它的 new 函数参数类型如下:

Gtk2::MessageDialog->new ($parent_window, $flags, $msg_type,
                          $buttons, $format, arguments);

大部分参数与 Dialog 类似。$msg_type 有五种,分别是 'info', 'warning', 'question', 'error', 'other'。$buttons 不能任意的指定,只能是 Gtk2::ButtonsType 类型,可以是 'none', 'ok', 'close', 'cancel', 'yes-no', 'ok-cancel' 这几种类型。$format 和 arguments 可以看成是 sprintf的参数,产生的字符串作为对话框显示的消息。
  1. sub show_dialog {
  2.     my $but = shift;
  3.     my $top = $but->get_toplevel;
  4.     my $amount = 100;
  5.     my $dia = Gtk2::MessageDialog->new(
  6.         $top, 'destroy-with-parent',
  7.         'question',
  8.         'yes-no',
  9.         "Pay me \$%.2f?", $amount
  10.     );
  11.     $dia->set_default_response('yes');
  12.     $dia->show();
  13.     $dia->signal_connect(
  14.         'response' => sub {
  15.             my ($dia, $response_id) = @_;
  16.             if ( $response_id eq 'yes' ) {
  17.                 $label->set_label('Send the bill');
  18.             } elsif ( $response_id eq 'no') {
  19.                 $label->set_label("Nothing");
  20.             }
  21.             $dia->destroy();
  22.             return FALSE;
  23.         });
  24.     return FALSE;
  25. }
复制代码
文件选择可以使用 FileChooserDialog。它的 new 函数参数如下:

Gtk2::FileChooserDialog->new ($title, $parent, $action, ...)

$action 可以是 'open', 'save', 'select-folder', 'create-folder' 四种类型,分别可以用于得到已经存在的文件名,用于保存的文件名,已经存在的目录名,需要创建的目录名。这是一个打开文件的对话框例子:
  1. sub show_dialog {
  2.     my $but = shift;
  3.     my $top = $but->get_toplevel;
  4.     my $dia = Gtk2::FileChooserDialog->new(
  5.         'Choose a file', $top, 'open',
  6.         'gtk-cancel' => 'cancel',
  7.         'gtk-ok' => 'ok'
  8.     );
  9.     my @filters = (
  10.         ['Perl Script' => '*.pl'],
  11.         ['All Files' => '*']
  12.     );
  13.     foreach ( @filters ) {
  14.         my $filter = Gtk2::FileFilter->new();
  15.         $filter->set_name($_->[0]);
  16.         $filter->add_pattern($_->[1]);
  17.         $dia->add_filter($filter);
  18.     }
  19.     $dia->show();
  20.     $dia->signal_connect(
  21.         'response' => sub {
  22.             my ($dia, $response_id) = @_;
  23.             if ( $response_id eq 'ok' ) {
  24.                 $label->set_label('Your select "' . $dia->get_filename . '"');
  25.             }
  26.             $dia->destroy;
  27.             return FALSE;
  28.         });
  29.     return FALSE;
  30. }
复制代码
当然你也可以不用任何信号回调:
  1. $dia->run;
  2. my $file = $dia->get_filename;
  3. $dia->destroy;
复制代码
这样这个对话框只使用一次,如果用户选择了文件,则 $file 的值为选择的文件名,否则,点击 cancel 或者直接关闭对话框,$file 的值都是 undef。

FontSelectionDialog 更简单,使用方法如下:
  1. sub show_dialog {
  2.     my $but = shift;
  3.     my $top = $but->get_toplevel;
  4.     my $dia = Gtk2::FontSelectionDialog->new('Choose a font');
  5.     $dia->show();
  6.     $dia->signal_connect(
  7.         'response' => sub {
  8.             my ($dia, $response_id) = @_;
  9.             if ( $response_id eq 'ok' ) {
  10.                 $label->set_label('Your select "' . $dia->get_font_name . '"');
  11.             }
  12.             $dia->destroy;
  13.             return FALSE;
  14.         });
  15.     return FALSE;
  16. }
复制代码
ColorSelectionDialog 也是类似的:
  1. sub show_dialog {
  2.     my $but = shift;
  3.     my $top = $but->get_toplevel;
  4.     my $dia = Gtk2::ColorSelectionDialog->new('Choose a color');
  5.     $dia->show();
  6.     $dia->signal_connect(
  7.         'response' => sub {
  8.             my ($dia, $response_id) = @_;
  9.             if ( $response_id eq 'ok' ) {
  10.                 my $color = $dia->colorsel->get_current_color;
  11.                 $label->set_label(sprintf('Your select color with rgb(%d, %d, %d)', map {$_/257} $color->red, $color->green, $color->blue));
  12.             }
  13.             $dia->destroy;
  14.             return FALSE;
  15.         });
  16.     return FALSE;
  17. }
复制代码
其它类型的 Dialog 用法大同小异,也比较少用。建议使用 Glade 创建。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:09 | 显示全部楼层
Gtk2-Perl 7.TreeView

TreeView 用于显示存储在 Gtk2::TreeModel 对象中的数据。两种主要的 model 类:Gtk2::TreeStore 和 Gtk2::ListStore。

下面这个例子可以显示当前目录下的文件内容:
  1. #!/usr/bin/perl -w
  2. # treeview1.pl --- Simple TreeView
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. use Cwd;
  6. use constant {
  7.     FILE_ICON  => 0,
  8.     FILE_NAME  => 1,
  9.     FILE_MTIME => 2,
  10. };

  11. my $dir = shift || getcwd;
  12. my $window = Gtk2::Window->new('toplevel');
  13. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  14. ret_vbox($window, $dir);
  15. $window->show();
  16. Gtk2->main;

  17. sub ret_vbox {
  18.     my $top = shift;
  19.     my $dir = shift;
  20.     $top->set_title('Directory contents of '. $dir);
  21.     my $vbox = Gtk2::VBox->new(FALSE, 4);
  22.     my $sw = Gtk2::ScrolledWindow->new;
  23.     $sw->set_size_request (600, 400);
  24.     $sw->set_policy ('automatic', 'automatic');
  25.     # create TreeView
  26.     my $model = create_model($dir);
  27.     my $treeview = Gtk2::TreeView->new_with_model($model);
  28.     add_columns($treeview);
  29.     $sw->add($treeview);
  30.     $vbox->pack_start($sw,TRUE,TRUE,0);
  31.     $vbox->show_all();
  32.     $top->add($vbox);
  33. }

  34. sub create_model {
  35.     my $dir = shift;
  36.     my $model = Gtk2::ListStore->new(
  37.         'Glib::String', 'Glib::String', 'Glib::String'
  38.     );
  39.     opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  40.     foreach my $file ( readdir(DIR) ) {
  41.         next if $file =~ /^[.]/; # ignore '.', '..' and hiden files
  42.         my $iter = $model->append();
  43.         $model->set(
  44.             $iter,
  45.             FILE_ICON, ( -d "$dir/$file" ? 'gtk-directory' : 'gtk-file' ),
  46.             FILE_NAME, $file,
  47.             FILE_MTIME,  scalar(localtime((stat("$dir/$file"))[9]))
  48.         );
  49.     }
  50.     return $model;
  51. }

  52. sub add_columns {
  53.     my $treeview = shift;
  54.     ## Add first column
  55.     my $column1 = Gtk2::TreeViewColumn->new();
  56.     $column1->set_title('file name');
  57.     ### first cell for column one
  58.     my $icon = Gtk2::CellRendererPixbuf->new();
  59.     $column1->pack_start($icon, FALSE);
  60.     $column1->set_attributes( $icon, 'stock-id' => FILE_ICON );
  61.     ### second cell for column one
  62.     my $name = Gtk2::CellRendererText->new();
  63.     $column1->pack_start($name, FALSE);
  64.     $column1->set_attributes( $name, 'text' => FILE_NAME );
  65.     $column1->set_sort_column_id(FILE_NAME);
  66.     $treeview->append_column($column1);
  67.     ## Add second column
  68.     my $column2 = Gtk2::TreeViewColumn->new();
  69.     $column2->set_title("modify time");
  70.     my $mtime = Gtk2::CellRendererText->new();
  71.     $column2->pack_start($mtime, FALSE);
  72.     $column2->set_attributes($mtime, 'text' => FILE_MTIME);
  73.     $column2->set_sort_column_id(FILE_MTIME);
  74.     $treeview->append_column($column2);
  75. }
复制代码
创建一个树的过程可以归纳为这样一个过程:

   1. 创建树的 model
   2. 使用这个 model 新建一个树
   3. 加入树的 column,每个 column 可以有多个 cell,每个 cell 都有不同的属性,通过设置属性来控制每个 column 里显示的内容。

显示列表里每一行对应 model 里每一个 TreeIter。

有时候可以用 insert_column_with_attributes 简化插入一个 column 的过程,比如前面第二个 column 可以换成下面这样,append_column 那一行就不需要了:
  1.     ## Add second column
  2.     $treeview->insert_column_with_attributes(
  3.         1, "modify time",
  4.         Gtk2::CellRendererText->new(),
  5.         'text' => FILE_MTIME
  6.     );
  7.     $treeview->get_column(1)->set_sort_column_id(FILE_MTIME);
复制代码
但是用 insert_column_with_attributes 后就不能在同一栏里插入两个 cell,所以 column1 还是要用前面这种写法。

TreeViewColumn 里显示的数据也可以不在 TreeModel 里。可以设置函数来控制每一个 TreeIter 在每一栏中应该显示什么内容。这可以用 TreeView 的 insert_column_with_data_func 或者 set_cell_data_func 函数实现。比如前面这个例子里,如果要让文件按时间排序,用 localtime 转换后的字符串是不行的。所以要改成这样:
  1. sub create_model {
  2.     my $dir = shift;
  3.     my $model = Gtk2::ListStore->new(
  4.         'Glib::String', 'Glib::String', 'Glib::Int'
  5.     );
  6.     opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  7.     foreach my $file ( readdir(DIR) ) {
  8.         next if $file =~ /^[.]/; # ignore '.', '..' and hiden files
  9.         my $iter = $model->append();
  10.         $model->set(
  11.             $iter,
  12.             FILE_ICON, ( -d "$dir/$file" ? 'gtk-directory' : 'gtk-file' ),
  13.             FILE_NAME, $file,
  14.             FILE_MTIME, (stat("$dir/$file"))[9]
  15.         );
  16.     }
  17.     return $model;
  18. }

  19. sub add_columns {
  20.     use Date::Format;
  21.     my $treeview = shift;
  22.     ## Add first column
  23.     my $column1 = Gtk2::TreeViewColumn->new();
  24.     $column1->set_title('file name');
  25.     ### first cell for column one
  26.     my $icon = Gtk2::CellRendererPixbuf->new();
  27.     $column1->pack_start($icon, FALSE);
  28.     $column1->set_attributes( $icon, 'stock-id' => FILE_ICON );
  29.     ### second cell for column one
  30.     my $name = Gtk2::CellRendererText->new();
  31.     $column1->pack_start($name, FALSE);
  32.     $column1->set_attributes( $name, 'text' => FILE_NAME );
  33.     $column1->set_sort_column_id(FILE_NAME);
  34.     $treeview->append_column($column1);
  35.     ## Add second column
  36.     $treeview->insert_column_with_data_func(
  37.         1, "modify time",
  38.         Gtk2::CellRendererText->new(),
  39.         sub {
  40.             my ($tree_column, $cell, $model, $iter) = @_;
  41.             my ($mtime) = $model->get ($iter, FILE_MTIME);
  42.             my @lc = localtime($mtime);
  43.             $cell->set (text => strftime("%c", @lc));
  44.         }
  45.     );
  46.     $treeview->get_column(1)->set_sort_column_id(FILE_MTIME);
  47. }
复制代码
前面是关于使用 ListStore 的使用,TreeStore 的使用和 ListStore 是很类似的。只是创建 model 的方法不同而已。对于静态数据只要修改前面的 create_model 函数就行了:
  1. sub read_dir {
  2.     my $model = shift;
  3.     my $dir = shift;
  4.     my $iter = shift;
  5.     opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  6.     foreach my $file ( readdir(DIR) ) {
  7.         next if $file =~ /^[.]/;
  8.         my $full = "$dir/$file";
  9.         my $iter_child = $model->append($iter);
  10.         if ( -d $full ) {
  11.             $model->set(
  12.                 $iter_child,
  13.                 FILE_ICON, 'gtk-directory',
  14.                 FILE_NAME, $file,
  15.                 FILE_MTIME, (stat("$dir/$file"))[9]
  16.             );
  17.             read_dir($model, $full, $iter_child);
  18.         } else {
  19.             $model->set(
  20.                 $iter_child,
  21.                 FILE_ICON, 'gtk-file',
  22.                 FILE_NAME, $file,
  23.                 FILE_MTIME, (stat("$dir/$file"))[9]
  24.             );
  25.         }
  26.     }
  27. }

  28. sub create_model {
  29.     my $dir = shift;
  30.     my $model = Gtk2::TreeStore->new(
  31.         'Glib::String', 'Glib::String', 'Glib::Int'
  32.     );
  33.     read_dir($model, $dir);
  34.     return $model;
  35. }
复制代码
在前面这个例子递归把目录下的文件加到 TreeStore 里。使用 append 函数向一个 TreeIter 加入一个子项并返回这个子项。由于是树在显示之前就读入全部的数据,所以在目录里文件较多时会明显的感觉变慢了。如果要动态展开树,需要使用 row-expanded 这个信号。这是一个动态显示文件系统树的例子。
  1. #!/usr/bin/perl -w
  2. # treeview4.pl ---
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);
  5. use Cwd;
  6. use constant {
  7.     FILE_ICON  => 0,
  8.     FILE_NAME  => 1,
  9.     FILE_FULE_NAME => 2,
  10.     FILE_MTIME => 3,
  11. };

  12. my $dir = shift || getcwd;
  13. my $window = Gtk2::Window->new('toplevel');
  14. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  15. ret_vbox($window, $dir);
  16. $window->show();
  17. Gtk2->main;

  18. sub ret_vbox {
  19.     my $top = shift;
  20.     my $dir = shift;
  21.     $top->set_title('Directory contents of '. $dir);
  22.     my $vbox = Gtk2::VBox->new(FALSE, 4);
  23.     my $sw = Gtk2::ScrolledWindow->new;
  24.     $sw->set_size_request (600, 400);
  25.     $sw->set_policy ('automatic', 'automatic');
  26.     # create TreeView
  27.     my $model = create_model($dir);
  28.     my $treeview = Gtk2::TreeView->new_with_model($model);
  29.     add_columns($treeview);
  30.     $treeview->signal_connect( 'row-expanded' => \&expand_dir );
  31.     open_dir($model, $dir, undef);
  32.     $sw->add($treeview);
  33.     $vbox->pack_start($sw,TRUE,TRUE,0);
  34.     $vbox->show_all();
  35.     $top->add($vbox);
  36. }

  37. sub create_model {
  38.     my $dir = shift;
  39.     my $model = Gtk2::TreeStore->new(
  40.         'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Int'
  41.     );
  42.     return $model;
  43. }

  44. sub expand_dir {
  45.     my ($treeview,$iter,$path,$self) = @_;
  46.     my $model = $treeview->get_model();
  47.     my $dir = $model->get($iter, FILE_FULE_NAME);
  48.     my $first = $model->iter_nth_child($iter, 0);
  49.     unless ( defined $model->get($first, FILE_NAME) ) {
  50.         open_dir($model, $dir, $iter);
  51.         $model->remove($first);
  52.     }
  53.     return FALSE;
  54. }

  55. sub open_dir {
  56.     my ($model, $dir, $parent_iter) = @_;
  57.     opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  58.     foreach my $file ( readdir(DIR) ) {
  59.         next if $file =~ /^[.]/;
  60.         my $full = "$dir/$file";
  61.         my $iter = $model->append($parent_iter);
  62.         $model->set(
  63.             $iter,
  64.             FILE_ICON, ( -d $full ? 'gtk-directory' : 'gtk-file' ),
  65.             FILE_NAME, $file,
  66.             FILE_FULE_NAME, $full,
  67.             FILE_MTIME, (stat($full))[9]
  68.         );
  69.         if ( -d $full ) {
  70.             my $dummy = $model->append($iter);
  71.         }
  72.     }
  73.     return $model;
  74. }

  75. sub add_columns {
  76.     use Date::Format;
  77.     my $treeview = shift;
  78.     my $column;
  79.     ## Add first column
  80.     my $column1 = Gtk2::TreeViewColumn->new();
  81.     $column1->set_title('file name');
  82.     ### first cell for column one
  83.     my $icon = Gtk2::CellRendererPixbuf->new();
  84.     $column1->pack_start($icon, FALSE);
  85.     $column1->set_attributes( $icon, 'stock-id' => FILE_ICON );
  86.     ### second cell for column one
  87.     my $name = Gtk2::CellRendererText->new();
  88.     $column1->pack_start($name, FALSE);
  89.     $column1->set_attributes( $name, 'text' => FILE_NAME );
  90.     $column1->set_sort_column_id(FILE_NAME);
  91.     $treeview->append_column($column1);
  92.     ## Add second column
  93.     $treeview->insert_column_with_data_func(
  94.         1, "modify time",
  95.         Gtk2::CellRendererText->new(),
  96.         sub {
  97.             my ($tree_column, $cell, $model, $iter) = @_;
  98.             my ($mtime) = $model->get ($iter, FILE_MTIME);
  99.             my @lc = localtime($mtime);
  100.             $cell->set (text => strftime("%c", @lc));
  101.         }
  102.     );
  103.     $treeview->get_column(1)->set_sort_column_id(FILE_MTIME);
  104. }
复制代码
这样一个显示文件的树基本实现了。考虑到 Gtk2 使用的字符串和 perl 内部字符串相同,所以在读入目录时文件名中有多字节字符时会有问题,需要改成这样:
  1. sub open_dir {
  2.     use Encode qw/encode decode/;
  3.     my ($model, $dir, $parent_iter) = @_;
  4.     opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  5.     foreach my $file ( readdir(DIR) ) {
  6.         next if $file =~ /^[.]/;
  7.         my $enc_name = decode('utf8', $file);
  8.         my $full = "$dir/$enc_name";
  9.         my $iter = $model->append($parent_iter);
  10.         $model->set(
  11.             $iter,
  12.             FILE_ICON, ( -d $full ? 'gtk-directory' : 'gtk-file' ),
  13.             FILE_NAME, $enc_name,
  14.             FILE_FULE_NAME, $full,
  15.             FILE_MTIME, (stat($full))[9]
  16.         );
  17.         if ( -d $full ) {
  18.             my $dummy = $model->append($iter);
  19.         }
  20.     }
  21. }
复制代码
但是还有一个不足之处是,这里排序时不会优先考虑文件夹。让我们再来实现这个功能。在 add_columns 这个函数 $column1->set_sort_column_id(FILE_NAME) 这一行之后加上这个排序函数就行了:
  1.     # Set customized sort funciton
  2.     my $model = $treeview->get_model;
  3.     $model->set_sort_func(
  4.         FILE_NAME,
  5.         sub {
  6.             my ($model, $itera, $iterb) = @_;
  7.             if ( $model->get($itera, FILE_NAME)
  8.                      && $model->get($iterb, FILE_NAME)
  9.                          && $model->get($itera, FILE_ICON)
  10.                      && $model->get($iterb, FILE_ICON)
  11.                  ) {
  12.                 $model->get($itera, FILE_ICON) cmp $model->get($iterb, FILE_ICON)
  13.                     || $model->get($itera, FILE_NAME) cmp $model->get($iterb, FILE_NAME);
  14.             }
  15.         });
  16.     $model->set_sort_column_id(FILE_NAME, $column1->get_sort_order);
  17.     $model->sort_column_changed();
复制代码
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:10 | 显示全部楼层
Gtk2-Perl 8.下拉菜单

Gtk2 中下拉菜单使用的 ComboBox 和 ComboEntry 组件。由于使用 TreeMode, ComboBox 的使用很灵活,也很强大。先来看一个简单的例子(以下例子来自 study guide):
  1. #!/usr/bin/perl -w
  2. # popmenu.pl ---
  3. use Gtk2 '-init';
  4. use Glib qw(TRUE FALSE);

  5. my $window = Gtk2::Window->new('toplevel');
  6. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
  7. $window->set_border_width(5);
  8. $window->set_position('center_always');
  9. my $vbox = Gtk2::VBox->new(FALSE,5);

  10. my $cb = Gtk2::ComboBox->new_text;
  11. my @bands = ("Beatles", "Ten Years After", "Bad Finger", "Gravy
  12. Train", "Family", "Spirit");
  13. $cb->append_text("Select a band:");
  14. $cb->append_text($_) for @bands;
  15. $cb->signal_connect('changed' => \&on_cb_changed);
  16. $cb->set_active(0);
  17. $vbox->pack_start($cb,FALSE,FALSE,0);

  18. $vbox->show_all();
  19. $window->add($vbox);
  20. $window->show();
  21. Gtk2->main;

  22. sub on_cb_changed {
  23.     my $cb = shift;
  24.     if ( $cb->get_active ) {
  25.         print "Right on Man, ".$cb->get_active_text." is a cool band\n";
  26.     }
  27.     return FALSE;
  28. }
复制代码
get_active 得到的是当前 ComboBox 选择的条目序号,从 0 开始。可以用 set_active 来设置。如果设置为 -1,则表示不选择任何一个,显示为空白。 get_active_text 得到选择条目的文本。在选择条目改变时发出 'changed' 信号。

前面的代码完全等价于使用一个 ListStore 作为 TreeModel:
  1. my $ls = Gtk2::ListStore->new('Glib::String');
  2. my @bands = ("Beatles", "Ten Years After", "Bad Finger", "Gravy Train", "Family", "Spirit");
  3. $ls->set($ls->append, 0, $_) for ("Select a band:", @bands) ;
  4. my $cb = Gtk2::ComboBox->new($ls);
  5. my $cr = Gtk2::CellRendererText->new();
  6. $cb->pack_start($cr, TRUE);
  7. $cb->add_attribute($cr, 'text', 0);
复制代码
使用 TreeModel 有下面这些好处:
  • 可以和 TreeView 或者其它组件使用相同的 TreeModel
  • 可以同时显示图片和文字
  • 可以使用 TreeModelSort 和 TreeModelFilter 对列表进行管理
  • 可以自定义函数创建和同步列表

如果列表很长,则可能整个列表显示不下。可以使用 set_wrap_width 函数将列表变成几行显示:
  1. my $ls = Gtk2::ListStore->new('Glib::String');
  2. $ls->set($ls->append, 0, "Pedro x  $_") for (1..50);
  3. my $cb = Gtk2::ComboBox->new_text;
  4. $cb->set_model($ls);
  5. $cb->set_wrap_width(5);
  6. $cb->set_active(0);
  7. $cb->signal_connect(
  8.     'changed' => sub {
  9.         print $cb->get_active_text, "\n";
  10.         return FALSE;
  11.     });
复制代码
注意到使用 new_text 方法,可以缺省的创建 CellRendererText。

ComboBoxEntry 的使用方法和 ComboBox 几乎相同,只是 ComboBoxEntry 带有一个 Entry 组件,可以让用户输入列表中没有的选项。由于 Entry 中只能有文字,所以指定的 Model 必须有一个 Glib::String 类型的一列。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

141

主题

192

帖子

1653

金币

大家网大学二年级

Rank: 15Rank: 15Rank: 15

积分
1105
 楼主| 发表于 2010-3-24 18:11 | 显示全部楼层
Gtk2-Perl 9.Entry

Entry 是可以输入一行文字的组件。标准的 Entry 使用是很简单的:
  1. use Gtk2 '-init';
  2. use Glib qw(TRUE FALSE);

  3. my $window = Gtk2::Window->new('toplevel');
  4. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });

  5. my $vbox = Gtk2::VBox->new(FALSE,5);
  6. my $hbox1 = Gtk2::HBox->new(FALSE, 5);
  7. $vbox->add($hbox1);
  8. my $label1 = Gtk2::Label->new_with_mnemonic('_Text: ');
  9. $hbox1->add($label1);
  10. my $entry = Gtk2::Entry->new_with_max_length(50);
  11. $label1->set_mnemonic_widget($entry);
  12. $hbox1->add($entry);
  13. $entry->signal_connect(
  14.     'activate' => sub {
  15.         my $entry = shift;
  16.         print "Text: ", $entry->get_text, "\n";
  17.         return FALSE;
  18.     });
  19. $entry->signal_connect(
  20.     'changed' => sub {
  21.         my $entry = shift;
  22.         print "Change to '", $entry->get_text, "'\n";
  23.         return FALSE;
  24.     });
  25. my $hbox2 = Gtk2::HBox->new(FALSE, 5);
  26. $vbox->add($hbox2);
  27. my $label2 = Gtk2::Label->new_with_mnemonic('_Password: ');
  28. $hbox2->add($label2);
  29. my $pass_entry = Gtk2::Entry->new();
  30. $label2->set_mnemonic_widget($pass_entry);
  31. $hbox2->add($pass_entry);
  32. $pass_entry->set_visibility(FALSE);
  33. $pass_entry->signal_connect(
  34.     'activate' => sub {
  35.         my $entry = shift;
  36.         print "Password: ", $entry->get_text, "\n";
  37.         return FALSE;
  38.     });

  39. $vbox->show_all();
  40. $window->add($vbox);
  41. $window->show();
  42. Gtk2->main;
复制代码
真正强大的组件是将 ComboBoxEntry 组件和 EntryCompletion 结合起来,做成一个既能记录历史,又能自动补全的组件。这里实现一个能补全并找到模块文件的 Entry:
  1. use File::Spec::Functions;
  2. use Gtk2 '-init';
  3. use Glib qw(TRUE FALSE);

  4. my $window = Gtk2::Window->new('toplevel');
  5. $window->signal_connect('delete_event' => sub { Gtk2->main_quit; });

  6. my $hbox = Gtk2::HBox->new(FALSE, 4);
  7. my $label = Gtk2::Label->new("Entry an module name: ");
  8. $hbox->add($label);
  9. ## setup completion for entry
  10. my (%modules, %history);
  11. my $ec = Gtk2::EntryCompletion->new();
  12. my $ls = Gtk2::ListStore->new('Glib::String');
  13. $ec->set_model($ls);
  14. $ec->set_text_column(0);
  15. $ec->set_inline_completion(1);
  16. ## create ComboBoxEntry with that completion and history popup list
  17. my $cb = Gtk2::ComboBoxEntry->new_text();
  18. my $entry = $cb->child;
  19. $entry->signal_connect(
  20.     'activate' => sub {
  21.         my $entry = shift;
  22.         my $mod = $entry->get_text();
  23.         if ( exists $modules{$mod} && $mod !~ /::$/ ) {
  24.             print "The module $mod is in $modules{$mod}\n";
  25.             add_history($mod);
  26.         }
  27.         else {
  28.             print "Invalid module name\n";
  29.         }
  30.         return FALSE;
  31.     });
  32. $entry->signal_connect('changed' => \&build_completion);
  33. $entry->set_completion($ec);
  34. $hbox->add($cb);
  35. $hbox->show_all();
  36. $window->add($hbox);
  37. $window->show();
  38. Gtk2->main;

  39. sub build_completion {
  40.     my $entry = shift;
  41.     my $prefix = $entry->get_text();
  42.     unless ( keys %modules ) {
  43.         add_module(\@INC);
  44.     }
  45.     if ( $prefix =~ /::/ ) {
  46.         my @part = split "::", $prefix;
  47.         # split omit null string
  48.         if ( $prefix =~ /::$/ ) {
  49.             push @part, "";
  50.         }
  51.         my $i = 0;
  52.         while ( $i < $#part ) {
  53.             last if not exists $modules{join('::', @part[0..$i]).'::'};
  54.             $i++;
  55.         }
  56.         foreach ( $i-1..$#part-1 ) {
  57.             my $pre = join('::', @part[0..$_])."::";
  58.             add_module($modules{$pre}, $pre);
  59.         }
  60.     }
  61.     return FALSE;
  62. }

  63. sub add_module {
  64.     my ($inc, $prefix) = @_;
  65.     $prefix ||= '';
  66.     foreach my $dir ( @$inc ) {
  67.         if ( -d $dir ) {
  68.             opendir(DIR, $dir) or die "Can't open directory $dir: $!";
  69.             foreach ( readdir(DIR) ) {
  70.                 next if /^[.]/;
  71.                 my $full = catfile($dir, $_);
  72.                 if ( -d $full ) {
  73.                     my $mod = $prefix . $_ . '::';
  74.                     unless ( exists $modules{$mod} ) {
  75.                         $ls->set($ls->append, 0, $mod);
  76.                     }
  77.                     push @{$modules{$mod}}, $full;
  78.                 } elsif ( -f $full && /\.pm$/ ) {
  79.                     my $mod = $prefix . substr($_, 0, -3);
  80.                     unless ( exists $modules{$mod} ) {
  81.                         $ls->set($ls->append, 0, $mod);
  82.                         $modules{$mod} = $full;
  83.                     }
  84.                 }
  85.             }
  86.         }
  87.     }
  88. }

  89. sub add_history {
  90.     my $text = shift;
  91.     my $model = $cb->get_model();
  92.     unless ( exists $history{$text} ) {
  93.         $history{$text}++;
  94.         $model->set($model->append, 0, $text);
  95.     }
  96. }
复制代码
由这个例子可以看出 EntryCompletion 使用的也是 TreeModel。 set_inline_completion 如果设置为真,当前缀是唯一时,会自动把这个前缀写到 Entry 里。
When I'm on Windows, I use Strawberry Perl.
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

诚聘英才|移动端|Archiver|版权声明|大家论坛 ( 京ICP备06071611号,京公网安备11010802018363号 )

GMT+8, 2021-4-19 08:47 , Processed in 0.661687 second(s), 22 queries .

Powered by Discuz!

© Comsenz Inc.

快速回复 返回顶部 返回列表