home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / RedHat_Win185020282005.psc / Bar.ctl < prev    next >
Text File  |  2005-02-05  |  5KB  |  134 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Bar 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    ScaleHeight     =   240
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   320
  11.    Begin RedHatSkin.Bar_Button Bar_Button1 
  12.       Height          =   1170
  13.       Index           =   0
  14.       Left            =   0
  15.       TabIndex        =   0
  16.       Top             =   0
  17.       Visible         =   0   'False
  18.       Width           =   855
  19.       _extentx        =   1508
  20.       _extenty        =   2064
  21.       hold_caption    =   "Test"
  22.    End
  23. End
  24. Attribute VB_Name = "Bar"
  25. Attribute VB_GlobalNameSpace = False
  26. Attribute VB_Creatable = True
  27. Attribute VB_PredeclaredId = False
  28. Attribute VB_Exposed = False
  29. Private Const Color_1 = "55,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,15132390,12895428,16119285"
  30.  
  31. Public Event Clicked(Index As Integer)
  32. Public Event MouseOver(Index As Integer)
  33. Public Event MouseOff(Index As Integer)
  34.  
  35. Function Button_Enable(Index As Integer, NewValue As Boolean)
  36. Bar_Button1(Index).Enabled = NewValue
  37. End Function
  38.  
  39. Function Button_Caption(Index As Integer, NewValue As String)
  40. Bar_Button1(Index).Caption = NewValue
  41. End Function
  42.  
  43. Function Button_Icon(Index As Integer, NewValue As Integer)
  44. Bar_Button1(Index).Icon = NewValue
  45. End Function
  46.  
  47. Private Function LoadBmpMenuLines(Legnth As Integer, ColorPallet As String, X As Integer, Y As Integer, Optional Gray As Boolean = True, Optional Brightness As Integer = 0) As Integer
  48.     If ColorPallet = "" Then Exit Function
  49.     Dim PixCount
  50.     Dim Colors() As String, CurrentRow, CurrentColumn, Count, Rows
  51.     Colors = Split(ColorPallet, ",")
  52.     Rows = Int(Split(ColorPallet, ",")(0))
  53.     For Count = 1 To UBound(Colors)
  54.         If CurrentRow > (Rows) Then CurrentRow = 0: CurrentColumn = CurrentColumn + 1
  55.             If Colors(Count) = &HFF00FF And Brightness <> 0 Then
  56.             
  57.             Else
  58.                 If Gray = True Then
  59.                 UserControl.Line (X + CurrentColumn, Y + CurrentRow)-(X + CurrentColumn + Legnth, Y + CurrentRow), AdjustBrightness(Colors(Count), Brightness)
  60.                 Else
  61.                 UserControl.Line (X + CurrentColumn, Y + CurrentRow)-(X + CurrentColumn + Legnth, Y + CurrentRow), MakeGrey(Colors(Count))
  62.                 End If
  63.             End If
  64.         CurrentRow = CurrentRow + 1
  65.     Next
  66.     LoadBmpMenuLines = CurrentColumn
  67. End Function
  68.  
  69. Function LoadGUI()
  70. LoadBmpMenuLines UserControl.ScaleWidth, Color_1, 0, 0
  71. UserControl.Height = 56 * 15
  72. Dim X
  73. For X = 0 To Bar_Button1.Count - 1
  74. Bar_Button1(X).Height = UserControl.ScaleHeight - 2
  75. Next
  76. End Function
  77.  
  78. Private Sub Bar_Button1_Clicked(Index As Integer)
  79. RaiseEvent Clicked(Index)
  80. End Sub
  81.  
  82. Private Sub Bar_Button1_MouseOff(Index As Integer)
  83. RaiseEvent MouseOff(Index)
  84. End Sub
  85.  
  86. Private Sub Bar_Button1_MouseOver(Index As Integer)
  87. RaiseEvent MouseOver(Index)
  88. End Sub
  89.  
  90. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  91. Screen.MousePointer = 0
  92. End Sub
  93.  
  94. Private Sub UserControl_Resize()
  95. LoadGUI
  96. End Sub
  97.  
  98. Private Sub UserControl_Show()
  99. LoadGUI
  100. End Sub
  101.  
  102. Function SubClassMe(SubClass As Boolean)
  103. Dim X
  104. Select Case SubClass
  105. Case True
  106.     For X = 0 To Bar_Button1.Count - 1
  107.     Bar_Button1(X).SubClassMe True
  108.     Next
  109. Case False
  110.     For X = 0 To Bar_Button1.Count - 1
  111.     Bar_Button1(X).SubClassMe False
  112.     Next
  113. End Select
  114. End Function
  115.  
  116. Function AddButton(Caption As String, Icon As Integer, Enabled As Boolean)
  117. Dim X: X = Bar_Button1.Count
  118. If X = 1 Then
  119.     Bar_Button1(X - 1).Caption = Caption
  120.     Bar_Button1(X - 1).Icon = Icon
  121.     Bar_Button1(X - 1).Enabled = Enabled
  122.     Bar_Button1(X - 1).Visible = True
  123.     Load Bar_Button1(X)
  124. Else
  125.     Bar_Button1(X - 1).Left = Bar_Button1(X - 2).Left + Bar_Button1(X - 2).Width
  126.     Bar_Button1(X - 1).Top = 0
  127.     Bar_Button1(X - 1).Caption = Caption
  128.     Bar_Button1(X - 1).Icon = Icon
  129.     Bar_Button1(X - 1).Enabled = Enabled
  130.     Bar_Button1(X - 1).Visible = True
  131.     Load Bar_Button1(X)
  132. End If
  133. End Function
  134.