1package Prima::VB::CoreClasses; 2use strict; 3use warnings; 4 5sub classes 6{ 7 return ( 8 'Prima::Button' => { 9 RTModule => 'Prima::Buttons', 10 class => 'Prima::VB::Button', 11 page => 'General', 12 icon => 'VB::classes.gif:0', 13 }, 14 'Prima::SpeedButton' => { 15 RTModule => 'Prima::Buttons', 16 class => 'Prima::VB::Button', 17 page => 'Additional', 18 icon => 'VB::classes.gif:19', 19 }, 20 'Prima::Label' => { 21 RTModule => 'Prima::Label', 22 class => 'Prima::VB::Label', 23 page => 'General', 24 icon => 'VB::classes.gif:15', 25 }, 26 'Prima::InputLine' => { 27 RTModule => 'Prima::InputLine', 28 class => 'Prima::VB::InputLine', 29 page => 'General', 30 icon => 'VB::classes.gif:13', 31 }, 32 'Prima::ListBox' => { 33 RTModule => 'Prima::Lists', 34 class => 'Prima::VB::ListBox', 35 page => 'General', 36 icon => 'VB::classes.gif:16', 37 }, 38 'Prima::DirectoryListBox' => { 39 RTModule => 'Prima::Dialog::FileDialog', 40 class => 'Prima::VB::DirectoryListBox', 41 page => 'Additional', 42 icon => 'VB::classes.gif:6', 43 }, 44 'Prima::ListViewer' => { 45 RTModule => 'Prima::Lists', 46 class => 'Prima::VB::ListViewer', 47 page => 'Abstract', 48 icon => 'VB::classes.gif:16', 49 }, 50 'Prima::CheckBox' => { 51 RTModule => 'Prima::Buttons', 52 class => 'Prima::VB::CheckBox', 53 page => 'General', 54 icon => 'VB::classes.gif:2', 55 }, 56 'Prima::Radio' => { 57 RTModule => 'Prima::Buttons', 58 class => 'Prima::VB::Radio', 59 page => 'General', 60 icon => 'VB::classes.gif:18', 61 }, 62 'Prima::GroupBox' => { 63 RTModule => 'Prima::Buttons', 64 class => 'Prima::VB::GroupBox', 65 page => 'General', 66 icon => 'VB::classes.gif:10', 67 }, 68 'Prima::ScrollBar' => { 69 RTModule => 'Prima::ScrollBar', 70 class => 'Prima::VB::ScrollBar', 71 page => 'General', 72 icon => 'VB::classes.gif:20', 73 }, 74 'Prima::ComboBox' => { 75 RTModule => 'Prima::ComboBox', 76 class => 'Prima::VB::ComboBox', 77 page => 'General', 78 icon => 'VB::classes.gif:3', 79 }, 80 'Prima::DriveComboBox' => { 81 RTModule => 'Prima::Dialog::FileDialog', 82 class => 'Prima::VB::DriveComboBox', 83 page => 'Additional', 84 icon => 'VB::classes.gif:5', 85 }, 86 'Prima::ColorComboBox' => { 87 RTModule => 'Prima::Dialog::ColorDialog', 88 class => 'Prima::VB::ColorComboBox', 89 page => 'Additional', 90 icon => 'VB::classes.gif:1', 91 }, 92 'Prima::Edit' => { 93 RTModule => 'Prima::Edit', 94 class => 'Prima::VB::Edit', 95 page => 'General', 96 icon => 'VB::classes.gif:8', 97 }, 98 'Prima::ImageViewer' => { 99 RTModule => 'Prima::ImageViewer', 100 class => 'Prima::VB::ImageViewer', 101 page => 'General', 102 icon => 'VB::classes.gif:14', 103 }, 104 'Prima::ScrollWidget' => { 105 RTModule => 'Prima::ScrollWidget', 106 class => 'Prima::VB::ScrollWidget', 107 page => 'Abstract', 108 icon => 'VB::classes.gif:21', 109 }, 110 'Prima::SpinButton' => { 111 RTModule => 'Prima::Sliders', 112 class => 'Prima::VB::SpinButton', 113 page => 'Sliders', 114 icon => 'VB::classes.gif:23', 115 }, 116 'Prima::AltSpinButton' => { 117 RTModule => 'Prima::Sliders', 118 class => 'Prima::VB::AltSpinButton', 119 page => 'Sliders', 120 icon => 'VB::classes.gif:24', 121 }, 122 'Prima::SpinEdit' => { 123 RTModule => 'Prima::Sliders', 124 class => 'Prima::VB::SpinEdit', 125 page => 'Sliders', 126 icon => 'VB::classes.gif:25', 127 }, 128 'Prima::Gauge' => { 129 RTModule => 'Prima::Sliders', 130 class => 'Prima::VB::Gauge', 131 page => 'Sliders', 132 icon => 'VB::classes.gif:9', 133 }, 134 'Prima::ProgressBar' => { 135 RTModule => 'Prima::Sliders', 136 class => 'Prima::VB::ProgressBar', 137 page => 'Sliders', 138 icon => 'VB::classes.gif:34', 139 }, 140 'Prima::Slider' => { 141 RTModule => 'Prima::Sliders', 142 class => 'Prima::VB::Slider', 143 page => 'Sliders', 144 icon => 'VB::classes.gif:22', 145 }, 146 'Prima::CircularSlider' => { 147 RTModule => 'Prima::Sliders', 148 class => 'Prima::VB::CircularSlider', 149 page => 'Sliders', 150 icon => 'VB::classes.gif:4', 151 }, 152 'Prima::StringOutline' => { 153 RTModule => 'Prima::Outlines', 154 class => 'Prima::VB::StringOutline', 155 page => 'General', 156 icon => 'VB::classes.gif:17', 157 }, 158 'Prima::OutlineViewer' => { 159 RTModule => 'Prima::Outlines', 160 class => 'Prima::VB::OutlineViewer', 161 page => 'Abstract', 162 icon => 'VB::classes.gif:17', 163 }, 164 'Prima::DirectoryOutline' => { 165 RTModule => 'Prima::Outlines', 166 class => 'Prima::VB::DirectoryOutline', 167 page => 'Additional', 168 icon => 'VB::classes.gif:7', 169 }, 170 'Prima::Notebook' => { 171 RTModule => 'Prima::Notebooks', 172 class => 'Prima::VB::Notebook', 173 page => 'Abstract', 174 icon => 'VB::classes.gif:29', 175 }, 176 'Prima::TabSet' => { 177 RTModule => 'Prima::Notebooks', 178 class => 'Prima::VB::TabSet', 179 page => 'Additional', 180 icon => 'VB::classes.gif:27', 181 }, 182 'Prima::TabbedNotebook' => { 183 RTModule => 'Prima::Notebooks', 184 class => 'Prima::VB::TabbedNotebook', 185 page => 'Additional', 186 icon => 'VB::classes.gif:28', 187 }, 188 'Prima::Header' => { 189 icon => 'VB::classes.gif:30', 190 RTModule => 'Prima::Header', 191 page => 'Sliders', 192 module => 'Prima::VB::CoreClasses', 193 class => 'Prima::VB::Header', 194 }, 195 'Prima::DetailedList' => { 196 icon => 'VB::classes.gif:31', 197 RTModule => 'Prima::DetailedList', 198 page => 'General', 199 module => 'Prima::VB::CoreClasses', 200 class => 'Prima::VB::DetailedList', 201 }, 202 'Prima::Calendar' => { 203 icon => 'VB::classes.gif:32', 204 RTModule => 'Prima::Calendar', 205 page => 'Additional', 206 module => 'Prima::VB::CoreClasses', 207 class => 'Prima::VB::Calendar', 208 }, 209 'Prima::Grid' => { 210 RTModule => 'Prima::Grids', 211 class => 'Prima::VB::Grid', 212 page => 'General', 213 icon => 'VB::classes.gif:33', 214 }, 215 ); 216} 217 218use Prima::Classes; 219use Prima::StdBitmap; 220 221package Prima::VB::CommonControl; 222use strict; 223use vars qw(@ISA); 224@ISA = qw(Prima::VB::Control); 225 226sub prf_adjust_default 227{ 228 my ( $self, $p, $pf) = @_; 229 $self-> SUPER::prf_adjust_default( $p, $pf); 230 delete $pf-> {$_} for qw ( 231 firstClick 232 palette 233 sizeMax 234 sizeMin 235 ownerColor 236 ownerFont 237 ownerHint 238 ownerBackColor 239 ownerShowHint 240 ownerPalette 241 ); 242} 243 244package Prima::VB::Button; 245use strict; 246use vars qw(@ISA); 247@ISA = qw(Prima::VB::CommonControl); 248 249sub prf_types 250{ 251 my $pt = $_[ 0]-> SUPER::prf_types; 252 my %de = ( 253 bool => [qw(flat vertical default checkable checked autoRepeat autoHeight autoWidth)], 254 uiv => [qw(glyphs borderWidth defaultGlyph hiliteGlyph disabledGlyph pressedGlyph 255 holdGlyph imageScale )], 256 modalResult => ['modalResult'], 257 icon => ['image',], 258 text => ['hotKey'], 259 ); 260 $_[0]-> prf_types_add( $pt, \%de); 261 return $pt; 262} 263 264sub profile_default 265{ 266 my $def = $_[ 0]-> SUPER::profile_default; 267 my %prf = ( 268 mainEvent => 'onClick', 269 ); 270 @$def{keys %prf} = values %prf; 271 return $def; 272} 273 274sub caption_box 275{ 276 my ($self,$canvas) = @_; 277 my $cap = $self-> text; 278 $cap =~ s/~//; 279 return $canvas-> get_text_width( $cap), $canvas-> font-> height; 280} 281 282sub on_paint 283{ 284 my ( $self, $canvas) = @_; 285 my @size = $canvas-> size; 286 my $cl = $self-> color; 287 if ( $self-> prf('flat')) { 288 $canvas-> rect3d( 0,0,$size[0]-1,$size[1]-1,1, 289 cl::Gray,cl::Gray,$self-> backColor); 290 } else { 291 $canvas-> rect3d( 0,0,$size[0]-1,$size[1]-1,$self-> prf('borderWidth'), 292 $self-> light3DColor,$self-> dark3DColor,$self-> backColor); 293 } 294 my $i = $self-> prf('image'); 295 my $capOk = length($self-> text) > 0; 296 my ( $fw, $fh) = $capOk ? $self-> caption_box($canvas) : ( 0, 0); 297 my ( $textAtX, $textAtY) = ( 2, $size[1]-3); 298 299 if ( defined $i) { 300 my $gy = $self-> prf('glyphs'); 301 $gy = 1 unless $gy; 302 my $pw = $i-> width / $gy; 303 my $ph = $i-> height; 304 my $sw = $pw * $self-> prf('imageScale'); 305 my $sh = $ph * $self-> prf('imageScale'); 306 my ( $imAtX, $imAtY); 307 if ( $capOk) { 308 if ( $self-> prf('vertical')) { 309 $imAtX = ( $size[ 0] - $sw) / 2; 310 $imAtY = ( $size[ 1] - $fh - $sh) / 3; 311 $textAtY = $imAtY; 312 $imAtY = $size[ 1] - $imAtY - $sh; 313 } else { 314 $imAtX = ( $size[ 0] - $fw - $sw) / 3; 315 $imAtY = ( $size[ 1] - $sh) / 2; 316 $textAtX = 2 * $imAtX + $sw; 317 } 318 } else { 319 $imAtX = ( $size[0] - $sw) / 2; 320 $imAtY = ( $size[1] - $sh) / 2; 321 } 322 $canvas-> put_image_indirect( $i, $imAtX, $imAtY, 0, 0, 323 $sw, $sh,$pw, $ph,rop::CopyPut); 324 } 325 326 $canvas-> color( $cl); 327 if ( $capOk) { 328 $canvas-> draw_text($self-> text, 329 $textAtX,2,$size[0]-3,$textAtY, 330 dt::DrawMnemonic|dt::Center|dt::VCenter|dt::UseClip); 331 } 332 $self-> common_paint($canvas); 333} 334 335sub prf_flat { $_[0]-> repaint; } 336sub prf_borderWidth { $_[0]-> repaint; } 337sub prf_glyphs { $_[0]-> repaint; } 338sub prf_vertical { $_[0]-> repaint; } 339sub prf_image { $_[0]-> repaint; } 340sub prf_imageScale { $_[0]-> repaint; } 341 342 343package Prima::VB::Label; 344use strict; 345use vars qw(@ISA); 346@ISA = qw(Prima::VB::CommonControl); 347 348sub prf_types 349{ 350 my $pt = $_[ 0]-> SUPER::prf_types; 351 my %de = ( 352 align => ['alignment',], 353 valign => ['valignment',], 354 bool => [qw(autoWidth autoHeight showAccelChar showPartial wordWrap)], 355 Handle => ['focusLink',], 356 text => ['hotKey'], 357 ); 358 $_[0]-> prf_types_add( $pt, \%de); 359 return $pt; 360} 361 362sub on_paint 363{ 364 my ( $self, $canvas) = @_; 365 my @sz = $canvas-> size; 366 my $cl = $self-> color; 367 $canvas-> color( $self-> backColor); 368 $canvas-> bar( 1,1,$sz[0]-2,$sz[1]-2); 369 $canvas-> color( cl::Gray); 370 $canvas-> rectangle( 0,0,$sz[0]-1,$sz[1]-1); 371 $canvas-> color( $cl); 372 my ( $a, $va, $sp, $ww, $sac) = 373 $self-> prf(qw( alignment valignment showPartial wordWrap showAccelChar)); 374 my $flags = dt::NewLineBreak | dt::WordBreak | dt::ExpandTabs | 375 (($a == ta::Left) ? dt::Left : (( $a == ta::Center) ? dt::Center : dt::Right)) | 376 (ta::Top == $va ? dt::Top : (( $va == ta::Middle) ? dt::VCenter : dt::Bottom)) | 377 ($sp ? dt::DrawPartial : 0) | 378 ($ww ? 0 : dt::NoWordWrap) | 379 ($sac ? 0 : dt::DrawMnemonic); 380 $canvas-> draw_text( $self-> text,0,0,$sz[0]-1,$sz[1]-1,$flags); 381 $self-> common_paint($canvas); 382} 383 384sub prf_alignment { $_[0]-> repaint; } 385sub prf_valignment { $_[0]-> repaint; } 386sub prf_showPartial { $_[0]-> repaint; } 387sub prf_wordWrap { $_[0]-> repaint; } 388sub prf_showAccelChar { $_[0]-> repaint; } 389 390package Prima::VB::InputLine; 391use strict; 392use vars qw(@ISA); 393@ISA = qw(Prima::VB::CommonControl); 394 395sub profile_default 396{ 397 my $def = $_[ 0]-> SUPER::profile_default; 398 my %prf = ( 399 mainEvent => 'onChange', 400 ); 401 @$def{keys %prf} = values %prf; 402 return $def; 403} 404 405sub prf_types 406{ 407 my $pt = $_[ 0]-> SUPER::prf_types; 408 my %de = ( 409 align => ['alignment',], 410 bool => [qw(writeOnly readOnly insertMode autoSelect autoHeight autoTab firstChar charOffset textDirection)], 411 upoint => ['selection',], 412 uiv => ['selStart','selEnd','maxLen','borderWidth'], 413 char => ['passwordChar',], 414 string => ['wordDelimiters',], 415 ); 416 $_[0]-> prf_types_add( $pt, \%de); 417 return $pt; 418} 419 420sub prf_adjust_default 421{ 422 my ( $self, $p, $pf) = @_; 423 $self-> SUPER::prf_adjust_default( $p, $pf); 424 delete $pf-> {$_} for qw ( 425 selection 426 selEnd 427 selStart 428 charOffset 429 firstChar 430 ); 431} 432 433sub on_paint 434{ 435 my ( $self, $canvas) = @_; 436 my @sz = $canvas-> size; 437 my $cl = $self-> color; 438 my ( $a, $bw, $wo, $pc) = $self-> prf(qw( alignment borderWidth writeOnly passwordChar)); 439 $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw,$self-> dark3DColor,$self-> light3DColor,$self-> backColor); 440 $canvas-> color( $cl); 441 $a = (ta::Left == $a ? dt::Left : (ta::Center == $a ? dt::Center : dt::Right)); 442 my $c = $self-> text; 443 $c =~ s/./$pc/g if $wo; 444 $canvas-> draw_text($c,2,2,$sz[0]-3,$sz[1]-3, 445 $a|dt::VCenter|dt::UseClip|dt::ExpandTabs|dt::NoWordWrap); 446 $self-> common_paint($canvas); 447} 448 449sub prf_alignment { $_[0]-> repaint; } 450sub prf_writeOnly { $_[0]-> repaint; } 451sub prf_borderWidth { $_[0]-> repaint; } 452sub prf_passwordChar { $_[0]-> repaint; } 453 454package Prima::VB::Cluster; 455use strict; 456use vars qw(@ISA); 457@ISA = qw(Prima::VB::CommonControl); 458 459sub profile_default 460{ 461 my $def = $_[ 0]-> SUPER::profile_default; 462 my %prf = ( 463 mainEvent => 'onCheck', 464 ); 465 @$def{keys %prf} = values %prf; 466 return $def; 467} 468 469sub prf_types 470{ 471 my $pt = $_[ 0]-> SUPER::prf_types; 472 my %de = ( 473 bool => [qw(auto checked pressed autoHeight autoWidth)], 474 ); 475 $_[0]-> prf_types_add( $pt, \%de); 476 return $pt; 477} 478 479sub prf_checked { $_[0]-> repaint; } 480 481sub paint 482{ 483 my ( $self, $canvas, $i) = @_; 484 my @sz = $canvas-> size; 485 $canvas-> color( $self-> backColor); 486 $canvas-> bar(1,1,$sz[0]-2,$sz[1]-2); 487 $canvas-> color( cl::Gray); 488 $canvas-> rectangle(0,0,$sz[0]-1,$sz[1]-1); 489 $canvas-> put_image( 2, ($sz[1] - $i-> height)/2, $i) if $i; 490 $canvas-> color( cl::Black); 491 my $w = $i ? $i-> width : 0; 492 $canvas-> draw_text($self-> text,2 + $w,2,$sz[0]-1,$sz[1]-1, 493 dt::Center|dt::VCenter|dt::UseClip|dt::DrawMnemonic); 494 $self-> common_paint($canvas); 495} 496 497package Prima::VB::CheckBox; 498use strict; 499use vars qw(@ISA); 500@ISA = qw(Prima::VB::Cluster); 501 502sub on_paint 503{ 504 my ( $self, $canvas) = @_; 505 $self-> paint( $canvas, Prima::StdBitmap::image( $self-> prf('checked') ? 506 sbmp::CheckBoxChecked : sbmp::CheckBoxUnchecked)); 507} 508 509package Prima::VB::Radio; 510use strict; 511use vars qw(@ISA); 512@ISA = qw(Prima::VB::Cluster); 513 514sub on_paint 515{ 516 my ( $self, $canvas) = @_; 517 $self-> paint( $canvas, Prima::StdBitmap::icon( $self-> prf('checked') ? 518 sbmp::RadioChecked : sbmp::RadioUnchecked)); 519} 520 521package Prima::VB::GroupBox; 522use strict; 523use vars qw(@ISA); 524@ISA = qw(Prima::VB::CommonControl); 525 526sub profile_default 527{ 528 my $def = $_[ 0]-> SUPER::profile_default; 529 my %prf = ( 530 mainEvent => 'onRadioClick', 531 ); 532 @$def{keys %prf} = values %prf; 533 return $def; 534} 535 536sub prf_types 537{ 538 my $pt = $_[ 0]-> SUPER::prf_types; 539 my %de = ( 540 uiv => ['index'], 541 ); 542 $_[0]-> prf_types_add( $pt, \%de); 543 return $pt; 544} 545 546sub on_paint 547{ 548 my ( $self, $canvas) = @_; 549 my @size = $canvas-> size; 550 my @clr = ( $self-> color, $self-> backColor); 551 $canvas-> color( $clr[1]); 552 $canvas-> bar( 0, 0, @size); 553 my $fh = $canvas-> font-> height; 554 $canvas-> color( $self-> light3DColor); 555 $canvas-> rectangle( 1, 0, $size[0] - 1, $size[1] - $fh / 2 - 2); 556 $canvas-> color( $self-> dark3DColor); 557 $canvas-> rectangle( 0, 1, $size[0] - 2, $size[1] - $fh / 2 - 1); 558 my $c = $self-> text; 559 if ( length( $c) > 0) { 560 $canvas-> color( $clr[1]); 561 $canvas-> bar ( 562 8, $size[1] - $fh - 1, 563 16 + $canvas-> get_text_width( $c), $size[1] - 1 564 ); 565 $canvas-> color( $clr[0]); 566 $canvas-> text_shape_out( $c, 12, $size[1] - $fh - 1); 567 } 568 $self-> common_paint($canvas); 569} 570 571package Prima::VB::BiScroller; 572use strict; 573 574sub paint_exterior 575{ 576 my ( $self, $canvas) = @_; 577 my @sz = $canvas-> size; 578 my $cl = $self-> color; 579 my ( $bw, $hs, $vs, $ahs, $avs) = 580 $self-> prf(qw( borderWidth hScroll vScroll autoHScroll autoVScroll)); 581 $hs ||= $ahs; 582 $vs ||= $avs; 583 $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw, 584 $self-> dark3DColor,$self-> light3DColor,$self-> backColor); 585 my $sw = 12 * $::application-> uiScaling; 586 my $sl = 16 * $::application-> uiScaling; 587 $hs = $hs ? $sw : 0; 588 $vs = $vs ? $sw : 0; 589 my @r = ( $bw, $bw+$hs, $sz[0]-$bw-1-$vs,$sz[1]-$bw-1); 590 if ( $hs) { 591 $self-> color( $ahs ? cl::Gray : cl::Black); 592 $canvas-> rectangle( $r[0], $bw, $r[2], $r[1]); 593 if ($r[0]+4+$sl < $r[2]-2-$sl) { 594 $canvas-> rectangle( $r[0]+2, $bw+2, $r[0]+2+$sl, $r[1]-2); 595 $canvas-> rectangle( $r[2]-2-$sl, $bw+2, $r[2]-2, $r[1]-2); 596 } 597 } 598 if ( $vs) { 599 $self-> color( $avs ? cl::Gray : cl::Black); 600 $canvas-> rectangle( $sz[0]-$bw-1-$sw,$hs+2,$sz[0]-$bw-1,$r[3]-0); 601 if ( $r[3]-$sl > $hs+2+$sl) { 602 $canvas-> rectangle( $sz[0]-$bw+1-$sw,$hs+4,$sz[0]-$bw-3,$hs+2+$sl); 603 $canvas-> rectangle( $sz[0]-$bw+1-$sw,$r[3]-2-$sl,$sz[0]-$bw-3,$r[3]-2); 604 } 605 } 606 $canvas-> color( $cl); 607 return if ( $r[0] > $r[2]) || ( $r[1] >= $r[3]); 608 return @r; 609} 610 611sub prf_autoHScroll { $_[0]-> repaint; } 612sub prf_autoVScroll { $_[0]-> repaint; } 613sub prf_borderWidth { $_[0]-> repaint; } 614sub prf_hScroll { $_[0]-> repaint; } 615sub prf_vScroll { $_[0]-> repaint; } 616 617package Prima::VB::ListBox; 618use strict; 619use vars qw(@ISA); 620@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 621 622sub profile_default 623{ 624 my $def = $_[ 0]-> SUPER::profile_default; 625 my %prf = ( 626 mainEvent => 'onClick', 627 ); 628 @$def{keys %prf} = values %prf; 629 return $def; 630} 631 632sub prf_events 633{ 634 return ( 635 $_[0]-> SUPER::prf_events, 636 onSelectItem => 'my ( $self, $index, $selectState) = @_;', 637 ); 638} 639 640 641sub prf_types 642{ 643 my $pt = $_[ 0]-> SUPER::prf_types; 644 my %de = ( 645 bool => [qw(autoWidth vScroll hScroll multiSelect extendedSelect 646 autoHeight integralWidth integralHeight multiColumn 647 autoHScroll autoVScroll drawGrid vertical)], 648 uiv => [qw(itemHeight itemWidth focusedItem borderWidth offset topItem)], 649 color => [qw(gridColor)], 650 items => [qw(items selectedItems)], 651 string => [qw(scrollBarClass)], 652 align => [qw(align)], 653 ); 654 $_[0]-> prf_types_add( $pt, \%de); 655 return $pt; 656} 657 658sub prf_adjust_default 659{ 660 my ( $self, $p, $pf) = @_; 661 $self-> SUPER::prf_adjust_default( $p, $pf); 662 delete $pf-> {$_} for qw (offset); 663} 664 665sub on_paint 666{ 667 my ( $self, $canvas) = @_; 668 my @r = $self-> paint_exterior( $canvas); 669 my $align = $self->prf('align'); 670 if ( $align == ta::Right ) { 671 $align = dt::Right; 672 } elsif ( $align == ta::Center ) { 673 $align = dt::Center; 674 } else { 675 $align = dt::Left; 676 } 677 $canvas-> draw_text( join("\n", @{$self-> prf('items')}), @r, 678 dt::NoWordWrap | 679 dt::NewLineBreak | dt::Top | dt::UseExternalLeading | 680 dt::UseClip | $align 681 ) if scalar @r; 682 $self-> common_paint($canvas); 683} 684 685sub prf_items { $_[0]-> repaint; } 686sub prf_align { $_[0]-> repaint; } 687 688package Prima::VB::ListViewer; 689use strict; 690use vars qw(@ISA); 691@ISA = qw(Prima::VB::ListBox); 692 693sub prf_events 694{ 695 return ( 696 $_[0]-> SUPER::prf_events, 697 onDrawItem => 'my ( $self, $canvas, $itemIndex, $x, $y, $x2, $y2, $selected, $focused, $prelight, $column) = @_;', 698 onStringify => 'my ( $self, $index, $result) = @_;', 699 onMeasureItem => 'my ( $self, $index, $result) = @_;', 700 ); 701} 702 703 704package Prima::VB::DirectoryListBox; 705use strict; 706use vars qw(@ISA); 707@ISA = qw(Prima::VB::ListBox); 708 709sub prf_types 710{ 711 my $pt = $_[ 0]-> SUPER::prf_types; 712 my %de = ( 713 uiv => ['indent'], 714 ); 715 $_[0]-> prf_types_add( $pt, \%de); 716 return $pt; 717} 718 719sub prf_adjust_default 720{ 721 my ( $self, $p, $pf) = @_; 722 $self-> SUPER::prf_adjust_default( $p, $pf); 723 delete $pf-> {$_} for qw (items itemWidth itemHeight); 724} 725 726sub on_paint 727{ 728 my ( $self, $canvas) = @_; 729 my @r = $self-> paint_exterior( $canvas); 730 $canvas-> draw_text( "usr\n\tlocal\n\t\tshare\n\t\t\texamples\n\t\t\t\tetc", @r, 731 dt::NoWordWrap | dt::ExpandTabs | 732 dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | 733 dt::UseClip 734 ) if scalar @r; 735 $self-> common_paint($canvas); 736} 737 738 739package Prima::VB::ScrollBar; 740use strict; 741use vars qw(@ISA); 742@ISA = qw(Prima::VB::CommonControl); 743 744sub prf_types 745{ 746 my $pt = $_[ 0]-> SUPER::prf_types; 747 my %de = ( 748 bool => [qw(autoTrack vertical)], 749 uiv => [qw(minThumbSize pageStep partial step whole)], 750 iv => [qw(min max value)], 751 ); 752 $_[0]-> prf_types_add( $pt, \%de); 753 return $pt; 754} 755 756sub profile_default 757{ 758 my $def = $_[ 0]-> SUPER::profile_default; 759 my %prf = ( 760 mainEvent => 'onChange', 761 ); 762 @$def{keys %prf} = values %prf; 763 return $def; 764} 765 766sub on_paint 767{ 768 my ( $self, $canvas) = @_; 769 my @sz = $canvas-> size; 770 my $cl = $self-> color; 771 my ( $v) = $self-> prf(qw( vertical)); 772 $canvas-> color( $self-> backColor); 773 $canvas-> bar(0,0,@sz); 774 $canvas-> color( $cl); 775 $canvas-> rectangle(0,0,$sz[0]-1,$sz[1]-1); 776 my $ws = 18; 777 my $ex = 5; 778 if ( $sz[ $v ? 1 : 0] > $ws * 2) { 779 if ( $v) { 780 $canvas-> rectangle(2,2,$sz[0]-3,2+$ws); 781 $canvas-> ellipse($sz[0]/2-2,$ws/2+2,$ex,$ex); 782 $canvas-> rectangle(2,$sz[1]-3-$ws,$sz[0]-3,$sz[1]-3); 783 $canvas-> ellipse($sz[0]/2-2,$sz[1]-$ws/2-3,$ex,$ex); 784 } else { 785 $canvas-> rectangle(2,2,2+$ws,$sz[1]-3); 786 $canvas-> ellipse($ws/2+2,$sz[1]/2-2,$ex,$ex); 787 $canvas-> rectangle($sz[0]-3-$ws,2,$sz[0]-3,$sz[1]-3); 788 $canvas-> ellipse($sz[0]-$ws/2-3,$sz[1]/2-2,$ex,$ex); 789 } 790 } 791 $self-> common_paint($canvas); 792} 793 794sub prf_vertical { $_[0]-> repaint; } 795 796package Prima::VB::ComboBox; 797use strict; 798use vars qw(@ISA); 799@ISA = qw(Prima::VB::CommonControl); 800 801sub prf_types 802{ 803 my $pt = $_[ 0]-> SUPER::prf_types; 804 my %de = ( 805 bool => [qw(caseSensitive literal autoSelect autoHeight)], 806 uiv => [qw(editHeight listHeight focusedItem)], 807 comboStyle => ['style'], 808 string => ['text'], 809 items => ['items'], 810 ); 811 $_[0]-> prf_types_delete( $pt, qw(text)); 812 $_[0]-> prf_types_add( $pt, \%de); 813 return $pt; 814} 815 816sub profile_default 817{ 818 my $def = $_[ 0]-> SUPER::profile_default; 819 my %prf = ( 820 mainEvent => 'onChange', 821 ); 822 @$def{keys %prf} = values %prf; 823 return $def; 824} 825 826sub prf_adjust_default 827{ 828 my ( $self, $p, $pf) = @_; 829 $self-> SUPER::prf_adjust_default( $p, $pf); 830 delete $pf-> {$_} for qw ( 831 writeOnly autoWidth selectedItems 832 selection vScroll borderWidth 833 readOnly hScroll alignment 834 insertMode multiSelect maxLen 835 autoTab extendedSelect buttonClass 836 selection integralHeight buttonProfile 837 selStart multiColumn editClass 838 selEnd itemHeight editProfile 839 firstChar itemWidth listProfile 840 charOffset offset listVisible 841 passwordChar topItem listClass 842 wordDelimiters gridColor autoHScroll 843 autoVScroll scrollBarClass 844 ); 845} 846 847 848 849sub on_paint 850{ 851 my ( $self, $canvas) = @_; 852 my @sz = $canvas-> size; 853 my $cl = $self-> color; 854 my @c3d = ( $self-> dark3DColor, $self-> light3DColor); 855 my $s = $self-> prf('style') == cs::Simple; 856 my $szy = $s ? ( $sz[1]-$canvas-> font-> height - 5) : 0; 857 $canvas-> rect3d( 0,$szy,$sz[0]-1,$sz[1]-1,1,$c3d[0],$c3d[1],$self-> backColor); 858 unless ( $s) { 859 $canvas-> rect3d( $sz[0]-18,0,$sz[0]-1,$sz[1]-1,2,$c3d[1],$c3d[0],$self-> backColor); 860 $canvas-> color( cl::Black); 861 $canvas-> fillpoly([ 862 $sz[0]-12,$sz[1] * 0.6, 863 $sz[0]-8,$sz[1] * 0.6, 864 $sz[0]-10,$sz[1] * 0.3, 865 ]); 866 } 867 868 $canvas-> color( $cl); 869 $canvas-> draw_text( $self-> text, 2, $szy + 2, $sz[0] - 3 - ( $s ? 0 : 17), $sz[1] - 3, 870 dt::Left|dt::VCenter|dt::NoWordWrap|dt::UseClip|dt::ExpandTabs); 871 if ( $s) { 872 $canvas-> rect3d( 0,0,$sz[0]-1,$szy-1,2,$c3d[0],$c3d[1],$self-> backColor); 873 my $i = $self-> prf('items'); 874 $canvas-> draw_text( join("\n", @$i),2,2,$sz[0]-3,$szy-3, 875 dt::Left|dt::Top|dt::NoWordWrap|dt::UseClip|dt::NewLineBreak|dt::UseExternalLeading 876 ); 877 } 878 $self-> common_paint($canvas); 879} 880 881sub prf_style { $_[0]-> repaint; } 882sub prf_items { $_[0]-> repaint; } 883sub prf_borderWidth { $_[0]-> repaint; } 884 885package Prima::VB::DriveComboBox; 886use strict; 887use vars qw(@ISA); 888@ISA = qw(Prima::VB::ComboBox); 889 890sub prf_types 891{ 892 my $pt = $_[ 0]-> SUPER::prf_types; 893 my %de = ( 894 char => ['drive'], 895 ); 896 $_[0]-> prf_types_add( $pt, \%de); 897 return $pt; 898} 899 900sub prf_adjust_default 901{ 902 my ( $self, $p, $pf) = @_; 903 $self-> SUPER::prf_adjust_default( $p, $pf); 904 delete $pf-> {$_} for qw ( 905 items 906 ); 907} 908 909package Prima::VB::ColorComboBox; 910use strict; 911use vars qw(@ISA); 912@ISA = qw(Prima::VB::ComboBox); 913 914sub prf_types 915{ 916 my $pt = $_[ 0]-> SUPER::prf_types; 917 my %de = ( 918 color => ['value'], 919 ); 920 $_[0]-> prf_types_add( $pt, \%de); 921 return $pt; 922} 923 924sub prf_adjust_default 925{ 926 my ( $self, $p, $pf) = @_; 927 $self-> SUPER::prf_adjust_default( $p, $pf); 928 delete $pf-> {$_} for qw ( 929 items 930 ); 931} 932 933 934package Prima::VB::Edit; 935use strict; 936use vars qw(@ISA); 937@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 938 939sub prf_types 940{ 941 my $pt = $_[ 0]-> SUPER::prf_types; 942 my %de = ( 943 bool => [qw(autoIndent cursorWrap insertMode hScroll vScroll 944 persistentBlock readOnly syntaxHilite wantTabs wantReturns wordWrap 945 autoHScroll autoVScroll 946 )], 947 uiv => [qw(borderWidth tabIndent undoLimit)], 948 editBlockType => ['blockType',], 949 color => [qw(hiliteNumbers hiliteQStrings hiliteQQStrings)], 950 string => ['wordDelimiters','scrollBarClass'], 951 ); 952 $_[0]-> prf_types_add( $pt, \%de); 953 return $pt; 954} 955 956 957sub prf_adjust_default 958{ 959 my ( $self, $p, $pf) = @_; 960 $self-> SUPER::prf_adjust_default( $p, $pf); 961 delete $pf-> {$_} for qw ( 962 accelItems selection 963 cursorX markers 964 cursorY textRef 965 modified topLine 966 offset 967 selection 968 selEnd 969 selStart 970 ); 971} 972 973sub on_paint 974{ 975 my ( $self, $canvas) = @_; 976 my @r = $self-> paint_exterior( $canvas); 977 $canvas-> draw_text( $self-> text, @r, 978 ( $self-> prf('wordWrap') ? dt::WordWrap : dt::NoWordWrap) | 979 dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | 980 dt::UseClip | dt::ExpandTabs 981 ) if scalar @r; 982 $self-> common_paint($canvas); 983} 984 985sub prf_wordWrap { $_[0]-> repaint; } 986 987package Prima::VB::ImageViewer; 988use strict; 989use vars qw(@ISA); 990@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 991 992sub prf_types 993{ 994 my $pt = $_[ 0]-> SUPER::prf_types; 995 my %de = ( 996 bool => [qw(hScroll vScroll quality autoHScroll autoVScroll stretch)], 997 uiv => [qw(borderWidth zoom)], 998 image => ['image'], 999 align => ['alignment',], 1000 valign => ['valignment',], 1001 string => ['scrollBarClass',], 1002 ); 1003 $_[0]-> prf_types_add( $pt, \%de); 1004 return $pt; 1005} 1006 1007sub prf_adjust_default 1008{ 1009 my ( $self, $p, $pf) = @_; 1010 $self-> SUPER::prf_adjust_default( $p, $pf); 1011 delete $pf-> {$_} for qw ( 1012 deltaX imageFile 1013 deltaY 1014 limitX 1015 limitY 1016 ); 1017} 1018 1019sub on_paint 1020{ 1021 my ( $self, $canvas) = @_; 1022 my @r = $self-> paint_exterior( $canvas); 1023 my $i = $self-> prf('image'); 1024 if ( $i) { 1025 $canvas-> clipRect( $r[0], $r[1], $r[2] - 1, $r[3] - 1); 1026 my ( $a, $v, $z) = $self-> prf(qw(alignment valignment zoom)); 1027 my ( $ix, $iy) = $i-> size; 1028 my ( $izx, $izy) = ( $ix * $z, $iy * $z); 1029 my ( $ax, $ay); 1030 $a = ta::Left if $izx >= $r[2] - $r[0]; 1031 $v = ta::Top if $izy >= $r[3] - $r[1]; 1032 if ( $a == ta::Left) { 1033 $ax = $r[0]; 1034 } elsif ( $a == ta::Center) { 1035 $ax = $r[0] + ( $r[2] - $r[0] - $izx) / 2; 1036 } else { 1037 $ax = $r[2] - $izx; 1038 } 1039 if ( $v == ta::Bottom) { 1040 $ay = $r[1]; 1041 } elsif ( $v == ta::Middle) { 1042 $ay = $r[1] + ( $r[3] - $r[1] - $izy) / 2; 1043 } else { 1044 $ay = $r[3] - $izy; 1045 } 1046 $canvas-> stretch_image( $ax, $ay, $izx, $izy, $i); 1047 } 1048 $self-> common_paint($canvas); 1049} 1050 1051sub prf_image { $_[0]-> repaint; } 1052sub prf_alignment { $_[0]-> repaint; } 1053sub prf_valignment { $_[0]-> repaint; } 1054sub prf_zoom { $_[0]-> repaint; } 1055 1056package Prima::VB::ScrollWidget; 1057use strict; 1058use vars qw(@ISA); 1059@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 1060 1061sub prf_types 1062{ 1063 my $pt = $_[ 0]-> SUPER::prf_types; 1064 my %de = ( 1065 bool => [qw(autoHScroll autoVScroll hScroll vScroll)], 1066 uiv => [qw(borderWidth deltaX deltaY limitX limitY)], 1067 string => ['scrollBarClass',], 1068 ); 1069 $_[0]-> prf_types_add( $pt, \%de); 1070 return $pt; 1071} 1072 1073sub on_paint 1074{ 1075 my ( $self, $canvas) = @_; 1076 $self-> paint_exterior( $canvas); 1077 $self-> common_paint( $canvas); 1078} 1079 1080package Prima::VB::SpinButton; 1081use strict; 1082use vars qw(@ISA); 1083@ISA = qw(Prima::VB::CommonControl); 1084 1085sub prf_events 1086{ 1087 return ( 1088 $_[0]-> SUPER::prf_events, 1089 onIncrement => 'my ( $self, $increment) = @_;', 1090 ); 1091} 1092 1093 1094sub profile_default 1095{ 1096 my $def = $_[ 0]-> SUPER::profile_default; 1097 my %prf = ( 1098 mainEvent => 'onChange', 1099 ); 1100 @$def{keys %prf} = values %prf; 1101 return $def; 1102} 1103 1104sub on_paint 1105{ 1106 my ( $self, $canvas) = @_; 1107 my @clr = ( $self-> color, $self-> backColor); 1108 my @c3d = ( $self-> light3DColor, $self-> dark3DColor); 1109 my @size = $canvas-> size; 1110 $canvas-> rect3d( 0, 0, $size[0] - 1, $size[1] * 0.4 - 1, 2, @c3d, $clr[1]); 1111 $canvas-> rect3d( 0, $size[1] * 0.4, $size[0] - 1, $size[1] * 0.6 - 1, 2, @c3d, $clr[1]); 1112 $canvas-> rect3d( 0, $size[1] * 0.6, $size[0] - 1, $size[1] - 1, 2, @c3d, $clr[1]); 1113 $canvas-> color( $clr[0]); 1114 $canvas-> fillpoly([ 1115 $size[0] * 0.3, $size[1] * 0.73, 1116 $size[0] * 0.5, $size[1] * 0.87, 1117 $size[0] * 0.7, $size[1] * 0.73 1118 ]); 1119 $canvas-> fillpoly([ 1120 $size[0] * 0.3, $size[1] * 0.27, 1121 $size[0] * 0.5, $size[1] * 0.13, 1122 $size[0] * 0.7, $size[1] * 0.27 1123 ]); 1124 $self-> common_paint( $canvas); 1125} 1126 1127package Prima::VB::AltSpinButton; 1128use strict; 1129use vars qw(@ISA); 1130@ISA = qw(Prima::VB::CommonControl); 1131 1132sub prf_events 1133{ 1134 return ( 1135 $_[0]-> SUPER::prf_events, 1136 onIncrement => 'my ( $self, $increment) = @_;', 1137 ); 1138} 1139 1140sub profile_default 1141{ 1142 my $def = $_[ 0]-> SUPER::profile_default; 1143 my %prf = ( 1144 mainEvent => 'onChange', 1145 ); 1146 @$def{keys %prf} = values %prf; 1147 return $def; 1148} 1149 1150 1151sub on_paint 1152{ 1153 my ( $self, $canvas) = @_; 1154 my @clr = ( $self-> color, $self-> backColor); 1155 my @c3d = ( $self-> light3DColor, $self-> dark3DColor); 1156 my @size = $canvas-> size; 1157 $canvas-> color( $clr[ 1]); 1158 $canvas-> bar( 0, 0, $size[0]-1, $size[1]-1); 1159 1160 $canvas-> color( $c3d[ 0]); 1161 $canvas-> line( 0, 0, 0, $size[1] - 1); 1162 $canvas-> line( 1, 1, 1, $size[1] - 2); 1163 $canvas-> line( 2, $size[1] - 2, $size[0] - 3, $size[1] - 2); 1164 $canvas-> line( 1, $size[1] - 1, $size[0] - 2, $size[1] - 1); 1165 1166 $canvas-> color( $c3d[ 1]); 1167 $canvas-> line( 1, 0, $size[0] - 1, 0); 1168 $canvas-> line( 2, 1, $size[0] - 1, 1); 1169 $canvas-> line( $size[0] - 2, 1, $size[0] - 2, $size[1] - 2); 1170 $canvas-> line( $size[0] - 1, 1, $size[0] - 1, $size[1] - 1); 1171 1172 $canvas-> color( $c3d[ 1]); 1173 $canvas-> line( -1, 0, $size[0] - 2, $size[1] - 1); 1174 $canvas-> line( 0, 0, $size[0] - 1, $size[1] - 1); 1175 $canvas-> color( $c3d[ 0]); 1176 $canvas-> line( 1, 0, $size[0], $size[1] - 1); 1177 1178 $canvas-> color( $clr[0]); 1179 $canvas-> fillpoly([ 1180 $size[0] * 0.2, $size[1] * 0.65, 1181 $size[0] * 0.3, $size[1] * 0.77, 1182 $size[0] * 0.4, $size[1] * 0.65 1183 ]); 1184 $canvas-> fillpoly([ 1185 $size[0] * 0.6, $size[1] * 0.35, 1186 $size[0] * 0.7, $size[1] * 0.27, 1187 $size[0] * 0.8, $size[1] * 0.35 1188 ]); 1189 $self-> common_paint( $canvas); 1190} 1191 1192package Prima::VB::SpinEdit; 1193use strict; 1194use vars qw(@ISA); 1195@ISA = qw(Prima::VB::InputLine); 1196 1197sub prf_types 1198{ 1199 my $pt = $_[ 0]-> SUPER::prf_types; 1200 my %de = ( 1201 align => ['alignment',], 1202 bool => ['writeOnly','readOnly','insertMode','autoSelect', 1203 'autoTab','firstChar','charOffset'], 1204 upoint => ['selection',], 1205 uiv => [qw(min max step value)], 1206 string => [qw(spinClass editClass)], 1207 ); 1208 $_[0]-> prf_types_add( $pt, \%de); 1209 return $pt; 1210} 1211 1212sub prf_adjust_default 1213{ 1214 my ( $self, $p, $pf) = @_; 1215 $self-> SUPER::prf_adjust_default( $p, $pf); 1216 delete $pf-> {$_} for qw ( 1217 selection passwordChar 1218 selEnd writeOnly 1219 selStart 1220 charOffset 1221 firstChar 1222 ); 1223} 1224 1225 1226sub on_paint 1227{ 1228 my ( $self, $canvas) = @_; 1229 my @sz = $canvas-> size; 1230 my $cl = $self-> color; 1231 my ( $a, $bw) = $self-> prf(qw( alignment borderWidth)); 1232 $canvas-> rect3d( 0,0,$sz[0]-1,$sz[1]-1,$bw, 1233 $self-> dark3DColor,$self-> light3DColor,$self-> backColor); 1234 $canvas-> rect3d( $sz[0]-$sz[1]-$bw,$bw,$sz[0]-1,$sz[1]-1,2, 1235 $self-> light3DColor,$self-> dark3DColor); 1236 $canvas-> color( $cl); 1237 $a = (ta::Left == $a ? dt::Left : (ta::Center == $a ? dt::Center : dt::Right)); 1238 my $c = $self-> prf('value'); 1239 $canvas-> draw_text($c,2,2,$sz[0]-$sz[1]-$bw*2,$sz[1]-3, 1240 $a|dt::VCenter|dt::UseClip|dt::ExpandTabs|dt::NoWordWrap); 1241 $self-> common_paint($canvas); 1242} 1243 1244sub prf_alignment { $_[0]-> repaint; } 1245sub prf_borderWidth { $_[0]-> repaint; } 1246 1247package Prima::VB::Gauge; 1248use strict; 1249use vars qw(@ISA); 1250@ISA = qw(Prima::VB::CommonControl); 1251 1252sub prf_events 1253{ 1254 return ( 1255 $_[0]-> SUPER::prf_events, 1256 onStringify => 'my ( $self, $index, $result) = @_;', 1257 ); 1258} 1259 1260sub profile_default 1261{ 1262 my $def = $_[ 0]-> SUPER::profile_default; 1263 my %prf = ( 1264 mainEvent => 'onChange', 1265 ); 1266 @$def{keys %prf} = values %prf; 1267 return $def; 1268} 1269 1270sub prf_types 1271{ 1272 my $pt = $_[ 0]-> SUPER::prf_types; 1273 my %de = ( 1274 bool => [qw(vertical indeterminate)], 1275 uiv => [qw(min max value threshold indent)], 1276 gaugeRelief => ['relief'], 1277 ); 1278 $_[0]-> prf_types_add( $pt, \%de); 1279 return $pt; 1280} 1281 1282sub on_paint 1283{ 1284 my ($self,$canvas) = @_; 1285 my ($x, $y) = $canvas-> size; 1286 my ($i, $relief, $v, $val, $min, $max, $l3, $d3) = 1287 $self-> prf(qw(indent relief vertical value min max light3DColor dark3DColor)); 1288 my ($clComplete,$clHilite,$clBack,$clFore) = 1289 ($self-> prf('hiliteBackColor', 'hiliteColor'), $self-> backColor, $self-> color); 1290 my $complete = $v ? $y : $x; 1291 my $ediv = $max - $min; 1292 $ediv = 1 unless $ediv; 1293 $complete = int(($complete - $i*2) * $val / $ediv + 0.5); 1294 $canvas-> color( $clComplete); 1295 $canvas-> bar ( $v ? 1296 ($i, $i, $x-$i-1, $i+$complete) : 1297 ( $i, $i, $i + $complete, $y-$i-1) 1298 ); 1299 $canvas-> color( $clBack); 1300 $canvas-> bar ( $v ? 1301 ($i, $i+$complete+1, $x-$i-1, $y-$i-1) : 1302 ( $i+$complete+1, $i, $x-$i-1, $y-$i-1) 1303 ); 1304 # draw the border 1305 $canvas-> color(( $relief == gr::Sink) ? $d3 : (( $relief == gr::Border) ? cl::Black : $l3)); 1306 for ( my $j = 0; $j < $i; $j++) 1307 { 1308 $canvas-> line( $j, $j, $j, $y - $j - 1); 1309 $canvas-> line( $j, $y - $j - 1, $x - $j - 1, $y - $j - 1); 1310 } 1311 $canvas-> color(( $relief == gr::Sink) ? $l3 : (( $relief == gr::Border) ? cl::Black : $d3)); 1312 for ( my $j = 0; $j < $i; $j++) 1313 { 1314 $canvas-> line( $j + 1, $j, $x - $j - 1, $j); 1315 $canvas-> line( $x - $j - 1, $j, $x - $j - 1, $y - $j - 1); 1316 } 1317 1318 # draw the text, if neccessary 1319 my $s = sprintf( "%2d%%", $val * 100.0 / $ediv); 1320 my ($fw, $fh) = ( $canvas-> get_text_width( $s), $canvas-> font-> height); 1321 my $xBeg = int(( $x - $fw) / 2 + 0.5); 1322 my $xEnd = $xBeg + $fw; 1323 my $yBeg = int(( $y - $fh) / 2 + 0.5); 1324 my $yEnd = $yBeg + $fh; 1325 my ( $zBeg, $zEnd) = $v ? ( $yBeg, $yEnd) : ( $xBeg, $xEnd); 1326 if ( $zBeg > $i + $complete) 1327 { 1328 $canvas-> color( $clFore); 1329 $canvas-> text_shape_out( $s, $xBeg, $yBeg); 1330 } 1331 elsif ( $zEnd < $i + $complete + 1) 1332 { 1333 $canvas-> color( $clHilite); 1334 $canvas-> text_shape_out( $s, $xBeg, $yBeg); 1335 } 1336 else 1337 { 1338 $canvas-> clipRect( $v ? 1339 ( 0, 0, $x, $i + $complete) : 1340 ( 0, 0, $i + $complete, $y)); 1341 $canvas-> color( $clHilite); 1342 $canvas-> text_shape_out( $s, $xBeg, $yBeg); 1343 $canvas-> clipRect( $v ? 1344 ( 0, $i + $complete + 1, $x, $y) : 1345 ( $i + $complete + 1, 0, $x, $y)); 1346 $canvas-> color( $clFore); 1347 $canvas-> text_shape_out( $s, $xBeg, $yBeg); 1348 } 1349 $self-> common_paint( $canvas); 1350} 1351 1352sub prf_min { $_[0]-> repaint; } 1353sub prf_max { $_[0]-> repaint; } 1354sub prf_value { $_[0]-> repaint; } 1355sub prf_indent { $_[0]-> repaint; } 1356sub prf_relief { $_[0]-> repaint; } 1357sub prf_vertical { $_[0]-> repaint; } 1358 1359package Prima::VB::ProgressBar; 1360use strict; 1361use vars qw(@ISA); 1362@ISA = qw(Prima::VB::CommonControl); 1363 1364sub prf_types 1365{ 1366 my $pt = $_[ 0]-> SUPER::prf_types; 1367 my %de = ( 1368 uiv => [qw(min max value )], 1369 ); 1370 $_[0]-> prf_types_add( $pt, \%de); 1371 return $pt; 1372} 1373 1374sub on_paint 1375{ 1376 my ($self,$canvas) = @_; 1377 my ($x, $y) = $canvas-> size; 1378 my ($val, $min, $max) = 1379 $self-> prf(qw(value min max)); 1380 my $complete = $x; 1381 my $ediv = $max - $min; 1382 $ediv = 1 unless $ediv; 1383 $complete = int($complete * $val / $ediv + 0.5); 1384 $canvas-> color( $self-> prf('color') ); 1385 $canvas-> bar ( 0, 0, $complete, $y-1); 1386 $canvas-> color( cl::Gray ); 1387 $canvas-> bar ( $complete+1, 0, $x-1, $y-1); 1388 $self-> common_paint( $canvas); 1389} 1390 1391sub prf_min { $_[0]-> repaint; } 1392sub prf_max { $_[0]-> repaint; } 1393sub prf_value { $_[0]-> repaint; } 1394 1395package Prima::VB::AbstractSlider; 1396use strict; 1397use vars qw(@ISA); 1398@ISA = qw(Prima::VB::CommonControl); 1399 1400sub profile_default 1401{ 1402 my $def = $_[ 0]-> SUPER::profile_default; 1403 my %prf = ( 1404 mainEvent => 'onChange', 1405 ); 1406 @$def{keys %prf} = values %prf; 1407 return $def; 1408} 1409 1410sub prf_types 1411{ 1412 my $pt = $_[ 0]-> SUPER::prf_types; 1413 my %de = ( 1414 bool => [qw(readOnly snap autoTrack)], 1415 uiv => [qw(min max value increment step)], 1416 sliderScheme => ['scheme'], 1417 ); 1418 $_[0]-> prf_types_add( $pt, \%de); 1419 return $pt; 1420} 1421 1422sub prf_adjust_default 1423{ 1424 my ( $self, $p, $pf) = @_; 1425 $self-> SUPER::prf_adjust_default( $p, $pf); 1426 delete $pf-> {$_} for qw ( ticks); 1427} 1428 1429package Prima::VB::Slider; 1430use strict; 1431use vars qw(@ISA); 1432@ISA = qw(Prima::VB::AbstractSlider); 1433 1434sub profile_default 1435{ 1436 my $def = $_[ 0]-> SUPER::profile_default; 1437 my %prf = ( 1438 mainEvent => 'onChange', 1439 ); 1440 @$def{keys %prf} = values %prf; 1441 return $def; 1442} 1443 1444sub prf_types 1445{ 1446 my $pt = $_[ 0]-> SUPER::prf_types; 1447 my %de = ( 1448 bool => [qw(ribbonStrip vertical)], 1449 uiv => [qw(shaftBreadth)], 1450 tickAlign => [qw(tickAlign)], 1451 ); 1452 $_[0]-> prf_types_add( $pt, \%de); 1453 return $pt; 1454} 1455 1456sub on_paint 1457{ 1458 my ($self,$canvas) = @_; 1459 my ($x, $y) = $canvas-> size; 1460 my ( $f, $b) = ( $self-> color, $self-> backColor); 1461 my @c3d = ( $self-> light3DColor, $self-> dark3DColor); 1462 $canvas-> color( $b); 1463 $canvas-> bar(0,0,$x,$y); 1464 $canvas-> color( $f); 1465 if ( $self-> prf('vertical')) { 1466 $canvas-> rect3d( $x * 0.4, 0, $x * 0.6, $y - 1, 1, @c3d); 1467 $canvas-> rect3d( $x * 0.25, 3, $x * 0.75, 20, 1, @c3d, $b); 1468 } else { 1469 $canvas-> rect3d( 0, $y * 0.4, $x - 1, $y * 0.6, 1, @c3d); 1470 $canvas-> rect3d( 3, $y * 0.25, 20, $y * 0.75, 1, @c3d, $b); 1471 } 1472 $self-> common_paint( $canvas); 1473} 1474 1475sub prf_vertical { $_[0]-> repaint; } 1476 1477package Prima::VB::CircularSlider; 1478use strict; 1479use vars qw(@ISA); 1480@ISA = qw(Prima::VB::AbstractSlider); 1481 1482sub prf_events 1483{ 1484 return ( 1485 $_[0]-> SUPER::prf_events, 1486 onStringify => 'my ( $self, $index, $result) = @_;', 1487 ); 1488} 1489 1490sub profile_default 1491{ 1492 my $def = $_[ 0]-> SUPER::profile_default; 1493 my %prf = ( 1494 mainEvent => 'onChange', 1495 ); 1496 @$def{keys %prf} = values %prf; 1497 return $def; 1498} 1499 1500sub prf_types 1501{ 1502 my $pt = $_[ 0]-> SUPER::prf_types; 1503 my %de = ( 1504 bool => [qw(buttons stdPointer)], 1505 ); 1506 $_[0]-> prf_types_add( $pt, \%de); 1507 return $pt; 1508} 1509 1510sub on_paint 1511{ 1512 my ($self,$canvas) = @_; 1513 my ($x, $y) = $canvas-> size; 1514 my ( $f, $b) = ( $self-> color, $self-> backColor); 1515 my @c3d = ( $self-> light3DColor, $self-> dark3DColor); 1516 $canvas-> color( $b); 1517 $canvas-> bar(0,0,$x,$y); 1518 $canvas-> color( $f); 1519 my ( $cx, $cy) = ( $x/2, $y/2); 1520 my $rad = ($x < $y) ? $cx : $cy; 1521 $rad -= 3; 1522 $canvas-> lineWidth(2); 1523 $canvas-> color( $c3d[0]); 1524 $canvas-> arc( $cx, $cy, $rad, $rad, 65, 235); 1525 $canvas-> color( $c3d[1]); 1526 $canvas-> arc( $cx, $cy, $rad, $rad, 255, 405); 1527 $canvas-> lineWidth(1); 1528 $self-> common_paint( $canvas); 1529} 1530 1531 1532package Prima::VB::AbstractOutline; 1533use strict; 1534use vars qw(@ISA); 1535@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 1536 1537sub profile_default 1538{ 1539 my $def = $_[ 0]-> SUPER::profile_default; 1540 my %prf = ( 1541 mainEvent => 'onClick', 1542 ); 1543 @$def{keys %prf} = values %prf; 1544 return $def; 1545} 1546 1547sub prf_events 1548{ 1549 return ( 1550 $_[0]-> SUPER::prf_events, 1551 onSelectItem => 'my ( $self, $index) = @_;', 1552 onDrawItem => 'my ( $self, $canvas, $node, $left, $bottom, $right, $top, $position, $selected, $focused, $prelight) = @_;', 1553 onMeasureItem => 'my ( $self, $node, $result) = @_;', 1554 onExpand => 'my ( $self, $node, $action) = @_;', 1555 onDragItem => 'my ( $self, $from, $to) = @_;', 1556 onStringify => 'my ( $self, $node, $result) = @_;', 1557 ); 1558} 1559 1560sub prf_types 1561{ 1562 my $pt = $_[ 0]-> SUPER::prf_types; 1563 my %de = ( 1564 bool => [ qw(autoHScroll autoVScroll vScroll hScroll dragable autoHeight showItemHint)], 1565 uiv => [ qw(itemHeight itemWidth focusedItem borderWidth offset topItem indent 1566 openedGlyphs closedGlyphs)], 1567 treeItems => [qw(items)], 1568 icon => [qw(closedIcon openedIcon)], 1569 string => ['scrollBarClass',], 1570 ); 1571 $_[0]-> prf_types_add( $pt, \%de); 1572 return $pt; 1573} 1574 1575 1576sub prf_adjust_default 1577{ 1578 my ( $self, $p, $pf) = @_; 1579 $self-> SUPER::prf_adjust_default( $p, $pf); 1580 delete $pf-> {$_} for qw (offset); 1581} 1582 1583package Prima::VB::OutlineViewer; 1584use strict; 1585use vars qw(@ISA); 1586@ISA = qw(Prima::VB::AbstractOutline); 1587 1588sub prf_adjust_default 1589{ 1590 my ( $self, $p, $pf) = @_; 1591 $self-> SUPER::prf_adjust_default( $p, $pf); 1592 delete $pf-> {$_} for qw (items); 1593} 1594 1595 1596package Prima::VB::StringOutline; 1597use strict; 1598use vars qw(@ISA); 1599@ISA = qw(Prima::VB::AbstractOutline); 1600 1601sub on_paint 1602{ 1603 my ( $self, $canvas) = @_; 1604 my @r = $self-> paint_exterior( $canvas); 1605 my $c = ''; 1606 my $i = $self-> prf('items'); 1607 my $traverse; 1608 if ( $i && scalar @r) { 1609 my $fh = $canvas-> font-> height; 1610 my $max = int(($r[3] - $r[1]) / $fh) + 1; 1611 $traverse = sub{ 1612 my ( $x, $l) = @_; 1613 goto ENOUGH unless $max--; 1614 $c .= "\t\t" x $l; 1615 $c .= $x-> [2] ? '[-] ' : '[+] ' if $x-> [1]; 1616 $c .= $x-> [0] . "\n"; 1617 $l++; 1618 if ( $x-> [1] && $x-> [2]) { 1619 $traverse-> ($_, $l) for @{$x-> [1]}; 1620 } 1621 }; 1622 $traverse-> ($_,0) for @$i; 1623ENOUGH: 1624 $canvas-> draw_text( $c, @r, 1625 dt::NoWordWrap | dt::ExpandTabs | 1626 dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | 1627 dt::UseClip 1628 ); 1629 } 1630 $self-> common_paint($canvas); 1631} 1632 1633sub prf_items { $_[0]-> repaint; } 1634 1635package Prima::VB::DirectoryOutline; 1636use strict; 1637use vars qw(@ISA); 1638@ISA = qw(Prima::VB::AbstractOutline); 1639 1640sub prf_adjust_default 1641{ 1642 my ( $self, $p, $pf) = @_; 1643 $self-> SUPER::prf_adjust_default( $p, $pf); 1644 delete $pf-> {$_} for qw ( items dragable ); 1645} 1646 1647sub on_paint 1648{ 1649 my ( $self, $canvas) = @_; 1650 my @r = $self-> paint_exterior( $canvas); 1651 $canvas-> draw_text( "usr\n\tlocal\n\t\tshare\n\t\t\texamples\n\t\t\t\tetc", @r, 1652 dt::NoWordWrap | dt::ExpandTabs | 1653 dt::NewLineBreak | dt::Left | dt::Top | dt::UseExternalLeading | 1654 dt::UseClip 1655 ) if scalar @r; 1656 $self-> common_paint($canvas); 1657} 1658 1659package Prima::VB::Notebook; 1660use strict; 1661use vars qw(@ISA); 1662@ISA = qw( Prima::VB::CommonControl); 1663 1664 1665sub prf_types 1666{ 1667 my $pt = $_[ 0]-> SUPER::prf_types; 1668 my %de = ( 1669 uiv => ['pageCount', 'pageIndex'], 1670 ); 1671 $_[0]-> prf_types_add( $pt, \%de); 1672 return $pt; 1673} 1674 1675sub prf_adjust_default 1676{ 1677 my ( $self, $p, $pf) = @_; 1678 $self-> SUPER::prf_adjust_default( $p, $pf); 1679 delete $pf-> {defaultInsertPage}; 1680} 1681 1682sub init 1683{ 1684 my $self = shift; 1685 my %profile = $self-> SUPER::init( @_); 1686 $self-> {list} = {}; 1687 $self-> {pageCount} = 0; 1688 $self-> {pageIndex} = 0; 1689 $self-> insert( Popup => 1690 name => 'AltPopup', 1691 items => [ 1692 ['~Next page' => '+' => '+' => sub { $self-> pg_inc(1); }], 1693 ['~Previous page' => '-' => '-' => sub { $self-> pg_inc(-1); }], 1694 ['~Move widget to page...' => 'Ctrl+M' => '^M' => sub { $self-> widget_repage } ], 1695 ], 1696 )-> selected(0); 1697 $self-> add_hooks(qw(name owner DESTROY)); 1698 return %profile; 1699} 1700 1701sub prf_pageIndex 1702{ 1703 my ( $self, $pi) = @_; 1704 return if $pi == $self-> {pageIndex}; 1705 my $l = $self-> {list}; 1706 for ( $VB::form-> widgets) { 1707 my $n = $_-> name; 1708 next unless exists $l-> {$n}; 1709 $_-> visible( $pi == $l-> {$n}); 1710 } 1711 $self-> {pageIndex} = $pi; 1712} 1713 1714sub ext_profile 1715{ 1716 my $self = $_[0]; 1717 my $l = $self-> {list}; 1718 return map { $_ => $l-> {$_}} keys %{$l}; 1719} 1720 1721sub act_profile 1722{ 1723 my $self = $_[0]; 1724 return ( 1725 onChild => '$_[2]-> defaultInsertPage( $_[1]-> {extras}-> {$_[3]})', 1726 ); 1727} 1728 1729sub repage 1730{ 1731 $_[0]-> {pageIndex} = -1; # force repage 1732 $_[0]-> prf_pageIndex($_[0]-> prf('pageIndex')); 1733} 1734 1735sub on_load 1736{ 1737 my $self = $_[0]; 1738 return unless $self-> {extras}; 1739 $self-> {list} = $self-> {extras}; 1740 delete $self-> {extras}; 1741 $self-> repage; 1742} 1743 1744sub on_show 1745{ 1746 my $self = $_[0]; 1747 $self-> insert( Timer => timeout => 1, onTick => sub { 1748 $self-> repage; 1749 $_[0]-> destroy; 1750 })-> start; 1751} 1752 1753sub on_hook 1754{ 1755 my ( $self, $who, $prop, $old, $new, $widget) = @_; 1756 if ( $prop eq 'name') { 1757 return unless exists $self-> {list}-> {$old}; 1758 $self-> {list}-> {$new} = $self-> {list}-> {$old}; 1759 delete $self-> {list}-> {$old}; 1760 return; 1761 } 1762 if ( $prop eq 'owner') { 1763 my $n = $self-> prf('name'); 1764 my $l = $self-> {list}; 1765 if (( $n eq $old) || exists $l-> {$old}) { 1766 return if exists $l-> {$new} || ( $n eq $new); 1767 delete $l-> {$who}; 1768 } elsif (( $n eq $new) && exists $l-> {$who}) { 1769 return; # notebook itself was renamed 1770 } elsif (( $n eq $new) || exists $l-> {$new}) { 1771 return if exists $l-> {$old} || ( $n eq $old); 1772 $l-> {$who} = $self-> {pageIndex}; 1773 } 1774 return; 1775 } 1776 if ( $prop eq 'DESTROY') { 1777 delete $self-> {list}-> {$who}; 1778 return; 1779 } 1780} 1781 1782sub widget_repage 1783{ 1784 my $self = $_[0]; 1785 my @mw = $VB::form-> marked_widgets; 1786 my $d = Prima::Dialog-> create( 1787 text => 'Move to page', 1788 size => [ 217, 63], 1789 centered => 1, 1790 icon => $VB::ico, 1791 visible => 0, 1792 designScale => [7, 16], 1793 ); 1794 $d-> insert( ['Prima::SpinEdit' => 1795 origin => [ 3, 8], 1796 name => 'Spin', 1797 size => [ 100, 20], 1798 value => $self-> {pageIndex}, 1799 max => 16383, 1800 ], [ 'Prima::Button' => 1801 origin => [ 109, 8], 1802 size => [ 96, 36], 1803 text => '~OK', 1804 onClick => sub { $d-> ok; }, 1805 ], [ 'Prima::Label' => 1806 origin => [ 3, 36], 1807 size => [ 100, 20], 1808 text => 'Move to page', 1809 ]); 1810 my $ok = $d-> execute == mb::OK; 1811 my $pi = $d-> Spin-> value; 1812 $d-> destroy; 1813 return unless $ok; 1814 return if $self-> {pageIndex} == $pi; 1815 my $ctrl = 0; 1816 for ( @mw) { 1817 my $name = $_-> name; 1818 next unless exists $self-> {list}-> {$name}; 1819 $self-> {list}-> {$name} = $pi; 1820 $ctrl++; 1821 } 1822 return unless $ctrl; 1823 $self-> prf_set( pageIndex => $pi); 1824} 1825 1826sub pg_inc 1827{ 1828 my ( $self, $inc) = @_; 1829 my $np = $self-> {pageIndex} + $inc; 1830 return if $np < 0 || $np > 16383; 1831 $self-> prf_set( pageIndex => $np); 1832} 1833 1834package Prima::VB::TabSet; 1835use strict; 1836use vars qw(@ISA); 1837@ISA = qw( Prima::VB::CommonControl); 1838 1839sub prf_events 1840{ 1841 return ( 1842 $_[0]-> SUPER::prf_events, 1843 onDrawTab => 'my ( $self, $canvas, $number, $colorSet, $largePolygon, $smallPolygon) = @_;', 1844 onMeasureTab => 'my ( $self, $index, $result) = @_;', 1845 ); 1846} 1847 1848sub profile_default 1849{ 1850 my $def = $_[ 0]-> SUPER::profile_default; 1851 my %prf = ( 1852 mainEvent => 'onChange', 1853 ); 1854 @$def{keys %prf} = values %prf; 1855 return $def; 1856} 1857 1858sub prf_types 1859{ 1860 my $pt = $_[ 0]-> SUPER::prf_types; 1861 my %de = ( 1862 uiv => [qw(firstTab focusedTab tabIndex)], 1863 bool => [qw(colored topMost)], 1864 items => ['tabs'], 1865 ); 1866 $_[0]-> prf_types_add( $pt, \%de); 1867 return $pt; 1868} 1869 1870sub prf_tabs { $_[0]-> repaint; } 1871sub prf_topMost { $_[0]-> repaint; } 1872 1873sub on_paint 1874{ 1875 my ( $self, $canvas) = @_; 1876 my @sz = $self-> size; 1877 my $c = $self-> color; 1878 $canvas-> color( $self-> backColor); 1879 $canvas-> bar( 0, 0, @sz); 1880 my $y = ( $sz[1] - $canvas-> font-> height) / 2; 1881 $canvas-> color( $c); 1882 my $x = 0; 1883 my @tabs = @{$self-> prf('tabs')}; 1884 my $topMost = $self-> prf( 'topMost'); 1885 for ( @tabs) { 1886 $canvas-> text_shape_out( $_, $x + 5, $y); 1887 my $tx = $canvas-> get_text_width( $_); 1888 $canvas-> polyline( $topMost ? [ 1889 $x, 2, 1890 $x + 5, $sz[1] - 2, 1891 $x + $tx + 5, $sz[1] - 2, 1892 $x + $tx + 10, 2 1893 ] : [ 1894 $x, $sz[1] - 2, 1895 $x + 5, 2, 1896 $x + $tx + 5, 2, 1897 $x + $tx + 10, $sz[1] - 2 1898 ]); 1899 $x += $tx + 20; 1900 last if $x >= $sz[0]; 1901 } 1902 if ( scalar @tabs) { 1903 my $tx = $canvas-> get_text_width( $tabs[0]); 1904 $topMost ? 1905 $canvas-> line( $tx + 10, 2, $sz[0] - 1, 2) : 1906 $canvas-> line( $tx + 10, $sz[1] - 2, $sz[0] - 1, $sz[1] - 2); 1907 } 1908 $self-> common_paint($canvas); 1909} 1910 1911package Prima::VB::TabbedNotebook; 1912use vars qw(@ISA); 1913@ISA = qw( Prima::VB::Notebook); 1914 1915sub prf_types 1916{ 1917 my $pt = $_[ 0]-> SUPER::prf_types; 1918 my %de = ( 1919 items => ['tabs'], 1920 uiv => ['tabIndex'], 1921 bool => ['style', 'orientation'], 1922 ); 1923 $_[0]-> prf_types_add( $pt, \%de); 1924 return $pt; 1925} 1926 1927sub prf_adjust_default 1928{ 1929 my ( $self, $p, $pf) = @_; 1930 $self-> SUPER::prf_adjust_default( $p, $pf); 1931 delete $pf-> {$_} for qw ( 1932 tabCount 1933 pageCount 1934 ); 1935} 1936 1937use constant OFFSET => 11; 1938 1939sub o_delta_aperture { OFFSET, OFFSET } 1940 1941sub on_paint 1942{ 1943 my ( $self, $canvas) = @_; 1944 my @sz = $canvas-> size; 1945 my $cl = $self-> color; 1946 my @c3d = ( $self-> light3DColor, $self-> dark3DColor); 1947 $canvas-> color( $self-> backColor); 1948 $canvas-> bar( 0, 0, @sz); 1949 $canvas-> color( $cl); 1950 my $fh = $canvas-> font-> height; 1951 my $mh = $fh * 2 + 4; 1952 my @tabs = @{$self-> prf('tabs')}; 1953 my $earx = 16; 1954 1955 my ( $page, $last, $x, $maxx, $ix) = 1956 (0,'', $earx * 3, $sz[0] - $earx * 3 - 1, $self-> prf('pageIndex')); 1957 my $y = $self-> prf('orientation') ? 0 : $sz[1] - $mh; 1958 for ( @tabs) { 1959 next unless $page++ >= $ix; 1960 next if $_ eq $last; 1961 $last = $_; 1962 1963 my $w = $canvas-> get_text_width( $last); 1964 $canvas-> text_shape_out( $last, $x + $earx + 2, $y + $fh/2 + 2); 1965 $canvas-> rectangle( $x+1, $y + $fh/2+1, $x + $earx * 2 + $w + 2, $y + $fh*3/2+2); 1966 $canvas-> rectangle( $x, $y + $fh/2, $x + $earx * 2 + $w + 3, $y + $fh*3/2+3) 1967 if $page == $ix+1; 1968 $x += $w + $earx * 2 + 4; 1969 last if $x > $maxx; 1970 } 1971 $canvas-> rect3d( 1972 $earx/2, $y + $fh/2, 1973 $earx * 2.5, $y + $fh * 3/2+4, 1974 2, @c3d, $canvas-> backColor); 1975 $canvas-> rect3d( 1976 $maxx + $earx/2, $y + $fh/2, 1977 $maxx + $earx * 2.5, $y + $fh * 3/2+4, 1978 2, @c3d, $canvas-> backColor); 1979 $canvas-> fillpoly([ 1980 $earx, $y + $fh, 1981 $earx*2, $y + $fh*0.5+3, 1982 $earx*2, $y + $fh*1.5-1 1983 ]); 1984 $canvas-> fillpoly([ 1985 $maxx + $earx*2, $y + $fh, 1986 $maxx + $earx, $y + $fh*0.5+3, 1987 $maxx + $earx, $y + $fh*1.5-1 1988 ]); 1989 1990 my @tr = $canvas-> translate; 1991 $canvas-> translate( $self-> prf('orientation') ? (0, $mh) : (0,0)); 1992 if ( $self-> prf('style')) { 1993 $canvas-> rect3d( 10, 10, $sz[0] - 11, $sz[1] - 10 - $mh, 1, reverse @c3d); 1994 $canvas-> rect3d( 2, 2, $sz[0] - 3, $sz[1] - $mh, 1, @c3d); 1995 } 1996 $canvas-> linePattern( lp::Dash); 1997 $canvas-> rectangle( OFFSET+1, OFFSET+1, $sz[0] - 17, $sz[1] - ($self-> prf('style') ? 48 : -4) - $mh); 1998 $canvas-> linePattern( lp::Solid); 1999 $canvas-> translate(@tr); 2000 $self-> common_paint( $canvas); 2001} 2002 2003sub on_mousedown 2004{ 2005 my ( $self, $btn, $mod, $x, $y) = @_; 2006 if ( $btn == mb::Left) { 2007 my @sz = $self-> size; 2008 my $fh = $self-> font-> height; 2009 my $ny = $self-> prf('orientation') ? 0 : $sz[1] - 2 * $fh - 4; 2010 my $earx = 16; 2011 my $maxx = $sz[0] - $earx; 2012 if ( $y > $ny + $fh/2 && $y < $ny + $fh*3/2+4) { 2013 if ( $x > $earx/2 && $x < $earx * 2.5) { 2014 $self-> prf_set( 'pageIndex' => $self-> prf('pageIndex') - 1); 2015 return; 2016 } elsif ( $x > $maxx - $earx*1.5 && $x < $maxx + $earx/2) { 2017 $self-> prf_set( 'pageIndex' => $self-> prf('pageIndex') + 1); 2018 return; 2019 } 2020 } 2021 } 2022 $self-> SUPER::on_mousedown( $btn, $mod, $x, $y); 2023} 2024 2025sub prf_tabs { $_[0]-> repaint; } 2026sub prf_orientation { $_[0]-> repaint } 2027sub prf_style { $_[0]-> repaint } 2028sub prf_pageIndex { 2029 $_[0]-> SUPER::prf_pageIndex( $_[1]); 2030 $_[0]-> repaint; 2031} 2032 2033 2034package Prima::VB::Header; 2035use strict; 2036use vars qw(@ISA); 2037@ISA = qw( Prima::VB::CommonControl); 2038 2039# use Prima::Header; 2040 2041sub prf_types 2042{ 2043 my $pt = $_[ 0]-> SUPER::prf_types; 2044 my %de = ( 2045 items => ['items', 'widths'], 2046 uiv => ['offset', 'minTabWidth'], 2047 iv => ['pressed'], 2048 bool => ['clickable', 'dragable', 'vertical', 'scalable'], 2049 ); 2050 $_[0]-> prf_types_add( $pt, \%de); 2051 return $pt; 2052} 2053 2054sub prf_adjust_default 2055{ 2056 my ( $self, $p, $pf) = @_; 2057 $self-> SUPER::prf_adjust_default( $p, $pf); 2058 delete $pf-> {$_} for qw ( pressed); 2059} 2060 2061sub on_paint 2062{ 2063 my ( $self, $canvas) = @_; 2064 my @sz = $canvas-> size; 2065 $canvas-> clear; 2066 my @w = @{$self-> prf('widths')}; 2067 my @i = @{$self-> prf('items')}; 2068 my $v = $self-> prf('vertical'); 2069 my $fh = $canvas-> font-> height; 2070 my @c3d = ( $canvas-> light3DColor, $canvas-> dark3DColor); 2071 my $x; 2072 my $z = 0; 2073 for ( $x = 0; $x < @i; $x++) { 2074 my $ww = $w[$x]; 2075 $ww = $canvas-> get_text_width( $i[$x]) if !(defined($ww)) || !($ww =~ m/^\s*\d+\s*$/); 2076 my @rc = $v ? ( 0, $z, $sz[0]-1, $z + $ww) : ( $z, 0, $z + $ww, $sz[1]-1); 2077 $canvas-> rect3d( @rc, 1, @c3d); 2078 $canvas-> clipRect( $rc[0]+1, $rc[1]+1, $rc[2]-1, $rc[3]-1); 2079 $canvas-> text_shape_out( $i[$x], $rc[0] + 1, $rc[1] + ($rc[3] - $rc[1] - $fh) / 2 + 1); 2080 $canvas-> clipRect( 0, 0, @sz); 2081 $z += $ww + 2; 2082 } 2083 $self-> common_paint( $canvas); 2084} 2085 2086 2087sub prf_items { $_[0]-> repaint; } 2088sub prf_widths{ $_[0]-> repaint; } 2089 2090 2091package Prima::VB::DetailedList; 2092use strict; 2093use vars qw(@ISA); 2094@ISA = qw( Prima::VB::ListBox); 2095 2096sub prf_types 2097{ 2098 my $pt = $_[ 0]-> SUPER::prf_types; 2099 my %de = ( 2100 items => ['headers', 'widths'], 2101 multiItems => ['items'], 2102 uiv => ['mainColumn', 'columns', 'minTabWidth', 'offset'], 2103 string => ['headerClass'], 2104 bool => ['clickable', 'dragable', 'vertical', 'scalable'], 2105 ); 2106 $_[0]-> prf_types_delete( $pt, qw(items)); 2107 $_[0]-> prf_types_add( $pt, \%de); 2108 return $pt; 2109} 2110 2111sub prf_adjust_default 2112{ 2113 my ( $self, $p, $pf) = @_; 2114 $self-> SUPER::prf_adjust_default( $p, $pf); 2115 delete $pf-> {$_} for qw ( pressed headerProfile headerDelegations multiColumn autoWidth 2116 vertical offset pressed gridColor); 2117} 2118 2119sub on_paint 2120{ 2121 my ( $self, $canvas) = @_; 2122 my @r = $self-> paint_exterior($canvas); 2123 my @w = @{$self-> prf('widths')}; 2124 my @h = @{$self-> prf('headers')}; 2125 my @i = @{$self-> prf('items')}; 2126 my $c = $self-> prf('columns'); 2127 my $f = $canvas-> font-> height; 2128 if ( scalar(@r)) { 2129 $canvas-> color( cl::Gray); 2130 $canvas-> bar( 1, $r[3] - $f, $r[2], $r[3] - 1); 2131 $canvas-> color( cl::Fore); 2132 if ( $c) { 2133 my $z = $r[0]; 2134 my $j; 2135 for ( $j = 0; $j < $c; $j++) { 2136 my $ww = $w[$j]; 2137 $ww = $canvas-> get_text_width( $h[$j]) 2138 if !(defined($ww)) || !($ww =~ m/^\s*\d+\s*$/); 2139 my @z = ( $z, $r[1], ( $z + $ww > $r[2]) ? $r[2] : $z + $ww, $r[3]); 2140 $z[2]++; $canvas-> rectangle( @z); $z[2]--; 2141 $canvas-> draw_text( join("\n", $h[$j], map { 2142 defined($i[$_]-> [$j]) ? $i[$_]-> [$j] : '' 2143 } 0..$#i), 2144 @z, 2145 dt::NoWordWrap | dt::NewLineBreak | dt::Left | 2146 dt::Top | dt::UseClip 2147 ); 2148 $z += $ww + 1; 2149 last if $z > $r[2]; 2150 } 2151 } 2152 } 2153 $self-> common_paint($canvas); 2154} 2155 2156sub prf_items 2157{ 2158 my ( $self, $data) = @_; 2159 my $c = $self-> prf('columns'); 2160 for ( @$data) { 2161 next if scalar @$_ >= $c; 2162 push( @$_, ('') x ( $c - scalar @$_)); 2163 } 2164 $self-> repaint; 2165} 2166 2167sub prf_columns { $_[0]-> prf_items( $_[0]-> prf('items')); } 2168 2169sub prf_widths { $_[0]-> repaint; } 2170sub prf_headers { $_[0]-> prf_set( columns => scalar @{$_[0]-> prf('headers')}); } 2171 2172 2173package Prima::VB::Calendar; 2174use strict; 2175use vars qw(@ISA); 2176@ISA = qw( Prima::VB::CommonControl); 2177 2178sub prf_types 2179{ 2180 my $pt = $_[ 0]-> SUPER::prf_types; 2181 my %de = ( 2182 date => [ 'date' ], 2183 bool => ['useLocale'], 2184 iv => [ 'day', 'year', 'month' ], 2185 ); 2186 $_[0]-> prf_types_add( $pt, \%de); 2187 return $pt; 2188} 2189 2190sub on_paint 2191{ 2192 my ( $self, $canvas) = @_; 2193 my ( $fh, $fw) = ( $canvas-> font-> height, $canvas-> font-> maximalWidth * 2); 2194 my @sz = $canvas-> size; 2195 $canvas-> clear; 2196 $canvas-> rectangle( 5, 5, $sz[0] - 6, $sz[1] - 17 - $fh * 3); 2197 $canvas-> rectangle( 5, $sz[1] - $fh * 2 - 10, $sz[0] - 110, $sz[1] - $fh - 6); 2198 $canvas-> rectangle( $sz[0] - 105, $sz[1] - $fh * 2 - 10, $sz[0] - 5, $sz[1] - $fh - 6); 2199 $canvas-> clipRect( 6, 6, $sz[0] - 7, $sz[1] - 18 - $fh * 3); 2200 my ( $xd, $yd) = ( int(( $sz[0] - 10 ) / 7), int(( $sz[1] - $fh * 4 - 22 ) / 7)); 2201 $yd = $fh if $yd < $fh; 2202 $xd = $fw if $xd < $fw; 2203 my ( $x, $y, $i) = ( 5 + $xd/2, $sz[1] - 17 - $fh * 4, 0); 2204 for ( 1 .. 31 ) { 2205 $canvas-> text_shape_out( $_, $x, $y); 2206 $x += $xd; 2207 next unless $i++ == 6; 2208 ( $x, $y, $i) = ( 5 + $xd/2, $y - $yd, 0); 2209 } 2210 $canvas-> clipRect( 0, 0, @sz); 2211 $self-> common_paint($canvas); 2212} 2213 2214package Prima::VB::Grid; 2215use strict; 2216use vars qw(@ISA); 2217@ISA = qw(Prima::VB::CommonControl Prima::VB::BiScroller); 2218 2219sub profile_default 2220{ 2221 my $def = $_[ 0]-> SUPER::profile_default; 2222 my %prf = ( 2223 mainEvent => 'onClick', 2224 ); 2225 @$def{keys %prf} = values %prf; 2226 return $def; 2227} 2228 2229sub prf_events 2230{ 2231 return ( 2232 $_[0]-> SUPER::prf_events, 2233 onSelectCell => 'my ( $self, $column, $row) = @_;', 2234 onDrawCell => <<DRAWCELL, 2235my ( \$self, \$canvas, 2236 \$column, \$row, \$indent, 2237 \$sx1, \$sy1, \$sx2, \$sy2, 2238 \$cx1, \$cy1, \$cx2, \$cy2, 2239 \$selected, \$focused, \$prelight 2240 ) = \@_; 2241DRAWCELL 2242 onGetRange => 'my ( $self, $axis, $index, $min, $max) = @_;', 2243 onMeasure => 'my ( $self, $axis, $index, $breadth) = @_;', 2244 onSetExtent => 'my ( $self, $axis, $index, $breadth) = @_;', 2245 onStringify => 'my ( $self, $column, $row, $text_ref) = @_;', 2246 ); 2247} 2248 2249 2250sub prf_types 2251{ 2252 my $pt = $_[ 0]-> SUPER::prf_types; 2253 my %de = ( 2254 bool => [qw( allowChangeCellHeight allowChangeCellWidth autoHScroll autoVScroll 2255 clipCells drawHGrid drawVGrid hScroll vScroll multiSelect)], 2256 uiv => [qw(borderWidth columns constantCellWidth constantCellHeight gridGravity 2257 leftCell topCell rows)], 2258 upoint => [qw(focusedCell)], 2259 color => [qw(gridColor indentCellBackColor indentCellColor)], 2260 urect => [qw(cellIndents)], 2261 multiItems => ['cells'], 2262 string => ['scrollBarClass',], 2263 ); 2264 $_[0]-> prf_types_add( $pt, \%de); 2265 return $pt; 2266} 2267 2268sub prf_adjust_default 2269{ 2270 my ( $self, $p, $pf) = @_; 2271 $self-> SUPER::prf_adjust_default( $p, $pf); 2272 delete $pf-> {$_} for qw (offset); 2273} 2274 2275sub on_paint 2276{ 2277 my ( $self, $canvas) = @_; 2278 my @r = $self-> paint_exterior($canvas); 2279 my @i = @{$self-> prf('cells')}; 2280 my $c = $self-> prf('columns'); 2281 my $r = $self-> prf('rows'); 2282 my $f = $canvas-> font-> height; 2283 if ( scalar(@r) && $c && $r) { 2284 my $z = $r[0]; 2285 my $j; 2286 my @polyline; 2287 my $lowline = $r[3] - $r * $f; 2288 $lowline = $r[1] if $lowline < $r[1]; 2289 for ( $j = 0; $j < $c; $j++) { 2290 my $ww = $canvas-> get_text_width( 2291 defined($i[0]-> [$j]) ? $i[0]-> [$j] : '' 2292 ); 2293 my @z = ( $z, $r[1], ( $z + $ww > $r[2]) ? $r[2] : $z + $ww, $r[3]); 2294 push @polyline, $z[2]+1, $lowline, $z[2]+1, $r[3]; 2295 $canvas-> draw_text( join("\n", map { 2296 defined($i[$_]-> [$j]) ? $i[$_]-> [$j] : '' 2297 } 0..($r-1)), 2298 @z, 2299 dt::NoWordWrap | dt::NewLineBreak | dt::Left | dt::Top | dt::UseClip 2300 ); 2301 $z += $ww + 1; 2302 last if $z > $r[2]; 2303 } 2304 push @polyline, $r[0], $lowline, $r[0], $r[3]; 2305 push @polyline, map { $r[0], $r[3] - $_ * $f, $z, $r[3] - $_ * $f } 1 .. $r; 2306 $self-> lines(\@polyline); 2307 } 2308 $self-> common_paint($canvas); 2309} 2310 2311sub prf_cells 2312{ 2313 my ( $self, $data) = @_; 2314 my $c = $self-> prf('columns'); 2315 my $r = $self-> prf('rows'); 2316 for ( @$data) { 2317 next if scalar @$_ >= $c; 2318 push( @$_, ('') x ( $c - scalar @$_)); 2319 } 2320 if ( scalar @$data < $r) { 2321 $r -= @$data; 2322 push @$data, [('') x $c] while $r--; 2323 } 2324 2325 $self-> repaint; 2326} 2327 2328sub prf_columns { $_[0]-> prf_cells( $_[0]-> prf('cells')); } 2329sub prf_rows { $_[0]-> prf_cells( $_[0]-> prf('cells')); } 2330 23311; 2332