home *** CD-ROM | disk | FTP | other *** search
- PROGRAM GadgetDemo;
-
- uses exec, triton, tritonmacros, utility, amigalib, vartags, amigautils, linklist,pastoc;
-
- {
- A demo in FPC Pascal using triton.library
-
- nils.sjoholm@mailbox.swipnet.se
- }
-
-
-
- CONST
-
-
- NumInList = 7;
- cyclenum = 4;
-
- mxstrings : ARRAY[0..NumInList-1] OF PChar = (
- 'Amiga 500',
- 'Amiga 600',
- 'Amiga 1200',
- 'Amiga 2000',
- 'Amiga 3000',
- 'Amiga 4000',
- NIL);
-
- cyclestrings : ARRAY[0..cyclenum-1] OF PChar = (
- 'Hallo',
- 'Moin',
- 'Tach',
- NIL);
- CONST
-
- ButtonGadID = 1;
- CheckGadID = 2;
- ScrollGadID = 3;
- ScrollGadTextID = 4;
- SlidGadID = 5;
- SlidGadTextID = 6;
- CycleGadID = 7;
- CycleGadTextID = 8;
- StringGadID = 9;
- EntryGadID = 10;
- PassGadID = 11;
- MxGadID = 12;
- MxGadTextID = 13;
- ListGadID = 14;
-
- VAR
- Triton_App : pTR_App;
- Project : pTR_Project;
- trmsg : pTR_Message;
- quit : Boolean;
- z : Longint;
- dummy : Longint;
- Mylist : pList;
- MyNode : pFPCNode;
- i : Longint;
- GadID : Longint;
-
- PROCEDURE CleanExit(errstring : STRING; rc : Longint);
- BEGIN
- IF assigned(Project) THEN TR_CloseProject(Project);
- if assigned(Triton_App) then TR_DeleteApp(Triton_App);
- if assigned(MyList) then DestroyList(MyList);
- IF errstring <> '' THEN WriteLn(errstring);
- Halt(rc)
- END;
-
- BEGIN
-
- CreateList(MyList);
- FOR i := 0 TO NumInList-2 DO BEGIN
- MyNode := AddNewNode(MyList,mxstrings[i]);
- END;
-
- Triton_App := TR_CreateApp(TAGS(
- TRCA_Name,longstr('FPC Pascal Demo'),
- TRCA_LongName,Longstr('FPC Pascal Application Demo :)'),
- TRCA_Version,longstr('0.01'),
- TRCA_Info,longstr('Just a test of Triton'),
- TRCA_Release,longstr('1'),
- TRCA_Date,longstr('01-05-1996'),
- TAG_DONE));
-
- if Triton_App = NIL then CleanExit('Can''t create application',20);
-
- ProjectStart;
- WindowID(1);
- WindowPosition(TRWP_CENTERDISPLAY);
- WindowTitle('Gadgets');
- HorizGroupAC;
- Space;
- VertGroupA;
- Space;
- NamedSeparator('Gadget deactivate');
- Space;
- Button('_Button',ButtonGadID);
- Space;
- HorizGroupSC;
- Space;
- HorizGroup;
- TextID('_Gadget activ?',CheckGadID);
- Space;
- CheckBoxCLEFT(CheckGadID);
- EndGroup;
- Space;
- EndGroup;
- SpaceB;
- NamedSeparator('Pick value');
- Space;
- LineArray;
- BeginLine;
- TextID('Sc_roller',ScrollGadID);
- SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
- Space;
- SetTRTag(TROB_Scroller,TROF_HORIZ);
- SetTRTag(TRSC_Total,40);
- SetTRTag(TRSC_Visible,10);
- SetTRTag(TRAT_Value,5);
- SetTRTag(TRAT_ID,ScrollGadID);
- Space;
- ClippedTextBoxMW(pas2c('5'),ScrollGadTextID,2);
- EndLine;
- Space;
- BeginLine;
- TextID('S_lider',SlidGadID);
- SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
- Space;
- SliderGadget(1,50,25,SlidGadID);
- Space;
- ClippedTextBoxMW('25',SlidGadTextID,2);
- EndLine;
- Space;
- BeginLine;
- TextID('C_ycle',CycleGadID);
- SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
- Space;
- CycleGadget(@cyclestrings,0,CycleGadID);
- Space;
- ClippedTextBoxMW(cyclestrings[0],CycleGadTextID,5);
- EndLine;
- EndArray;
- SpaceB;
- NamedSeparator('Type some Text');
- Space;
- LineArray;
- BeginLine;
- TextID('_String',StringGadID);
- SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
- Space;
- StringGadget('Please change',StringGadID);
- GetEntryButton(EntryGadID);
- EndLine;
- Space;
- BeginLine;
- TextID('_Password',PassGadID);
- SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
- Space;
- PasswordGadget('',PassGadID);
- EndLine;
- EndArray;
- Space;
- EndGroup;
- Space;
- VertSeparator;
- Space;
- VertGroupAC;
- Space;
- NamedSeparatorI('C_hoose',MxGadID);
- Space;
- MXGadget(@mxstrings,4,MxGadID);
- Space;
- ClippedTextBox(mxstrings[4],MxGadTextID);
- SpaceB;
- NamedSeparatorI('D_oubleclick!',ListGadID);
- Space;
- ListSS(Mylist,ListGadID,0,0);
- 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 :
- BEGIN
- TR_LockProject(project);
- dummy := TR_EasyRequest(Triton_App,'%3Sure you want to end this demo?','Yes|No',NIL);
- TR_UnlockProject(project);
- IF dummy = 1 THEN quit := True;
- END;
-
- TRMS_NEWVALUE :
- BEGIN
- GadID := trmsg^.trm_ID;
- CASE GadID OF
-
- CheckGadID :
- BEGIN
- dummy := trmsg^.trm_Data;
- IF dummy = 1 THEN BEGIN
- TR_Disable(project,ButtonGadID);
- END ELSE BEGIN
- TR_Enable(project,ButtonGadID);
- TR_SetString(project,StringGadID,'hello test');
- END;
- END;
-
- ScrollGadID : TR_SetText(project,ScrollGadTextID,LongToStr(trmsg^.trm_Data));
-
- SlidGadID : TR_SetText(project,SlidGadTextID,LongToStr(trmsg^.trm_Data));
-
- CycleGadID : TR_SetText(project,CycleGadTextID,cyclestrings[trmsg^.trm_Data]);
-
- StringGadID : ;
-
- EntryGadID : ;
-
- PassGadID : ;
-
- MxGadID:
- BEGIN
- TR_SetText(project,MxGadTextID,mxstrings[trmsg^.trm_Data]);
- TR_SetValue(project,ListGadID,(trmsg^.trm_Data));
- END;
-
- ListGadID :
- BEGIN
- TR_SetValue(project,MxGadID,(trmsg^.trm_Data));
- TR_SetText(project,MxGadTextID,mxstrings[trmsg^.trm_Data]);
- END;
- END;
- END;
-
- TRMS_ACTION :
- BEGIN
- GadID := trmsg^.trm_ID;
- CASE GadID OF
-
- ButtonGadID :
- begin
- TR_LockProject(project);
- TR_EasyRequest(Triton_App,'You clicked on button ' + LongToStr(trmsg^.trm_ID),'_Aha',nil);
- TR_UnlockProject(Project);
- END;
-
- EntryGadID:
- BEGIN
- TR_LockProject(project);
- z := TR_EasyRequest(Triton_App,TR_GetSTRPTR(project,StringGadID),'OK',NIL);
- TR_UnlockProject(Project);
- END;
- END;
- END;
- ELSE
- END;
- END;
- TR_ReplyMsg(trmsg);
- END;
- UNTIL quit OR (trmsg = NIL);
- END;
- CleanExit('',0);
- END.
-
-
-