paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-12 23:52:33 +02:00
Code Issues Packages Projects Releases Wiki Activity
047b2b57e5
lazarus/components/aggpas/src/ctrl/agg_slider_ctrl.pas
mattias 36a2b1ea07 added aggpas 
git-svn-id: trunk@21942 -
2009-10-01 12:24:32 +00:00

696 lines
12 KiB
ObjectPascal
Raw Blame History

//----------------------------------------------------------------------------
// Anti-Grain Geometry - Version 2.4 (Public License)
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
//
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
// Pascal Port By: Milan Marusinec alias Milano
// milan@marusinec.sk
// http://www.aggpas.org
// Copyright (c) 2005-2006
//
// Permission to copy, use, modify, sell and distribute this software
// is granted provided this copyright notice appears in all copies.
// This software is provided "as is" without express or implied
// warranty, and with no claim as to its suitability for any purpose.
//
//----------------------------------------------------------------------------
// Contact: mcseem@antigrain.com
// mcseemagg@yahoo.com
// http://www.antigrain.com
//
//----------------------------------------------------------------------------
//
// classes slider_ctrl_impl, slider_ctrl
//
// [Pascal Port History] -----------------------------------------------------
//
// 21.12.2005-Milano: Complete unit port
// 18.12.2005-Milano: Unit port establishment
//
{ agg_slider_ctrl.pas }
unit
agg_slider_ctrl ;
INTERFACE
{$I agg_mode.inc }
uses
SysUtils ,
agg_basics ,
agg_ctrl ,
agg_color ,
agg_ellipse ,
agg_path_storage ,
agg_conv_stroke ,
agg_gsv_text ,
agg_math ,
agg_math_stroke ;
{ TYPES DEFINITION }
type
slider_ctrl_impl = object(ctrl )
m_border_width ,
m_border_extra ,
m_text_thickness ,
m_value ,
m_preview_value ,
m_min ,
m_max : double;
m_num_steps : unsigned;
m_descending : boolean;
m_label : array[0..63 ] of byte;
m_xs1 ,
m_ys1 ,
m_xs2 ,
m_ys2 ,
m_pdx : double;
m_mouse_move : boolean;
m_vx ,
m_vy : array[0..31 ] of double;
m_ellipse : ellipse;
m_idx ,
m_vertex : unsigned;
m_text : gsv_text;
m_text_poly : conv_stroke;
m_storage : path_storage;
constructor Construct(x1 ,y1 ,x2 ,y2 : double; flip_y : boolean = false );
destructor Destruct; virtual;
procedure border_width_(t : double; extra : double = 0.0 );
procedure range_ (min ,max : double );
procedure num_steps_ (num : unsigned );
procedure label_ (fmt : PChar );
procedure text_thickness_(t : double );
function _descending : boolean;
procedure descending_(v : boolean );
function _value : double;
procedure value_(v : double );
function in_rect(x ,y : double ) : boolean; virtual;
function on_mouse_button_down(x ,y : double ) : boolean; virtual;
function on_mouse_button_up (x ,y : double ) : boolean; virtual;
function on_mouse_move(x ,y : double; button_flag : boolean ) : boolean; virtual;
function on_arrow_keys(left ,right ,down ,up : boolean ) : boolean; virtual;
// Vertex source interface
function num_paths : unsigned; virtual;
procedure rewind(path_id : unsigned ); virtual;
function vertex(x ,y : double_ptr ) : unsigned; virtual;
// Private
procedure calc_box;
function normalize_value(preview_value_flag : boolean ) : boolean;
end;
slider_ctrl_ptr = ^slider_ctrl;
slider_ctrl = object(slider_ctrl_impl )
m_background_color ,
m_triangle_color ,
m_text_color ,
m_pointer_preview_color ,
m_pointer_color : aggclr;
m_colors : array[0..5 ] of aggclr_ptr;
constructor Construct(x1 ,y1 ,x2 ,y2 : double; flip_y : boolean = false );
procedure background_color_(c : aggclr_ptr );
procedure pointer_color_ (c : aggclr_ptr );
function _color(i : unsigned ) : aggclr_ptr; virtual;
end;
{ GLOBAL PROCEDURES }
IMPLEMENTATION
{ LOCAL VARIABLES & CONSTANTS }
{ UNIT IMPLEMENTATION }
{ CONSTRUCT }
constructor slider_ctrl_impl.Construct;
begin
inherited Construct(x1 ,y1 ,x2 ,y2 ,flip_y );
m_ellipse.Construct;
m_text.Construct;
m_text_poly.Construct(@m_text );
m_storage.Construct;
m_border_width :=1.0;
m_border_extra :=(y2 - y1 ) / 2;
m_text_thickness:=1.0;
m_pdx :=0.0;
m_mouse_move :=false;
m_value :=0.5;
m_preview_value :=0.5;
m_min :=0.0;
m_max :=1.0;
m_num_steps :=0;
m_descending :=false;
m_label[0 ]:=0;
calc_box;
end;
{ DESTRUCT }
destructor slider_ctrl_impl.Destruct;
begin
m_storage.Destruct;
m_text_poly.Destruct;
m_text.Destruct;
end;
{ BORDER_WIDTH_ }
procedure slider_ctrl_impl.border_width_;
begin
m_border_width:=t;
m_border_extra:=extra;
calc_box;
end;
{ RANGE_ }
procedure slider_ctrl_impl.range_;
begin
m_min:=min;
m_max:=max;
end;
{ NUM_STEPS_ }
procedure slider_ctrl_impl.num_steps_;
begin
m_num_steps:=num;
end;
{ LABEL_ }
procedure slider_ctrl_impl.label_;
var
len : unsigned;
begin
m_label[0 ]:=0;
if fmt <> NIL then
begin
len:=StrLen(fmt );
if len > 63 then
len:=63;
move(fmt^ ,m_label[0 ] ,len );
m_label[len ]:=0;
end;
end;
{ TEXT_THICKNESS_ }
procedure slider_ctrl_impl.text_thickness_;
begin
m_text_thickness:=t;
end;
{ _DESCENDING }
function slider_ctrl_impl._descending;
begin
result:=m_descending;
end;
{ DESCENDING_ }
procedure slider_ctrl_impl.descending_;
begin
m_descending:=v;
end;
{ _VALUE }
function slider_ctrl_impl._value;
begin
result:=m_value * (m_max - m_min ) + m_min;
end;
{ VALUE_ }
procedure slider_ctrl_impl.value_;
begin
m_preview_value:=(v - m_min ) / (m_max - m_min );
if m_preview_value > 1.0 then
m_preview_value:=1.0;
if m_preview_value < 0.0 then
m_preview_value:=0.0;
normalize_value(true );
end;
{ IN_RECT }
function slider_ctrl_impl.in_rect;
begin
inverse_transform_xy(@x ,@y );
result:=
(x >= m_x1 ) and
(x <= m_x2 ) and
(y >= m_y1 ) and
(y <= m_y2 );
end;
{ ON_MOUSE_BUTTON_DOWN }
function slider_ctrl_impl.on_mouse_button_down;
var
xp ,yp : double;
begin
inverse_transform_xy(@x ,@y );
xp:=m_xs1 + (m_xs2 - m_xs1 ) * m_value;
yp:=(m_ys1 + m_ys2 ) / 2.0;
if calc_distance(x ,y ,xp ,yp ) <= m_y2 - m_y1 then
begin
m_pdx:=xp - x;
m_mouse_move:= true;
result:=true;
end
else
result:=false;
end;
{ ON_MOUSE_BUTTON_UP }
function slider_ctrl_impl.on_mouse_button_up;
begin
m_mouse_move:=false;
normalize_value(true );
result:=true;
end;
{ ON_MOUSE_MOVE }
function slider_ctrl_impl.on_mouse_move;
var
xp : double;
begin
inverse_transform_xy(@x ,@y );
if not button_flag then
begin
on_mouse_button_up(x ,y );
result:=false;
exit;
end;
if m_mouse_move then
begin
xp:=x + m_pdx;
m_preview_value:=(xp - m_xs1 ) / (m_xs2 - m_xs1 );
if m_preview_value < 0.0 then
m_preview_value:=0.0;
if m_preview_value > 1.0 then
m_preview_value:=1.0;
result:=true;
end
else
result:=false;
end;
{ ON_ARROW_KEYS }
function slider_ctrl_impl.on_arrow_keys;
var
d : double;
begin
d:=0.005;
if m_num_steps <> 0 then
d:=1.0 / m_num_steps;
if right or
up then
begin
m_preview_value:=m_preview_value + d;
if m_preview_value > 1.0 then
m_preview_value:=1.0;
normalize_value(true );
result:=true;
exit;
end;
if left or
down then
begin
m_preview_value:=m_preview_value - d;
if m_preview_value < 0.0 then
m_preview_value:=0.0;
normalize_value(true );
result:=true;
end
else
result:=false;
end;
{ NUM_PATHS }
function slider_ctrl_impl.num_paths;
begin
result:=6;
end;
{ REWIND }
procedure slider_ctrl_impl.rewind;
var
i : unsigned;
d ,x : double;
buf : array[0..255 ] of byte;
label
_0 ;
begin
m_idx:=path_id;
case path_id of
0 : // Background
begin
_0 :
m_vertex:=0;
m_vx[0 ]:=m_x1 - m_border_extra;
m_vy[0 ]:=m_y1 - m_border_extra;
m_vx[1 ]:=m_x2 + m_border_extra;
m_vy[1 ]:=m_y1 - m_border_extra;
m_vx[2 ]:=m_x2 + m_border_extra;
m_vy[2 ]:=m_y2 + m_border_extra;
m_vx[3 ]:=m_x1 - m_border_extra;
m_vy[3 ]:=m_y2 + m_border_extra;
end;
1 : // Triangle
begin
m_vertex:=0;
if m_descending then
begin
m_vx[0 ]:=m_x1;
m_vy[0 ]:=m_y1;
m_vx[1 ]:=m_x2;
m_vy[1 ]:=m_y1;
m_vx[2 ]:=m_x1;
m_vy[2 ]:=m_y2;
m_vx[3 ]:=m_x1;
m_vy[3 ]:=m_y1;
end
else
begin
m_vx[0 ]:=m_x1;
m_vy[0 ]:=m_y1;
m_vx[1 ]:=m_x2;
m_vy[1 ]:=m_y1;
m_vx[2 ]:=m_x2;
m_vy[2 ]:=m_y2;
m_vx[3 ]:=m_x1;
m_vy[3 ]:=m_y1;
end;
end;
2 :
begin
m_text.text_(@m_label[0 ] );
if m_label[0 ] <> 0 then
begin
sprintf(@buf[0 ] ,@m_label[0 ] ,_value );
m_text.text_(@buf[0 ] );
end;
m_text.start_point_(m_x1 ,m_y1 );
m_text.size_ ((m_y2 - m_y1 ) * 1.2 ,m_y2 - m_y1 );
m_text_poly.width_ (m_text_thickness );
m_text_poly.line_join_(round_join );
m_text_poly.line_cap_ (round_cap );
m_text_poly.rewind(0 );
end;
3 : // pointer preview
m_ellipse.init(
m_xs1 + (m_xs2 - m_xs1 ) * m_preview_value ,
(m_ys1 + m_ys2 ) / 2.0 ,
m_y2 - m_y1 ,
m_y2 - m_y1 ,
32 );
4 : // pointer
begin
normalize_value(false );
m_ellipse.init(
m_xs1 + (m_xs2 - m_xs1 ) * m_value ,
(m_ys1 + m_ys2 ) / 2.0 ,
m_y2 - m_y1 ,
m_y2 - m_y1 ,
32 );
m_ellipse.rewind(0 );
end;
5 :
begin
m_storage.remove_all;
if m_num_steps <> 0 then
begin
d:=(m_xs2 - m_xs1 ) / m_num_steps;
if d > 0.004 then
d:=0.004;
for i:=0 to m_num_steps do
begin
x:=m_xs1 + (m_xs2 - m_xs1 ) * i / m_num_steps;
m_storage.move_to(x ,m_y1 );
m_storage.line_to(x - d * (m_x2 - m_x1 ) ,m_y1 - m_border_extra );
m_storage.line_to(x + d * (m_x2 - m_x1 ) ,m_y1 - m_border_extra );
end;
end;
end;
else
goto _0;
end;
end;
{ VERTEX }
function slider_ctrl_impl.vertex;
var
cmd : unsigned;
begin
cmd:=path_cmd_line_to;
case m_idx of
0 :
begin
if m_vertex = 0 then
cmd:=path_cmd_move_to;
if m_vertex >= 4 then
cmd:=path_cmd_stop;
x^:=m_vx[m_vertex ];
y^:=m_vy[m_vertex ];
inc(m_vertex );
end;
1 :
begin
if m_vertex = 0 then
cmd:=path_cmd_move_to;
if m_vertex >= 4 then
cmd:=path_cmd_stop;
x^:=m_vx[m_vertex ];
y^:=m_vy[m_vertex ];
inc(m_vertex );
end;
2 :
cmd:=m_text_poly.vertex(x ,y );
3 ,4 :
cmd:=m_ellipse.vertex(x ,y );
5 :
cmd:=m_storage.vertex(x ,y );
else
cmd:=path_cmd_stop;
end;
if not is_stop(cmd ) then
transform_xy(x ,y );
result:=cmd;
end;
{ CALC_BOX }
procedure slider_ctrl_impl.calc_box;
begin
m_xs1:=m_x1 + m_border_width;
m_ys1:=m_y1 + m_border_width;
m_xs2:=m_x2 - m_border_width;
m_ys2:=m_y2 - m_border_width;
end;
{ NORMALIZE_VALUE }
function slider_ctrl_impl.normalize_value;
var
ret : boolean;
step : int;
begin
ret:=true;
if m_num_steps <> 0 then
begin
step:=trunc(m_preview_value * m_num_steps + 0.5 );
ret :=m_value <> (step / m_num_steps );
m_value:=step / m_num_steps;
end
else
m_value:=m_preview_value;
if preview_value_flag then
m_preview_value:=m_value;
result:=ret;
end;
{ CONSTRUCT }
constructor slider_ctrl.Construct;
begin
inherited Construct(x1 ,y1 ,x2 ,y2 ,flip_y );
m_background_color.ConstrDbl (1.0 ,0.9 ,0.8 );
m_triangle_color.ConstrDbl (0.7 ,0.6 ,0.6 );
m_text_color.ConstrDbl (0.0 ,0.0 ,0.0 );
m_pointer_preview_color.ConstrDbl(0.6 ,0.4 ,0.4 ,0.4 );
m_pointer_color.ConstrDbl (0.8 ,0.0 ,0.0 ,0.6 );
m_colors[0 ]:=@m_background_color;
m_colors[1 ]:=@m_triangle_color;
m_colors[2 ]:=@m_text_color;
m_colors[3 ]:=@m_pointer_preview_color;
m_colors[4 ]:=@m_pointer_color;
m_colors[5 ]:=@m_text_color;
end;
{ BACKGROUND_COLOR_ }
procedure slider_ctrl.background_color_;
begin
m_background_color:=c^;
end;
{ POINTER_COLOR_ }
procedure slider_ctrl.pointer_color_;
begin
m_pointer_color:=c^;
end;
{ _COLOR }
function slider_ctrl._color;
begin
result:=m_colors[i ];
end;
END.
Reference in New Issue View Git Blame Copy Permalink