mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-31 10:02:30 +01:00
293 lines
6.1 KiB
ObjectPascal
293 lines
6.1 KiB
ObjectPascal
//
|
||
// AggPas 2.4 RM3 Demo application
|
||
// Note: Press F1 key on run to see more info about this demo
|
||
//
|
||
// Paths: src;src\ctrl;src\svg;src\util;src\platform\win;expat-wrap
|
||
//
|
||
program
|
||
rounded_rect ;
|
||
|
||
uses
|
||
agg_basics ,
|
||
agg_platform_support ,
|
||
agg_color ,
|
||
agg_pixfmt ,
|
||
agg_pixfmt_rgb ,
|
||
|
||
agg_ctrl ,
|
||
agg_slider_ctrl ,
|
||
agg_cbox_ctrl ,
|
||
|
||
agg_renderer_base ,
|
||
agg_renderer_scanline ,
|
||
agg_rasterizer_scanline_aa ,
|
||
agg_scanline_p ,
|
||
agg_render_scanlines ,
|
||
|
||
agg_gamma_functions ,
|
||
agg_gamma_lut ,
|
||
agg_ellipse ,
|
||
agg_rounded_rect ,
|
||
agg_conv_stroke ,
|
||
agg_vertex_source ;
|
||
|
||
{$I agg_mode.inc }
|
||
|
||
const
|
||
flip_y = true;
|
||
|
||
type
|
||
the_application = object(platform_support )
|
||
m_x ,
|
||
m_y : array[0..1 ] of double;
|
||
|
||
m_dx ,
|
||
m_dy : double;
|
||
|
||
m_idx : int;
|
||
|
||
m_radius ,
|
||
m_gamma ,
|
||
m_offset : slider_ctrl;
|
||
|
||
m_white_on_black : cbox_ctrl;
|
||
|
||
constructor Construct(format_ : pix_format_e; flip_y_ : boolean );
|
||
destructor Destruct;
|
||
|
||
procedure on_draw; virtual;
|
||
|
||
procedure on_mouse_move (x ,y : int; flags : unsigned ); virtual;
|
||
procedure on_mouse_button_down(x ,y : int; flags : unsigned ); virtual;
|
||
procedure on_mouse_button_up (x ,y : int; flags : unsigned ); virtual;
|
||
|
||
procedure on_key(x ,y : int; key ,flags : unsigned ); virtual;
|
||
|
||
end;
|
||
|
||
{ CONSTRUCT }
|
||
constructor the_application.Construct;
|
||
var
|
||
rgba8 : aggclr;
|
||
|
||
begin
|
||
inherited Construct(format_ ,flip_y_ );
|
||
|
||
m_radius.Construct(10 ,10 ,600 - 10 ,19 ,not flip_y_ );
|
||
m_gamma.Construct (10 ,10 + 20 ,600 - 10 ,19 + 20 ,not flip_y_ );
|
||
m_offset.Construct(10 ,10 + 40 ,600 - 10 ,19 + 40 ,not flip_y_ );
|
||
|
||
m_white_on_black.Construct(10 ,10 + 60 ,'White on black' );
|
||
|
||
m_idx:=-1;
|
||
|
||
m_x[0 ]:=100; m_y[0 ]:=100;
|
||
m_x[1 ]:=500; m_y[1 ]:=350;
|
||
|
||
add_ctrl(@m_radius );
|
||
add_ctrl(@m_gamma );
|
||
add_ctrl(@m_offset );
|
||
add_ctrl(@m_white_on_black );
|
||
|
||
m_gamma.label_('gamma=%4.3f' );
|
||
m_gamma.range_(0.0 ,3.0 );
|
||
m_gamma.value_(1.8 );
|
||
|
||
m_radius.label_('radius=%4.3f' );
|
||
m_radius.range_(0.0 ,50.0 );
|
||
m_radius.value_(25.0 );
|
||
|
||
m_offset.label_('subpixel offset=%4.3f' );
|
||
m_offset.range_(-2.0 ,3.0 );
|
||
|
||
rgba8.ConstrInt(127 ,127 ,127 );
|
||
|
||
m_white_on_black.text_color_ (@rgba8 );
|
||
m_white_on_black.inactive_color_(@rgba8 );
|
||
|
||
end;
|
||
|
||
{ DESTRUCT }
|
||
destructor the_application.Destruct;
|
||
begin
|
||
inherited Destruct;
|
||
|
||
m_radius.Destruct;
|
||
m_gamma.Destruct;
|
||
m_offset.Destruct;
|
||
|
||
m_white_on_black.Destruct;
|
||
|
||
end;
|
||
|
||
{ ON_DRAW }
|
||
procedure the_application.on_draw;
|
||
var
|
||
pixf : pixel_formats;
|
||
|
||
rb : renderer_base;
|
||
ren : renderer_scanline_aa_solid;
|
||
ras : rasterizer_scanline_aa;
|
||
sl : scanline_p8;
|
||
|
||
rgba : aggclr;
|
||
gamma : gamma_lut;
|
||
gm_no : vertex_source;
|
||
|
||
e : ellipse;
|
||
r : agg_rounded_rect.rounded_rect;
|
||
p : conv_stroke;
|
||
d : double;
|
||
|
||
begin
|
||
// Initialize structures
|
||
gamma.Construct(m_gamma._value ,8 ,8 );
|
||
|
||
pixfmt_bgr24_gamma(pixf ,rbuf_window ,@gamma );
|
||
|
||
rb.Construct (@pixf );
|
||
ren.Construct(@rb );
|
||
|
||
if m_white_on_black._status then
|
||
rgba.ConstrDbl(0 ,0 ,0 )
|
||
else
|
||
rgba.ConstrDbl(1 ,1 ,1 );
|
||
|
||
rb.clear(@rgba );
|
||
|
||
ras.Construct;
|
||
sl.Construct;
|
||
|
||
// Render two "control" circles
|
||
e.Construct;
|
||
rgba.ConstrInt(127 ,127 ,127 );
|
||
ren.color_ (@rgba );
|
||
|
||
e.init (m_x[0 ] ,m_y[0 ] ,3 ,3 ,16 );
|
||
ras.add_path(@e );
|
||
|
||
render_scanlines(@ras ,@sl ,@ren );
|
||
|
||
e.init (m_x[1 ] ,m_y[1 ] ,3 ,3 ,16 );
|
||
ras.add_path(@e );
|
||
|
||
render_scanlines(@ras ,@sl ,@ren );
|
||
|
||
// Creating a rounded rectangle
|
||
d:=m_offset._value;
|
||
|
||
r.Construct(m_x[0 ] + d ,m_y[0 ] + d ,m_x[1 ] + d ,m_y[1 ] + d ,m_radius._value );
|
||
r.normalize_radius;
|
||
|
||
// Drawing as an outline
|
||
p.Construct(@r );
|
||
p.width_ (1.0 );
|
||
|
||
ras.add_path(@p );
|
||
|
||
if m_white_on_black._status then
|
||
rgba.ConstrDbl(1 ,1 ,1 )
|
||
else
|
||
rgba.ConstrDbl(0 ,0 ,0 );
|
||
|
||
ren.color_(@rgba );
|
||
|
||
render_scanlines(@ras ,@sl ,@ren );
|
||
|
||
gm_no.Construct;
|
||
ras.gamma(@gm_no );
|
||
|
||
// Render the controls
|
||
render_ctrl(@ras ,@sl ,@ren ,@m_radius );
|
||
render_ctrl(@ras ,@sl ,@ren ,@m_gamma );
|
||
render_ctrl(@ras ,@sl ,@ren ,@m_offset );
|
||
render_ctrl(@ras ,@sl ,@ren ,@m_white_on_black );
|
||
|
||
// Free AGG resources
|
||
ras.Destruct;
|
||
sl.Destruct;
|
||
|
||
gamma.Destruct;
|
||
p.Destruct;
|
||
|
||
end;
|
||
|
||
{ ON_MOUSE_MOVE }
|
||
procedure the_application.on_mouse_move;
|
||
begin
|
||
if flags and mouse_left <> 0 then
|
||
if m_idx >= 0 then
|
||
begin
|
||
m_x[m_idx ]:=x - m_dx;
|
||
m_y[m_idx ]:=y - m_dy;
|
||
|
||
force_redraw;
|
||
|
||
end
|
||
else
|
||
else
|
||
on_mouse_button_up(x ,y ,flags );
|
||
|
||
end;
|
||
|
||
{ ON_MOUSE_BUTTON_DOWN }
|
||
procedure the_application.on_mouse_button_down;
|
||
var
|
||
i : unsigned;
|
||
|
||
begin
|
||
if flags and mouse_left <> 0 then
|
||
for i:=0 to 1 do
|
||
if Sqrt((x - m_x[i ] ) * (x - m_x[i ] ) + (y - m_y[i ] ) * (y - m_y[i ] ) ) < 5.0 then
|
||
begin
|
||
m_dx :=x - m_x[i ];
|
||
m_dy :=y - m_y[i ];
|
||
m_idx:=i;
|
||
|
||
break;
|
||
|
||
end;
|
||
|
||
end;
|
||
|
||
{ ON_MOUSE_BUTTON_UP }
|
||
procedure the_application.on_mouse_button_up;
|
||
begin
|
||
m_idx:=-1;
|
||
|
||
end;
|
||
|
||
{ ON_KEY }
|
||
procedure the_application.on_key;
|
||
begin
|
||
if key = key_f1 then
|
||
message_(
|
||
'Yet another example dedicated to Gamma Correction. If you have a CRT monitor: '#13 +
|
||
'The rectangle looks bad - the rounded corners are thicker than its side lines. '#13 +
|
||
'First try to drag the "subpixel offset" control <20> it simply adds some fractional '#13 +
|
||
'value to the coordinates. When dragging you will see that the rectangle is'#13 +
|
||
'"blinking". Then increase "Gamma" to about 1.5. The result will look almost '#13 +
|
||
'perfect <20> the visual thickness of the rectangle remains the same. That''s good, '#13 +
|
||
'but turn the checkbox "White on black" on <20> what do we see ? Our rounded '#13 +
|
||
'rectangle looks terrible. Drag the "subpixel offset" slider <20> it''s blinking as hell. '#13 +
|
||
'Now decrease "Gamma" to about 0.6. What do we see now ? Perfect result ! '#13 +
|
||
'If you use an LCD monitor, the good value of gamma will be closer to 1.0 in both '#13 +
|
||
'cases <20> black on white or white on black. There''s no perfection in this world, but '#13 +
|
||
'at least you can control Gamma in Anti-Grain Geometry :-)' +
|
||
#13#13'Note: F2 key saves current "screenshot" file in this demo''s directory. ' );
|
||
|
||
end;
|
||
|
||
VAR
|
||
app : the_application;
|
||
|
||
BEGIN
|
||
app.Construct(pix_format_bgr24 ,flip_y );
|
||
app.caption_ ('AGG Example. Rounded rectangle with gamma-correction & stuff (F1-Help)' );
|
||
|
||
if app.init(600 ,400 ,window_resize ) then
|
||
app.run;
|
||
|
||
app.Destruct;
|
||
|
||
END. |