Planet Source Code Jumbo …e CD Visual Basic 1 to 7/5_2007-2008.ISO/data/Zips/Outlook_2K2097081112008.psc/Buttons.pag

Text File | 2008-01-01 | 17KB | 592 lines

VERSION 5.00
Begin VB.PropertyPage Buttons
   Caption         =   "Buttons"
   ClientHeight    =   3495
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5925
   PaletteMode     =   0  'Halftone
   ScaleHeight     =   3495
   ScaleWidth      =   5925
   Begin VB.CheckBox chkVisible
      Caption         =   "&Visible"
      Height          =   240
      Left            =   1155
      TabIndex        =   28
      Tag             =   "E"
      Top             =   2760
      Width           =   1140
   End
   Begin VB.Frame Frame2
      Caption         =   "&Small Icon"
      Enabled         =   0   'False
      Height          =   870
      Left            =   4080
      TabIndex        =   24
      Tag             =   "E"
      Top             =   2520
      Width           =   1680
      Begin VB.PictureBox picImg
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Enabled         =   0   'False
         Height          =   480
         Index           =   0
         Left            =   180
         ScaleHeight     =   32
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   32
         TabIndex        =   27
         TabStop         =   0   'False
         Top             =   270
         Width           =   480
      End
      Begin VB.CommandButton btnBrowse
         Height          =   375
         Index           =   0
         Left            =   765
         Picture         =   "Buttons.pgx":0000
         Style           =   1  'Graphical
         TabIndex        =   26
         Tag             =   "E"
         ToolTipText     =   "Browse Picture"
         Top             =   315
         Width           =   375
      End
      Begin VB.CommandButton btnClear
         Height          =   375
         Index           =   0
         Left            =   1140
         Picture         =   "Buttons.pgx":014A
         Style           =   1  'Graphical
         TabIndex        =   25
         Tag             =   "E"
         ToolTipText     =   "Clear Picture"
         Top             =   315
         Width           =   375
      End
   End
   Begin VB.CommandButton btnAction
      Caption         =   "Swap..."
      Height          =   375
      Index           =   4
      Left            =   4425
      TabIndex        =   18
      Tag             =   "E"
      ToolTipText     =   "Move Button to specified location"
      Top             =   120
      Width           =   1320
   End
   Begin VB.CommandButton btnAction
      Height          =   375
      Index           =   3
      Left            =   3930
      Picture         =   "Buttons.pgx":0294
      Style           =   1  'Graphical
      TabIndex        =   17
      Tag             =   "E"
      ToolTipText     =   "Move Button Right"
      Top             =   120
      Width           =   375
   End
   Begin VB.CommandButton btnAction
      Height          =   375
      Index           =   2
      Left            =   3570
      Picture         =   "Buttons.pgx":03DE
      Style           =   1  'Graphical
      TabIndex        =   16
      Tag             =   "E"
      ToolTipText     =   "Move Button Left"
      Top             =   120
      Width           =   375
   End
   Begin VB.CommandButton btnAction
      Caption         =   "&Insert"
      Height          =   375
      Index           =   0
      Left            =   2130
      TabIndex        =   15
      ToolTipText     =   "Add Button"
      Top             =   120
      Width           =   1050
   End
   Begin VB.CommandButton btnAction
      Height          =   375
      Index           =   1
      Left            =   3180
      Picture         =   "Buttons.pgx":0528
      Style           =   1  'Graphical
      TabIndex        =   14
      Tag             =   "E"
      ToolTipText     =   "Remove Button"
      Top             =   120
      Width           =   375
   End
   Begin VB.TextBox txtField
      BackColor       =   &H80000014&
      Height          =   285
      Index           =   0
      Left            =   660
      Locked          =   -1  'True
      TabIndex        =   13
      TabStop         =   0   'False
      Tag             =   "E"
      Top             =   165
      Width           =   690
   End
   Begin VB.HScrollBar hsbIDX
      Height          =   285
      Left            =   1425
      Max             =   1
      Min             =   1
      TabIndex        =   12
      TabStop         =   0   'False
      Tag             =   "E"
      Top             =   165
      Value           =   1
      Width           =   465
   End
   Begin VB.TextBox txtField
      Height          =   285
      Index           =   1
      Left            =   1155
      TabIndex        =   11
      Tag             =   "E"
      Top             =   1065
      Width           =   1320
   End
   Begin VB.TextBox txtField
      Height          =   285
      Index           =   2
      Left            =   1155
      TabIndex        =   10
      Tag             =   "E"
      Top             =   1425
      Width           =   1320
   End
   Begin VB.TextBox txtField
      Height          =   285
      Index           =   3
      Left            =   1155
      TabIndex        =   9
      Tag             =   "E"
      Top             =   2145
      Width           =   2490
   End
   Begin VB.Frame Frame1
      Enabled         =   0   'False
      Height          =   870
      Left            =   3510
      TabIndex        =   5
      Tag             =   "E"
      Top             =   660
      Width           =   2220
      Begin VB.CommandButton cmdBrowse
         Caption         =   "..."
         Enabled         =   0   'False
         Height          =   285
         Left            =   1500
         Style           =   1  'Graphical
         TabIndex        =   7
         Tag             =   "E"
         Top             =   360
         Width           =   285
      End
      Begin VB.CheckBox chkUseMask
         Caption         =   "&UseMaskColor"
         Enabled         =   0   'False
         Height          =   285
         Left            =   180
         TabIndex        =   6
         Tag             =   "E"
         Top             =   0
         Width           =   1365
      End
      Begin VB.Shape shpCol
         FillColor       =   &H00FF00FF&
         FillStyle       =   0  'Solid
         Height          =   285
         Left            =   945
         Top             =   360
         Width           =   555
      End
      Begin VB.Label lblHdr
         AutoSize        =   -1  'True
         Caption         =   "C&olour:"
         Enabled         =   0   'False
         Height          =   195
         Index           =   5
         Left            =   315
         TabIndex        =   8
         Tag             =   "E"
         Top             =   405
         Width           =   495
      End
   End
   Begin VB.Frame Frame3
      Caption         =   "&Icon"
      Enabled         =   0   'False
      Height          =   870
      Left            =   4080
      TabIndex        =   1
      Tag             =   "E"
      Top             =   1560
      Width           =   1680
      Begin VB.CommandButton btnClear
         Height          =   375
         Index           =   1
         Left            =   1140
         Picture         =   "Buttons.pgx":0672
         Style           =   1  'Graphical
         TabIndex        =   4
         Tag             =   "E"
         ToolTipText     =   "Clear Picture"
         Top             =   315
         Width           =   375
      End
      Begin VB.CommandButton btnBrowse
         Height          =   375
         Index           =   1
         Left            =   765
         Picture         =   "Buttons.pgx":07BC
         Style           =   1  'Graphical
         TabIndex        =   3
         Tag             =   "E"
         ToolTipText     =   "Browse Picture"
         Top             =   315
         Width           =   375
      End
      Begin VB.PictureBox picImg
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Enabled         =   0   'False
         Height          =   480
         Index           =   1
         Left            =   180
         ScaleHeight     =   32
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   32
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   270
         Width           =   480
      End
   End
   Begin VB.TextBox txtField
      Height          =   285
      Index           =   5
      Left            =   1155
      TabIndex        =   0
      Tag             =   "E"
      Top             =   1785
      Width           =   2490
   End
   Begin VB.Label lblHdr
      AutoSize        =   -1  'True
      Caption         =   "Index:"
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   23
      Top             =   210
      Width           =   435
   End
   Begin VB.Label lblHdr
      AutoSize        =   -1  'True
      Caption         =   "&Key:"
      Height          =   195
      Index           =   2
      Left            =   120
      TabIndex        =   22
      Tag             =   "E"
      Top             =   1110
      Width           =   315
   End
   Begin VB.Label lblHdr
      AutoSize        =   -1  'True
      Caption         =   "&Caption:"
      Height          =   195
      Index           =   3
      Left            =   120
      TabIndex        =   21
      Tag             =   "E"
      Top             =   1470
      Width           =   585
   End
   Begin VB.Label lblHdr
      AutoSize        =   -1  'True
      Caption         =   "&ToolTipText:"
      Height          =   195
      Index           =   4
      Left            =   120
      TabIndex        =   20
      Tag             =   "E"
      Top             =   2190
      Width           =   900
   End
   Begin VB.Label lblHdr
      AutoSize        =   -1  'True
      Caption         =   "&Description:"
      Height          =   195
      Index           =   7
      Left            =   120
      TabIndex        =   19
      Tag             =   "E"
      Top             =   1830
      Width           =   840
   End
End
Attribute VB_Name = "Buttons"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
DefInt A-Z

Dim NP As NavPane
Dim LastBtn

Private Sub ClearField()
  txtField(1) = ""
  txtField(2) = ""
  txtField(3) = ""
  txtField(5) = ""
  chkUseMask = 0
End Sub

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 = NP.AddButton()
  If i > 0 Then
    hsbIDX.Max = i
    hsbIDX = i
    Call hsbIDX_Change
    If NP.ExpandedButtons = i - 1 Then NP.ExpandedButtons = i
  Else
    MsgBox "Unable to add button", vbCritical
  End If
  Changed = -1
  Return

DelButton:
  Changed = 0
  i = NP.RemoveButton(Z)
  hsbIDX.Max = i
  If i >= 0 Then
    If NP.ButtonCount = 0 Then
      ClearField
      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 = NP.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 < NP.ButtonCount Then
    PropertyPage_ApplyChanges
    Z = NP.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 = NP.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
    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 chkVisible_Click()
  Changed = True
End Sub

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

Private Sub hsbIDX_Change()
  Dim i
  Dim L As Boolean, R As Boolean
  i = hsbIDX
  If i <> LastBtn And Changed = -1 Then PropertyPage_ApplyChanges
  LastBtn = i
  With NP
    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
      txtField(1) = .ButtonKey(i)
      txtField(2) = .ButtonCaption(i)
      txtField(3) = .ButtonToolTipText(i)
      txtField(5) = .ButtonDescription(i)
      chkUseMask = Abs(.ButtonUseMaskColor(i))
      chkVisible = Abs(.ButtonVisible(i))
      shpCol.FillColor = .ButtonMaskColor(i)
      Set picImg(1).Picture = .ButtonIcon(i)
      Set picImg(0).Picture = .ButtonSmallIcon(i)
      Changed = 0
    Else
      MsgBox "Button index '" & i & "' not found.", vbCritical
      SetTagControls
    End If
  End With
End Sub

Private Sub hsbIDX_Scroll()
  hsbIDX_Change
End Sub

Private Sub PropertyPage_ApplyChanges()
  Dim i
  With NP
    i = LastBtn
    If i <= .ButtonCount Then
      .Redraw = 0
      .ButtonKey(i) = txtField(1)
      .ButtonCaption(i) = txtField(2)
      .ButtonToolTipText(i) = txtField(3)
      .ButtonDescription(i) = txtField(5)
      .ButtonUseMaskColor(i) = chkUseMask
      .ButtonVisible(i) = chkVisible
      .ButtonMaskColor(i) = shpCol.FillColor
      Set .ButtonIcon(i) = picImg(1).Picture
      Set .ButtonSmallIcon(i) = picImg(0).Picture
      .Redraw = 1
      .Refresh
    End If
  End With
End Sub

Private Sub PropertyPage_SelectionChanged()
  If TypeOf SelectedControls(0) Is NavPane Then
    If NP Is Nothing Then
      GoSub LoadProperties
    ElseIf NP.hwnd <> SelectedControls(0).hwnd Then
      GoSub LoadProperties
    End If
  End If
  Exit Sub

LoadProperties:
  Set NP = SelectedControls(0)
  If NP.ButtonCount Then
    hsbIDX.Max = NP.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