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
|
program gttest;
{
This is just a small test of gtlayout.library.
It's from gtlayout.doc.
No problems so far.
16 Jul 2000.
Added MessageBox for report.
31 Jul 2000.
Updated to use fpc 1.0.7
07 Jan 2003.
nils.sjoholm@mailbox.swipnet.se
}
uses intuition, exec, gadtools, utility, gtlayout, msgbox;
const
ltrue : longint = 1;
lfalse : longint = 0;
var
handle : pLayoutHandle;
win : pWindow;
msg : pIntuiMessage;
msgQuali : ulong;
msgclass : ulong;
msgcode : word;
msggadget : pGadget;
done : boolean;
procedure CleanUp(why : string; rc : integer);
begin
LT_DeleteHandle(handle);
if why <> '' then MessageBox('GTLayout Report',why,'OK');
halt(rc);
end;
begin
done := false;
handle := LT_CreateHandleTags(nil,[
LAHN_AutoActivate, lfalse,
TAG_DONE]);
if handle = nil then CleanUp('Could''t create a handle',20);
LT_New(handle,[LA_Type,VERTICAL_KIND, { A vertical group. }
LA_LabelText,'Main Group',
TAG_DONE]);
LT_New(handle,[LA_Type,BUTTON_KIND, { A plain button. }
LA_LabelText,'A button',
LA_ID,11,
TAG_DONE]);
LT_New(handle,[LA_Type,XBAR_KIND,TAG_DONE]); { A separator bar. }
LT_New(handle,[LA_Type,BUTTON_KIND, { A plain button. }
LA_LabelText,'Another button',
LA_ID,22,
TAG_DONE]);
LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,'test',LA_ID,33,LA_BOOL,1,TAG_DONE]);
LT_New(handle,[La_Type,END_KIND,TAG_DONE]); { This ends the current group. }
win := LT_Build(handle,[LAWN_Title,'Window title',
LAWN_IDCMP, IDCMP_CLOSEWINDOW,
WA_CloseGadget, ltrue,
TAG_DONE]);
if win = nil then CleanUp('Can''t open the window',20);
repeat
msg := pIntuiMessage(WaitPort(win^.UserPort));
msg := GT_GetIMsg(win^.UserPort);
while msg <> nil do begin
msgclass := msg^.IClass;
msgcode := msg^.Code;
msgQuali := msg^.Qualifier;
msggadget := msg^.IAddress;
GT_ReplyIMsg(msg);
LT_HandleInput(handle,msgQuali,@msgclass,@msgcode,@msggadget);
case msgclass of
IDCMP_CLOSEWINDOW : begin
writeln(LT_GetAttributesA(handle,33,nil));
done := true;
end;
IDCMP_GADGETUP: begin
case msggadget^.GadgetId of
11 : writeln('First gadget');
22 : writeln('Second gadget');
end;
end;
end;
msg := GT_GetIMsg(win^.UserPort);
end;
until done;
CleanUp('all ok',0);
end.
|
