Wow, thanks. This is a great example.
I'll go through it, but i am pretty sure that this solves my problem.
Am Mittwoch, den 09.07.2008, 14:09 -0400 schrieb zentara:
>
> #!/usr/bin/perl
> use warnings;
> use strict;
> use Gtk2 -init;
> use Gnome2::Canvas;
> use Glib qw(TRUE FALSE);
>
> my $draw_flag = 0;
> my %lines; # way to store multiple continuous lines
> my $count = 0;
>
> my $window = Gtk2::Window->new;
> $window->signal_connect( destroy => sub { exit } );
> $window->set_default_size( 500, 500 );
>
> my $vbox = Gtk2::VBox->new;
> $vbox->set_border_width(4);
> $vbox->show;
>
> my $hbox = Gtk2::HBox->new(FALSE, 4);
> $vbox->pack_start($hbox, FALSE, FALSE, 0);
> $hbox->show;
>
> $window->add($vbox);
>
> my $scroller = Gtk2::ScrolledWindow->new;
> my $canvas = Gnome2::Canvas->new();
> my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
> $canvas->modify_bg('normal',$white);
>
> $scroller->add( $canvas );
> $vbox->pack_start($scroller, 1, 1, 0);
>
> $canvas->set_scroll_region( 0, 0, 700, 700 );
> $window->show_all;
>
> my $root = $canvas->root;
>
> my $text = Gnome2::Canvas::Item->new(
> $root, 'Gnome2::Canvas::Text',
> x => 20,
> y => 15,
> fill_color => 'black',
> font => 'Sans 14',
> anchor => 'GTK_ANCHOR_NW',
> text => 'Click to start and stop drawing....Drag Mouse'
> );
>
>
> $canvas->signal_connect (event => \&event_handler);
>
> # Zoom
> my $z = Gtk2::Label->new("Zoom:");
> $hbox->pack_start($z, FALSE, FALSE, 0);
> $z->show;
>
> my $adj = Gtk2::Adjustment->new(1, 0.05, 100, 0.05, 0.5, 0.5);
> my $sb = Gtk2::SpinButton->new($adj, 0, 2);
> $adj->signal_connect("value-changed", \&zoom_changed, $canvas);
> $sb->set_size_request(60, -1);
> $hbox->pack_start($sb, FALSE, FALSE, 10);
> $sb->show;
>
> my $button1 = Gtk2::Button->new_from_stock('Screenshot');
> $hbox->pack_start( $button1, FALSE, FALSE, 0 );
> $button1->signal_connect( clicked => \&screenshot );
>
>
> $window->show_all();
>
> Gtk2->main;
>
> ##############################
>
> sub event_handler{
> my ( $widget, $event ) = @_;
> #print $widget ,' ',$event->type,"\n";
>
> my $scale = $adj->get_value;
> # print "scale->$scale\n";
>
> if ( $event->type eq "button-press" ) {
> $draw_flag = 1;
>
> #start a new line curve
> $count++;
>
> my ($x,$y) = ($event->x,$event->y);
> # print "$x $y\n";
>
> $lines{$count}{'points'} = [$x/$scale,$y/$scale,$x/$scale,
> $y/$scale]; #need at least 2 points
> $lines{$count}{'line'} = Gnome2::Canvas::Item->new ($root,
> 'Gnome2::Canvas::Line',
> points => $lines{$count}{'points'},
> fill_color => "red",
> width_units => 3.0,
> cap_style => 'projecting',
> join_style => 'miter',
> );
> }
>
> if ( $event->type eq "button-release" ) {
> $draw_flag = 0;
> }
>
>
> if ( $event->type eq "focus-change" ) {
> return 0;
> }
>
> if ( $event->type eq "expose" ) {
> return 0;
> }
>
>
> if($draw_flag){
> #left with motion-notify
> if ( $event->type eq "motion-notify"){
> my ($x,$y) = ($event->x,$event->y);
> # print "$x $y\n";
>
> push @{$lines{$count}{'points'}},$x/$scale,$y/$scale;
>
> $lines{$count}{'line'}->set(points=>$lines{$count}{'points'});
>
> # my $p = $lines{$count}{'line'}->get('points');
> # print "@$p\n";
> }
> }
>
> }
>
>
> sub zoom_changed {
> my ($adj, $canvas) = @_;
> $canvas->set_pixels_per_unit($adj->get_value);
> }
>
>
> sub screenshot{
>
> #we are going to save the visible canvas
> my ($width, $height) = $canvas->window->get_size;
>
> # create blank pixbuf to hold the image
> my $gdkpixbuf = Gtk2::Gdk::Pixbuf->new ('rgb',
> 0,
> 8,
> $width,
> $height);
>
> $gdkpixbuf->get_from_drawable ($canvas->window,
> undef, 0, 0, 0, 0, $width, $height);
>
> #only jpeg and png is supported !!!! it's 'jpeg', not 'jpg'
> $gdkpixbuf->save ("$0.jpg", 'jpeg', quality => 100);
> return FALSE;
> }
>
> #$pixbuf->save ($filename, 'jpeg', quality => '100');
> # Currently only a few parameters exist. JPEG images can be saved
> # with a "quality" parameter; its value should be in the range
> # [0,100]. Text chunks can be attached to PNG images by specifying
> # parameters of the form "tEXt::key", where key is an ASCII string of
> # length 1-79. The values are UTF-8 encoded strings.
_______________________________________________
gtk-perl-list mailing list
[email protected]
http://mail.gnome.org/mailman/listinfo/gtk-perl-list
