1 PROGRAM Slider;
2
3 uses triton, tritonmacros, utility;
4
5 {
6 A demo in FPC Pascal using triton.library
7
8 Updated for fpc 1.0.7
9 11 Jan 2003.
10
11 nils.sjoholm@mailbox.swipnet.se
12 }
13
14
15
16 VAR
17 Project : pTR_Project;
18 close_me : BOOLEAN;
19 trmsg : pTR_Message;
20 dummy : longint;
21 Triton_App : pTR_App;
22
IntToStrnull23 Function IntToStr (I : Longint) : String;
24
25 Var S : String;
26
27 begin
28 Str (I,S);
29 IntToStr:=S;
30 end;
31
32 begin
33 if not Assigned(TritonBase) then
34 begin
35 writeln('cannot open ' + TRITONNAME);
36 Halt(5);
37 end;
38 Triton_App := TR_CreateAppTags([
39 TRCA_Name, AsTag(' Triton Slider Demo'),
40 TRCA_Release, AsTag(' 1.0'),
41 TRCA_Date, AsTag(' 03-08-1998'),
42 TAG_DONE]);
43
44 if Triton_App <> nil then begin
45 ProjectStart;
46 WindowID(1);
47 WindowTitle(' Slider' );
48 VertGroupA;
49 Space;
50 HorizGroupAC;
51 Space;
52 TextID(' _Slider' ,1);
53 Space;
54 SliderGadget(1,100,50,1);
55 Space;
56 TextID(' 50' ,2); SetTRTag(TRAT_MinWidth,3);
57 Space;
58 EndGroup;
59 Space;
60 EndGroup;
61 EndProject;
62
63 Project := TR_OpenProject(Triton_App,@tritontags);
64 IF Project <> NIL THEN BEGIN
65 close_me := FALSE;
66 WHILE NOT close_me DO BEGIN
67 dummy := TR_Wait(Triton_App,0);
68 REPEAT
69 trmsg := TR_GetMsg(Triton_App);
70 IF trmsg <> NIL THEN BEGIN
71 IF (trmsg^.trm_Project = Project) THEN BEGIN
72 CASE trmsg^.trm_Class OF
73 TRMS_CLOSEWINDOW : begin
74 writeln(' The final number was: ' ,TR_GetValue(Project,1));
75 close_me := True;
76 end;
77 TRMS_ERROR: WriteLN(TR_GetErrorString(trmsg^.trm_Data));
78 TRMS_NEWVALUE : begin
79 IF trmsg^.trm_ID = 1 then begin
80 writeln(' The number is: ' ,trmsg^.trm_Data);
81 TR_SetText(Project,2,IntToStr(trmsg^.trm_Data));
82 end;
83 end;
84 END;
85 END;
86 TR_ReplyMsg(trmsg);
87 END;
88 UNTIL close_me OR (trmsg = NIL);
89 END;
90 TR_CloseProject(Project);
91 end;
92 TR_DeleteApp(Triton_App);
93 END ELSE writeln(' Cant create Application');
94 end.
95