home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / app / tprog.x < prev    next >
Text File  |  1995-08-11  |  4KB  |  125 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. PROGRAM "tprog"
  7. VERSION "0.0000"
  8. '
  9. IMPORT  "xst"
  10. IMPORT  "xgr"
  11. IMPORT  "xui"
  12. '
  13. INTERNAL FUNCTION  Progress        ( )
  14. INTERNAL FUNCTION  GetDisplayGrid  ( @label )
  15. INTERNAL FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  16. '
  17. '
  18. ' ######################
  19. ' #####  Progress  #####
  20. ' ######################
  21. '
  22. FUNCTION  Progress ()
  23.   $XuiProgress = 20
  24. '
  25.   delta = 2
  26.   GetDisplayGrid ( @label )
  27. '
  28. ' create window with XuiProgress grid
  29. '
  30.   XuiCreateWindow      (@grid, @"XuiProgress", 100, 256, 200, 80, 0, "")
  31.   XuiSendStringMessage ( grid, @"SetCallback", grid, &XuiQueueCallbacks(), -1, -1, $XuiProgress, -1)
  32.   XuiSendStringMessage ( grid, @"SetGridName", 0, 0, 0, 0, 0, @"Progress")
  33.   XuiSendStringMessage ( grid, @"SetValues", 50, 100, 0, 0, 0, 0)
  34.   XuiSendStringMessage ( grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  35. '
  36. ' convenience function message loop
  37. '
  38.   DO
  39.     XgrProcessMessages (1)
  40.     DO WHILE XuiGetNextCallback (@grid, @message$, @v0, @v1, @v2, @v3, @kid, @r1$)
  41.       GOSUB Callback
  42.     LOOP
  43.   LOOP
  44.   RETURN
  45. '
  46. ' callback
  47. '
  48. SUB Callback
  49.   win = kid >> 16
  50.   kid = kid AND 0xFF
  51.   SELECT CASE message$
  52.     CASE "CloseWindow" : QUIT (0)
  53.     CASE "Selection"   : GOSUB Selection
  54.     CASE ELSE          : DisplayCallback (grid, @message$, v0, v1, v2, v3, kid, @r1$)
  55.                          XuiSendStringMessage (grid, @"GetValues", @v0, @v1, 0, 0, 0, 0)
  56.                          v0 = v0 + delta
  57.                          IF (v0 > 100) THEN v0 = v0 - delta - delta : delta = -delta
  58.                          IF (v0 < 0) THEN v0 = v0 - delta - delta : delta = -delta
  59.                          XuiSendStringMessage (grid, @"SetValues", v0, v1, 0, 0, 0, 0)
  60.   END SELECT
  61. END SUB
  62. '
  63. ' Selection message
  64. '
  65. SUB Selection
  66.   text$ = "XuiProgress"
  67.   text$ = text$ + "\n    grid = " + HEX$ (grid,8)
  68.   text$ = text$ + "\n message = " + message$
  69.   text$ = text$ + "\n   state = " + HEX$ (v0,8) + v0$
  70.   text$ = text$ + "\n      v1 = " + HEX$ (v1,8)
  71.   text$ = text$ + "\n      v2 = " + HEX$ (v2,8)
  72.   text$ = text$ + "\n      v3 = " + HEX$ (v3,8)
  73.   text$ = text$ + "\n     kid = " + HEX$ (kid,8)
  74.   text$ = text$ + "\n     r1$ = " + r1$
  75.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)    ' set message text
  76.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)                ' redraw label
  77. END SUB
  78. END FUNCTION
  79. '
  80. '
  81. ' ###############################
  82. ' #####  GetDisplayGrid ()  #####
  83. ' ###############################
  84. '
  85. FUNCTION  GetDisplayGrid ( label )
  86.   STATIC  grid
  87. '
  88.   IFZ grid THEN
  89.     XuiCreateWindow      (@grid, @"XuiLabel", 100, 100, 512, 128, 0, "")
  90.     XuiSendStringMessage ( grid, @"SetColor", $$BrightGreen, -1, -1, -1, 0, 0)
  91.     XuiSendStringMessage ( grid, @"SetAlign", $$AlignUpperLeft, 0, 0, 0, 0, 0)
  92.     XuiSendStringMessage ( grid, @"SetJustify", $$JustifyLeft, 0, 0, 0, 0, 0)
  93.     XuiSendStringMessage ( grid, @"SetIndent", 6, 4, 0, 0, 0, 0)
  94.     XuiSendStringMessage ( grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  95.   END IF
  96. '
  97.   label = grid
  98. END FUNCTION
  99. '
  100. '
  101. ' ################################
  102. ' #####  DisplayCallback ()  #####
  103. ' ################################
  104. '
  105. FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  106. '
  107.   XgrGetGridType (grid, @gridType)
  108.   XgrGridTypeNumberToName (gridType, @gridType$)
  109. '
  110.   text$ = gridType$ + "\n"
  111.   text$ = text$ + "   grid = " + HEX$ (grid, 8) + "\n"
  112.   text$ = text$ + "message = " + message$ + "\n"
  113.   text$ = text$ + "     v0 = " + HEX$ (v0,8) + "\n"
  114.   text$ = text$ + "     v1 = " + HEX$ (v1,8) + "\n"
  115.   text$ = text$ + "     v2 = " + HEX$ (v2,8) + "\n"
  116.   text$ = text$ + "     v3 = " + HEX$ (v3,8) + "\n"
  117.   text$ = text$ + "    kid = " + HEX$ (kid,8) + "\n"
  118.   text$ = text$ + "    r1$ = " + r1$
  119. '
  120.   GetDisplayGrid (@label)
  121.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)
  122.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)
  123. END FUNCTION
  124. END PROGRAM