pushbutton.pp 1.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758
  1. Program pushButtons;
  2. { A demo that shows the use of push buttons. }
  3. uses xforms;
  4. var form : PFL_FORM;
  5. Abox : array[0..8] of PFL_OBJECT;
  6. procedure push_cb( ob : PFL_OBJECT; n : longint);export;
  7. begin
  8. if (fl_get_button(ob)<>0) then
  9. fl_show_object(abox[n])
  10. else
  11. fl_hide_object(abox[n]);
  12. end;
  13. Procedure makeform;
  14. Var i : Integer;
  15. obj : PFL_OBJECT;
  16. begin
  17. form := fl_bgn_form(FL_UP_BOX,400,400);
  18. for i:=0 to 7 do
  19. begin
  20. obj := fl_add_button(FL_PUSH_BUTTON,40,310-40*i,80,30,'');
  21. fl_set_object_color(obj,FL_BLACK+i+1,FL_BLACK+i+1);
  22. fl_set_object_callback(obj,PFL_CALLBACKPTR(@push_cb),i);
  23. abox[i] := fl_add_box(FL_DOWN_BOX,150+30*i,40,25,320,'');
  24. fl_set_object_color(abox[i],FL_BLACK+i+1,FL_BLACK+i+1);
  25. fl_hide_object(abox[i]);
  26. end;
  27. fl_add_button(FL_NORMAL_BUTTON,40,350,80,30,'Exit');
  28. fl_end_form;
  29. end;
  30. Begin
  31. fl_initialize(@argc, argv, 'FormDemo', nil,0);
  32. makeform;
  33. fl_show_form(form,FL_PLACE_CENTER,FL_NOBORDER,'Push Buttons');
  34. { fl_do_forms will return only when Exit is pressed }
  35. fl_do_forms;
  36. end.
  37. {
  38. $Log$
  39. Revision 1.3 2003-10-27 15:48:13 peter
  40. * renamed forms unit to xforms to prevent conflict with Forms
  41. from the LCL
  42. Revision 1.2 2002/09/07 15:42:57 peter
  43. * old logs removed and tabs fixed
  44. Revision 1.1 2002/01/29 17:55:02 peter
  45. * splitted to base and extra
  46. }