home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / app / tmenu.x < prev    next >
Encoding:
Text File  |  1995-08-11  |  4.8 KB  |  160 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. PROGRAM "tmenu"
  7. VERSION "0.0000"
  8. '
  9. IMPORT  "xst"
  10. IMPORT  "xgr"
  11. IMPORT  "xui"
  12. '
  13. INTERNAL FUNCTION  Menu            ( )
  14. INTERNAL FUNCTION  GetDisplayGrid  ( @label )
  15. INTERNAL FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  16. '
  17. '
  18. ' ##################
  19. ' #####  Menu  #####
  20. ' ##################
  21. '
  22. FUNCTION  Menu ()
  23.   $XuiMenu = 12
  24. '
  25.   GetDisplayGrid ( @label )
  26. '
  27. ' create window with XuiMenu grid
  28. '
  29.   DIM menu$[15]             ' callback arguments
  30.   menu$[ 0] = "_File"
  31.   menu$[ 1] = " _Load"      ' v0 = 1 : v1 = 0
  32.   menu$[ 2] = " _Save"      ' v0 = 1 : v1 = 1
  33.   menu$[ 3] = " _Quit"      ' v0 = 1 : v1 = 2
  34.   menu$[ 4] = "_Edit"
  35.   menu$[ 5] = " _Cut"       ' v0 = 2 : v1 = 0
  36.   menu$[ 6] = " _Grab"      ' v0 = 2 : v1 = 1
  37.   menu$[ 7] = " _Paste"     ' v0 = 2 : v1 = 2
  38.   menu$[ 8] = "_View"
  39.   menu$[ 9] = " _First"     ' v0 = 3 : v1 = 0
  40.   menu$[10] = " _Last"      ' v0 = 3 : v1 = 1
  41.   menu$[11] = " _All"       ' v0 = 3 : v1 = 2
  42.   menu$[12] = "_Help"
  43.   menu$[13] = " _Contents"  ' v0 = 4 : v1 = 0
  44.   menu$[14] = " _Summary"   ' v0 = 4 : v1 = 1
  45.   menu$[15] = " _Index"     ' v0 = 4 : v1 = 2
  46. '
  47.   XuiCreateWindow      (@grid, @"XuiMenu", 100, 256, 256, 24, 0, "")
  48.   XuiSendStringMessage ( grid, @"SetCallback", grid, &XuiQueueCallbacks(), -1, -1, $XuiMenu, -1)
  49.   XuiSendStringMessage ( grid, @"SetGridName", 0, 0, 0, 0, 0, @"Menu")
  50.   XuiSendStringMessage ( grid, @"SetTextArray", 0, 0, 0, 0, 0, @menu$[])
  51.   XuiSendStringMessage ( grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  52. '
  53. ' convenience function message loop
  54. '
  55.   DO
  56.     XgrProcessMessages (1)
  57.     DO WHILE XuiGetNextCallback (@grid, @message$, @v0, @v1, @v2, @v3, @kid, @r1$)
  58.       GOSUB Callback
  59.     LOOP
  60.   LOOP
  61.   RETURN
  62. '
  63. ' callback
  64. '
  65. SUB Callback
  66.   win = kid >> 16
  67.   kid = kid AND 0xFF
  68.   SELECT CASE message$
  69.     CASE "CloseWindow" : QUIT (0)
  70.     CASE "Selection"   : GOSUB Selection
  71.     CASE ELSE          : DisplayCallback (grid, @message$, v0, v1, v2, v3, kid, @r1$)
  72.   END SELECT
  73. END SUB
  74. '
  75. ' Selection message
  76. '
  77. SUB Selection
  78.   XuiSendStringMessage (grid, @"GetTextArray", 0, 0, 0, 0, 0, @text$[])
  79.   IF text$[] THEN
  80.     u = UBOUND (text$[])
  81.     menubar = 0
  82.     FOR i = 0 TO u
  83.       text$ = text$[i]
  84.       IF text$ THEN
  85.         char = text${0}
  86.         IF ((char != ' ') AND (char != '    ')) THEN    ' not tab or space
  87.           INC menubar
  88.           IF (menubar = v0) THEN header = i : EXIT FOR
  89.         END IF
  90.       END IF
  91.     NEXT i
  92.     IF (v0 = menubar) THEN
  93.       menu$ = text$[header]
  94.       list = header + v1 + 1
  95.       IF (list <= u) THEN list$ = text$[list]
  96.       v0$ = " : Menu entry : \"" + menu$ + "\""
  97.       v1$ = " : List entry : \"" + list$ + "\""
  98.     END IF
  99.   END IF
  100. '
  101.   text$ = "XuiMenu"
  102.   text$ = text$ + "\n    grid = " + HEX$ (grid,8)
  103.   text$ = text$ + "\n message = " + message$
  104.   text$ = text$ + "\n   state = " + HEX$ (v0,8) + v0$
  105.   text$ = text$ + "\n      v1 = " + HEX$ (v1,8) + v1$
  106.   text$ = text$ + "\n      v2 = " + HEX$ (v2,8)
  107.   text$ = text$ + "\n      v3 = " + HEX$ (v3,8)
  108.   text$ = text$ + "\n     kid = " + HEX$ (kid,8)
  109.   text$ = text$ + "\n     r1$ = " + r1$
  110.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)    ' set message text
  111.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)                ' redraw label
  112. END SUB
  113. END FUNCTION
  114. '
  115. '
  116. ' ###############################
  117. ' #####  GetDisplayGrid ()  #####
  118. ' ###############################
  119. '
  120. FUNCTION  GetDisplayGrid ( label )
  121.   STATIC  grid
  122. '
  123.   IFZ grid THEN
  124.     XuiCreateWindow      (@grid, @"XuiLabel", 100, 100, 512, 128, 0, "")
  125.     XuiSendStringMessage ( grid, @"SetColor", $$BrightGreen, -1, -1, -1, 0, 0)
  126.     XuiSendStringMessage ( grid, @"SetAlign", $$AlignUpperLeft, 0, 0, 0, 0, 0)
  127.     XuiSendStringMessage ( grid, @"SetJustify", $$JustifyLeft, 0, 0, 0, 0, 0)
  128.     XuiSendStringMessage ( grid, @"SetIndent", 6, 4, 0, 0, 0, 0)
  129.     XuiSendStringMessage ( grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  130.   END IF
  131. '
  132.   label = grid
  133. END FUNCTION
  134. '
  135. '
  136. ' ################################
  137. ' #####  DisplayCallback ()  #####
  138. ' ################################
  139. '
  140. FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  141. '
  142.   XgrGetGridType (grid, @gridType)
  143.   XgrGridTypeNumberToName (gridType, @gridType$)
  144. '
  145.   text$ = gridType$ + "\n"
  146.   text$ = text$ + "    grid = " + HEX$ (grid, 8) + "\n"
  147.   text$ = text$ + " message = " + message$ + "\n"
  148.   text$ = text$ + "      v0 = " + HEX$ (v0,8) + "\n"
  149.   text$ = text$ + "      v1 = " + HEX$ (v1,8) + "\n"
  150.   text$ = text$ + "      v2 = " + HEX$ (v2,8) + "\n"
  151.   text$ = text$ + "      v3 = " + HEX$ (v3,8) + "\n"
  152.   text$ = text$ + "     kid = " + HEX$ (kid,8) + "\n"
  153.   text$ = text$ + "     r1$ = " + r1$
  154. '
  155.   GetDisplayGrid (@label)
  156.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)
  157.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)
  158. END FUNCTION
  159. END PROGRAM