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