← Back to branch summary

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

« back to all changes in this revision

Viewing changes to packages/extra/forms/demo/objpos.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/objpos.pp
 
1
program objpos;
 
2
 
 
3
uses xforms;
 
4
 
 
5
const
 
6
  dx : TFL_Coord = 11 ;
 
7
  dy : TFL_Coord = 7 ;
 
8
 
 
9
procedure move_cb(ob : PFL_OBJECT; data : longint);export;
 
10
 
 
11
var
 
12
   but : PFL_OBJECT;
 
13
   x,y,w,h : TFL_COORD;
 
14
 
 
15
begin
 
16
   but := PFL_OBJECT (data);
 
17
   fl_get_object_geometry(but,@x,@y, @w, @h);
 
18
 
 
19
   if ( (x + dx) < 0) or ( (x+w+dx) >= but^.form^.w) then
 
20
       dx := -dx;
 
21
   if ( (y + dy) < 0) or ( (y+h+dy) >= but^.form^.h) then
 
22
       dy := -dy;
 
23
    x := x+dx;
 
24
    y := y+dy;
 
25
 
 
26
    fl_set_object_position(but,x,y);
 
27
end;
 
28
 
 
29
var
 
30
  form : PFL_FORM;
 
31
  but, obj : PFL_OBJECT ;
 
32
 
 
33
begin
 
34
  fl_initialize(@argc, argv, 'FormDemo', nil, 0);
 
35
 
 
36
  form := fl_bgn_form(FL_DOWN_BOX,400,200);
 
37
    but := fl_add_button(FL_NORMAL_BUTTON,140,160,70,35,'Exit');
 
38
    obj := fl_add_button(FL_TOUCH_BUTTON,330,150,50,30,'Move');
 
39
     fl_set_object_callback(obj,PFL_CALLBACKPTR(@move_cb),longint(but));
 
40
  fl_end_form();
 
41
 
 
42
  fl_show_form(form,FL_PLACE_MOUSE,FL_NOBORDER,'ObjPos');
 
43
 
 
44
  fl_do_forms();
 
45
 
 
46
end.
 
47
{
 
48
  $Log: objpos.pp,v $
 
49
  Revision 1.3  2003/10/27 15:48:13  peter
 
50
    * renamed forms unit to xforms to prevent conflict with Forms
 
51
      from the LCL
 
52
 
 
53
  Revision 1.2  2002/09/07 15:42:57  peter
 
54
    * old logs removed and tabs fixed
 
55
 
 
56
}