# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # $Id: scrollbar.pl,v 1.11 2005/10/13 17:22:53 dk Exp $ # =pod =item NAME A Prima toolkit example =item FEATURES Tests correct representation of a color created by a combination of R,G and B components. The Prima::Widget::sizeMin and Prima::Widget::sizeMax implementation is tested - the Area widget changes its height on a mouse click, up to the left button and down to the right button. Note how Area widget maintains its maximum size when the window gets maximized. =cut use strict; use Prima qw(ScrollBar); use Prima::Application name => 'scrollbar'; package MyWindow; use vars qw(@ISA); @ISA = qw(Prima::MainWindow); sub updateArea { $_[0]-> Area-> backColor( $_[0]-> Blue-> value|($_[0]-> Green-> value<<8)|($_[0]-> Red-> value<<16) ); } sub Timer1_Tick { $_[ 0]-> Red -> backColor(( $_[ 0]-> Red -> backColor == cl::Red ) ? cl::LightRed : cl::Red ); $_[ 0]-> Green-> backColor(( $_[ 0]-> Green-> backColor == cl::Green) ? cl::LightGreen : cl::Green); $_[ 0]-> Blue -> backColor(( $_[ 0]-> Blue -> backColor == cl::Blue ) ? cl::LightBlue : cl::Blue ); } package UserInit; my $w = MyWindow-> create( text => "Scrollbar & timer example", left => 100, bottom => 100, width => 300, height => 300, borderStyle => bs::Sizeable, ); $w-> insert( "ScrollBar", name => "Red", origin => [ 2, 20], vertical => 0, max => 255, width => $w-> width - 2, onChange => sub { $w-> updateArea }, ); $w-> insert( "ScrollBar", name => "Green", origin => [ 2, 40], vertical => 0, max => 255, width => $w-> width - 2, onChange => sub { $w-> updateArea }, ); $w-> insert( "ScrollBar", name => "Blue", origin => [ 2, 60], vertical => 0, max => 255, width => $w-> width - 2, onChange => sub { $w-> updateArea }, ); $w-> insert( "ScrollBar", name => "Bluex", origin => [ 2, 80], vertical => 1, max => 255, height => $w-> height - 80, ); $w-> insert( "Widget", name => "Area", rect => [ 20, 100, 280, 280], backColor => cl::Black, growMode => gm::GrowHiX | gm::GrowHiY, sizeMin => [120, 120], sizeMax => [420, 420], onPaint => sub { my ($x,$y)=$_[0]-> size; $_[0]-> color($_[0]-> backColor); $_[0]-> bar(0,0,$x,$y); $_[0]-> color(cl::Set); $_[0]-> rop(rop::XorPut); $_[0]-> line(0,0,$x,$y); $_[0]-> line(0,$y,$x,0); }, onMouseDown =>sub{ $_[0]-> height($_[0]-> height+(($_[1]==1)?1:-1)); }, ); my $t = $w-> insert( Timer=> timeout=> 2000, name => 'Timer1', delegations => ['Tick'], ); $t-> start; run Prima;