home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / app / tfile.x < prev    next >
Encoding:
Text File  |  1995-08-11  |  4.6 KB  |  144 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. PROGRAM "tfile"
  7. VERSION "0.0000"
  8. '
  9. IMPORT  "xst"
  10. IMPORT  "xgr"
  11. IMPORT  "xui"
  12. '
  13. INTERNAL FUNCTION  File            ( )
  14. INTERNAL FUNCTION  GetDisplayGrid  ( @label )
  15. INTERNAL FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  16. '
  17. '
  18. ' ##################
  19. ' #####  File  #####
  20. ' ##################
  21. '
  22. FUNCTION  File ()
  23.   STATIC  label
  24.   $XuiFile = 29
  25. '
  26.   GetDisplayGrid ( @label )
  27. '
  28. ' create window with XuiFile grid
  29. '
  30.   XuiCreateWindow      (@grid, @"XuiFile", 100, 256, 256, 128, 0, "")
  31.   XuiSendStringMessage ( grid, @"SetCallback", grid, &XuiQueueCallbacks(), -1, -1, $XuiFile, -1)
  32.   XuiSendStringMessage ( grid, @"SetGridName", 0, 0, 0, 0, 0, @"File")
  33.   XuiSendStringMessage ( grid, @"SetTextString", 0, 0, 0, 0, 1, @"XuiFile")
  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.   END SELECT
  56. END SUB
  57. '
  58. ' Selection message
  59. '
  60. SUB Selection
  61.   IF (v0 < 0) THEN
  62.     file$ = "cancel"
  63.   ELSE
  64.     xx$ = ""
  65.     attributes = 0
  66.     XuiSendStringMessage (grid, @"GetTextString", 0, 0, 0, 0, 2, @file$)
  67.     IF file$ THEN XstGetFileAttributes (@file$, @attributes)
  68.     IFZ attributes THEN
  69.       xx$ = xx$ + " $$FileNonexistent"
  70.     ELSE
  71.       SELECT CASE ALL TRUE
  72.         CASE (attributes AND $$FileReadOnly)    : xx$ = xx$ + " $$FileReadOnly"
  73.         CASE (attributes AND $$FileHidden)      : xx$ = xx$ + " $$FileHidden"
  74.         CASE (attributes AND $$FileSystem)      : xx$ = xx$ + " $$FileSystem"
  75.         CASE (attributes AND $$FileDirectory)   : xx$ = xx$ + " $$FileDirectory"
  76.         CASE (attributes AND $$FileArchive)     : xx$ = xx$ + " $$FileArchive"
  77.         CASE (attributes AND $$FileNormal)      : xx$ = xx$ + " $$FileNormal"
  78.         CASE (attributes AND $$FileTemporary)   : xx$ = xx$ + " $$FileTemporary"
  79.         CASE (attributes AND $$FileAtomicWrite) : xx$ = xx$ + " $$FileAtomicWrite"
  80.         CASE (attributes AND $$FileExecutable)  : xx$ = xx$ + " $$FileExecutable"
  81.       END SELECT
  82.     END IF
  83.   END IF
  84. '
  85.   text$ = "XuiFile\n"
  86.   text$ = text$ + "    grid = " + HEX$ (grid, 8) + "\n"
  87.   text$ = text$ + " message = " + message$ + "\n"
  88.   text$ = text$ + "      v0 = " + HEX$ (v0,8) + "   : " + file$ + "\n"
  89.   text$ = text$ + "      v1 = " + HEX$ (v1,8) + "   :" + xx$ + "\n"
  90.   text$ = text$ + "      v2 = " + HEX$ (v2,8) + "\n"
  91.   text$ = text$ + "      v3 = " + HEX$ (v3,8) + "\n"
  92.   text$ = text$ + "     kid = " + HEX$ (kid,8) + "\n"
  93.   text$ = text$ + "     r1$ = " + r1$
  94.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)    ' set message text
  95.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)                ' redraw label
  96. END SUB
  97. END FUNCTION
  98. '
  99. '
  100. ' ###############################
  101. ' #####  GetDisplayGrid ()  #####
  102. ' ###############################
  103. '
  104. FUNCTION  GetDisplayGrid ( label )
  105.   STATIC  grid
  106. '
  107.   IFZ grid THEN
  108.     XuiCreateWindow      (@grid, @"XuiLabel", 100, 100, 512, 128, 0, "")
  109.     XuiSendStringMessage ( grid, @"SetColor", $$BrightGreen, -1, -1, -1, 0, 0)
  110.     XuiSendStringMessage ( grid, @"SetAlign", $$AlignUpperLeft, 0, 0, 0, 0, 0)
  111.     XuiSendStringMessage ( grid, @"SetJustify", $$JustifyLeft, 0, 0, 0, 0, 0)
  112.     XuiSendStringMessage ( grid, @"SetIndent", 6, 4, 0, 0, 0, 0)
  113.     XuiSendStringMessage ( grid, @"DisplayWindow", 0, 0, 0, 0, 0, 0)
  114.   END IF
  115. '
  116.   label = grid
  117. END FUNCTION
  118. '
  119. '
  120. ' ################################
  121. ' #####  DisplayCallback ()  #####
  122. ' ################################
  123. '
  124. FUNCTION  DisplayCallback ( grid, message$, v0, v1, v2, v3, kid, r1$ )
  125. '
  126.   XgrGetGridType (grid, @gridType)
  127.   XgrGridTypeNumberToName (gridType, @gridType$)
  128. '
  129.   text$ = gridType$ + "\n"
  130.   text$ = text$ + "    grid = " + HEX$ (grid, 8) + "\n"
  131.   text$ = text$ + " message = " + message$ + "\n"
  132.   text$ = text$ + "      v0 = " + HEX$ (v0,8) + "\n"
  133.   text$ = text$ + "      v1 = " + HEX$ (v1,8) + "\n"
  134.   text$ = text$ + "      v2 = " + HEX$ (v2,8) + "\n"
  135.   text$ = text$ + "      v3 = " + HEX$ (v3,8) + "\n"
  136.   text$ = text$ + "     kid = " + HEX$ (kid,8) + "\n"
  137.   text$ = text$ + "     r1$ = " + r1$
  138. '
  139.   GetDisplayGrid (@label)
  140.   XuiSendStringMessage (label, @"SetTextString", 0, 0, 0, 0, 0, @text$)
  141.   XuiSendStringMessage (label, @"Redraw", 0, 0, 0, 0, 0, 0)
  142. END FUNCTION
  143. END PROGRAM