toolmanager1.pas 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160
  1. Program ToolManager1;
  2. (*
  3. * OpenTriton -- A free release of the triton.library source code
  4. * Copyright (C) 1993-1998 Stefan Zeiger
  5. *
  6. * This program is free software; you can redistribute it and/or modify
  7. * it under the terms of the GNU General Public License as published by
  8. * the Free Software Foundation; either version 2 of the License, or
  9. * (at your option) any later version.
  10. *
  11. * This program is distributed in the hope that it will be useful,
  12. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. * GNU General Public License for more details.
  15. *
  16. * You should have received a copy of the GNU General Public License
  17. * along with this program; if not, write to the Free Software
  18. * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  19. * MA 02110-1301, USA.
  20. *
  21. * Toolmanager1.c - Looks like the original ToolManager
  22. *
  23. *)
  24. {
  25. A demo in FPC Pascal using triton.library
  26. Updated for fpc 1.0.7
  27. 11 Jan 2003.
  28. [email protected]
  29. }
  30. uses exec, triton, tritonmacros, amigalib, utility, linklist;
  31. const
  32. cycle_entries : array [0..7] of PChar = ('Exec','Image','Sound','Menu','Icon','Dock','Access',NIL);
  33. liststrings : array [0..8] of PChar = (
  34. '2024view' ,
  35. 'Add to archive',
  36. 'Delete',
  37. 'Edit text',
  38. 'Env',
  39. 'Exchange',
  40. 'Global Help System',
  41. 'Multiview',
  42. 'Paint');
  43. var
  44. i : Longint;
  45. LVList : pList;
  46. MyNode : pFPCNode;
  47. Triton_App : pTR_App;
  48. procedure CleanUp(why : string; err : longint);
  49. begin
  50. if assigned(Triton_App) then TR_DeleteApp(Triton_App);
  51. if assigned(LVList) then DestroyList(LVList);
  52. if why <> '' then writeln(why);
  53. halt(err);
  54. end;
  55. begin
  56. CreateList(LVList);
  57. FOR i := 0 TO 8 DO BEGIN
  58. MyNode := AddNewNode(LVList,liststrings[i]);
  59. END;
  60. Triton_App := TR_CreateAppTags([
  61. TRCA_Name,'ToolManagerGUIDemo1',
  62. TRCA_LongName,'ToolManager GUI demo 1',
  63. TRCA_Info,'Looks like the original ToolManager',
  64. TAG_END]);
  65. if Triton_App = nil then CleanUp('Can''t create application',20);
  66. ProjectStart;
  67. WindowID(0); WindowPosition(TRWP_BELOWTITLEBAR);
  68. WindowTitle('ToolManager GUI demo 1'); WindowFlags(TRWF_NOSIZEGADGET OR TRWF_NODELZIP OR TRWF_NOZIPGADGET OR TRWF_NOESCCLOSE);
  69. WindowBackfillNone;
  70. VertGroupA;
  71. Space;
  72. HorizGroupAC;
  73. Space;
  74. TextID('_Object Type',1);
  75. Space;
  76. CycleGadget(@cycle_entries,0,1);
  77. Space;
  78. EndGroup;
  79. Space;
  80. HorizGroupAC;
  81. Space;
  82. VertGroupAC;
  83. CenteredTextID('Object List',2);
  84. Space;
  85. ListSSCN(LVList,2,0,0);
  86. EndGroup;
  87. Space;
  88. VertGroupA;
  89. TextN('');
  90. Space;
  91. Button('Top',3);
  92. Space;
  93. Button('Up',4);
  94. Space;
  95. Button('Down',5);
  96. Space;
  97. Button('Bottom',6);
  98. Space;
  99. Button('So_rt',7);
  100. EndGroup;
  101. Space;
  102. EndGroup;
  103. Space;
  104. HorizGroupEA;
  105. Space;
  106. Button('_New...',8);
  107. Space;
  108. Button('_Edit...',9);
  109. Space;
  110. Button('Co_py',10);
  111. Space;
  112. Button('Remove',11);
  113. Space;
  114. EndGroup;
  115. Space;
  116. HorizGroupEA;
  117. Space;
  118. Button('_Save',12);
  119. Space;
  120. Button('_Use',13);
  121. Space;
  122. Button('_Test',14);
  123. Space;
  124. Button('_Cancel',15);
  125. Space;
  126. EndGroup;
  127. Space;
  128. EndGroup;
  129. EndProject;
  130. i := TR_AutoRequest(Triton_App,NIL,@tritontags);
  131. CleanUp('',0);
  132. end.