home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 27 / CDROM27.iso / share / progra / mai / coolbar.bas < prev    next >
Encoding:
BASIC Source File  |  1997-07-13  |  10.0 KB  |  283 lines
  1. Attribute VB_Name = "xGlobal"
  2. Option Explicit
  3. Public giTwipsX              As Integer
  4. Public giTwipsY              As Integer
  5.  
  6. Public giTbarButton          As Integer     '/ Holds index of toolbar button
  7. Public ghTbarPrevWindow      As Long        '/ Handle for previous button
  8. Public glTbarOutLeft()       As Long        '/ Position of outline, left
  9. Public glTbarOutTop()        As Long        '/ Position of outline, top
  10. Public glTbarOutRight()      As Long        '/ Position of outline, right
  11. Public glTbarOutBtm()        As Long        '/ Position of outline, bottom
  12.  
  13. Public gbThlpActive          As Boolean     '/ Flag for active state
  14. Public gbThlpShowNextTime    As Boolean     '/ Flag for showing help the next time
  15. Public giThlpWait            As Integer     '/ Waiting time in milliseconds
  16. Public glThlpBackColor       As Long        '/ Background color
  17. Public glThlpShadowTop       As Long        '/ Top shadow color
  18. Public glThlpShadowBtm       As Long        '/ Bottom shadow color
  19. Public gbTbarPrevWindow      As Long        '/ Handle for previous button
  20.    
  21. Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  22. Declare Function GetActiveWindow Lib "user32" () As Long
  23. Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  24. Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  25. Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  26.  
  27. Public Const SW_SHOWNOACTIVATE = 4
  28.    
  29.    Type POINTAPI
  30.       x As Long
  31.       y As Long
  32.    End Type
  33.  
  34. Type RECT
  35.     Left    As Long
  36.     Top     As Long
  37.     Right   As Long
  38.     Bottom  As Long
  39. End Type
  40.    
  41.  
  42. Public Sub Toolhelp(frm As Form, strHelp As String)
  43.    Dim iRtn        As Integer
  44.    Dim Point       As POINTAPI
  45.    
  46.    frm.BackColor = glThlpBackColor
  47.    frm.lblHelp.BackColor = glThlpBackColor
  48.    
  49.    If Len(strHelp) Then
  50.  
  51.       frm.Hide
  52.       
  53.       frm.lblHelp.Caption = " " & strHelp & " "
  54.  
  55.       Call GetCursorPos(Point)
  56.       frm.Left = (Point.x - 2) * giTwipsX
  57.       frm.Top = (Point.y + 18) * giTwipsY
  58.  
  59.       frm.Width = frm.lblHelp.Width + 4 * giTwipsX
  60.       frm.Height = frm.lblHelp.Height + 5 * giTwipsY
  61.  
  62.       '/ Draw left shadow
  63.       frm.linBorder(0).BorderColor = glThlpShadowTop
  64.       frm.linBorder(0).X1 = 0
  65.       frm.linBorder(0).Y1 = 0
  66.       frm.linBorder(0).X2 = 0
  67.       frm.linBorder(0).Y2 = frm.ScaleHeight - giTwipsY
  68.       '/ Draw top shadow
  69.       frm.linBorder(1).BorderColor = glThlpShadowTop
  70.       frm.linBorder(1).X1 = 0
  71.       frm.linBorder(1).Y1 = 0
  72.       frm.linBorder(1).X2 = frm.ScaleWidth
  73.       frm.linBorder(1).Y2 = 0
  74.       '/ Draw right shadow
  75.       frm.linBorder(2).BorderColor = glThlpShadowBtm
  76.       frm.linBorder(2).X1 = frm.ScaleWidth - giTwipsX
  77.       frm.linBorder(2).Y1 = giTwipsY
  78.       frm.linBorder(2).X2 = frm.ScaleWidth - giTwipsX
  79.       frm.linBorder(2).Y2 = frm.ScaleHeight
  80.       '/ Draw bottom shadow
  81.       frm.linBorder(3).BorderColor = glThlpShadowBtm
  82.       frm.linBorder(3).X1 = 0
  83.       frm.linBorder(3).Y1 = frm.ScaleHeight - giTwipsY
  84.       frm.linBorder(3).X2 = frm.ScaleWidth - giTwipsX
  85.       frm.linBorder(3).Y2 = frm.ScaleHeight - giTwipsY
  86.       
  87.       frm.ZOrder
  88.  
  89.       iRtn = ShowWindow(frm.hwnd, SW_SHOWNOACTIVATE)
  90.    Else
  91.        frm.Hide
  92.    End If
  93.    
  94. End Sub
  95.  
  96. Public Sub Toolbar97Setup(frm As Form, iNoOfIcons As Integer, Optional ctlLogo As Variant)
  97.    Dim iCnt    As Integer
  98.    Dim iPosX   As Integer
  99.    Dim lRtn    As Long
  100.    Dim iHeight As Integer
  101.    Dim Icon97  As RECT
  102.    
  103.    frm.AutoRedraw = True
  104.       
  105.    frm.Line (0, 0)-(frm.ScaleWidth - giTwipsX, 0), &H808080
  106.    
  107.    iHeight = frm.picToolIcons(0).Height + 4
  108.    frm.Line (0, giTwipsY)-(frm.ScaleWidth - giTwipsX, giTwipsY), &HFFFFFF
  109.    frm.Line -(frm.ScaleWidth - giTwipsX, iHeight + (8 * giTwipsY)), &H808080
  110.    frm.Line -(0, iHeight + (8 * giTwipsY)), &H808080
  111.    frm.Line -(0, 0), &HFFFFFF
  112.    
  113.    iPosX = 6
  114.    For iCnt = 0 To 1
  115.       frm.Line (iPosX * giTwipsX, 3 * giTwipsY)-(iPosX * giTwipsX, iHeight + (6 * giTwipsY)), &H808080
  116.       frm.Line -((iPosX - 2) * giTwipsX, iHeight + (6 * giTwipsY)), &H808080
  117.       frm.Line ((iPosX - 2) * giTwipsX, iHeight + (6 * giTwipsY))-((iPosX - 2) * giTwipsX, 3 * giTwipsY), &HFFFFFF
  118.       frm.Line -(iPosX * giTwipsX, 3 * giTwipsY), &HFFFFFF
  119.       iPosX = iPosX + 3
  120.    Next
  121.    
  122.    iPosX = 14 * giTwipsX
  123.    If iNoOfIcons Then
  124.       For iCnt = 0 To iNoOfIcons - 1
  125.          
  126.          If Left(frm.picToolIcons(iCnt).Tag, 1) = "<" Then
  127.             frm.Line (iPosX, 2 * giTwipsY)-(iPosX, iHeight + (6 * giTwipsY)), &H808080
  128.             frm.Line (iPosX + giTwipsX, 2 * giTwipsY)-(iPosX + giTwipsX, iHeight + (6 * giTwipsY)), &HFFFFFF
  129.             iPosX = iPosX + 6 * giTwipsX
  130.          End If
  131.          
  132.          frm.picToolIcons(iCnt).Top = 5 * giTwipsY
  133.          frm.picToolIcons(iCnt).Left = iPosX
  134.          iPosX = iPosX + frm.picToolIcons(iCnt).Width + 4 * giTwipsX
  135.          
  136.          If Left(frm.picToolIcons(iCnt).Tag, 1) = ">" Then
  137.             frm.Line (iPosX, 2 * giTwipsY)-(iPosX, iHeight + (6 * giTwipsY)), &H808080
  138.             frm.Line (iPosX + giTwipsX, 2 * giTwipsY)-(iPosX + giTwipsX, iHeight + (6 * giTwipsY)), &HFFFFFF
  139.             iPosX = iPosX + 6 * giTwipsX
  140.          End If
  141.        
  142.             lRtn = GetWindowRect(frm.picToolIcons(iCnt).hwnd, Icon97)
  143.    
  144.          ReDim Preserve glTbarOutLeft(iCnt)
  145.          ReDim Preserve glTbarOutTop(iCnt)
  146.          ReDim Preserve glTbarOutRight(iCnt)
  147.          ReDim Preserve glTbarOutBtm(iCnt)
  148.          
  149.          glTbarOutLeft(iCnt) = (Icon97.Left - 2 - 4) * giTwipsX - frm.Left
  150.          glTbarOutTop(iCnt) = (Icon97.Top - 2 - 42) * giTwipsY - frm.Top
  151.          glTbarOutRight(iCnt) = (Icon97.Right + 2 - 4) * giTwipsX - frm.Left
  152.          glTbarOutBtm(iCnt) = (Icon97.Bottom + 2 - 42) * giTwipsY - frm.Top
  153.          
  154.        Next
  155.    End If
  156.    
  157.    If Not IsMissing(ctlLogo) Then
  158.       ctlLogo.Top = 4 * giTwipsY
  159.       ctlLogo.Left = frm.ScaleWidth - ctlLogo.Width - 6 * giTwipsX
  160.    End If
  161.  
  162. End Sub
  163. Public Sub CenterForm(frm As Form, Optional vParent As Variant)
  164.    Dim oParent    As Object
  165.    Dim iMode      As Integer
  166.    Dim iLeft      As Integer
  167.    Dim iTop       As Integer
  168.    
  169.    If IsMissing(vParent) Then
  170.       Set oParent = Screen
  171.    ElseIf TypeOf vParent Is Screen Or TypeOf vParent Is Form Then
  172.       Set oParent = vParent
  173.    Else
  174.       Exit Sub
  175.    End If
  176.    
  177.    If TypeOf oParent Is Form Then
  178.       iLeft = oParent.Left
  179.       iTop = oParent.Top
  180.    End If
  181.  
  182.    frm.Move iLeft + (oParent.Width - frm.Width) / 2, iTop + (oParent.Height - frm.Height) / 2
  183.    
  184. End Sub
  185.  
  186. Public Sub Toolbar97Highlight(frm As Form, bFlag As Boolean)
  187.    If giTbarButton < 0 Then Exit Sub
  188.    
  189.    Dim ctlIcon As Object
  190.    Set ctlIcon = frm.picToolIcons(giTbarButton)
  191.    
  192.    If bFlag Then
  193.       frm.Line (glTbarOutLeft(giTbarButton), glTbarOutTop(giTbarButton))-(glTbarOutLeft(giTbarButton), glTbarOutBtm(giTbarButton) - giTwipsY), &HFFFFFF
  194.       frm.Line -(glTbarOutRight(giTbarButton) - giTwipsX, glTbarOutBtm(giTbarButton) - giTwipsY), &H808080
  195.       frm.Line -(glTbarOutRight(giTbarButton) - giTwipsX, glTbarOutTop(giTbarButton)), &H808080
  196.       frm.Line -(glTbarOutLeft(giTbarButton), glTbarOutTop(giTbarButton)), &HFFFFFF
  197.       
  198.       If gbThlpActive Then
  199.          frm.tmrToolhelp.Enabled = True
  200.       End If
  201.       
  202.    Else
  203.       
  204.       Dim lRtn            As Long
  205.       Dim hTbarCurrWindow As Long
  206.       Dim Point           As POINTAPI
  207.       
  208.       frm.picToolIcons(giTbarButton).Left = glTbarOutLeft(giTbarButton) + 2 * giTwipsX
  209.       frm.picToolIcons(giTbarButton).Top = glTbarOutTop(giTbarButton) + 2 * giTwipsY
  210.       
  211.       frm.Line (glTbarOutLeft(giTbarButton), glTbarOutTop(giTbarButton))-(glTbarOutRight(giTbarButton) - giTwipsX, glTbarOutBtm(giTbarButton) - giTwipsY), &HC0C0C0, BF
  212.   
  213.       lRtn = GetCursorPos(Point)
  214.       hTbarCurrWindow = WindowFromPoint(Point.x, Point.y)
  215.       
  216.       Select Case hTbarCurrWindow
  217.       Case frm.picToolIcons(giTbarButton).hwnd
  218.                   
  219.       Case Else
  220.          ghTbarPrevWindow = hTbarCurrWindow
  221.          giTbarButton = -1
  222.          
  223.          If gbThlpActive Then
  224.             If hTbarCurrWindow <> gbTbarPrevWindow Then
  225.                frmHelp.Hide
  226.                frm.tmrToolhelp.Enabled = False
  227.                gbTbarPrevWindow = 0
  228.                gbThlpShowNextTime = True
  229.             End If
  230.          End If
  231.      End Select
  232.    End If
  233. End Sub
  234.  
  235.  
  236. Public Sub Toolbar97ButtonDown(frm As Form, Index As Integer)
  237.    If giTbarButton < 0 Then Exit Sub
  238.    ghTbarPrevWindow = frm.picToolIcons(giTbarButton).hwnd
  239.    
  240.    frm.picToolIcons(giTbarButton).Left = glTbarOutLeft(giTbarButton) + 3 * giTwipsX
  241.    frm.picToolIcons(giTbarButton).Top = glTbarOutTop(giTbarButton) + 3 * giTwipsY
  242.    
  243.    If gbThlpActive Then
  244.       Call Toolhelp(frmHelp, "")
  245.       frm.tmrToolhelp.Enabled = False
  246.       frm.tmrToolhelp.Interval = giThlpWait
  247.       gbThlpShowNextTime = False
  248.    End If
  249.    
  250.    DoEvents
  251.      
  252.    frm.Line (glTbarOutLeft(Index), glTbarOutTop(Index))-(glTbarOutLeft(Index), glTbarOutBtm(Index) - giTwipsY), &H808080
  253.    frm.Line -(glTbarOutRight(Index) - giTwipsX, glTbarOutBtm(Index) - giTwipsY), &HFFFFFF
  254.    frm.Line -(glTbarOutRight(Index) - giTwipsX, glTbarOutTop(Index)), &HFFFFFF
  255.    frm.Line -(glTbarOutLeft(Index), glTbarOutTop(Index)), &H808080
  256. End Sub
  257. Public Sub Toolbar97MonitorCursor(frm As Form, Index As Integer)
  258.    Dim lRtn            As Long
  259.    Dim hTbarCurrWindow As Long
  260.    Dim Point           As POINTAPI
  261.    
  262.       lRtn = GetCursorPos(Point)
  263.       hTbarCurrWindow = WindowFromPoint(Point.x, Point.y)
  264.    
  265.    If hTbarCurrWindow <> ghTbarPrevWindow Then
  266.       ghTbarPrevWindow = hTbarCurrWindow
  267.       
  268.       Select Case hTbarCurrWindow
  269.       Case frm.picToolIcons(Index).hwnd
  270.          
  271.          Call Toolbar97Highlight(frm, False)
  272.          
  273.          giTbarButton = Index
  274.          
  275.          Call Toolbar97Highlight(frm, True)
  276.       
  277.       Case Else
  278.       
  279.          Call Toolbar97Highlight(frm, False)
  280.       End Select
  281.    End If
  282. End Sub
  283.