1 //----------------------------------------------------------------------------
2 // Anti-Grain Geometry - Version 2.4 (Public License)
3 // Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
4 //
5 // Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
6 // Pascal Port By: Milan Marusinec alias Milano
7 // milan@marusinec.sk
8 // http://www.aggpas.org
9 // Copyright (c) 2005-2006
10 //
11 // Permission to copy, use, modify, sell and distribute this software
12 // is granted provided this copyright notice appears in all copies.
13 // This software is provided "as is" without express or implied
14 // warranty, and with no claim as to its suitability for any purpose.
15 //
16 //----------------------------------------------------------------------------
17 // Contact: mcseem@antigrain.com
18 // mcseemagg@yahoo.com
19 // http://www.antigrain.com
20 //
21 //----------------------------------------------------------------------------
22 //
23 // classes slider_ctrl_impl, slider_ctrl
24 //
25 // [Pascal Port History] -----------------------------------------------------
26 //
27 // 21.12.2005-Milano: Complete unit port
28 // 18.12.2005-Milano: Unit port establishment
29 //
30 { agg_slider_ctrl.pas }
31 unit
32 agg_slider_ctrl ;
33
34 INTERFACE
35
36 {$I agg_mode.inc }
37
38 uses
39 SysUtils ,
40 agg_basics ,
41 agg_ctrl ,
42 agg_color ,
43 agg_ellipse ,
44 agg_path_storage ,
45 agg_conv_stroke ,
46 agg_gsv_text ,
47 agg_math ,
48 agg_math_stroke ;
49
50 { TYPES DEFINITION }
51 type
52 slider_ctrl_impl = object(ctrl )
53 m_border_width ,
54 m_border_extra ,
55 m_text_thickness ,
56 m_value ,
57 m_preview_value ,
58
59 m_min ,
60 m_max : double;
61
62 m_num_steps : unsigned;
63 m_descending : boolean;
64
65 m_label : array[0..63 ] of byte;
66
67 m_xs1 ,
68 m_ys1 ,
69 m_xs2 ,
70 m_ys2 ,
71 m_pdx : double;
72
73 m_mouse_move : boolean;
74
75 m_vx ,
76 m_vy : array[0..31 ] of double;
77
78 m_ellipse : ellipse;
79
80 m_idx ,
81 m_vertex : unsigned;
82
83 m_text : gsv_text;
84 m_text_poly : conv_stroke;
85 m_storage : path_storage;
86
87 constructor Construct(x1 ,y1 ,x2 ,y2 : double; flip_y : boolean = false );
88 destructor Destruct; virtual;
89
90 procedure border_width_(t : double; extra : double = 0.0 );
91
92 procedure range_ (min ,max : double );
93 procedure num_steps_ (num : unsigned );
94 procedure label_ (fmt : PChar );
95 procedure text_thickness_(t : double );
96
_descendingnull97 function _descending : boolean;
98 procedure descending_(v : boolean );
99
_valuenull100 function _value : double;
101 procedure value_(v : double );
102
in_rectnull103 function in_rect(x ,y : double ) : boolean; virtual;
104
on_mouse_button_downnull105 function on_mouse_button_down(x ,y : double ) : boolean; virtual;
on_mouse_button_upnull106 function on_mouse_button_up (x ,y : double ) : boolean; virtual;
107
on_mouse_movenull108 function on_mouse_move(x ,y : double; button_flag : boolean ) : boolean; virtual;
on_arrow_keysnull109 function on_arrow_keys(left ,right ,down ,up : boolean ) : boolean; virtual;
110
111 // Vertex source interface
num_pathsnull112 function num_paths : unsigned; virtual;
113 procedure rewind(path_id : unsigned ); virtual;
vertexnull114 function vertex(x ,y : double_ptr ) : unsigned; virtual;
115
116 // Private
117 procedure calc_box;
normalize_valuenull118 function normalize_value(preview_value_flag : boolean ) : boolean;
119
120 end;
121
122 slider_ctrl_ptr = ^slider_ctrl;
123 slider_ctrl = object(slider_ctrl_impl )
124 m_background_color ,
125 m_triangle_color ,
126 m_text_color ,
127 m_pointer_preview_color ,
128 m_pointer_color : aggclr;
129
130 m_colors : array[0..5 ] of aggclr_ptr;
131
132 constructor Construct(x1 ,y1 ,x2 ,y2 : double; flip_y : boolean = false );
133
134 procedure background_color_(c : aggclr_ptr );
135 procedure pointer_color_ (c : aggclr_ptr );
136
_colornull137 function _color(i : unsigned ) : aggclr_ptr; virtual;
138
139 end;
140
141 { GLOBAL PROCEDURES }
142
143
144 IMPLEMENTATION
145 { LOCAL VARIABLES & CONSTANTS }
146 { UNIT IMPLEMENTATION }
147 { CONSTRUCT }
148 constructor slider_ctrl_impl.Construct;
149 begin
150 inherited Construct(x1 ,y1 ,x2 ,y2 ,flip_y );
151
152 m_ellipse.Construct;
153 m_text.Construct;
154 m_text_poly.Construct(@m_text );
155 m_storage.Construct;
156
157 m_border_width :=1.0;
158 m_border_extra :=(y2 - y1 ) / 2;
159 m_text_thickness:=1.0;
160 m_pdx :=0.0;
161 m_mouse_move :=false;
162 m_value :=0.5;
163 m_preview_value :=0.5;
164 m_min :=0.0;
165 m_max :=1.0;
166 m_num_steps :=0;
167 m_descending :=false;
168
169 m_label[0 ]:=0;
170
171 calc_box;
172
173 end;
174
175 { DESTRUCT }
176 destructor slider_ctrl_impl.Destruct;
177 begin
178 m_storage.Destruct;
179 m_text_poly.Destruct;
180 m_text.Destruct;
181
182 end;
183
184 { BORDER_WIDTH_ }
185 procedure slider_ctrl_impl.border_width_;
186 begin
187 m_border_width:=t;
188 m_border_extra:=extra;
189
190 calc_box;
191
192 end;
193
194 { RANGE_ }
195 procedure slider_ctrl_impl.range_;
196 begin
197 m_min:=min;
198 m_max:=max;
199
200 end;
201
202 { NUM_STEPS_ }
203 procedure slider_ctrl_impl.num_steps_;
204 begin
205 m_num_steps:=num;
206
207 end;
208
209 { LABEL_ }
210 procedure slider_ctrl_impl.label_;
211 var
212 len : unsigned;
213
214 begin
215 m_label[0 ]:=0;
216
217 if fmt <> NIL then
218 begin
219 len:=StrLen(fmt );
220
221 if len > 63 then
222 len:=63;
223
224 move(fmt^ ,m_label[0 ] ,len );
225
226 m_label[len ]:=0;
227
228 end;
229
230 end;
231
232 { TEXT_THICKNESS_ }
233 procedure slider_ctrl_impl.text_thickness_;
234 begin
235 m_text_thickness:=t;
236
237 end;
238
239 { _DESCENDING }
slider_ctrl_impl._descendingnull240 function slider_ctrl_impl._descending;
241 begin
242 result:=m_descending;
243
244 end;
245
246 { DESCENDING_ }
247 procedure slider_ctrl_impl.descending_;
248 begin
249 m_descending:=v;
250
251 end;
252
253 { _VALUE }
slider_ctrl_impl._valuenull254 function slider_ctrl_impl._value;
255 begin
256 result:=m_value * (m_max - m_min ) + m_min;
257
258 end;
259
260 { VALUE_ }
261 procedure slider_ctrl_impl.value_;
262 begin
263 m_preview_value:=(v - m_min ) / (m_max - m_min );
264
265 if m_preview_value > 1.0 then
266 m_preview_value:=1.0;
267
268 if m_preview_value < 0.0 then
269 m_preview_value:=0.0;
270
271 normalize_value(true );
272
273 end;
274
275 { IN_RECT }
slider_ctrl_impl.in_rectnull276 function slider_ctrl_impl.in_rect;
277 begin
278 inverse_transform_xy(@x ,@y );
279
280 result:=
281 (x >= m_x1 ) and
282 (x <= m_x2 ) and
283 (y >= m_y1 ) and
284 (y <= m_y2 );
285
286 end;
287
288 { ON_MOUSE_BUTTON_DOWN }
slider_ctrl_impl.on_mouse_button_downnull289 function slider_ctrl_impl.on_mouse_button_down;
290 var
291 xp ,yp : double;
292
293 begin
294 inverse_transform_xy(@x ,@y );
295
296 xp:=m_xs1 + (m_xs2 - m_xs1 ) * m_value;
297 yp:=(m_ys1 + m_ys2 ) / 2.0;
298
299 if calc_distance(x ,y ,xp ,yp ) <= m_y2 - m_y1 then
300 begin
301 m_pdx:=xp - x;
302
303 m_mouse_move:= true;
304
305 result:=true;
306
307 end
308 else
309 result:=false;
310
311 end;
312
313 { ON_MOUSE_BUTTON_UP }
slider_ctrl_impl.on_mouse_button_upnull314 function slider_ctrl_impl.on_mouse_button_up;
315 begin
316 m_mouse_move:=false;
317
318 normalize_value(true );
319
320 result:=true;
321
322 end;
323
324 { ON_MOUSE_MOVE }
slider_ctrl_impl.on_mouse_movenull325 function slider_ctrl_impl.on_mouse_move;
326 var
327 xp : double;
328
329 begin
330 inverse_transform_xy(@x ,@y );
331
332 if not button_flag then
333 begin
334 on_mouse_button_up(x ,y );
335
336 result:=false;
337
338 exit;
339
340 end;
341
342 if m_mouse_move then
343 begin
344 xp:=x + m_pdx;
345
346 m_preview_value:=(xp - m_xs1 ) / (m_xs2 - m_xs1 );
347
348 if m_preview_value < 0.0 then
349 m_preview_value:=0.0;
350
351 if m_preview_value > 1.0 then
352 m_preview_value:=1.0;
353
354 result:=true;
355
356 end
357 else
358 result:=false;
359
360 end;
361
362 { ON_ARROW_KEYS }
slider_ctrl_impl.on_arrow_keysnull363 function slider_ctrl_impl.on_arrow_keys;
364 var
365 d : double;
366
367 begin
368 d:=0.005;
369
370 if m_num_steps <> 0 then
371 d:=1.0 / m_num_steps;
372
373 if right or
374 up then
375 begin
376 m_preview_value:=m_preview_value + d;
377
378 if m_preview_value > 1.0 then
379 m_preview_value:=1.0;
380
381 normalize_value(true );
382
383 result:=true;
384
385 exit;
386
387 end;
388
389 if left or
390 down then
391 begin
392 m_preview_value:=m_preview_value - d;
393
394 if m_preview_value < 0.0 then
395 m_preview_value:=0.0;
396
397 normalize_value(true );
398
399 result:=true;
400
401 end
402 else
403 result:=false;
404
405 end;
406
407 { NUM_PATHS }
slider_ctrl_impl.num_pathsnull408 function slider_ctrl_impl.num_paths;
409 begin
410 result:=6;
411
412 end;
413
414 { REWIND }
415 procedure slider_ctrl_impl.rewind;
416 var
417 i : unsigned;
418
419 d ,x : double;
420
421 buf : array[0..255 ] of byte;
422
423 label
424 _0 ;
425
426 begin
427 m_idx:=path_id;
428
429 case path_id of
430 0 : // Background
431 begin
432 _0 :
433 m_vertex:=0;
434
435 m_vx[0 ]:=m_x1 - m_border_extra;
436 m_vy[0 ]:=m_y1 - m_border_extra;
437 m_vx[1 ]:=m_x2 + m_border_extra;
438 m_vy[1 ]:=m_y1 - m_border_extra;
439 m_vx[2 ]:=m_x2 + m_border_extra;
440 m_vy[2 ]:=m_y2 + m_border_extra;
441 m_vx[3 ]:=m_x1 - m_border_extra;
442 m_vy[3 ]:=m_y2 + m_border_extra;
443
444 end;
445
446 1 : // Triangle
447 begin
448 m_vertex:=0;
449
450 if m_descending then
451 begin
452 m_vx[0 ]:=m_x1;
453 m_vy[0 ]:=m_y1;
454 m_vx[1 ]:=m_x2;
455 m_vy[1 ]:=m_y1;
456 m_vx[2 ]:=m_x1;
457 m_vy[2 ]:=m_y2;
458 m_vx[3 ]:=m_x1;
459 m_vy[3 ]:=m_y1;
460
461 end
462 else
463 begin
464 m_vx[0 ]:=m_x1;
465 m_vy[0 ]:=m_y1;
466 m_vx[1 ]:=m_x2;
467 m_vy[1 ]:=m_y1;
468 m_vx[2 ]:=m_x2;
469 m_vy[2 ]:=m_y2;
470 m_vx[3 ]:=m_x1;
471 m_vy[3 ]:=m_y1;
472
473 end;
474
475 end;
476
477 2 :
478 begin
479 m_text.text_(@m_label[0 ] );
480
481 if m_label[0 ] <> 0 then
482 begin
483 sprintf(@buf[0 ] ,@m_label[0 ] ,_value );
484
485 m_text.text_(@buf[0 ] );
486
487 end;
488
489 m_text.start_point_(m_x1 ,m_y1 );
490 m_text.size_ ((m_y2 - m_y1 ) * 1.2 ,m_y2 - m_y1 );
491
492 m_text_poly.width_ (m_text_thickness );
493 m_text_poly.line_join_(round_join );
494 m_text_poly.line_cap_ (round_cap );
495
496 m_text_poly.rewind(0 );
497
498 end;
499
500 3 : // pointer preview
501 m_ellipse.init(
502 m_xs1 + (m_xs2 - m_xs1 ) * m_preview_value ,
503 (m_ys1 + m_ys2 ) / 2.0 ,
504 m_y2 - m_y1 ,
505 m_y2 - m_y1 ,
506 32 );
507
508 4 : // pointer
509 begin
510 normalize_value(false );
511
512 m_ellipse.init(
513 m_xs1 + (m_xs2 - m_xs1 ) * m_value ,
514 (m_ys1 + m_ys2 ) / 2.0 ,
515 m_y2 - m_y1 ,
516 m_y2 - m_y1 ,
517 32 );
518
519 m_ellipse.rewind(0 );
520
521 end;
522
523 5 :
524 begin
525 m_storage.remove_all;
526
527 if m_num_steps <> 0 then
528 begin
529 d:=(m_xs2 - m_xs1 ) / m_num_steps;
530
531 if d > 0.004 then
532 d:=0.004;
533
534 for i:=0 to m_num_steps do
535 begin
536 x:=m_xs1 + (m_xs2 - m_xs1 ) * i / m_num_steps;
537
538 m_storage.move_to(x ,m_y1 );
539
540 m_storage.line_to(x - d * (m_x2 - m_x1 ) ,m_y1 - m_border_extra );
541 m_storage.line_to(x + d * (m_x2 - m_x1 ) ,m_y1 - m_border_extra );
542
543 end;
544
545 end;
546
547 end;
548
549 else
550 goto _0;
551
552 end;
553
554 end;
555
556 { VERTEX }
slider_ctrl_impl.vertexnull557 function slider_ctrl_impl.vertex;
558 var
559 cmd : unsigned;
560
561 begin
562 cmd:=path_cmd_line_to;
563
564 case m_idx of
565 0 :
566 begin
567 if m_vertex = 0 then
568 cmd:=path_cmd_move_to;
569
570 if m_vertex >= 4 then
571 cmd:=path_cmd_stop;
572
573 x^:=m_vx[m_vertex ];
574 y^:=m_vy[m_vertex ];
575
576 inc(m_vertex );
577
578 end;
579
580 1 :
581 begin
582 if m_vertex = 0 then
583 cmd:=path_cmd_move_to;
584
585 if m_vertex >= 4 then
586 cmd:=path_cmd_stop;
587
588 x^:=m_vx[m_vertex ];
589 y^:=m_vy[m_vertex ];
590
591 inc(m_vertex );
592
593 end;
594
595 2 :
596 cmd:=m_text_poly.vertex(x ,y );
597
598 3 ,4 :
599 cmd:=m_ellipse.vertex(x ,y );
600
601 5 :
602 cmd:=m_storage.vertex(x ,y );
603
604 else
605 cmd:=path_cmd_stop;
606
607 end;
608
609 if not is_stop(cmd ) then
610 transform_xy(x ,y );
611
612 result:=cmd;
613
614 end;
615
616 { CALC_BOX }
617 procedure slider_ctrl_impl.calc_box;
618 begin
619 m_xs1:=m_x1 + m_border_width;
620 m_ys1:=m_y1 + m_border_width;
621 m_xs2:=m_x2 - m_border_width;
622 m_ys2:=m_y2 - m_border_width;
623
624 end;
625
626 { NORMALIZE_VALUE }
slider_ctrl_impl.normalize_valuenull627 function slider_ctrl_impl.normalize_value;
628 var
629 ret : boolean;
630 step : int;
631
632 begin
633 ret:=true;
634
635 if m_num_steps <> 0 then
636 begin
637 step:=trunc(m_preview_value * m_num_steps + 0.5 );
638 ret :=m_value <> (step / m_num_steps );
639
640 m_value:=step / m_num_steps;
641
642 end
643 else
644 m_value:=m_preview_value;
645
646 if preview_value_flag then
647 m_preview_value:=m_value;
648
649 result:=ret;
650
651 end;
652
653 { CONSTRUCT }
654 constructor slider_ctrl.Construct;
655 begin
656 inherited Construct(x1 ,y1 ,x2 ,y2 ,flip_y );
657
658 m_background_color.ConstrDbl (1.0 ,0.9 ,0.8 );
659 m_triangle_color.ConstrDbl (0.7 ,0.6 ,0.6 );
660 m_text_color.ConstrDbl (0.0 ,0.0 ,0.0 );
661 m_pointer_preview_color.ConstrDbl(0.6 ,0.4 ,0.4 ,0.4 );
662 m_pointer_color.ConstrDbl (0.8 ,0.0 ,0.0 ,0.6 );
663
664 m_colors[0 ]:=@m_background_color;
665 m_colors[1 ]:=@m_triangle_color;
666 m_colors[2 ]:=@m_text_color;
667 m_colors[3 ]:=@m_pointer_preview_color;
668 m_colors[4 ]:=@m_pointer_color;
669 m_colors[5 ]:=@m_text_color;
670
671 end;
672
673 { BACKGROUND_COLOR_ }
674 procedure slider_ctrl.background_color_;
675 begin
676 m_background_color:=c^;
677
678 end;
679
680 { POINTER_COLOR_ }
681 procedure slider_ctrl.pointer_color_;
682 begin
683 m_pointer_color:=c^;
684
685 end;
686
687 { _COLOR }
slider_ctrl._colornull688 function slider_ctrl._color;
689 begin
690 result:=m_colors[i ];
691
692 end;
693
694 END.
695
696