home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / code_lib / objlibr / objlib12 / sample2 / desk.bas next >
Encoding:
BASIC Source File  |  1995-06-05  |  6.7 KB  |  262 lines
  1. Option Explicit
  2. 'global variables
  3. Global nl$, tx%, ty%
  4. 'array of 'ListWindow' forms
  5. Global ListWin() As New ListWindow
  6. Global ListWinOpen%()
  7.  
  8. 'data for each item in the list
  9. 'each window will declare an array of this type
  10. Type ITEMDATA
  11.     cap As String           'description
  12.     cline As String         'command line
  13.     dir As String           'working dir
  14.     iconpath As String      '-
  15.     iconindex As Integer    '-
  16.     min As Integer          'run minimized
  17. End Type
  18.  
  19. Type PointAPI
  20.     x As Integer
  21.     y As Integer
  22. End Type
  23.  
  24. Type rect
  25.     left As Integer
  26.     top As Integer
  27.     right As Integer
  28.     bottom As Integer
  29. End Type
  30.  
  31. Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Long
  32. Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
  33. Declare Function SetWindowLong& Lib "User" (ByVal hWnd%, ByVal nIndex%, ByVal dwNewLong&)
  34.  
  35. Declare Function ShellExecute Lib "Shell.dll" (ByVal hWnd%, ByVal lpszOp$, ByVal lpszFile$, ByVal lpszParams As Any, ByVal lpszDir$, ByVal fsShowCnd%) As Integer
  36.  
  37. Sub GetIcon (file$, ndx%)
  38. Dim h%, r%, inst%
  39. inst% = GetWindowWord(mnu.hWnd, GWW_HINSTANCE)
  40. h% = ExtractIcon(inst%, file$, ndx%)
  41. mnu.loader.Cls
  42. If h% > 1 Then 'has icons
  43.     r% = DrawIcon(mnu.loader.hDC, 0, 0, h%)
  44. Else
  45.     mnu.loader = mnu.dosicon
  46. End If
  47. End Sub
  48.  
  49. Sub GetPMGroups ()
  50. Dim i%, s$, n%
  51. Dim items$()
  52. '
  53. GetPMLinkData "PROGMAN"
  54. s$ = mnu.txt
  55. '
  56. i = InStr(s$, nl)
  57.  
  58. 'get list of grps from PM
  59. Do While i
  60.     If n Mod 20 = 0 Then ReDim Preserve items(1 To n + 20)
  61.     n = n + 1
  62.     items(n) = Left$(s$, i - 1)
  63.     s$ = Mid$(s$, i + 2)
  64.     i = InStr(s$, nl)
  65. Loop 'Debug.Print n
  66.  
  67. 'load groups into menu
  68. If n > 0 Then
  69.     For i = 1 To n
  70.         Load mnu.zgroup(i)
  71.         mnu.zgroup(i).Caption = items(i)
  72.     Next
  73.     mnu.zgroup(0).Visible = 0
  74. End If
  75. End Sub
  76.  
  77. Sub GetPMItems (group$, pm As LISTDATA, items() As ITEMDATA)
  78. 'called by InitializeWin
  79. 'retrieves the items in a PM group and
  80. 'parses them into the item() array
  81. Dim s$(), t$
  82. Dim i%, x%, CT%, cap$, Temp$, y%
  83. Dim r1%, r2%
  84. ' get num of items in the program group
  85.     mnu.txt = ""
  86.       GetPMLinkData group$
  87.       Temp$ = mnu.txt
  88.       'Debug.Print temp
  89.       i% = InStr(Temp$, nl)
  90.       cap$ = Left$(Temp$, i% - 1)
  91.       cap$ = Trim(cap$)
  92.       
  93.       i% = InStr(cap$, ",")
  94.       i% = InStr(i% + 1, cap$, ",")
  95.       cap$ = Mid$(cap$, i% + 1)
  96.       pm.itemcount = Val(cap$)
  97.       Debug.Print pm.itemcount
  98.       If pm.itemcount < 1 Then Exit Sub
  99. ReDim items(1 To pm.itemcount)
  100. ReDim s$(1 To pm.itemcount)
  101. ' strip off 1st line of label
  102.       i% = InStr(Temp$, nl)
  103.       If i% Then
  104.         Temp$ = Mid$(Temp$, i% + 2)
  105.         i% = InStr(Temp$, nl)
  106.       End If
  107.       CT% = 1
  108. ' extract each item's data
  109. Do While i%
  110.     ' add item's data string to s()
  111.     s(CT%) = Left$(Temp$, InStr(Temp$, nl) - 1)
  112.      Temp$ = Mid$(Temp$, i% + 2)
  113.      i% = InStr(Temp$, nl)
  114.      CT% = CT% + 1
  115. Loop
  116. ' loop through s() getting the the item data
  117. For i% = 1 To pm.itemcount
  118.     'extract command line/work dir
  119.     t$ = s(i%)
  120.     'Debug.Print t
  121.     'get caption (strip quotes)
  122.     r1% = InStr(t$, ",")
  123.     cap$ = Left$(t$, r1% - 1)
  124.     items(i%).cap = Mid$(cap$, 2, Len(cap$) - 2)
  125.     'get cline (strip quotes)
  126.     r2% = InStr(r1% + 1, t$, ",")
  127.     cap$ = Mid$(t$, r1 + 2, r2 - 2 - (r1 + 1))
  128.     items(i%).cline = cap$
  129.     'get def dir
  130.     r1% = InStr(r2% + 1, t$, ",")
  131.     cap$ = Mid$(t$, r2% + 1, r1 - 1 - r2)
  132.     items(i%).dir = cap$
  133.     'get iconpath
  134.     r2% = InStr(r1% + 1, t$, ",")
  135.     cap$ = Mid$(t$, r1% + 1, r2 - 1 - r1)
  136.     items(i%).iconpath = cap$
  137.     'xpos
  138.     r1% = InStr(r2% + 1, t$, ",")
  139.     cap$ = Mid$(t$, r2% + 1, r1 - 1)
  140.     'items(i%).xpos = Val(cap$)
  141.     'ypos
  142.     r2% = InStr(r1% + 1, t$, ",")
  143.     cap$ = Mid$(t$, r1% + 1, r2 - 1)
  144.     'items(i%).ypos = Val(cap$)
  145.     'get icon index
  146.     r1% = InStr(r2% + 1, t$, ",")
  147.     cap$ = Mid$(t$, r2% + 1, r1 - 1 - r2)
  148.     items(i%).iconindex = Val(cap$)
  149.     'get min
  150.     cap$ = Mid$(t$, r2% + 1, 1)
  151.     items(i%).min = Val(cap$)
  152.     
  153. Next i%
  154.  
  155. End Sub
  156.  
  157. Sub GetPMLinkData (item$)
  158. On Error Resume Next
  159. mnu.txt.LinkItem = item$
  160. mnu.txt.LinkMode = 2
  161. mnu.txt.LinkRequest
  162. mnu.txt.LinkMode = 0
  163. End Sub
  164.  
  165. Sub gItemClear ()
  166. gItem.cap = ""
  167. gItem.cline = ""
  168. gItem.dir = ""
  169. gItem.iconpath = ""
  170. gItem.iconindex = 0
  171. gItem.min = 0
  172. End Sub
  173.  
  174. Function launch% (F As Form, item As ITEMDATA)
  175. Dim s$, m%, t$, r%
  176. Dim hWnd%, state%
  177. Dim cnclform%
  178. 'check min param
  179. If item.min < 1 Or item.min > 9 Then state% = 5 Else state% = item.min
  180. 'check if the file can be found
  181. s$ = Trim$(item.cline)
  182. 'launch w/ vb
  183. On Error GoTo shellerr
  184. r = Shell(s$, state%)
  185. r = DoEvents()
  186. launch = -1
  187. screen.MousePointer = 0
  188. Exit Function
  189. '--------------------------------------------------------------
  190. shellerr:
  191.     screen.MousePointer = 0
  192.     'try api instead
  193.     r% = ShellExecute(F.hWnd, "Open", s$, 0&, item.dir, state%)
  194.     If r% < 32 Then
  195.     MsgBox "Can't launch" & nl & item.cline + nl + Error(Err), 64, "LAUNCH ERROR"
  196.     Else
  197.     Exit Function
  198.     End If
  199. Exit Function
  200. '
  201. End Function
  202.  
  203. Function LoadListWindow (Caption$, index%)
  204. Static totalwindows%
  205. Dim i%, ndx%
  206. 'see if its already open
  207. Debug.Print "totalwindows=" & totalwindows: Debug.Print "caption=" & Caption$
  208.  
  209. If index% > 0 Then 'close the window
  210.     Debug.Print "Closing " & index%
  211.     totalwindows = totalwindows - 1
  212.     Debug.Print Caption
  213.     ListWinOpen(index%) = 0
  214. Else 'open a new win
  215.     If totalwindows Then
  216.     Debug.Print "ubound(ListWin)=" & UBound(ListWin)
  217.     For i = 1 To UBound(ListWin)
  218.         If ListWinOpen(i) Then
  219.         'Debug.Print "i=" & i
  220.         'Debug.Print "ListWin(i).cap=" & ListWin(i).caption
  221.         If ListWin(i).Caption = Caption$ Then
  222.             'show it, it may be in iconbar
  223.             'to_do
  224.             MsgBox "already loaded"
  225.             Exit Function
  226.         End If
  227.         End If
  228.     Next
  229.     End If
  230.     'find unused index
  231.     If totalwindows Then
  232.     Debug.Print "ubound(ListWin)=" & UBound(ListWin)
  233.     For i% = 1 To UBound(ListWin)
  234.         If ListWinOpen(i%) = 0 Then
  235.             ndx% = i%
  236.             Debug.Print "unused index=" & ndx
  237.             Exit For
  238.         End If
  239.     Next
  240.     End If
  241.     'if no unused slots, expand array
  242.     If ndx% = 0 Then
  243.         totalwindows = totalwindows + 1
  244.         ReDim Preserve ListWin(1 To totalwindows)
  245.         ReDim Preserve ListWinOpen(1 To totalwindows)
  246.         ndx% = totalwindows
  247.         Debug.Print "expanding array=" & ndx
  248.     End If
  249.     Debug.Print "Opening" & ndx
  250.     '
  251.     ListWinOpen(ndx%) = -1
  252.     'pass the window its caption:
  253.     
  254.     gItem.cap = Caption$
  255.     'load form, pass the window its index:
  256.     ListWin(ndx%).Tag = ndx%
  257.     ListWin(ndx%).Show
  258. End If
  259.  
  260. End Function
  261.  
  262.