view release on metacpan or  search on metacpan

Prima/ScrollBar.pm  view on Meta::CPAN

		return;
	}

	return if $self->{drop_transaction} and $who !~ /^b\d$/;
	if ( $who eq q(tab)) {
		my @groove = @{$self-> {groove}-> {rect}};
		my @tab    = @{$self-> {tab}-> {rect}};
		my $val    = eval{$self-> {vertical} ?
			$self-> {max} -
				(( $y - $self-> {$who}-> {aperture} - $self-> {btx}) *
				( $self-> {max} - $self-> {min})) /
				($groove[3] - $groove[1] - $tab[3] + $tab[1])
			:
			$self-> {min} +
				(( $x - $self-> {$who}-> {aperture} - $self-> {btx}) *
				( $self-> {max} - $self-> {min})) /
				( $groove[2] - $groove[0] - $tab[2] + $tab[0])};
		if ( defined $val) {
			my $ov = $self-> {value};
			$self-> {suppressNotify} = $self-> {autoTrack} ? undef : 1;
			$self-> set_value( $val);
			$self-> {suppressNotify} = undef;
			$self-> notify(q(Track)) if !$self-> {autoTrack} && $ov != $self-> {value};
		}
	} elsif (
		$who eq q(b1) ||
		$who eq q(b2) ||
		$who eq q(left) ||
		$who eq q(right)
	) {
		my $upon  = $self-> translate_point( $x, $y);
		my $oldPress = $self-> {$who}-> {pressed};
		$self-> {$who}-> {pressed} = ( defined $upon && ( $upon eq $who)) ? 1 : 0;
		my $useRepaint = $self-> {$who}-> {pressed} != $oldPress;
		$self-> repaint if $useRepaint;
	}
}

sub on_mouseleave
{
	my $self = shift;
	$self-> repaint if defined( delete $self->{prelight} );
}

sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
	$z = (abs($z) > 120) ? int($z/120) : (($z > 0) ? 1 : -1);
	$self-> value( $self-> value - $self-> step * $z);
	$self-> clear_event;
}

sub on_dragbegin
{
	my $self = shift;
	$self->{drop_transaction} = [0,0];
}

sub on_dragover
{
	my ($self, $clipboard, $action, $mod, $x, $y, $ref) = @_;
	$ref->{allow} = 0;
	if ( $self-> {mouseTransaction} ) {
		$self->notify(q(MouseMove), 0, $x, $y);
		@{$self->{drop_transaction}} = [$x, $y];
	} else {
		$self->notify(q(MouseDown), mb::Left, 0, $x, $y);
	}
}

sub on_dragend
{
	my ($self, $clipboard, $action, $mod, $x, $y, $ref) = @_;
	$ref->{allow} = 0;
	$self->notify(q(MouseUp), mb::Left, 0, $x, $y);
	undef $self->{drop_transaction};
}

sub reset
{
	my $self = $_[0];

	$self-> { b1} -> { enabled} = $self-> { value} > $self-> { min};
	$self-> { b2} -> { enabled} = $self-> { value} < $self-> { max};
	my $fullDisable = $self-> { partial} == $self-> { whole};
	$self-> { tab}-> { enabled} = ( $self-> { min} != $self-> { max}) && !$fullDisable;
	$self-> { b1}-> { enabled} = 0 if ( $self-> { value} == $self-> { min});
	$self-> { b2}-> { enabled} = 0 if ( $self-> { value} == $self-> { max});

	my $btx  = $self-> { minThumbSize};
	my $v    = $self-> { vertical};
	my @size = $self-> size;
	my ( $maxx, $maxy) = ( $size[0]-1, $size[1]-1);

	if ( $v) {
		$btx = int($size[1] / 2) if $btx * 2 >= $maxy;
	} else {
		$btx = int($size[0] / 2) if $btx * 2 >= $maxx;
	}
	my @rect = $v ?
		( 1, $maxy - $btx + 1, $maxx - 1, $maxy - 1) :
		( 1, 1, $btx - 1, $maxy - 1);
	$self-> { b1}-> { rect} = [ @rect];
	@rect  = $v ?
		( 1, 1, $maxx - 1, $btx - 1) :
		( $maxx - $btx + 1, 1, $maxx - 1, $maxy - 1);
	$self-> { b2}-> { rect} = [ @rect];
	$self-> { btx} = $btx;

	@rect = $v ? (
		2, $btx, $maxx - 1, $maxy - $btx
	) : (
		$btx, 1, $maxx - $btx, $maxy - 2
	);

	$self-> {groove}-> {rect} = [@rect];
	my $startx  = $v ? $size[1]: $size[0];
	my $groovex = $startx - $btx * 2;
	$self-> { tab}-> { enabled} = 0 if $groovex < $self-> {minThumbSize};

	if ( $self-> { tab}-> { enabled}) {
		my $lenx = int( $groovex * $self-> { partial} / $self-> { whole});
		$lenx = $self-> {minThumbSize} if $lenx < $self-> {minThumbSize};
		my $atx  =
			int(( $self-> { value} - $self-> {min}) *
			( $groovex - $lenx) /
			( $self-> { max} - $self-> { min}));
		$atx = $groovex - $lenx if $lenx + $atx > $groovex;
		( $lenx, $atx) = ( $groovex - 1, 0) if $atx < 0;

		@rect = $v ? (
			1, $maxy - $btx - $lenx - $atx, $maxx - 1, $maxy - $btx - $atx
		) : (