You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
75 lines
1.3 KiB
75 lines
1.3 KiB
#!/usr/bin/perl -w
|
|
use strict;
|
|
package ConnectWidget;
|
|
use TQt;
|
|
use TQt::isa qw(TQt::Widget);
|
|
use TQt::attributes qw(
|
|
points
|
|
colors
|
|
count
|
|
down
|
|
);
|
|
use constant MAXPOINTS => 2000;
|
|
use constant MAXCOLORS => 40;
|
|
|
|
#
|
|
# Constructs a ConnectWidget.
|
|
#
|
|
|
|
sub NEW {
|
|
shift->SUPER::NEW(@_[0,1], &WStaticContents);
|
|
|
|
setBackgroundColor(&white);
|
|
count = 0;
|
|
down = 0;
|
|
points = [];
|
|
my @colors;
|
|
for(1 .. MAXCOLORS) {
|
|
push @colors, TQt::Color(rand(255), rand(255), rand(255));
|
|
}
|
|
colors = \@colors;
|
|
}
|
|
|
|
sub paintEvent {
|
|
my $paint = TQt::Painter(this);
|
|
for(my $i = 0; $i < count-1; $i++) {
|
|
for(my $j = $i+1; $j < count; $j++) {
|
|
$paint->setPen(colors->[rand(MAXCOLORS)]);
|
|
$paint->drawLine(points->[$i], points->[$j]);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub mousePressEvent {
|
|
down = 1;
|
|
count = 0;
|
|
points = [];
|
|
erase();
|
|
}
|
|
|
|
sub mouseReleaseEvent {
|
|
down = 0;
|
|
update();
|
|
}
|
|
|
|
sub mouseMoveEvent {
|
|
my $e = shift;
|
|
if(down && count < MAXPOINTS) {
|
|
my $paint = TQt::Painter(this);
|
|
push @{this->points}, TQt::Point($e->pos);
|
|
count++;
|
|
$paint->drawPoint($e->pos);
|
|
}
|
|
}
|
|
|
|
package main;
|
|
use TQt;
|
|
use ConnectWidget;
|
|
|
|
my $a = TQt::Application(\@ARGV);
|
|
my $connect = ConnectWidget;
|
|
$connect->setCaption("PerlTQt Example - Draw lines");
|
|
$a->setMainWidget($connect);
|
|
$connect->show;
|
|
exit $a->exec;
|