ActiveX Programming Unleashed CD/AXU.iso/activex/demos/oletrial/samples/vb/mhfile/mhgfil.frm

Visual Basic Form | 1995-11-28 | 13.8 KB | 436 lines

VERSION 4.00
Begin VB.Form MhgFil
   Caption         =   "Mh3dFile Example"
   ClientHeight    =   4080
   ClientLeft      =   1308
   ClientTop       =   1872
   ClientWidth     =   7368
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   7.8
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   4680
   Left            =   1260
   LinkTopic       =   "Form1"
   ScaleHeight     =   4080
   ScaleWidth      =   7368
   Top             =   1320
   Width           =   7464
   Begin VB.PictureBox picStatus
      Align           =   2  'Align Bottom
      Height          =   360
      Left            =   0
      ScaleHeight     =   312
      ScaleWidth      =   7320
      TabIndex        =   0
      Top             =   3720
      Width           =   7365
   End
   Begin MhgfilLib.Mh3dFile Mh3dFile1
      Height          =   3144
      Left            =   180
      TabIndex        =   1
      Top             =   216
      Width           =   3936
      _Version        =   65536
      _ExtentX        =   6943
      _ExtentY        =   5546
      _StockProps     =   79
      TintColor       =   16711935
      BevelStyleInner =   0
      BevelSizeInner  =   0
      BorderType      =   1
      BorderColor     =   -2147483642
      Case            =   0
      DividerStyle    =   0
      FillColor       =   -2147483633
      FontStyle       =   0
      LightColor      =   -2147483643
      MultiSelect     =   0
      PictureHeight   =   16
      PictureWidth    =   16
      ScrollBars      =   1
      ShadowColor     =   -2147483632
      WallPaper       =   0
      Sorted          =   0   'False
      TextColor       =   -2147483640
      WrapList        =   0   'False
      WrapWidth       =   0
      Archive         =   -1  'True
      DefaultPics     =   1
      Hidden          =   -1  'True
      Normal          =   -1  'True
      Path            =   "C:\PROJECTS"
      Pattern         =   "*.*"
      ReadOnly        =   -1  'True
      System          =   -1  'True
      FocusColor      =   0
      HighColor       =   -2147483634
   End
   Begin VB.Menu mnuBevel
      Caption         =   "Bevel"
      Begin VB.Menu mnuBevelSizeInner
         Caption         =   "BevelSizeInner"
      End
      Begin VB.Menu mnuBevelStyleInner
         Caption         =   "BevelStyleInner"
      End
   End
   Begin VB.Menu mnuBorder
      Caption         =   "Border"
      Begin VB.Menu mnuBorderColor
         Caption         =   "BorderColor"
      End
      Begin VB.Menu mnuBorderType
         Caption         =   "BorderType"
      End
   End
   Begin VB.Menu mnuColor
      Caption         =   "Color"
      Begin VB.Menu mnuFillColor
         Caption         =   "FillColor"
      End
      Begin VB.Menu mnuFocusColor
         Caption         =   "FocusColor"
      End
      Begin VB.Menu mnuHighColor
         Caption         =   "HighColor"
      End
      Begin VB.Menu mnuLightColor
         Caption         =   "LightColor"
      End
      Begin VB.Menu mnuShadowColor
         Caption         =   "ShadowColor"
      End
      Begin VB.Menu mnuTextColor
         Caption         =   "TextColor"
      End
   End
   Begin VB.Menu mnuFind
      Caption         =   "Find"
      Begin VB.Menu mnuFindInstr
         Caption         =   "FindInstr"
      End
      Begin VB.Menu mnuFindString
         Caption         =   "FindString"
      End
      Begin VB.Menu mnuFoundIndex
         Caption         =   "FoundIndex"
      End
   End
   Begin VB.Menu mnuList
      Caption         =   "List"
      Begin VB.Menu mnuListData
         Caption         =   "ListData"
      End
      Begin VB.Menu mnuListPicture
         Caption         =   "ListPicture"
      End
      Begin VB.Menu mnuListPictureSel
         Caption         =   "ListPictureSel"
      End
   End
   Begin VB.Menu mnuMiscellaneous
      Caption         =   "Miscellaneous"
      Begin VB.Menu mnuCase
         Caption         =   "Case"
      End
      Begin VB.Menu mnuClearBox
         Caption         =   "ClearBox"
      End
      Begin VB.Menu mnuDividerStyle
         Caption         =   "DividerStyle"
      End
      Begin VB.Menu mnuFontStyle
         Caption         =   "FontStyle"
      End
      Begin VB.Menu mnuScreenUpdate
         Caption         =   "ScreenUpdate"
      End
      Begin VB.Menu mnuScrollbars
         Caption         =   "Scrollbars"
      End
      Begin VB.Menu mnuWallPaper
         Caption         =   "WallPaper"
      End
      Begin VB.Menu mnuWrapList
         Caption         =   "WrapList"
      End
      Begin VB.Menu mnuWrapWidth
         Caption         =   "WrapWidth"
      End
   End
   Begin VB.Menu mnuPicture
      Caption         =   "Picture"
      Begin VB.Menu mnuDefaultPics
         Caption         =   "DefaultPics"
      End
      Begin VB.Menu mnuPictureHeight
         Caption         =   "PictureHeight"
      End
      Begin VB.Menu mnuPictureWidth
         Caption         =   "PictureWidth"
      End
   End
   Begin VB.Menu mnuSelect
      Caption         =   "Select"
      Begin VB.Menu mnuLastAdded
         Caption         =   "LastAdded"
      End
      Begin VB.Menu mnuLastReplaced
         Caption         =   "LastReplaced"
      End
      Begin VB.Menu mnuMultiSelect
         Caption         =   "MultiSelect"
      End
      Begin VB.Menu mnuSelectedCount
         Caption         =   "SelectedCount"
      End
      Begin VB.Menu mnuTagged
         Caption         =   "Tagged"
      End
      Begin VB.Menu mnuTopIndex
         Caption         =   "TopIndex"
      End
   End
Attribute VB_Name = "MhgFil"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    ' this is to set path of control so that files appear in the list
    Mh3dFile1.Path = App.Path
End Sub
Private Sub Mh3dFile1_PathChange()
    picStatus.Cls
    picStatus.Print "Custom Event - Mh3dFile1_PathChange"
    If picStatus.ForeColor = &H800000 Then
        picStatus.ForeColor = &H0&
    Else
        picStatus.ForeColor = &H800000
    End If
End Sub
Private Sub Mh3dFile1_TopIndexChange()
    picStatus.Cls
    picStatus.Print "Custom Event - Mh3dFile1_TopIndexChange"
    If picStatus.ForeColor = &H800000 Then
        picStatus.ForeColor = &H0&
    Else
        picStatus.ForeColor = &H800000
    End If
End Sub
Private Sub mnuBevelSizeInner_Click()
    igRangeArray(0) = 0
    igRangeArray(1) = Mh3dFile1.BevelSizeInner
    igRangeArray(2) = 10
    Mh3dFile1.BevelSizeInner = GetRange("BevelSizeInner")
End Sub
Private Sub mnuBevelStyleInner_Click()
    ReDim sgOptionArray(0 To 2)
    sgOptionArray(0) = "Lowered"
    sgOptionArray(1) = "Raised"
    sgOptionArray(2) = "Chiseled"
    igOptionState = Mh3dFile1.BevelStyleInner
    Mh3dFile1.BevelStyleInner = GetOption("BevelStyleInner")
End Sub
Private Sub mnuBorderColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.BorderColor = lgCurrentColor
End Sub
Private Sub mnuBorderType_Click()
    ReDim sgOptionArray(0 To 4)
    sgOptionArray(0) = "None"
    sgOptionArray(1) = "Thin"
    sgOptionArray(2) = "Sizeable"
    sgOptionArray(3) = "Thin with caption"
    sgOptionArray(4) = "Sizeable with caption"
    igOptionState = Mh3dFile1.BorderType
    Mh3dFile1.BorderType = GetOption("BorderType")
End Sub
Private Sub mnuCase_Click()
    ReDim sgOptionArray(0 To 2)
    sgOptionArray(0) = "Mixed"
    sgOptionArray(1) = "Lower"
    sgOptionArray(2) = "Upper"
    igOptionState = Mh3dFile1.Case
    Mh3dFile1.Case = GetOption("Case")
End Sub
Private Sub mnuClearBox_Click()
    Mh3dFile1.ClearBox = 1
    End Sub
Private Sub mnuDefaultPics_Click()
    ReDim sgOptionArray(0 To 1)
    sgOptionArray(0) = "False"
    sgOptionArray(1) = "True"
    igOptionState = Mh3dFile1.DefaultPics
    Mh3dFile1.DefaultPics = GetOption("DefaultPics")
End Sub
Private Sub mnuDividerStyle_Click()
    ReDim sgOptionArray(0 To 4)
    sgOptionArray(0) = "None"
    sgOptionArray(1) = "Singe Border Color"
    sgOptionArray(2) = "Single Shadow Color"
    sgOptionArray(3) = "Lowered"
    sgOptionArray(4) = "Raised"
    igOptionState = Mh3dFile1.DividerStyle
    Mh3dFile1.DividerStyle = GetOption("DividerStyle")
End Sub
Private Sub mnuFillColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.FillColor = lgCurrentColor
End Sub
Private Sub mnuFindInstr_Click()
    Dim spResp As String
    spResp = InputBox$("Enter the string to search for", "FindInstr", "", Me.Left + 120, Me.Top + 120)
    If Len(spResp) Then
        Mh3dFile1.FindInstr = spResp
    Else
        MsgBox "Action canceled", , "Error"
    End If
End Sub
Private Sub mnuFindString_Click()
    Dim spResp As String
    spResp = InputBox$("Enter the string to search for", "FindString", "", Me.Left + 120, Me.Top + 120)
    If Len(spResp) Then
        Mh3dFile1.FindString = spResp
    Else
        MsgBox "Action canceled", , "Error"
    End If
End Sub
Private Sub mnuFocusColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.FocusColor = lgCurrentColor
End Sub
Private Sub mnuFontStyle_Click()
    ReDim sgOptionArray(0 To 4)
    sgOptionArray(0) = "None"
    sgOptionArray(1) = "Raised"
    sgOptionArray(2) = "Raised with more shading"
    sgOptionArray(3) = "Lowered"
    sgOptionArray(4) = "Lowered with more shading"
    igOptionState = Mh3dFile1.FontStyle
    Mh3dFile1.FontStyle = GetOption("FontStyle")
End Sub
Private Sub mnuFoundIndex_Click()
    MsgBox Str(Mh3dFile1.FoundIndex), , "FoundIndex"
End Sub
Private Sub mnuHighColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.HighColor = lgCurrentColor
End Sub
Private Sub mnuLastAdded_Click()
    MsgBox Mh3dFile1.LastAdded, , "LastAdded"
End Sub
Private Sub mnuLastReplaced_Click()
    MsgBox Mh3dFile1.LastReplaced, , "LastReplaced"
End Sub
Private Sub mnuLightColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.LightColor = lgCurrentColor
End Sub
Private Sub mnuListData_Click()
    MsgBox "Used like .ItemData in the standard VB listbox to associate data to an index", , ""
End Sub
Private Sub mnuListPicture_Click()
    Dim spResp As String
    spResp = InputBox$("Enter the picture to show.", "ListPicture", "", Me.Left + 120, Me.Top + 120)
    If Len(spResp) And Dir$(spResp) <> "" Then
        Mh3dFile1.ListPicture(0) = LoadPicture(spResp)
    Else
        MsgBox "Action canceled", , "Error"
    End If
End Sub
Private Sub mnuListPictureSel_Click()
    Dim spResp As String
    spResp = InputBox$("Enter the picture to show.", "ListPictureSel", "", Me.Left + 120, Me.Top + 120)
    If Len(spResp) And Dir$(spResp) <> "" Then
        Mh3dFile1.ListPictureSel(0) = LoadPicture(spResp)
    Else
        MsgBox "Action canceled", , "Error"
    End If
End Sub
Private Sub mnuMultiSelect_Click()
    ReDim sgOptionArray(0 To 1)
    sgOptionArray(0) = "False"
    sgOptionArray(1) = "True"
    igOptionState = Mh3dFile1.MultiSelect
    Mh3dFile1.MultiSelect = GetOption("Multiselect")
End Sub
Private Sub mnuPictureHeight_Click()
    igRangeArray(0) = 0
    igRangeArray(1) = Mh3dFile1.PictureHeight
    igRangeArray(2) = 20
    Mh3dFile1.PictureHeight = GetRange("PictureHeight")
End Sub
Private Sub mnuPictureWidth_Click()
    igRangeArray(0) = 0
    igRangeArray(1) = Mh3dFile1.PictureWidth
    igRangeArray(2) = 20
    Mh3dFile1.PictureWidth = GetRange("PictureWidth")
End Sub
Private Sub mnuScreenUpdate_Click()
    ReDim sgOptionArray(0 To 1)
    sgOptionArray(0) = "No automatic refresh on data change"
    sgOptionArray(1) = "Automatic refresh"
    igOptionState = Mh3dFile1.Screenupdate
    Mh3dFile1.Screenupdate = GetOption("ScreenUpdate")
End Sub
Private Sub mnuScrollbars_Click()
    ReDim sgOptionArray(0 To 1)
    sgOptionArray(0) = "None"
    sgOptionArray(1) = "Verticle only"
    igOptionState = Mh3dFile1.ScrollBars
    Mh3dFile1.ScrollBars = GetOption("Scrollbars")
End Sub
Private Sub mnuSelectedCount_Click()
    MsgBox Mh3dFile1.SelectedCount, , "SelectedCount"
End Sub
Private Sub mnuShadowColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.ShadowColor = lgCurrentColor
End Sub
Private Sub mnuTagged_Click()
    Dim pMsg As String
    Dim i As Integer
    pMsg = ""
    For i = 0 To Mh3dFile1.ListCount - 1
        pMsg = pMsg & Str(i) & Chr$(9) & Mh3dFile1.Tagged(i) & Chr$(13) & Chr$(10)
    Next i
    MsgBox pMsg, , "Tagged"
End Sub
Private Sub mnuTextColor_Click()
    ColorSelect.Show 1
    Mh3dFile1.TextColor = lgCurrentColor
End Sub
Private Sub mnuTopIndex_Click()
    MsgBox Mh3dFile1.TopIndex, , "TopIndex"
End Sub
Private Sub mnuWallPaper_Click()
    ReDim sgOptionArray(0 To 2)
    sgOptionArray(0) = "StrBlt"
    sgOptionArray(1) = "BitBlt"
    sgOptionArray(2) = "Replicate"
    igOptionState = Mh3dFile1.WallPaper
    Mh3dFile1.WallPaper = GetOption("WallPaper")
End Sub
Private Sub mnuWrapList_Click()
    ReDim sgOptionArray(0 To 1)
    sgOptionArray(0) = "False"
    sgOptionArray(1) = "True"
    igOptionState = Mh3dFile1.WrapList
    Mh3dFile1.WrapList = GetOption("WrapList")
End Sub
Private Sub mnuWrapWidth_Click()
    igRangeArray(0) = 0
    igRangeArray(1) = Mh3dFile1.WrapWidth
    igRangeArray(2) = 10
    Mh3dFile1.WrapWidth = GetRange("WrapWidth")
End Sub