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