buttons.pag

非常漂亮的VB控件

   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&GroupID:"
      Height          =   195
      Index           =   8
      Left            =   135
      TabIndex        =   40
      Tag             =   "E"
      Top             =   2880
      Width           =   645
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&Description:"
      Height          =   195
      Index           =   7
      Left            =   135
      TabIndex        =   14
      Tag             =   "E"
      Top             =   1800
      Width           =   840
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&Width:"
      Height          =   195
      Index           =   6
      Left            =   135
      TabIndex        =   18
      Tag             =   "E"
      Top             =   2520
      Width           =   465
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&ToolTipText:"
      Height          =   195
      Index           =   4
      Left            =   135
      TabIndex        =   16
      Tag             =   "E"
      Top             =   2160
      Width           =   900
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&Caption:"
      Height          =   195
      Index           =   3
      Left            =   135
      TabIndex        =   12
      Tag             =   "E"
      Top             =   1440
      Width           =   585
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&Key:"
      Height          =   195
      Index           =   2
      Left            =   135
      TabIndex        =   10
      Tag             =   "E"
      Top             =   1080
      Width           =   315
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "&Style:"
      Height          =   195
      Index           =   1
      Left            =   135
      TabIndex        =   8
      Tag             =   "E"
      Top             =   720
      Width           =   390
   End
   Begin VB.Label lblHdr 
      AutoSize        =   -1  'True
      Caption         =   "Index:"
      Height          =   195
      Index           =   0
      Left            =   135
      TabIndex        =   0
      Top             =   180
      Width           =   435
   End
End
Attribute VB_Name = "ppgTBButtons"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
DefInt A-Z

Dim TB As asxToolbar
Dim LastBtn

Private Sub btnAction_Click(Index As Integer)
 Dim I, Z, X
 Dim M$
 Z = hsbIDX
 Select Case Index
  Case 0: GoSub AddButton
  Case 1: GoSub DelButton
  Case 2: GoSub MoveLeft
  Case 3: GoSub MoveRight
  Case 4: GoSub MoveX
 End Select
Exit Sub

AddButton:
 If Changed Then PropertyPage_ApplyChanges
 I = TB.AddButton()
 If I Then
  hsbIDX.Max = I
  If Z = hsbIDX.Max Then
   hsbIDX = I
  Else
   TB.SwapButton I, Z + 1
   hsbIDX = Z + 1
  End If
 Else
  MsgBox "Unable to add button", vbCritical
 End If
 Changed = -1
Return

DelButton:
 Changed = 0
 I = TB.DeleteButton(Z)
 hsbIDX.Max = I
 If I Then
  If TB.ButtonCount = 0 Then
   SetTagControls
  Else
   hsbIDX.Max = I
   If Z >= I Then
    hsbIDX = I
   Else
    hsbIDX = Z
   End If
   hsbIDX_Change
   Changed = -1
  End If
 ElseIf I = -1 Then
  MsgBox "Unable to delete button", vbCritical
 End If
Return

MoveLeft:
 I = hsbIDX
 If I > 1 Then
  PropertyPage_ApplyChanges
  Z = TB.SwapButton(I, I - 1)
  If Z Then LastBtn = Z: hsbIDX = Z
  Changed = -1
 Else
  MsgBox "Button cannot be moved any further left.", 48
 End If
Return

MoveRight:
 I = hsbIDX
 If I < TB.ButtonCount Then
  PropertyPage_ApplyChanges
  Z = TB.SwapButton(I, I + 1)
  If Z Then LastBtn = Z: hsbIDX = Z
  Changed = -1
 Else
  MsgBox "Button cannot be moved any further right.", 48
 End If
Return

MoveX:
 Z = hsbIDX.Max
 X = hsbIDX
 M$ = InputBox$("Swap button " & X & " with which index?" & Chr$(10) & Chr$(10) & "Plese select a position between 1 and " & Z, "Swap Button")
 If M$ <> "" Then
  I = Val(M$)
  If I < 1 Or I > Z Then
   MsgBox "Value entered out of range.", vbExclamation
  Else
   PropertyPage_ApplyChanges
   Z = TB.SwapButton(hsbIDX, I)
   If Z Then LastBtn = Z: hsbIDX = Z
   Changed = -1
  End If
 End If
Return
End Sub

Private Sub btnBrowse_Click(Index As Integer)
 Dim F$
 F$ = SelectFile$(hWnd, "Browse Picture", "Pictures (*.bmp;*.dib;*.gif;*.ico;*.jpg;*.rle)|*.bmp;*.dib;*.gif;*.ico;*.jpg;*.rle|All Files (*.*)|*.*", 0, "", "", "BMP", fdmOpenFile)
 If F$ <> "" Then
  On Error Resume Next
   picImg(Index).BackColor = shpCol.FillColor
   picImg(Index).Picture = LoadPicture(F$)
   picImg(Index).Picture = picImg(Index).Image
   If txtField(3) = "" Then txtField(3) = RemoveExtension$(GetFile$(F$))
   If txtField(1) = "" Then txtField(1) = RemoveExtension$(GetFile$(F$))
   Changed = -1
   If Err Then MsgBox Error$, vbExclamation
  On Error GoTo 0
 End If
End Sub

Private Sub btnClear_Click(Index As Integer)
 Set picImg(Index).Picture = Nothing
 Changed = -1
End Sub


Private Sub cboStyle_Click()
 Changed = -1
End Sub

Private Sub chkCaption_Click()
 Changed = -1
End Sub

Private Sub chkChecked_Click()
 Changed = -1
End Sub

Private Sub chkEnabled_Click()
 Changed = -1
End Sub


Private Sub chkUseMask_Click()
 Changed = -1
End Sub

Private Sub chkVisible_Click()
 Changed = -1
End Sub

Private Sub cmdBrowse_Click()
 Dim C As Long
 C = SelectColor(hWnd, shpCol.FillColor, 0)
 If C <> -1 Then
  shpCol.FillColor = C
  picImg(0).BackColor = C
  picImg(1).BackColor = C
  picImg(2).BackColor = C
  Changed = -1
 End If
End Sub


Private Sub hsbIDX_Change()
 Dim I
 Dim L As Boolean, R As Boolean
 Pointer 11
  I = hsbIDX
  If I <> LastBtn And Changed = -1 Then PropertyPage_ApplyChanges
  LastBtn = I
  With TB
   txtField(0) = I
   If .ButtonCount >= I Then
    SetTagControls , -1
    If I = 1 Then L = 0 Else L = -1
    If I = .ButtonCount Then R = 0 Else R = -1
    btnAction(2).Enabled = L
    btnAction(3).Enabled = R
    cboStyle.ListIndex = .ButtonStyle(I)
    txtField(1) = .ButtonKey(I)
    txtField(2) = .ButtonCaption(I)
    txtField(3) = .ButtonToolTipText(I)
    txtField(4) = .ButtonPlaceholderWidth(I)
    txtField(5) = .ButtonDescription(I)
    txtField(6) = .ButtonGroupID(I)
    chkEnabled = Abs(.ButtonEnabled(I))
    chkChecked = Abs(.ButtonChecked(I))
    chkUseMask = Abs(.ButtonUseMaskColor(I))
    chkVisible = Abs(.ButtonVisible(I))
    chkCaption = Abs(.ButtonAlwaysShowCaption(I))
    shpCol.FillColor = .ButtonMaskColor(I)
    Set picImg(0).Picture = .ButtonPicture(I)
    Set picImg(1).Picture = .ButtonPictureOver(I)
    Set picImg(2).Picture = .ButtonPictureDown(I)
    Changed = 0
   Else
    MsgBox "Button index '" & I & "' not found.", vbCritical
    SetTagControls
   End If
  End With
 Pointer 0
End Sub

Private Sub hsbIDX_Scroll()
 hsbIDX_Change
End Sub


Private Sub PropertyPage_ApplyChanges()
 Dim I
 With TB
  I = LastBtn
  If I <= .ButtonCount Then
   .Redraw = 0
    .ButtonStyle(I) = cboStyle.ListIndex
    .ButtonKey(I) = txtField(1)
    .ButtonCaption(I) = txtField(2)
    .ButtonToolTipText(I) = txtField(3)
    .ButtonPlaceholderWidth(I) = Val(txtField(4))
    .ButtonDescription(I) = txtField(5)
    .ButtonGroupID(I) = txtField(6)
    .ButtonEnabled(I) = chkEnabled
    .ButtonChecked(I) = chkChecked
    .ButtonAlwaysShowCaption(I) = chkCaption
    .ButtonUseMaskColor(I) = chkUseMask
    .ButtonVisible(I) = chkVisible
    .ButtonMaskColor(I) = shpCol.FillColor
    Set .ButtonPicture(I) = picImg(0).Picture
    Set .ButtonPictureOver(I) = picImg(1).Picture
    Set .ButtonPictureDown(I) = picImg(2).Picture
   .Redraw = -1
   .Refresh
  End If
 End With
End Sub

Private Sub PropertyPage_SelectionChanged()
 If TypeOf SelectedControls(0) Is asxToolbar Then
  If TB Is Nothing Then
   GoSub LoadProperties
  ElseIf TB.hWnd <> SelectedControls(0).hWnd Then
   GoSub LoadProperties
  End If
 End If
Exit Sub

LoadProperties:
 Set TB = SelectedControls(0)
 If TB.ButtonCount Then
  hsbIDX.Max = TB.ButtonCount
  hsbIDX_Change
 Else
  SetTagControls
 End If
 Changed = 0
Return
End Sub


Private Sub SetTagControls(Optional T$ = "E", Optional V As Boolean = 0)
 Dim I
 Dim C As Control
 On Error Resume Next
  For Each C In Controls
   If C.Tag = T$ Then C.Enabled = V
  Next
 On Error GoTo 0
End Sub

Private Sub txtField_Change(Index As Integer)
 If Index <> 0 Then Changed = -1
End Sub


Private Sub txtField_GotFocus(Index As Integer)
 Highlight txtField(Index)
End Sub


Private Sub txtField_KeyPress(Index As Integer, KeyAscii As Integer)
 Dim C$
 If Index = 4 Or Index = 6 Then
  C$ = Chr$(KeyAscii)
  If C$ < "0" Or C$ > "9" Then
   If KeyAscii <> 8 Then Beep: KeyAscii = 0
  End If
 End If
End Sub