string.pas 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273
  1. PROGRAM Stringtest;
  2. uses triton, tritonmacros, utility;
  3. {
  4. A demo in FPC Pascal using triton.library
  5. Updated for fpc 1.0.7
  6. 11 Jan 2003.
  7. [email protected]
  8. }
  9. VAR
  10. Project : pTR_Project;
  11. close_me : BOOLEAN;
  12. trmsg : pTR_Message;
  13. dummy : longint;
  14. App : pTR_App;
  15. begin
  16. App := TR_CreateAppTags([
  17. TRCA_Name,'Triton String Demo',
  18. TRCA_Release,'1.0',
  19. TRCA_Date,'03-06-1998',
  20. TAG_DONE]);
  21. if App <> nil then begin
  22. ProjectStart;
  23. WindowID(1);
  24. WindowTitle('String');
  25. VertGroupA;
  26. Space;
  27. HorizGroupAC;
  28. Space;
  29. TextID('_String',3);
  30. Space;
  31. StringGadget('Please change',3);
  32. Space;
  33. EndGroup;
  34. Space;
  35. EndGroup;
  36. EndProject;
  37. Project := TR_OpenProject(App,@tritontags);
  38. IF Project <> NIL THEN BEGIN
  39. close_me := FALSE;
  40. WHILE NOT close_me DO BEGIN
  41. dummy := TR_Wait(App,0);
  42. REPEAT
  43. trmsg := TR_GetMsg(App);
  44. IF trmsg <> NIL THEN BEGIN
  45. IF (trmsg^.trm_Project = Project) THEN BEGIN
  46. CASE trmsg^.trm_Class OF
  47. TRMS_CLOSEWINDOW : begin
  48. writeln('The text was: ',TR_GetString(Project,3));
  49. close_me := True;
  50. end;
  51. TRMS_ERROR: WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  52. TRMS_NEWVALUE : IF trmsg^.trm_ID = 3 then writeln('<RETURN> or <TAB> was pressed in stringgadget');
  53. END;
  54. END;
  55. TR_ReplyMsg(trmsg);
  56. END;
  57. UNTIL close_me OR (trmsg = NIL);
  58. END;
  59. TR_CloseProject(Project);
  60. end;
  61. TR_DeleteApp(App);
  62. END ELSE writeln('Can''t create application');
  63. end.