fpc/packages/xforms/examples/newbutton.pp

{
 * Demo showing the use of user defined object class: CROSSBUTTON
 *
 * Form definition file generated with fdesign.
 * changed stub button to crossbutton
 }

uses xforms;

Const FL_CROSSBUTTON=2000;
      FL_CROSSBUTTON_BW = 2;

{ How to draw it }
type TSPEC = TFL_BUTTON_STRUCT;
     PSPEC = ^TSPEC;

Procedure draw_crossbutton(ob : PFL_OBJECT);cdecl;

var temp : longint;
    xx, yy, ww, hh ,tt : TFL_Coord;

begin
   temp:=0;
   { if redraw is demanded by FL_ENTER, ignore it }

   if PSPEC(ob^.spec)^.event = FL_ENTER then exit;

   { draw the bounding box first }
   fl_drw_box(ob^.boxtype, ob^.x, ob^.y, ob^.w, ob^.h, ob^.col1, ob^.bw);

   { draw the box that contains the cross }
   if ob^.w>ob^.h then tt:=ob^.h else tt:=ob^.w;

    ww := tt div 2 - 1;
    hh:=ww;
    xx := ob^.x + FL_BOUND_WIDTH;
    yy := ob^.y + (ob^.h - hh) div 2;


   { if pushed, draw a down box with the cross }
   if PSPEC(ob^.spec)^.val<>0 then
      begin
      fl_drw_box(FL_DOWN_BOX, xx, yy, ww, hh, ob^.col1, ob^.bw);
      fl_drw_text(FL_ALIGN_CENTER, xx-2, yy-2, ww+4, hh+4, ob^.col2, 0, 0, '@9plus');
      end
   else
     begin
      fl_drw_box(FL_UP_BOX, xx, yy, ww, hh, ob^.col1, ob^.bw);
     end;

    { label }
    if (ob^.align = FL_ALIGN_CENTER) then
        fl_drw_text(FL_ALIGN_LEFT, xx + ww + 3, ob^.y, 0, ob^.h,
                    ob^.lcol, ob^.lstyle, ob^.lsize, ob^.thelabel)
    else
        fl_draw_object_label_outside(ob);

    if (ob^.thetype = FL_RETURN_BUTTON) then
        fl_drw_text(FL_ALIGN_CENTER,
                    TFL_Coord (ob^.x + ob^.w - round(0.8 * ob^.h)),
                    TFL_Coord (ob^.y + round(0.2 * ob^.h)),
                    TFL_Coord (round(0.6 * ob^.h)),
                    TFL_Coord (round(0.6 * ob^.h)), ob^.lcol, 0, 0, '@returnarrow');

end;


{ creation }
function fl_create_crossbutton(Thetype : Longint; x,y,w,h : TFL_Coord; thelabel : Pchar) : PFL_OBJECT;

var ob : PFL_OBJECT;

begin
     fl_add_button_class(FL_CROSSBUTTON, PFL_Drawbutton(@draw_crossbutton), nil);
     ob := fl_create_generic_button(FL_CROSSBUTTON, thetype, x, y,w, h, thelabel);
     ob^.boxtype := FL_NO_BOX;
     ob^.col2 := FL_BLACK;   { cross color }
     { ob^.bw := FL_CROSSBUTTON_BW; }
     fl_create_crossbutton:=ob;
end;

function fl_add_crossbutton(Thetype : longint; x,y,w,h : TFL_COORD; thelabel : pchar): PFL_OBJECT;

var ob : PFL_OBJECT;
    theform : PFL_FORM;

begin
    ob := fl_create_crossbutton(thetype, x, y, w, h, thelabel);
    theform:=fl_current_form;
    fl_add_object(theform, ob);
    fl_add_crossbutton:=ob;
end;

{*** Forms and Objects ***}
type TFD_NEwBut = record
        newbut : PFL_FORM;
        bexit : PFL_object;
        vdata : pointer;
        ldata : Longint;
end;
PFD_NewBut= ^TFD_NewBut;

function create_form_newbut : PFD_Newbut;

var
  obj : PFL_OBJECT;
  fdui  : PFD_newbut;
  oldbw : longint;

begin
  new (fdui);
  oldbw := fl_get_border_width;

  fl_set_border_width(-2);
  fdui^.newbut := fl_bgn_form(FL_NO_BOX, 310, 190);
  obj := fl_add_box(FL_UP_BOX,0,0,310,190,'');
  obj := fl_add_labelframe(FL_ENGRAVED_FRAME,40,45,100,120,'CrossB');
    fl_set_object_boxtype(obj,FL_FLAT_BOX);
    fl_set_object_lstyle(obj,FL_BOLD_STYLE);
  obj := fl_add_crossbutton(FL_RADIO_BUTTON,50,115,80,30,'cross1');
    fl_set_object_color(obj,FL_COL1,FL_RED);
  obj := fl_add_crossbutton(FL_RADIO_BUTTON,50,85,80,30,'Button');
    fl_set_object_color(obj,FL_COL1,FL_GREEN);
  obj := fl_add_crossbutton(FL_RADIO_BUTTON,50,55,80,30,'Button');
    fl_set_object_color(obj,FL_COL1,FL_BLUE);
  obj := fl_add_labelframe(FL_ENGRAVED_FRAME,180,45,100,120,'CrossB');
    fl_set_object_boxtype(obj,FL_FLAT_BOX);
    fl_set_object_lstyle(obj,FL_BOLD_STYLE);
  obj := fl_add_crossbutton(FL_PUSH_BUTTON,190,115,80,30,'Button');
    fl_set_object_color(obj,FL_COL1,FL_RED);
  obj := fl_add_crossbutton(FL_PUSH_BUTTON,190,85,90,30,'Button');
    fl_set_object_color(obj,FL_COL1,FL_GREEN);
  obj := fl_add_crossbutton(FL_PUSH_BUTTON,190,55,80,30,'Button');
    fl_set_object_color(obj,FL_COL1,FL_BLUE);
  obj := fl_add_button(FL_NORMAL_BUTTON,125,10,65,25,'Exit');
  fdui^.bexit :=obj;
  fl_end_form;
  fl_set_border_width(oldbw);

  create_form_newbut:=fdui;
end;


var cbform : PFD_newbut;

begin
      fl_initialize(@argc, argv, 'FormDemo', nil, 0);
      cbform := create_form_newbut();
      fl_show_form(cbform^.newbut, FL_PLACE_CENTER, 0, nil);
      while(fl_do_forms <> cbform^.bexit) do ;
end.