← Back to branch summary

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

« back to all changes in this revision

Viewing changes to packages/forms/demo/boxtype.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/forms/demo/boxtype.pp
1
 
{ This demo show the different boxtypes. Note that some
2
 
 * boxtypes are not appropriate for some objects
3
 
 }
4
 
program boxtype;
5
 
 
6
 
uses forms;
7
 
 
8
 
const border = FL_TRANSIENT;
9
 
 
10
 
 
11
 
type TVN_Struct = record
12
 
     theval : longint;
13
 
     name : pchar;
14
 
     end;
15
 
 
16
 
const gmode : array[0..5] of TVN_Struct =
17
 
 ((theval : FL_StaticGray;  name : 'StaticGray'),
18
 
 (theval : FL_GrayScale;   name : 'GrayScale'),
19
 
 (Theval : FL_StaticColor; name : 'StaticColor'),
20
 
 (Theval : FL_Pseudocolor; name : 'PseudoColor'),
21
 
 (theval : FL_Truecolor;   name : 'TrueColor'),
22
 
 (Theval : FL_DirectColor; name : 'DirectColor'));
23
 
 
24
 
Const btypes : array [0..15] of TVN_struct=
25
 
(
26
 
   (theval : FL_NO_BOX; name : 'no box'),
27
 
   (theval : FL_UP_BOX; name : 'up box'),
28
 
   (theval : FL_DOWN_BOX; name : 'down box'),
29
 
   (theval : FL_BORDER_BOX; name : 'border box'),
30
 
   (theval : FL_SHADOW_BOX; name : 'shadow box'),
31
 
   (theval : FL_FLAT_BOX; name : 'flat box'),
32
 
   (theval : FL_FRAME_BOX; name : 'frame box'),
33
 
   (theval : FL_EMBOSSED_BOX; name : 'embossed box'),
34
 
   (theval : FL_ROUNDED_BOX; name : 'rounded box'),
35
 
   (theval : FL_RFLAT_BOX; name : 'rflat box'),
36
 
   (theval : FL_RSHADOW_BOX; name : 'shadow box'),
37
 
   (theval : FL_OVAL_BOX; name : 'oval box'),
38
 
   (theval : FL_ROUNDED3D_UPBOX; name : 'rounded3d upbox'),
39
 
   (theval : FL_ROUNDED3D_DOWNBOX; name : 'rounded3d downbox'),
40
 
   (theval : FL_OVAL3D_UPBOX; name : 'oval3d upbox'),
41
 
   (theval : FL_OVAL3D_DOWNBOX; name : 'oval3d downbox')
42
 
   );
43
 
 
44
 
{$i srs.xbm}
45
 
 
46
 
{************** Callback *********************}
47
 
 
48
 
var
49
 
  form : PFL_FORM;
50
 
  tobj : array [0..17] of PFL_OBJECT;
51
 
  exitob, btypeob, modeob : PFL_OBJECT;
52
 
Const
53
 
lastbt : Longint = -1;
54
 
 
55
 
procedure boxtype_cb (ob : PFL_OBJECT; arg : longint);export;
56
 
 
57
 
var
58
 
  i, req_bt  : longint;
59
 
  
60
 
begin
61
 
  req_bt:= fl_get_choice(ob) - 1;
62
 
  if (lastbt <> req_bt) then
63
 
    begin
64
 
     fl_freeze_form (form);
65
 
     fl_redraw_form (form);
66
 
     i:=0;
67
 
     while i<18 do
68
 
       begin
69
 
       fl_set_object_boxtype (tobj[i], btypes[req_bt].theval);
70
 
       inc(i);
71
 
       end;
72
 
     fl_unfreeze_form (form);
73
 
     lastbt := req_bt;
74
 
    end;
75
 
end;
76
 
 
77
 
Const lval : longint = -1;
78
 
 
79
 
procedure  mode_cb (ob : PFL_OBJECT; arg : longint);export;
80
 
 
81
 
var
82
 
  db,theval : longint;
83
 
 
84
 
begin
85
 
  db:=0;
86
 
  theval := fl_get_choice (ob) -1;
87
 
  if (theval = lval) or ( theval < 0) then exit;
88
 
 
89
 
  fl_hide_form (form);
90
 
  if not (fl_mode_capable(gmode[theval].theval, 0)<>0) then
91
 
    begin
92
 
      fl_set_choice(ob, lval);
93
 
      theval := lval;
94
 
    end;
95
 
 
96
 
  fl_set_graphics_mode (gmode[theval].theval, db);
97
 
  fl_show_form (form, FL_PLACE_GEOMETRY, border, 'Box types');
98
 
 
99
 
  lval := theval;
100
 
end;
101
 
 
102
 
{************** Creation Routines ********************}
103
 
 
104
 
procedure create_form_form;
105
 
var
106
 
  obj : PFL_OBJECT;
107
 
 
108
 
begin
109
 
  form := fl_bgn_form(FL_NO_BOX, 720, 520);
110
 
  obj := fl_add_box(FL_UP_BOX, 0, 0, 720, 520, '');
111
 
  fl_set_object_color(obj, FL_BLUE, FL_COL1);
112
 
  obj := fl_add_box(FL_DOWN_BOX, 10, 90, 700, 420, '');
113
 
  fl_set_object_color(obj, FL_COL1, FL_COL1);
114
 
  obj := fl_add_box(FL_DOWN_BOX, 10, 10, 700, 70, '');
115
 
  fl_set_object_color(obj, FL_SLATEBLUE, FL_COL1);
116
 
  obj:= fl_add_box(FL_UP_BOX, 30, 110, 110, 110, 'Box');
117
 
  tobj[0] := obj ;
118
 
  obj:= fl_add_text(FL_NORMAL_TEXT, 30, 240, 110, 30, 'Text');
119
 
  tobj[1] := obj ;
120
 
  obj:= fl_add_bitmap(FL_NORMAL_BITMAP, 40, 280, 90, 80, 'Bitmap');
121
 
  tobj[2] := obj ;
122
 
  fl_set_object_lcol(obj, FL_BLUE);
123
 
  obj:= fl_add_chart(FL_BAR_CHART, 160, 110, 160, 110, 'Chart');
124
 
  tobj[3] := obj ;
125
 
  obj:= fl_add_clock(FL_ANALOG_CLOCK, 40, 390, 90, 90, 'Clock');
126
 
  tobj[4] := obj ;
127
 
  fl_set_object_dblbuffer(tobj[4],1);
128
 
  obj:=fl_add_button(FL_NORMAL_BUTTON, 340, 110, 120, 30, 'Button');
129
 
  tobj[5]:=obj;
130
 
  obj:=fl_add_lightbutton(FL_PUSH_BUTTON,340,150,120,30,'Lightbutton');
131
 
  tobj[6]:=obj;
132
 
  obj:=fl_add_roundbutton(FL_PUSH_BUTTON,340,190,120,30,'Roundbutton');
133
 
  tobj[7]:=obj;
134
 
  obj:=fl_add_slider(FL_VERT_SLIDER, 160, 250, 40, 230, 'Slider');
135
 
  tobj[8]:=obj;
136
 
  obj:=fl_add_valslider(FL_VERT_SLIDER, 220, 250, 40, 230, 'Valslider');
137
 
  tobj[9]:=obj;
138
 
  obj:=fl_add_dial (FL_LINE_DIAL, 280, 250, 100, 100, 'Dial');
139
 
  tobj[10]:=obj;
140
 
  obj:=fl_add_positioner(FL_NORMAL_POSITIONER,280,380,150,100, 'Positioner');
141
 
  tobj[11]:=obj;
142
 
  obj:=fl_add_counter (FL_NORMAL_COUNTER,480,110,210,30, 'Counter');
143
 
  tobj[12]:=obj;
144
 
  obj:=fl_add_input (FL_NORMAL_INPUT, 520,170,170,30, 'Input');
145
 
  tobj[13]:=obj;
146
 
  obj:=fl_add_menu (FL_PUSH_MENU, 400, 240, 100, 30, 'Menu');
147
 
  tobj[14]:=obj;
148
 
  obj:=fl_add_choice (FL_NORMAL_CHOICE, 580, 250, 110, 30, 'Choice');
149
 
  tobj[15]:=obj;
150
 
  obj:=fl_add_timer (FL_VALUE_TIMER, 580, 210, 110, 30, 'Timer');
151
 
  tobj[16]:=obj;
152
 
  fl_set_object_dblbuffer(tobj[16], 1);
153
 
  obj:=fl_add_browser (FL_NORMAL_BROWSER,450,300,240, 180, 'Browser');
154
 
  tobj[17]:=obj;
155
 
  obj:= fl_add_button (FL_NORMAL_BUTTON, 590, 30, 100, 30, 'Exit');
156
 
  exitob:=obj;
157
 
  obj:= fl_add_choice (FL_NORMAL_CHOICE,110,30, 130, 30, 'Boxtype');
158
 
  btypeob:=obj;
159
 
  fl_set_object_callback (obj, PFL_CALLBACKPTR(@boxtype_cb), 0);
160
 
  obj  :=fl_add_choice(FL_NORMAL_CHOICE,370,30,130,30,'Graphics mode');
161
 
  modeob := obj;
162
 
  fl_set_object_callback (obj, PFL_CALLBACKPTR(@mode_cb), 0);
163
 
  fl_end_form ;
164
 
end;
165
 
 
166
 
procedure create_the_forms;
167
 
begin
168
 
  create_form_form;
169
 
end;
170
 
 
171
 
{************** Main Routine **********************}
172
 
 
173
 
const browserlines : array [0..21] of pchar = (
174
 
   ' ', '@C1@c@l@bObjects Demo',   ' ',
175
 
   'This demo shows you all',      'objects that currently',
176
 
   'exist in the Forms Library.',  ' ',
177
 
   'You can change the boxtype',   'of the different objects',
178
 
   'using the buttons at the',     'top of the form. Note that',
179
 
   'some combinations might not',  'look too good. Also realize',
180
 
   'that for all object classes',  'many different types are',
181
 
   'available with different',     'behaviour.', ' ',
182
 
   'With this demo you can also',  'see the effect of the drawing',
183
 
   'mode on the appearance of the','objects.');
184
 
 
185
 
 
186
 
var
187
 
  ob : PFL_OBJECT;
188
 
  c : TFL_COLOR;
189
 
  p : ppchar;
190
 
  vn : ^TVN_struct;
191
 
  i : longint;
192
 
  
193
 
begin
194
 
  c := FL_BLACK;
195
 
  fl_initialize(@argc, argv, 'FormDemo', nil, 0);
196
 
  create_the_forms ();
197
 
  fl_set_bitmap_data (tobj[2], sorceress_width, sorceress_height, pchar(@sorceress_bits));
198
 
  fl_add_chart_value (tobj[3], 15, 'item 1', c);inc(c);
199
 
  fl_add_chart_value (tobj[3], 5, 'item 2', c);inc(c);
200
 
  fl_add_chart_value (tobj[3], -10, 'item 3', c);inc(c);
201
 
  fl_add_chart_value (tobj[3], 25, 'item 4', c);inc(c);
202
 
  fl_set_menu (tobj[14], 'item 1|item 2|item 3|item 4|item 5');
203
 
  fl_addto_choice (tobj[15], 'item 1');
204
 
  fl_addto_choice (tobj[15], 'item 2');
205
 
  fl_addto_choice (tobj[15], 'item 3');
206
 
  fl_addto_choice (tobj[15], 'item 4');
207
 
  fl_addto_choice (tobj[15], 'item 5');
208
 
  fl_set_timer (tobj[16], 1000.0);
209
 
  for i:=0 to 21 do 
210
 
     fl_add_browser_line (tobj[17], browserlines[i]);
211
 
  for i:= 0 to 15 do
212
 
     fl_addto_choice(btypeob, btypes[i].name);
213
 
  for i:=0 to 5 do
214
 
      begin 
215
 
      fl_addto_choice (modeob, gmode[i].name);
216
 
      if (fl_mode_capable(gmode[i].theval, 0)=0) then
217
 
        fl_set_choice_item_mode(modeob, i, FL_PUP_GRAY);
218
 
      end;
219
 
  fl_set_choice (modeob, fl_vmode+1); 
220
 
   fl_show_form (form, FL_PLACE_MOUSE, border, 'Box types');
221
 
  while (fl_do_forms <> exitob) do;
222
 
end.
 
 
b'\\ No newline at end of file'