home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / checkbox.pas next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.4 KB  |  88 lines
  1. PROGRAM CheckBoxGad;
  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.  
  13. VAR
  14.      App      : pTR_App;
  15.      Project  : pTR_Project;
  16.      close_me : BOOLEAN;
  17.      trmsg    : pTR_Message;
  18.      dummy    : Longint;
  19.  
  20. procedure CleanUp(why : string; err : longint);
  21. begin
  22.     if assigned(Project) then TR_CloseProject(Project);
  23.     if assigned(App) then TR_DeleteApp(App);
  24.     if why <> '' then writeln(why);
  25.     halt(err);
  26. end;
  27.  
  28. begin
  29.  
  30.      App := TR_CreateApp(TAGS(
  31.                          TRCA_Name,longstr('Triton CheckBox'),
  32.                          TRCA_Release,longstr('1'),
  33.                          TRCA_Date,longstr('03-06-1998'),
  34.                          TAG_DONE));
  35.      
  36.      if App = nil then CleanUp('Can''t create application',20);
  37.      
  38.       ProjectStart;
  39.       WindowID(1);
  40.       WindowTitle('CheckBox');
  41.          VertGroupA;
  42.             Space;
  43.             HorizGroupAC;
  44.                Space;
  45.                TextID('_CheckBox',10);
  46.                Space;
  47.                CheckBox(10);
  48.                Space;
  49.             EndGroup;
  50.             Space;
  51.          EndGroup;
  52.       EndProject;
  53.  
  54.   Project := TR_OpenProject(App,@tritontags);
  55.     IF Project = NIL THEN CleanUp('Can''t create Project',20);
  56.       close_me := FALSE;
  57.       WHILE NOT close_me DO BEGIN
  58.         dummy := TR_Wait(App,0);
  59.         REPEAT
  60.           trmsg := TR_GetMsg(App);
  61.           IF trmsg <> NIL THEN BEGIN
  62.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  63.                CASE trmsg^.trm_Class OF
  64.                  TRMS_CLOSEWINDOW : begin
  65.                                      if TR_GetCheckBox(Project,10) then 
  66. writeln('CheckBox was on')
  67.                                         else writeln('CheckBox was off');
  68.                                      close_me := True;
  69.                                     end;
  70.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  71.                  TRMS_NEWVALUE    : begin
  72.                                       IF trmsg^.trm_ID = 10 then begin
  73.                                           if trmsg^.trm_Data = 0 then 
  74. writeln('CheckBox off')
  75.                                             else writeln('CheckBox on');
  76.                                       end;
  77.                                     end;
  78.                END;
  79.             END;
  80.             TR_ReplyMsg(trmsg);
  81.           END;
  82.         UNTIL close_me OR (trmsg = NIL);
  83.       END;
  84.    CleanUp('',0);
  85. end.
  86.  
  87.  
  88.