home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / OPTIMIZE / GLOBAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-12-07  |  4.7 KB  |  157 lines
  1. Attribute VB_Name = "Global"
  2. Option Explicit
  3. Public Const VBVer = "5.0"
  4. Public Const LastAppUpdate = "9/4/96"
  5.  
  6. Public Const WM_SYSCOMMAND = &H112
  7. Public Const SC_RESTORE = &HF120
  8. Public Const SWP_NOMOVE = 2
  9. Public Const SWP_NOSIZE = 1
  10. Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  11. Public Const HWND_TOPMOST = -1
  12. Public Const HWND_NOTOPMOST = -2
  13.  
  14. Public Const WM_SETREDRAW = &HB
  15.  
  16. ' Windows API calls for creating Topmost window
  17. Declare Function SetWindowPos Lib "User32" (ByVal h&, ByVal hb&, ByVal x&, ByVal y&, ByVal cx&, ByVal cy&, ByVal f&) As Long
  18. Declare Function FindWindow Lib "User32" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
  19. Declare Function SendMessage Lib "User32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  20.  
  21. Declare Function SetParent Lib "User32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  22.  
  23. Type BookAuthor
  24.     ID As Integer
  25.     Name As String * 25
  26. End Type
  27.  
  28. Dim arDemos(20) As String
  29.  
  30. Public Function SetRedraw(hWnd As Long, lState As Long) As Long
  31.   
  32.   Dim lRetVal As Long
  33.   
  34.   On Error GoTo SetRedraw_Error
  35.   ' Set iState = 0 to Disable automatic Updating
  36.   ' Set iState = 1 to Enable automatic updating
  37.   lRetVal = SendMessage(hWnd, WM_SETREDRAW, lState, 0)
  38.   If lRetVal <> False Then GoTo SetRedraw_Error
  39.   
  40.   SetRedraw = True
  41.   Exit Function
  42.   
  43. SetRedraw_Error:
  44.   SetRedraw = lRetVal
  45.   Exit Function
  46.   
  47. End Function
  48.  
  49. Public Function SetTopWindow(hWnd As Long, bState As Boolean) As Boolean
  50.       
  51.   If bState = True Then 'Put the window on top
  52.     SetTopWindow = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  53.   ElseIf bState = False Then ' Turn off the TopMost flag
  54.     SetTopWindow = SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  55.   Else
  56.     Debug.Print "bState Unknown."
  57.     SetTopWindow = False
  58.   End If
  59.   
  60. End Function
  61.  
  62. ' Centers the Form object passed to it.
  63. Sub CenterMe(frmForm As Form)
  64.   frmForm.Left = (Screen.Width - frmForm.Width) / 2
  65.   frmForm.Top = (Screen.Height - frmForm.Height) / 2
  66. End Sub
  67.  
  68. Sub Main()
  69.   Dim iCount As Integer
  70.   Dim iLimit As Integer
  71.   Dim tvwSample As TreeView
  72.   Dim nodRoot As Node
  73.   Dim nodX As Node
  74.   Dim sLastParent As String
  75.   Dim ilImages As ListImages
  76.   Dim iNextParentImage As Integer
  77.   
  78.   Set tvwSample = frmExplore.tvExample
  79.   Set ilImages = frmExplore.ilExplore.ListImages
  80.   
  81.   frmExplore.Show
  82.   
  83.   ' Display Speed Categories
  84.   arDemos(0) = "Algorithms"
  85.   arDemos(1) = "Display Speed"
  86.   arDemos(2) = "Paint Picture"
  87.   arDemos(3) = "Display Speed"
  88.   arDemos(4) = "Graphics"
  89.   arDemos(5) = "Display Speed"
  90.   
  91.   ' Real Speed Categories
  92.   arDemos(6) = "String Manipulation"
  93.   arDemos(7) = "Real Speed"
  94.   arDemos(8) = "Code Optimizations"
  95.   arDemos(9) = "Real Speed"
  96.   arDemos(10) = "Numeric Types"
  97.   arDemos(11) = "Real Speed"
  98.   
  99.   ' Resource Usage Categories
  100.   arDemos(12) = "Picture vs. Image"
  101.   arDemos(13) = "Resource Usage"
  102.   arDemos(14) = "Destroy Form Objects"
  103.   arDemos(15) = "Resource Usage"
  104.   
  105.   ' Apparent Speed Categories
  106.   arDemos(16) = "Splash Screen"
  107.   arDemos(17) = "Apparent Speed"
  108.     
  109.   ' Collection Categories
  110.   arDemos(18) = "Collections"
  111.   arDemos(19) = "Collections"
  112.   
  113.   Set nodRoot = tvwSample.Nodes.Add(, , "Root", "Optimizing Samples")
  114.   nodRoot.Image = 1
  115.   iNextParentImage = 2
  116.   'Set up the first Demo Type
  117.   'Create a new Demo Type off the Root and Make this node a child of it.
  118.   iCount = 0
  119.   sLastParent = arDemos(iCount + 1)
  120.   Set nodX = tvwSample.Nodes.Add("Root", tvwChild, sLastParent, arDemos(iCount + 1))
  121.   nodX.Image = iNextParentImage  'Display Speed
  122.   iNextParentImage = iNextParentImage + 1
  123.   'Make this node a child of the last Demo Type
  124.   Set nodX = tvwSample.Nodes.Add(sLastParent, tvwChild, , arDemos(iCount))
  125.   nodX.Image = 7
  126.   iLimit = UBound(arDemos)
  127.   For iCount = 2 To iLimit - 1 Step 2
  128.     If arDemos(iCount + 1) <> arDemos(iCount - 1) Then
  129.       nodX.EnsureVisible  ' Make sure all children are visible in the last group
  130.       'Create a new Demo Type off the Root and Make this node a child of it.
  131.       sLastParent = arDemos(iCount + 1)
  132.       Set nodX = tvwSample.Nodes.Add("Root", tvwChild, sLastParent, arDemos(iCount + 1))
  133.       nodX.Image = iNextParentImage
  134.       iNextParentImage = iNextParentImage + 1
  135.     End If
  136.     'Make this node a child of the last Demo Type
  137.     Set nodX = tvwSample.Nodes.Add(sLastParent, tvwChild, , arDemos(iCount))
  138.     nodX.Image = 7
  139.   Next iCount
  140.     
  141.   nodX.EnsureVisible
  142.   
  143.   ' Destroy all of the objects we have created.
  144.   Set nodX = Nothing
  145.   Set nodRoot = Nothing
  146.   Set ilImages = Nothing
  147.   Set tvwSample = Nothing
  148.  
  149. End Sub
  150.  
  151. Sub PosForm(frmForm As Form)
  152.   frmForm.Left = frmExplore.Left + frmExplore.Width
  153.   frmForm.Top = frmExplore.Top
  154. End Sub
  155.  
  156.  
  157.