1 PROGRAM GadgetDemo;
2
3 uses triton, tritonmacros, utility;
4
5 {
6 If you have seen gadtoolsgadgets.c in the RKRM's then you
7 have seen this program. One diffs is that this example
8 is made in Triton. Much better.:)
9 Jun 06 1998
10
11 Updated for fpc 1.0.7
12 11 Jan 2003.
13
14 nils.sjoholm@mailbox.swipnet.se
15 }
16
17
18
19
20 CONST
21 MYGAD_SLIDER = 1;
22 MYGAD_SLIDERTEXT = 10;
23 MYGAD_STRING1 = 2;
24 MYGAD_STRING2 = 3;
25 MYGAD_STRING3 = 4;
26 MYGAD_BUTTON = 5;
27
28 (* Range for the slider: *)
29 SLIDER_MIN = 1;
30 SLIDER_MAX = 20;
31 SLIDER_DEF = 10;
32 VAR
33 Project : pTR_Project;
34 trmsg : pTR_Message;
35 quit : Boolean;
36 dummy : longint;
37 Triton_App : pTR_App;
38
longToStrnull39 Function longToStr (I : Longint) : String;
40
41 Var S : String;
42
43 begin
44 Str (I,S);
45 longToStr:=S;
46 end;
47
48
49 PROCEDURE CleanExit(errstring : STRING; rc : Integer);
50 BEGIN
51 IF Project <> NIL THEN TR_CloseProject(Project);
52 if Triton_App <> nil then TR_DeleteApp(Triton_App);
53 IF errstring <> '' THEN WriteLn(errstring);
54 Halt(rc)
55 END;
56
57
58
59 begin
60 if not Assigned(TritonBase) then
61 begin
62 writeln('cannot open ' + TRITONNAME);
63 Halt(5);
64 end;
65 Triton_App := TR_CreateAppTags([
66 TRCA_Name, AsTag('TritonGadtools'),
67 TRCA_LongName, AsTag('GadToolsDemo in Triton'),
68 TRCA_Version, AsTag('0.01'),
69 TRCA_Info, AsTag('Just a test of Triton'),
70 TRCA_Release, AsTag('1.0'),
71 TRCA_Date, AsTag('26-05-1998'),
72 TAG_DONE]);
73
74 if Triton_App = nil then CleanExit('Can''t create Application',20);
75
76 ProjectStart;
77 WindowID(1);
78 WindowTitle('Instead of GadTools :)');
79 WindowPosition(TRWP_CENTERTOP);
80 HorizGroupA;
81 Space;
82 VertGroupA;
83 Space;
84 LineArray;
85 BeginLine;
86 Space;
87 TextID('_Volume:',MYGAD_SLIDER); SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
88 Space;
89 SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
90 Space;
91 TextID(string('5'),MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
92 Space;
93 EndLine;
94 SpaceS;
95 BeginLine;
96 Space;
97 TextID('_First:',MYGAD_STRING1); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
98 Space;
99 StringGadget('Try pressing',MYGAD_STRING1); SetTRTag(TRAT_Value,50);
100 Space;
101 EndLine;
102 SpaceS;
103 BeginLine;
104 Space;
105 TextID('_Second:',MYGAD_STRING2); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
106 Space;
107 StringGadget('TAB or Shift-TAB',MYGAD_STRING2); SetTRTag(TRAT_Value,50);
108 Space;
109 EndLine;
110 SpaceS;
111 BeginLine;
112 Space;
113 TextID('_Third:',MYGAD_STRING3); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
114 Space;
115 StringGadget('To see what happens!',MYGAD_STRING3); SetTRTag(TRAT_Value,50);
116 Space;
117 EndLine;
118 EndArray;
119 Space;
120 CenteredButton('_Click Here',MYGAD_BUTTON);
121 Space;
122 EndGroup;
123 Space;
124 EndGroup;
125 EndProject;
126
127
128
129 Project := TR_OpenProject(Triton_App,@tritontags);
130 IF Project = NIL THEN CleanExit('No project',20);
131
132 quit := False;
133 WHILE NOT quit DO BEGIN
134 dummy := TR_Wait(Triton_App,0);
135 REPEAT
136 trmsg := TR_GetMsg(Triton_App);
137 IF trmsg <> NIL THEN BEGIN
138 IF (trmsg^.trm_Project = Project) THEN BEGIN
139 CASE trmsg^.trm_Class OF
140
141 TRMS_CLOSEWINDOW : quit := True;
142
143 TRMS_NEWVALUE :
144 BEGIN
145 case trmsg^.trm_ID of
146 MYGAD_SLIDER : begin
147 TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(trmsg^.trm_Data));
148 writeln('Slider at level ',trmsg^.trm_Data);
149 end;
150 MYGAD_STRING1 : writeln('String Gadget 1: "',TR_GetString(Project,MYGAD_STRING1),'".');
151 MYGAD_STRING2 : writeln('String Gadget 2: "',TR_GetString(Project,MYGAD_STRING2),'".');
152 MYGAD_STRING3 : writeln('String Gadget 3: "',TR_GetString(Project,MYGAD_STRING3),'".');
153 END;
154 END;
155 TRMS_ACTION :
156 BEGIN
157 if trmsg^.trm_ID = MYGAD_BUTTON then begin
158 TR_SetValue(Project,MYGAD_SLIDER,SLIDER_DEF);
159 TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(SLIDER_DEF));
160 writeln('Button was pressed, slider reset to 10.');
161 end;
162 END;
163 TRMS_ERROR: WriteLN(TR_GetErrorString(trmsg^.trm_Data));
164 END;
165 END;
166 TR_ReplyMsg(trmsg);
167 END;
168 UNTIL quit OR (trmsg = NIL);
169 END;
170 CleanExit('',0);
171 END.
172