← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/extra/forms/demo/positioner.pp
 
1
{ This demo shows the use of a positioner.  }
 
2
program positioner;
 
3
 
 
4
uses xforms;
 
5
 
 
6
var
 
7
 xval, yval : PFL_Object;
 
8
 
 
9
{ callback routine }
 
10
 
 
11
Procedure Do_position (ob :PFL_OBJECT; q : longint);
 
12
 
 
13
var
 
14
    st : string [30];
 
15
 
 
16
begin
 
17
 
 
18
    str(fl_get_positioner_xvalue(ob),st);st:=st+#0;
 
19
    fl_set_object_label(xval,@st[1]);
 
20
    str(fl_get_positioner_yvalue(ob),st);st:=st+#0;
 
21
    fl_set_object_label(yval,@st[1]);
 
22
end;
 
23
 
 
24
procedure positioner_cb(ob :PFL_OBJECT; q : longint);export;
 
25
 
 
26
begin
 
27
  Do_Position (ob,q);
 
28
end;
 
29
 
 
30
var
 
31
  form : PFL_FORM;
 
32
  thepos, button : PFL_OBJECT;
 
33
 
 
34
 
 
35
begin
 
36
 
 
37
  fl_initialize(@argc, argv, 'FormDemo', nil, 0);
 
38
 
 
39
  form := fl_bgn_form(FL_UP_BOX,400,280);
 
40
     thepos := fl_add_positioner(FL_NORMAL_POSITIONER,40,40,200,200,'');
 
41
     fl_set_positioner_xbounds(thepos,0,1);
 
42
     fl_set_positioner_ybounds(thepos,0,1);
 
43
     fl_set_object_callback(thepos,PFL_CALLBACKPTR(@positioner_cb),0);
 
44
     xval := fl_add_box(FL_DOWN_BOX,270,40,100,30,'');
 
45
     yval := fl_add_box(FL_DOWN_BOX,270,90,100,30,'');
 
46
     fl_set_object_color(xval,FL_COL1,FL_COL1);
 
47
     fl_set_object_color(yval,FL_COL1,FL_COL1);
 
48
     button := fl_add_button(FL_NORMAL_BUTTON,270,210,100,30,'Exit');
 
49
  fl_end_form();
 
50
 
 
51
  fl_show_form(form,FL_PLACE_CENTER,FL_NOBORDER,NiL);
 
52
  Do_position(thepos,0);
 
53
  fl_do_forms;
 
54
  fl_hide_form(form);
 
55
end.
 
56
{
 
57
  $Log: positioner.pp,v $
 
58
  Revision 1.3  2003/10/27 15:48:13  peter
 
59
    * renamed forms unit to xforms to prevent conflict with Forms
 
60
      from the LCL
 
61
 
 
62
  Revision 1.2  2002/09/07 15:42:57  peter
 
63
    * old logs removed and tabs fixed
 
64
 
 
65
  Revision 1.1  2002/01/29 17:55:01  peter
 
66
    * splitted to base and extra
 
67
 
 
68
}