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

« back to all changes in this revision

Viewing changes to packages/extra/forms/demo/borderwidth.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
[ 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:
1
 
program borderwidth;
2
 
 
3
 
uses xforms;
4
 
 
5
 
type TFD_bwform = record
6
 
        bwform : PFL_FORM;
7
 
        vdata : pointer;
8
 
        ldata : longint;
9
 
        done,
10
 
        bw_choice,
11
 
        bwgroup,
12
 
        pmobj : PFL_OBJECT;
13
 
        end;
14
 
PFD_bwform = ^TFD_bwform;
15
 
 
16
 
 
17
 
{ callbacks for form bwform }
18
 
procedure done_callback(ob : PFL_OBJECT; data : longint);export;
19
 
begin
20
 
  { fill-in code for callback }
21
 
   halt(0);
22
 
end;
23
 
 
24
 
var
25
 
fd_bwform : PFD_bwform;
26
 
 
27
 
const bws : array[0..7] of longint = (-3,-2,-1,1,2,3,4,5);
28
 
 
29
 
procedure bw_callback(ob : PFL_OBJECT; data : longint);export;
30
 
 
31
 
var bw : longint;
32
 
 
33
 
begin
34
 
   bw := bws[fl_get_choice(ob)-1];
35
 
 
36
 
   fl_set_object_bw(fd_bwform^.bwgroup, bw);
37
 
   { since bwgroup includes the backface, it wipes out the done button}
38
 
   fl_redraw_object(fd_bwform^.done);
39
 
   fl_redraw_object(fd_bwform^.bw_choice);
40
 
end;
41
 
 
42
 
function create_form_bwform : PFD_bwform;
43
 
var
44
 
  obj : PFL_OBJECT;
45
 
  fdui : PFD_bwform;
46
 
 
47
 
begin
48
 
 
49
 
  new(fdui);
50
 
  fdui^.bwform := fl_bgn_form(FL_NO_BOX, 380, 340);
51
 
 
52
 
  fdui^.bwgroup := fl_bgn_group();
53
 
  obj := fl_add_box(FL_UP_BOX,0,0,380,340,'');
54
 
  obj := fl_add_frame(FL_EMBOSSED_FRAME,220,60,135,145,'');
55
 
  obj := fl_add_frame(FL_ENGRAVED_FRAME,15,60,185,145,'');
56
 
  obj := fl_add_slider(FL_HOR_SLIDER,25,75,160,25,'');
57
 
  obj := fl_add_pixmapbutton(FL_NORMAL_BUTTON,305,145,40,35,'');
58
 
  fdui^.pmobj := obj;
59
 
  obj := fl_add_positioner(FL_NORMAL_POSITIONER,30,225,100,80,'');
60
 
  obj := fl_add_counter(FL_NORMAL_COUNTER,25,160,160,25,'');
61
 
  obj := fl_add_lightbutton(FL_PUSH_BUTTON,230,100,100,30,'LightButton');
62
 
  obj := fl_add_roundbutton(FL_PUSH_BUTTON,230,130,80,33,'Button');
63
 
  obj := fl_add_round3dbutton(FL_PUSH_BUTTON,230,152,80,33,'Button');
64
 
    fl_set_object_color(obj,FL_COL1, FL_BLUE);
65
 
  obj := fl_add_checkbutton(FL_PUSH_BUTTON,230,174,80,33,'Button');
66
 
  obj := fl_add_input(FL_NORMAL_INPUT,195,240,160,28,'Input');
67
 
  obj := fl_add_valslider(FL_HOR_BROWSER_SLIDER,25,120,160,25,'');
68
 
  obj := fl_add_button(FL_NORMAL_BUTTON,230,65,100,30,'Button');
69
 
  fl_end_group();
70
 
 
71
 
  obj := fl_add_button(FL_NORMAL_BUTTON,270,290,75,30,'Done');
72
 
  fdui^.done := obj;
73
 
    fl_set_object_callback(obj,PFL_CALLBACKPTR(@done_callback),0);
74
 
  obj:= fl_add_choice(FL_NORMAL_CHOICE,105,20,80,25,'Border Width');
75
 
  fdui^.bw_choice := obj ;
76
 
    fl_set_object_callback(obj,PFL_CALLBACKPTR(@bw_callback),0);
77
 
  fl_end_form();
78
 
  fdui^.bwform^.fdui  := fdui;
79
 
 
80
 
  create_form_bwform:= fdui;
81
 
end;
82
 
 
83
 
begin
84
 
   { application default. Can be overriden by the command line options }
85
 
   fl_set_border_width(-2);
86
 
 
87
 
   fl_initialize(@argc, argv, 'FormDemo', nil, 0);
88
 
   fd_bwform := create_form_bwform;
89
 
 
90
 
   { fill-in form initialization code }
91
 
   fl_set_pixmapbutton_file(fd_bwform^.pmobj, 'crab.xpm');
92
 
 
93
 
   fl_addto_choice(fd_bwform^.bw_choice,'-3 Pixel|-2 Pixel|-1 Pixel');
94
 
   fl_addto_choice(fd_bwform^.bw_choice,' 1 Pixel| 2 Pixel| 3 Pixel');
95
 
   fl_addto_choice(fd_bwform^.bw_choice,' 4 Pixel| 5 Pixel');
96
 
   fl_set_choice_text(fd_bwform^.bw_choice, '-2 Pixel');
97
 
 
98
 
   { show the first form }
99
 
   fl_show_form(fd_bwform^.bwform,FL_PLACE_CENTER,FL_NOBORDER,'bwform');
100
 
   while (fl_do_forms<>nil) do;
101
 
end.
102
 
{
103
 
  $Log: borderwidth.pp,v $
104
 
  Revision 1.3  2003/10/27 15:48:13  peter
105
 
    * renamed forms unit to xforms to prevent conflict with Forms
106
 
      from the LCL
107
 
 
108
 
  Revision 1.2  2002/09/07 15:42:54  peter
109
 
    * old logs removed and tabs fixed
110
 
 
111
 
  Revision 1.1  2002/01/29 17:55:00  peter
112
 
    * splitted to base and extra
113
 
 
114
 
}