freepascal.compiler/packages/amunits/examples/otherlibs/tritongadgets.pas

PROGRAM GadgetDemo;

uses triton, tritonmacros, utility;

{
    If you have seen gadtoolsgadgets.c in the RKRM's then you
    have seen this program. One diffs is that this example
    is made in Triton. Much better.:)
    Jun 06 1998

    Updated for fpc 1.0.7
    11 Jan 2003.

    [email protected]
}




CONST
    MYGAD_SLIDER     = 1;
    MYGAD_SLIDERTEXT = 10;
    MYGAD_STRING1    = 2;
    MYGAD_STRING2    = 3;
    MYGAD_STRING3    = 4;
    MYGAD_BUTTON     = 5;

(* Range for the slider: *)
    SLIDER_MIN  = 1;
    SLIDER_MAX  = 20;
    SLIDER_DEF  = 10;
VAR
    Project     : pTR_Project;
    trmsg       : pTR_Message;
    quit        : Boolean;
    dummy       : longint;
    Triton_App  : pTR_App;

Function longToStr (I : Longint) : String;

     Var S : String;

     begin
      Str (I,S);
      longToStr:=S;
     end;


PROCEDURE CleanExit(errstring : STRING; rc : Integer);
BEGIN
    IF Project <> NIL THEN TR_CloseProject(Project);
    if Triton_App <> nil then TR_DeleteApp(Triton_App);
    IF errstring <> '' THEN WriteLn(errstring);
    Halt(rc)
END;



begin
  if not Assigned(TritonBase) then
  begin
    writeln('cannot open ' + TRITONNAME);
    Halt(5);
  end;
    Triton_App := TR_CreateAppTags([
                     TRCA_Name, AsTag('TritonGadtools'),
                     TRCA_LongName, AsTag('GadToolsDemo in Triton'),
                     TRCA_Version, AsTag('0.01'),
                     TRCA_Info, AsTag('Just a test of Triton'),
                     TRCA_Release, AsTag('1.0'),
                     TRCA_Date, AsTag('26-05-1998'),
                     TAG_DONE]);

     if Triton_App = nil then CleanExit('Can''t create Application',20);

     ProjectStart;
     WindowID(1);
     WindowTitle('Instead of GadTools :)');
     WindowPosition(TRWP_CENTERTOP);
         HorizGroupA;
             Space;
             VertGroupA;
                 Space;
                LineArray;
                    BeginLine;
                        Space;
                        TextID('_Volume:',MYGAD_SLIDER); SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
                        Space;
                        SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
                        Space;
                        TextID(string('5'),MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
                        Space;
                    EndLine;
                    SpaceS;
                    BeginLine;
                        Space;
                        TextID('_First:',MYGAD_STRING1); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
                        Space;
                        StringGadget('Try pressing',MYGAD_STRING1); SetTRTag(TRAT_Value,50);
                        Space;
                    EndLine;
                    SpaceS;
                    BeginLine;
                        Space;
                        TextID('_Second:',MYGAD_STRING2); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
                        Space;
                        StringGadget('TAB or Shift-TAB',MYGAD_STRING2); SetTRTag(TRAT_Value,50);
                        Space;
                    EndLine;
                    SpaceS;
                    BeginLine;
                        Space;
                        TextID('_Third:',MYGAD_STRING3); SetTRTag(TRAT_Flags, TROF_RIGHTALIGN);
                        Space;
                        StringGadget('To see what happens!',MYGAD_STRING3); SetTRTag(TRAT_Value,50);
                        Space;
                    EndLine;
                EndArray;
                Space;
                        CenteredButton('_Click Here',MYGAD_BUTTON);
                Space;
            EndGroup;
            Space;
        EndGroup;
     EndProject;



    Project := TR_OpenProject(Triton_App,@tritontags);
    IF Project = NIL THEN CleanExit('No project',20);

    quit := False;
    WHILE NOT quit DO BEGIN
      dummy := TR_Wait(Triton_App,0);
      REPEAT
        trmsg := TR_GetMsg(Triton_App);
        IF trmsg <> NIL THEN BEGIN
          IF (trmsg^.trm_Project = Project) THEN BEGIN
             CASE trmsg^.trm_Class OF

               TRMS_CLOSEWINDOW : quit := True;

               TRMS_NEWVALUE    :
                       BEGIN
                       case trmsg^.trm_ID of
                         MYGAD_SLIDER  : begin
                                         TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(trmsg^.trm_Data));
                                         writeln('Slider at level ',trmsg^.trm_Data);
                                         end;
                         MYGAD_STRING1 : writeln('String Gadget 1: "',TR_GetString(Project,MYGAD_STRING1),'".');
                         MYGAD_STRING2 : writeln('String Gadget 2: "',TR_GetString(Project,MYGAD_STRING2),'".');
                         MYGAD_STRING3 : writeln('String Gadget 3: "',TR_GetString(Project,MYGAD_STRING3),'".');
                       END;
                       END;
               TRMS_ACTION :
                      BEGIN
                      if trmsg^.trm_ID = MYGAD_BUTTON then begin
                                           TR_SetValue(Project,MYGAD_SLIDER,SLIDER_DEF);
                                           TR_SetText(Project,MYGAD_SLIDERTEXT,LongToStr(SLIDER_DEF));
                                           writeln('Button was pressed, slider reset to 10.');
                                         end;
                      END;
               TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
             END;
           END;
           TR_ReplyMsg(trmsg);
         END;
       UNTIL quit OR (trmsg = NIL);
    END;
    CleanExit('',0);
END.