home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / design / toolba / toolbar.bas < prev    next >
BASIC Source File  |  1995-02-14  |  6KB  |  195 lines
  1. Option Explicit
  2. Global Const SRCCOPY = &HCC0020    ' API Call for Picture Copy Bild kopieren
  3. Global SourceBitmap As PictureBox  ' Where are all my Bitmaps
  4.  
  5. Type ToolbarButtonType             ' All my active Bitmaps are here
  6.    Left As Integer
  7.    Top As Integer
  8.    right As Integer
  9.    bottom As Integer
  10.    Nummer As Integer
  11.    pressed As Integer
  12.    enabled As Integer
  13.    visible As Integer
  14.    Yellowhelp As String
  15.    Statushelp As String
  16. End Type
  17.  
  18. Type POINTAPI  '4 Bytes
  19.    x As Integer
  20.    y As Integer
  21. End Type
  22.  
  23. Type RECT   '8 Bytes
  24.    Left As Integer
  25.    Top As Integer
  26.    right As Integer
  27.    bottom As Integer
  28. End Type
  29.  
  30. ' Only API Call for Copy then Bitmaps
  31. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  32. Declare Sub GetCursorPos Lib "User" (sPoint As POINTAPI)
  33. Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
  34.  
  35. Sub ToolbarAddButton (Ctrl As Control, TbBtn As ToolbarButtonType, ByVal XPos As Integer, ByVal Nummer As Integer, SourceBitmap As PictureBox)
  36.    '
  37.    ' Button in Toolbar anfⁿgen und zeichnen
  38.    '
  39.    '  Ctrl = Toolbar
  40.    '  XPos = von Links in Pixel, 4 von oben
  41.    '  Nummer = Nummer des Bitmaps, gemΣss Verzeichnis
  42.    '
  43.    On Error Resume Next
  44.    Dim success As Integer
  45.    TbBtn.Top = 2
  46.    TbBtn.Left = XPos
  47.    TbBtn.right = XPos + 24
  48.    TbBtn.bottom = 2 + 22
  49.    TbBtn.Nummer = Nummer
  50.    TbBtn.pressed = False
  51.    TbBtn.visible = True
  52.    TbBtn.enabled = True
  53.    success = BitBlt(Ctrl.hDC, XPos, 2, 24, 22, SourceBitmap.hDC, (Nummer * 24) - 24, 0, SRCCOPY)
  54.    Ctrl.Refresh
  55. End Sub
  56.  
  57. Function ToolBarGetClicked (Ctrl As Control, TbBtn() As ToolbarButtonType) As Integer
  58.    '
  59.    ' Gibt zurⁿck, welcher Knopf auf der Toolbar gedrⁿckt wurde.
  60.    ' wurde kein Kopf gedrⁿckt, gibt es 0 (False) zurⁿck
  61.    '
  62.    On Error Resume Next
  63.    Dim mpos As POINTAPI      ' mposition
  64.    Dim TbPos As RECT
  65.    Dim i As Integer
  66.    GetCursorPos mpos
  67.    GetWindowRect Ctrl.hWnd, TbPos
  68.    ToolBarGetClicked = -1
  69.    For i = 0 To UBound(TbBtn)
  70.       If Err Then Exit Function
  71.       If mpos.x > TbBtn(i).Left + TbPos.Left And mpos.x < TbBtn(i).right + TbPos.Left Then
  72.          If mpos.y > TbBtn(i).Top + TbPos.Top And mpos.y < TbBtn(i).bottom + TbPos.Top Then
  73.             If TbBtn(i).enabled Then
  74.                ToolBarGetClicked = i
  75.                Exit Function
  76.             End If
  77.          End If
  78.       End If
  79.    Next
  80. End Function
  81.  
  82. Sub ToolBarGrayButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
  83.    '
  84.    ' Button in Toolbar gray werden lassen
  85.    '
  86.    '
  87.    '  Ctrl = Toolbar
  88.    '  Nummer = Nummer des Buttons
  89.    '
  90.    On Error Resume Next
  91.    Dim success As Integer
  92.    success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 44, SRCCOPY)
  93.    TbBtn.enabled = False
  94.    Ctrl.Refresh
  95.  
  96. End Sub
  97.  
  98. Sub ToolBarHideButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
  99.    '
  100.    ' Button in Toolbar verschwinden lassen
  101.    '
  102.    '
  103.    '  Ctrl = Toolbar
  104.    '  Nummer = Nummer des Buttons
  105.    '
  106.    On Error Resume Next
  107.    Dim success As Integer
  108.    success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, 0, 66, SRCCOPY)   ' Graue FlΣche
  109.    TbBtn.enabled = False
  110.    Ctrl.Refresh
  111. End Sub
  112.  
  113. Sub ToolBarMousedown (Ctrl As Control, TbBtn() As ToolbarButtonType, x As Single, y As Single, SourceBitmap As PictureBox)
  114.    '
  115.    '
  116.    '
  117.    On Error Resume Next
  118.    Dim i As Integer
  119.    For i = 0 To UBound(TbBtn)
  120.       If Err Then Exit Sub
  121.       If x > TbBtn(i).Left And x < TbBtn(i).right Then
  122.          If y > TbBtn(i).Top And y < TbBtn(i).bottom Then
  123.             If TbBtn(i).enabled And Not TbBtn(i).pressed Then
  124.                ToolbarPressButton Ctrl, TbBtn(i), SourceBitmap
  125.                Exit Sub
  126.             End If
  127.          End If
  128.       End If
  129.    Next
  130. End Sub
  131.  
  132. Sub ToolBarMouseUp (Ctrl As Control, TbBtn() As ToolbarButtonType, x As Single, y As Single, SourceBitmap As PictureBox)
  133.    '
  134.    '
  135.    '
  136.    On Error Resume Next
  137.    Dim i As Integer
  138.    For i = 0 To UBound(TbBtn)
  139.       If Err Then Exit Sub
  140.       If x > TbBtn(i).Left And x < TbBtn(i).right Then
  141.          If y > TbBtn(i).Top And y < TbBtn(i).bottom Then
  142.             If TbBtn(i).enabled And TbBtn(i).pressed Then
  143.                ToolbarShowButton Ctrl, TbBtn(i), SourceBitmap
  144.                Exit Sub
  145.             End If
  146.          End If
  147.       End If
  148.    Next
  149.    '
  150.    ' Knopf der tief ist releasen
  151.    '
  152.    For i = 0 To UBound(TbBtn)
  153.       If TbBtn(i).pressed Then
  154.          If TbBtn(i).enabled Then ToolbarShowButton Ctrl, TbBtn(i), SourceBitmap
  155.          Exit For
  156.       End If
  157.    Next
  158.  
  159. End Sub
  160.  
  161. Sub ToolbarPressButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
  162.    '
  163.    ' Button in Toolbar versenken
  164.    '
  165.    '
  166.    '  Ctrl = Toolbar
  167.    '  Nummer = Nummer des Buttons
  168.    '
  169.    On Error Resume Next
  170.    Dim success As Integer
  171.    If Not TbBtn.enabled Then Exit Sub
  172.    success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 22, SRCCOPY)
  173.    Ctrl.Refresh
  174.    TbBtn.pressed = True
  175.    'DoEvents
  176. End Sub
  177.  
  178. Sub ToolbarShowButton (Ctrl As Control, TbBtn As ToolbarButtonType, SourceBitmap As PictureBox)
  179.    '
  180.    ' Button in Toolbar versenken
  181.    '
  182.    '
  183.    '  Ctrl = Toolbar
  184.    '  Nummer = Nummer des Buttons
  185.    '
  186.    On Error Resume Next
  187.    Dim success As Integer
  188.    If Not TbBtn.visible Then Exit Sub
  189.    success = BitBlt(Ctrl.hDC, TbBtn.Left, TbBtn.Top, 24, 22, SourceBitmap.hDC, (TbBtn.Nummer * 24) - 24, 0, SRCCOPY)
  190.    Ctrl.Refresh
  191.    TbBtn.pressed = False
  192.    TbBtn.enabled = True
  193. End Sub
  194.  
  195.