1{ Demo: complete pop-ups.
2 * test font/cursor change
3 * test attaching pup to menu
4 }
5program popup;
6
7uses xforms,strings;
8
9var
10pup : PFL_FORM;
11done, pret, b1, b2, b3, menu : PFL_OBJECT;
12
13var
14    aa : TFL_IOPT;
15    mask : cardinal;
16
17
18const
19   subm : longint = -1;
20    m : longint = -1;
21    ssm : longint = 0;
22    n1 : longint = -1;
23    n2 : longint = -1;
24    n : longint = 0;
25
26{ post-handler }
27function  post(ob : PFL_OBJECT; ev : Longint; mx,y : TFL_Coord; key  : longint; xev : pointer) : Longint;
28
29begin
30    if (n1 = -1) then
31     begin
32      n1 := fl_defpup(FL_ObjWin(ob),'line1|line2');
33      fl_setpup_shadow(n1,0);
34      fl_setpup_bw(n1,0);
35      fl_setpup_pad(n1,3,0);
36
37      n2 := fl_defpup(FL_ObjWin(ob),'button1|button2');
38      fl_setpup_shadow(n2,0);
39      fl_setpup_bw(n2,-1);
40      fl_setpup_pad(n2,3,0);
41    end;
42
43    if (ev = FL_ENTER) then
44      begin
45       if (ob=b3) then
46         fl_show_oneliner('button3',ob^.form^.x+ob^.x,
47                         ob^.form^.y+ob^.y + ob^.h + 5)
48       else
49        begin
50          fl_setpup_position(ob^.form^.x+ob^.x, ob^.form^.y+ob^.y+ob^.h + 5);
51          if ob=b1 then
52            fl_showpup(n1)
53          else
54            fl_showpup(n2);
55        end
56      end
57    else if(ev <> FL_MOTION) then
58      begin
59       if (ob=b3) then
60         fl_hide_oneliner
61       else
62         if ob=b1 then
63           fl_hidepup(n1)
64         else
65           fl_hidepup(n2);
66      end;
67end;
68
69
70procedure show_return_val(i :  longint);
71
72var
73    buf : string[128];
74
75begin
76      str(i,buf);
77      buf:= 'Returned '+buf;
78     if i>0 then
79       buf:=buf+'('++strpas(fl_getpup_text(m,i))+')'#0;
80
81    fl_set_object_label(pret, @buf[1]);
82end;
83
84function ssm_cb(a : longint) : longint;
85begin
86   show_return_val(a);
87   ssm_cb:=a;
88end;
89
90procedure do_pup(ob : PFL_OBJECT; q : longint);
91
92begin
93   if (subm = -1) then
94   begin
95      ssm  := fl_newpup(FL_ObjWin(ob));
96      subm := fl_newpup(FL_ObjWin(ob));
97      m    := fl_newpup(FL_ObjWin(ob));
98
99      { Problem, variable nr. of arguments in c code !!!!}
100      { fl_addtopup(ssm,'SubSubM%F%t',ssm_cb); }
101      fl_addtopup(ssm,'SSMItem20%x20%R1');
102      fl_addtopup(ssm,'SSMItem21%x21%r1');
103      fl_addtopup(ssm,'SSMItem22%x22%r1%l');
104      fl_addtopup(ssm,'SSMitem30%x30%R2');
105      fl_addtopup(ssm,'SSMItem31%x31%r2');
106      fl_addtopup(ssm,'SSMItem32%x32%r2');
107
108      fl_addtopup(subm,'SubMenu%t');
109      fl_addtopup(subm,'SMItemA\tAlt-A%x10%h','#a');
110      fl_addtopup(subm,'SMItemB\tAlt-B%x11%h','#b');
111      fl_addtopup(subm,'SMItemC\tAlt-C%x12%h','#c');
112      fl_addtopup(subm,'SMItemD\tAlt-F5%x13%h%m','#&5',ssm);
113      fl_addtopup(subm,'SMItemE\tAlt-E%x14','#E');
114
115      fl_setpup_mode(subm, 14, FL_PUP_GREY);
116
117      fl_addtopup(m,'PopUP%t');
118      fl_addtopup(m,'MenuItem1%h','1#1');
119
120      fl_addtopup(m,'MenuItem2%h','2#2');
121      fl_setpup_submenu(m, 2, subm);
122      fl_addtopup(m,'MenuItem3%h','3#3');
123      fl_addtopup(m,'MenuItem4%h','4#4');
124   end;
125
126
127   if (fl_get_button_numb(ob) >= FL_SHORTCUT) then
128      fl_setpup_position(ob^.form^.x + ob^.x,
129                      ob^.form^.y + ob^.y + ob^.h);
130
131   show_return_val(fl_dopup(m));
132
133   { test if changing size/style ok }
134   n := not(n);
135   if n<>0 then
136    begin
137    fl_setpup_fontsize(14);
138    fl_setpup_fontstyle(FL_TIMES_STYLE);
139    fl_setpup_cursor(m, XC_hand2);
140    end
141   else
142     begin
143     fl_setpup_fontsize(12);
144     fl_setpup_fontstyle(FL_BOLDITALIC_STYLE);
145     fl_setpup_cursor(m,XC_sb_right_arrow);
146     end;
147end;
148
149procedure init_menu;
150var
151    mm,smm : longint;
152
153begin
154    mm := fl_newpup(fl_default_win);
155    fl_setpup_bw(mm, -2);
156    fl_setpup_shadow(mm, 0);
157    smm := fl_newpup(0);
158    fl_setpup_shadow(smm, 0);
159
160    fl_addtopup(mm,'MenuItem1|MenuItem2%m|MenuItem3',smm);
161    fl_addtopup(smm,'SubItem1%x11|SubItem2%x12|SubItem3%x13');
162
163
164    { attach pup to menu }
165
166    fl_set_menu_popup(menu, mm);
167end;
168
169
170procedure do_menu(ob  : PFL_OBJECT; data : longint);
171var
172    buf : string[128];
173
174begin
175    str(fl_get_menu(ob),buf);
176    if (fl_get_menu(ob) >= 0) then
177       buf:=buf+strpas(fl_get_menu_text(ob));
178    buf:=buf+#0;
179
180    fl_set_object_label(pret, @buf[1]);
181end;
182
183procdure done_cb(ob : PFL_OBJECT; data : longint);
184
185begin
186  halt(0)
187end;
188
189procedure create_form_pup;
190
191var
192  obj : PFL_OBJECT ;
193
194begin
195  if (pup<>nil) then
196     exit;
197  pup := fl_bgn_form(FL_UP_BOX,260,210);
198  obj := fl_add_button(FL_NORMAL_BUTTON,150,150,90,35,'Done');
199    fl_set_object_callback(obj,PFL_CALLBACKPTR(@done_cb), 0);
200  done := obj;
201  obj := fl_add_button(FL_MENU_BUTTON,30,90,100,30,'PopUp');
202    fl_set_button_shortcut(obj,'Pp#p',1);
203    fl_set_object_callback(obj, PFL_CALLBACKPTR(@do_pup), 0);
204  obj := fl_add_menu(FL_PULLDOWN_MENU,160,95,60,25,'Menu');
205    fl_set_object_callback(obj, PFL_CALLBACKPTR(@do_menu), 0);
206  menu := obj;
207  obj := fl_add_text(FL_NORMAL_TEXT,20,60,220,30,'');
208    fl_set_object_lalign(obj,FL_ALIGN_CENTER);
209  pret := obj;
210  b1 := fl_add_button(FL_NORMAL_BUTTON, 20, 10, 60, 30,'Button1');
211  b2 := fl_add_button(FL_NORMAL_BUTTON, 90, 10, 60, 30,'Button2');
212  b3 := fl_add_button(FL_NORMAL_BUTTON, 160, 10, 60, 30,'Button3');
213  fl_end_form();
214end;
215
216
217begin
218    mask := FL_PDVisual;
219    aa.vclass := FL_DefaultVisual;
220    fl_set_defaults(mask, @aa);
221
222    fl_initialize(@argc, argv, 'FormDemo', nil, 0);
223
224    create_form_pup();
225
226    { initialize }
227
228    fl_set_object_posthandler(b1, @post);
229    fl_set_object_posthandler(b2, @post);
230    fl_set_object_posthandler(b3, @post);
231
232    fl_show_form(pup, FL_PLACE_MOUSE, FL_TRANSIENT,'PupDemo');
233    init_menu;
234
235    fl_do_forms;
236end.
237