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