← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to packages/extra/forms/demo/counter.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/extra/forms/demo/counter.pp
1
 
{ This is an example of the use of counters.
2
 
}
3
 
program counter;
4
 
 
5
 
uses xforms;
6
 
 
7
 
var
8
 
form : PFL_FORM;
9
 
result : PFL_OBJECT;
10
 
co : array[0..2] of PFL_OBJECT;
11
 
 
12
 
procedure color_change(ob : PFL_OBJECT; data : longint);export;
13
 
 
14
 
var r,g,b : longint;
15
 
 
16
 
begin
17
 
    r :=  round(fl_get_counter_value(co[0]));
18
 
    g :=  round(fl_get_counter_value(co[1]));
19
 
    b :=  round(fl_get_counter_value(co[2]));
20
 
 
21
 
    fl_mapcolor(FL_FREE_COL1,r,g,b);
22
 
    fl_redraw_object(result);
23
 
end;
24
 
 
25
 
procedure create_form_form;
26
 
var
27
 
  obj : PFL_OBJECT;
28
 
 
29
 
begin
30
 
  form := fl_bgn_form(FL_NO_BOX,480,200);
31
 
  obj := fl_add_box(FL_UP_BOX,0,0,480,200,'');
32
 
  obj := fl_add_box(FL_DOWN_BOX,310,20,150,160,'');
33
 
  result := obj ;
34
 
    fl_set_object_dblbuffer(result, 1);
35
 
  obj := fl_add_counter(FL_NORMAL_COUNTER,20,20,270,30,'');
36
 
  co[0] := obj;
37
 
    fl_set_object_color(obj,FL_INDIANRED,FL_RED);
38
 
    fl_set_object_callback(obj,PFL_CALLBACKPTR(@color_change),0);
39
 
  obj:= fl_add_counter(FL_NORMAL_COUNTER,20,60,270,30,'');
40
 
  co[1] := obj;
41
 
    fl_set_object_color(obj,FL_PALEGREEN,FL_GREEN);
42
 
    fl_set_object_callback(obj,PFL_CALLBACKPTR(@color_change),0);
43
 
  obj := fl_add_counter(FL_NORMAL_COUNTER,20,100,270,30,'');
44
 
  co[2] := obj ;
45
 
    fl_set_object_color(obj,FL_SLATEBLUE,FL_BLUE);
46
 
    fl_set_object_callback(obj,PFL_CALLBACKPTR(@color_change),0);
47
 
  obj := fl_add_button(FL_NORMAL_BUTTON,100,150,110,30,'Exit');
48
 
  fl_end_form();
49
 
end;
50
 
 
51
 
var i : longint;
52
 
 
53
 
begin
54
 
  fl_initialize(@argc, argv, 'FormDemo', nil, 0);
55
 
  create_form_form();
56
 
  fl_set_object_color(result,FL_FREE_COL1,FL_FREE_COL1);
57
 
 
58
 
  for i:=0 to 2 do
59
 
    begin
60
 
    fl_set_counter_bounds(co[i],0.0,255.0);
61
 
    fl_set_counter_step(co[i],1.0,10.0);
62
 
    fl_set_counter_precision(co[i],0);
63
 
    fl_set_counter_return(co[i],1);
64
 
    end;
65
 
 
66
 
  fl_call_object_callback(co[0]);
67
 
 
68
 
  fl_show_form(form,FL_PLACE_CENTER,FL_NOBORDER,'Counter');
69
 
  fl_do_forms();
70
 
 
71
 
end.
72
 
{
73
 
  $Log: counter.pp,v $
74
 
  Revision 1.3  2003/10/27 15:48:13  peter
75
 
    * renamed forms unit to xforms to prevent conflict with Forms
76
 
      from the LCL
77
 
 
78
 
  Revision 1.2  2002/09/07 15:42:55  peter
79
 
    * old logs removed and tabs fixed
80
 
 
81
 
  Revision 1.1  2002/01/29 17:55:00  peter
82
 
    * splitted to base and extra
83
 
 
84
 
}