home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / Scroller.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.1 KB  |  78 lines
  1. PROGRAM Scroller;
  2.  
  3. uses triton, tritonmacros, utility, vartags;
  4.  
  5. {
  6.    A demo in FPC Pascal using triton.library
  7.    
  8.    nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11.  
  12. VAR
  13.      Project  : pTR_Project;
  14.      App : pTR_App;
  15.      close_me : BOOLEAN;
  16.      trmsg : pTR_Message;
  17.      dummy : longint;
  18.  
  19. begin
  20.  
  21.     App := TR_CreateApp(TAGS(
  22.                      TRCA_Name,longstr(' Triton Scroller Demo') ,
  23.                      TRCA_Release,longstr(' 1') ,
  24.                      TRCA_Date,longstr(' 03-08-1998') ,
  25.                      TAG_DONE));
  26.  
  27.     if App <> nil then begin
  28.  
  29.       ProjectStart;
  30.       WindowID(1);
  31.       WindowTitle(' Scroller' );
  32.          VertGroupA;
  33.             Space;
  34.             HorizGroupAC;
  35.                Space;
  36.                TextID(' _Scroller' ,7);
  37.                Space;
  38.                SetTRTag(TROB_Scroller,TROF_HORIZ);
  39.                SetTRTag(TRSC_Total,40);
  40.                SetTRTag(TRSC_Visible,10);
  41.                SetTRTag(TRAT_Value,5);
  42.                SetTRTag(TRAT_ID,7);
  43.                Space;
  44.             EndGroup;
  45.             Space;
  46.          EndGroup;
  47.       EndProject;
  48.  
  49.   Project := TR_OpenProject(App,@tritontags);
  50.     IF Project <> NIL THEN BEGIN
  51.       close_me := FALSE;
  52.       WHILE NOT close_me DO BEGIN
  53.         dummy := TR_Wait(App,0);
  54.         REPEAT
  55.           trmsg := TR_GetMsg(App);
  56.           IF trmsg <> NIL THEN BEGIN
  57.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  58.                CASE trmsg^.trm_Class OF
  59.                  TRMS_CLOSEWINDOW : begin
  60.                                        writeln(' The final value was: ' ,TR_GetValue(Project,7));
  61.                                        close_me := True;
  62.                                     end;
  63.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  64.                  TRMS_NEWVALUE    : IF trmsg^.trm_ID = 7 then writeln(' The value is: ' ,trmsg^.trm_Data);
  65.                END;
  66.             END;
  67.             TR_ReplyMsg(trmsg);
  68.           END;
  69.         UNTIL close_me OR (trmsg = NIL);
  70.       END;
  71.      TR_CloseProject(Project);
  72.    end;
  73.    TR_DeleteApp(App);
  74.    END ELSE writeln(' Cant creat Application' );
  75. end.
  76.  
  77.  
  78.