1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
{
* 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.
|
