Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/peacoc/samplvbx.frm

Visual Basic Form | 1994-10-27 | 11.0 KB | 360 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Color By Name"
   ClientHeight    =   4860
   ClientLeft      =   1800
   ClientTop       =   1635
   ClientWidth     =   5700
   Height          =   5550
   Icon            =   SAMPLVBX.FRX:0000
   Left            =   1740
   LinkTopic       =   "Form1"
   ScaleHeight     =   4860
   ScaleWidth      =   5700
   Top             =   1005
   Width           =   5820
   Begin PictureBox Picture2
      Height          =   1245
      Left            =   3015
      ScaleHeight     =   1215
      ScaleWidth      =   2520
      TabIndex        =   5
      Top             =   3270
      Width           =   2550
   End
   Begin PictureBox Picture1
      Height          =   1245
      Left            =   165
      ScaleHeight     =   1215
      ScaleWidth      =   2520
      TabIndex        =   4
      Top             =   3285
      Width           =   2550
   End
   Begin Peacock Peacock1
      ColorName       =   "Black"
      ColorValue      =   0
      DefaultValue    =   0
      Left            =   1995
      Text            =   "Peacock1"
      Top             =   -180
   End
   Begin ListBox List2
      Height          =   2760
      Left            =   3030
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   300
      Width           =   2520
   End
   Begin ListBox List1
      BackColor       =   &H00FFFFFF&
      Height          =   2760
      Left            =   165
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   295
      Width           =   2550
   End
   Begin CommonDialog CMDialog
      Left            =   4890
      Top             =   -270
   End
   Begin Label Label2
      Caption         =   "User Defined Colors"
      Height          =   255
      Left            =   2955
      TabIndex        =   2
      Top             =   45
      Width           =   2085
   End
   Begin Label Label1
      Caption         =   "Predefined Colors"
      Height          =   255
      Left            =   210
      TabIndex        =   1
      Top             =   45
      Width           =   2085
   End
   Begin Menu M_FILE
      Caption         =   "&File"
      Begin Menu M_EXIT
         Caption         =   "E&xit"
      End
   End
   Begin Menu M_EDIT
      Caption         =   "&Edit"
      Begin Menu M_ADD_COLOR
         Caption         =   "&Add Color"
      End
      Begin Menu M_CHANGE
         Caption         =   "&Change Color"
      End
      Begin Menu M_DELETE
         Caption         =   "&Delete Color"
      End
   End
   Begin Menu M_VIEW
      Caption         =   "&View"
      Begin Menu M_VIEW_COLOR
         Caption         =   "&Color Name"
         Begin Menu M_NAME_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_NAME_PRE
            Caption         =   "&Predefined"
         End
      End
      Begin Menu M_DETAIL
         Caption         =   "Color &Detail"
         Begin Menu M_COLOR_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_COLOR_PRE
            Caption         =   "&Predefined"
         End
      End
   End
Option Explicit
Sub Form_Load ()
  Dim i As Integer
  For i = 0 To peacock1.ColorListCnt - 1
    List1.AddItem peacock1.ColorList(i)
  Next
  For i = 0 To peacock1.UserColorListCnt - 1
    List2.AddItem peacock1.UserColorList(i)
  Next
  List1.ListIndex = 0
  List1_DblClick
  If peacock1.UserColorListCnt > 0 Then
    List2.ListIndex = 0
    List2_DblClick
  End If
End Sub
Sub List1_Click ()
  List1_DblClick
End Sub
Sub List1_DblClick ()
  Dim ColorName As String
  Dim Color As Long
  ColorName = List1.List(List1.ListIndex)
  peacock1.ColorName = List1.List(List1.ListIndex)
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Picture1.BackColor = peacock1.ColorValue
End Sub
Sub List2_Click ()
  List2_DblClick
End Sub
Sub List2_DblClick ()
  Dim ColorName As String
  Dim Color As Long
  peacock1.ColorName = List2.List(List2.ListIndex)
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  Picture2.BackColor = peacock1.ColorValue
End Sub
Sub M_ADD_COLOR_Click ()
  Dim ColorName As String
  On Error GoTo ErrorHandler
  ColorName = InputBox("Enter New Color Name:", "Color Name")
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  ' if color exists in predef
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If
  CMDialog.CancelError = True
  CMDialog.Flags = &H2&
  CMDialog.Action = 3
  peacock1.ColorValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_ADD_COLOR
  List2.AddItem ColorName
  List2.ListIndex = List2.NewIndex
  Picture2.BackColor = CMDialog.Color
ErrorHandler:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_CHANGE_Click ()
  Dim ColorName As String
  Dim Color As Long
  Dim cnt As Integer
  On Error GoTo ErrorHandler2
  ColorName = InputBox("Enter Color Name To Change:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  ' if color exists in predef
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: " + ColorName + " is predefined - can only change user colors", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.DefaultValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_GET_COLOR
  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
  peacock1.ColorValue = CLng(CMDialog.Color)
  peacock1.Action = ACTION_ADD_COLOR
  Picture2.BackColor = CMDialog.Color
  ' find colorName in the list and set the index to it
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = ColorName Then
      List2.ListIndex = cnt
      Exit For
    End If
  Next
' Error handling here please
ErrorHandler2:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_COLOR_PRE_Click ()
  Dim ColorName As String
  Dim Color As Long
  On Error GoTo ErrorHandlerColorPre
  ColorName = InputBox("Enter Color Name To View:", "Color Name", List1.List(List1.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  ' if color exists in predef
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.DefaultValue = Picture1.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture1.BackColor = peacock1.ColorValue
  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
ErrorHandlerColorPre:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_COLOR_USER_Click ()
  Dim ColorName As String
  Dim Color As Long
  On Error GoTo ErrorHandlerColorUser
  ColorName = InputBox("Enter Color Name To View:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.DefaultValue = Picture2.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture2.BackColor = peacock1.ColorValue
  CMDialog.Color = peacock1.ColorValue
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
ErrorHandlerColorUser:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_DELETE_Click ()
  Dim ColorName As String
  Dim Color As Long
  Dim cnt As Integer
  On Error GoTo ErrorHandlerDelete
  ColorName = InputBox("Enter Color Name To Delete:", "Color Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_PREDEF_COLOR
  If peacock1.Action = ACTION_NONE Then
    MsgBox "Error: " + ColorName + " is predefined - can only delete user colors", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.Action = ACTION_GET_USER_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: User Color " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.Action = ACTION_DELETE_COLOR
  ' find colorname in the user defined list and
  ' blow it away
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = ColorName Then
      List2.RemoveItem cnt
      Exit For
    End If
  Next
  List2.ListIndex = 0
  List2_Click
' Error handling here please
ErrorHandlerDelete:
  ' user pressed the cancel button
  Exit Sub
End Sub
Sub M_EXIT_Click ()
  End
End Sub
Sub M_NAME_PRE_Click ()
  Dim ColorName As String
  Dim Color As Long
  ColorName = InputBox("Enter Color Name to View:", "View Color By Name", List1.List(List1.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.DefaultValue = Picture1.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture1.BackColor = peacock1.ColorValue
End Sub
Sub M_NAME_USER_Click ()
  Dim ColorName As String
  Dim Color As Long
  ColorName = InputBox("Enter Color Name to View:", "View Color By Name", List2.List(List2.ListIndex))
  If ColorName = "" Then
    Exit Sub
  End If
  peacock1.ColorName = ColorName
  peacock1.Action = ACTION_GET_COLOR
  If peacock1.Action <> ACTION_NONE Then
    MsgBox "Error: Color name " + ColorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If
  peacock1.DefaultValue = Picture2.BackColor
  peacock1.Action = ACTION_GET_COLOR
  Picture2.BackColor = peacock1.ColorValue
End Sub