PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.5/Tools/Arsenal/parts/pseditor/PSEDITOR.ETO

Text File | 1996-07-08 | 37KB | 1,180 lines

Type PropertySheetEditor From Form
  Type ObToolBar From ObjectBox
    Dim AddSheetGadget As New ToolGadget
    Dim DeleteSheetGadget As New ToolGadget
    Dim MoveLeftGadget As New ToolGadget
    Dim MoveRightGadget As New ToolGadget
    Dim ToggleEditorGadget As New ToolGadget
    Dim NewPageGadget As New ToolGadget
    Dim ConfigureSheetGadget As New ToolGadget
    Dim ResizeGadget As New ToolGadget
  End Type
  Dim CurrentPage As Object
  Type CmbSheetViewer From ComboBox
    Dim SupressClick As Boolean

    ' METHODS for object: PropertySheetEditor.CmbSheetViewer
    Sub Change()
      dim o as Object
      o = FindEmbed(PropertySheetEditor.CurrentPage, Text & "Tab")
      If o && TypeOf o Is PropertySheetMaster.Ptab Then
        PropertySheetEditor.CurrentPage.SetCurrentTab(o)
        o.DetailedEdit
      End If
    End Sub

    Sub Click()
      If SupressClick Then
        SupressClick = False
        Exit Sub
      End If
      With PropertySheetEditor
        .CurrentPage.SetCurrentTab(FindEmbed(.CurrentPage, List(ListIndex) & "Tab"))
        .EditFocus(.CurrentPage)
      End With ' PropertySheetEditor
    End Sub

    Sub DropDown()
      If Parent.CurrentPage Then
        Dim i as integer
        Dim s As String
        Clear
        With Parent.CurrentPage.TabGroup
          For i = .Count - 1 To 0 Step -1
            s = .ObjectAt(i).sheet.Name
            If s <> "" Then AddItem(s)
          Next i
        End With ' Parent.CurrentPage.TabGroup
        If Parent.CurrentPage.CurrentTab && Parent.CurrentPage.CurrentTab.sheet.Name <> Text Then
          SupressClick = True
          ListIndex = ItemIndex(Parent.CurrentPage.CurrentTab.sheet.Name)
        End If
      Else
        Clear
      End If
    End Sub

  End Type

  ' METHODS for object: PropertySheetEditor
  Sub AddSheetGadget_Click()
    Try
      Dim nm as String
      nm = GetNewSheetName()
      If nm = "" Then Exit Sub
      ' Create a new sheet
      CurrentPage.NewSheet(nm, nm)
      EditFocus(CurrentPage)
    Catch DuplicateSheet
      InfoBox.Message("Duplicate Sheet", "Sheet '" & nm & "' already in '" & CurrentPage & "'.")
    End Try

  End Sub

  Function AddSheetGadget_Enable() As Integer
    If CurrentPage Then
      AddSheetGadget_Enable = True
    Else
      AddSheetGadget_Enable = False
    End If
  End Function

  Sub ConfigureSheetGadget_Click()
    Dim newname, OldName As String
    Dim Result As Long
    Dim NewColumn, OrigionalColumn As Integer
    Dim ptw, pth As Integer

    ' Initialize textboxes
    With PropertySheetMaster.ConfigForm
      .LoadForm ' Load the form so textboxes may be set.
      ' This is always called on the current tab, which is always foward
      OrigionalColumn = CurrentPage.TabGroup.ObjectIndex(CurrentPage.CurrentTab) + 1
      .txtNewPosition.Text = Str$(OrigionalColumn)
      OldName = CurrentPage.CurrentTab.sheet.Name
      .txtSheetName.Text = OldName
      .ShowModal
    End With ' PropertySheetMaster.ConfigForm
    Result = PropertySheetMaster.ConfigForm.ReturnID

    If Result <> IDOK Then
      Exit Sub
    Else
      With PropertySheetMaster.ConfigForm
        NewColumn = Val(.txtNewPosition.Text) - 1 ' convert to array notation
        OrigionalColumn = OrigionalColumn - 1 ' convert to array notation
        newname = .txtSheetName.Text
        If newname <> "" && newname <> CurrentPage.CurrentTab.sheet.Name Then
          CurrentPage.CurrentTab.Name = newname & "Tab"
          CurrentPage.CurrentTab.Caption = newname
          CurrentPage.CurrentTab.sheet.Name = newname
        End If
      End With ' PropertySheetMaster.ConfigForm
      ' If a position textbox was left empty, don't try to swap tabs
      If NewColumn <> -1 && NewColumn <> OrigionalColumn Then
        CurrentPage.SwapTabs(NewColumn, OrigionalColumn)
      End If
      If newname <> "" && newname <> OldName Then
        With CurrentPage.CurrentTab
          .GetTextExtent(.hDC, .Caption, ptw, pth)
          .Move(CurrentPage.TabGroup.RightEdge, .sheet.Top - (.Height - 30), ptw + 180, .Height)
          CurrentPage.TabGroup.AdjustTabPositions
        End With ' CurrentPage.CurrentTab
      End If
    End If
  End Sub

  Function ConfigureSheetGadget_Enable() As Integer
    If CurrentPage && CurrentPage.CurrentTab Then
      ConfigureSheetGadget_Enable = True
    Else
      ConfigureSheetGadget_Enable = False
    End If
  End Function

  Sub DeleteSheetGadget_Click()
    ' Remove sheet and reset CurrentTab
    CurrentPage.RemoveSheet()
    EditFocus(CurrentPage)
  End Sub

  Function DeleteSheetGadget_Enable() As Integer
    Dim s As String
    Dim ReturnValue As Integer

    If CurrentPage = Nothing Then
      ReturnValue = 0
    Else
      If Not CurrentPage.CurrentTab Then
        ReturnValue = 0
      Else
        ReturnValue = -1
      End If
    End If

    If ReturnValue Then
      s = CurrentPage.CurrentTab.sheet.Name
      With CmbSheetViewer
        If .ItemIndex(s) = -1 Then .AddItem(s)
        If .Text <> s Then .ListIndex = .ItemIndex(s)
      End With ' CmbSheetViewer
      s = "Editing: " & CurrentPage
      If StrComp(Caption, s) <> 0 Then Caption = s
    Else
      s = "Editing: " & CurrentPage
      If StrComp(Caption, s) <> 0 Then
        If CurrentPage Then Caption = s
      End If
    End If

    If Not CurrentPage || Not CurrentPage.CurrentTab Then CmbSheetViewer.Clear
    If Not CurrentPage && StrComp(Caption, "Editing: ") <> 0 Then Caption = "Editing: "

    ' Editor shouldn't continue to edit a hidden page.
    ' NOTE: there is no way to re-edit a page that has no sheets.
    If CurrentPage && Not CurrentPage.Visible Then EditFocus(Nothing)
    DeleteSheetGadget_Enable = ReturnValue
  End Function

  Function EditFocus(page As PropertySheetMaster.Page) As Boolean

    ' default to false.
    EditFocus = False

    ' If no page set editor to nothing
    If Not page Then
      CurrentPage = Nothing
    Else
      ' set CurrentPage to given page.
      CurrentPage = page
    End If

    If FindObject("FormEditor") && CurrentPage && CurrentPage.CurrentTab Then
      If FormEditor.CurForm <> CurrentPage.CurrentTab.sheet Then FormEditor.CurForm = CurrentPage.CurrentTab.sheet
    End If

    PropertySheetEditor.Show
    PropertySheetEditor.BringToTop

    EditFocus = True
  End Function

  Function GetNewSheetName() As String
    Dim indlg As New InputDialog
    Dim title, instructions, defaultanswer As String
    Dim tempstr As String
    Dim endDigit, i As Integer

    title = "Name Sheet"
    instructions = "Enter a name for the sheet"
    defaultanswer = UniqueEmbedName(CurrentPage, "Sheet")

    indlg.Execute(title, instructions, defaultanswer)
    ' Proceed only if OK was clicked, the answer is a valid string,
    ' and the object does not already exist.
    If (indlg.Response = IDOK) && ValidName(indlg.Text) && (Not FindEmbed(CurrentPage, indlg.Text)) Then
      GetNewSheetName = indlg.Text
    End If
  End Function

  Sub Load()
    ObToolBar.AutoEnabler = True
  End Sub

  Function MoveLeftGadget_Click() As Integer
    CurrentPage.MoveLeft
  End Function

  Function MoveLeftGadget_Enable() As Integer
    If CurrentPage && CurrentPage.CurrentTab Then
      If CurrentPage.CurrentTab <> CurrentPage.TabGroup(0) Then
        If CurrentPage.TabGroup.Count > 1 Then
          MoveLeftGadget_Enable = True
        End If
      End If
    Else
      MoveLeftGadget_Enable = False
    End If
  End Function

  Function MoveRightGadget_Click() As Integer
    CurrentPage.MoveRight
  End Function

  Function MoveRightGadget_Enable() As Integer
    If CurrentPage && CurrentPage.CurrentTab Then
      With CurrentPage.TabGroup
        If .Count > 1 Then
          If CurrentPage.CurrentTab <> .ObjectAt(.Count - 1) Then
            MoveRightGadget_Enable = True
          End If
        End If
      End With ' CurrentPage.TabGroup
    Else
      MoveRightGadget_Enable = False
    End If
  End Function

  Function NeedToHide() As Boolean
    Dim i, NumberVisible As Integer

    NumberVisible = 0
    With CurrentPage.TabGroup
      ' count the number of visible sheets in the group
      For i = 0 To .Count - 1
        If .ObjectAt(i).sheet.Visible Then NumberVisible = NumberVisible + 1
      Next i
    End With ' CurrentPage.TabGroup

    If NumberVisible > 1 Then
      NeedToHide = True
    Else
      NeedToHide = False
    End If
  End Function

  Sub NewPageGadget_Click()
    Dim indlg As New InputDialog
    Dim newname As String
    Dim title, instructions, defaultanswer As String
    Dim ExistingObject As Object

    title = "Create New Property Page"
    instructions = "Enter a name for the new page:"
    If CurrentPage && Left$(CurrentPage.Name, 4) <> "Page" Then
      defaultanswer = UniqueObjectName(CurrentPage)
    Else
      defaultanswer = UniqueObjectName(PropertySheetMaster.Page)
    End If

    indlg.Execute(title, instructions, defaultanswer)
    newname = indlg.Text
    ExistingObject = FindObject(newname)

    ' Inform the user that he has tried use the name of an existing object.
    If ExistingObject Then
      If Not ExistingObject.Visible Then
        InfoBox.Message("Error creating new Property Page", "A hidden Property Page called " & newname & " already exists!")
      Else
        InfoBox.Message("Error creating new Property Page", "A Property Page called " & newname & " already exists!")
      End If
      Exit Sub
    End If

    If (indlg.Response = IDOK) && ValidName(newname) Then
      PropertySheetMaster.NewPage(newname, newname).Show
      EditFocus(FindObject(newname))
    End If

  End Sub

  Function NewPageGadget_Enable() As Integer
    NewPageGadget_Enable = True
  End Function

  Sub Resize()
    Dim w, h as single
    Dim tbw, mar as single
    mar = 75
    With ObToolBar
      Dim desH As Single
      desH = IIf(.Height > 400, .Height + 400, 800)
      If Height <> desH Then
        Height = desH
      End If
      w = .Width : h = .Height
    End With ' ObWith PropertySheetToolBar
    ObToolBar.Move(0, 0, w, h)
    tbw = IIf(ScaleWidth - w > 0, ScaleWidth - w - 2 * mar, 2 * mar)
    CmbSheetViewer.Move(w + mar, mar, tbw, h - 2 * mar)
  End Sub

  Sub ResizeGadget_Click()
    If CurrentPage.BorderStyle <> "Sizable" Then
      CurrentPage.BorderStyle = "Sizable"
    Else
      CurrentPage.BorderStyle = "Fixed Single"
    End If
  End Sub

  Function ResizeGadget_Enable() As Integer
    If CurrentPage Then
      If CurrentPage.BorderStyle = "Sizable" Then
        ObToolBar.ResizeGadget.State = "Down"
      Else
        ObToolBar.ResizeGadget.State = "Up"
      End If
    End If
    ResizeGadget_Enable = (CurrentPage <> Nothing)
  End Function

  Sub Setup()
    If CurrentPage = Nothing Then EditFocus(Nothing)
  End Sub

  Function TextUnload(ByVal indent As String, cmds As String) As Integer
    TextUnload = False
  End Function

  Sub ToggleEditorGadget_Click()
    FormEditor.Editing = Not FormEditor.Editing
  End Sub

  Function ToggleEditorGadget_Enable() As Integer
    ObToolBar.ToggleEditorGadget.State = IIf(FormEditor.Editing, "Down", "Up")
    ToggleEditorGadget_Enable = (TypeOf FormEditor.CurForm Is PropertySheetMaster.Sheet) && (CurrentPage <> Nothing)
  End Function

  Function ValidName(ByVal namestr As String) As Boolean
    Dim i, char As Integer

    ' Return False if empty string is entered.  Send no error message.
    ' User may enter an empty string as a way to exit the dialog.
    If namestr = "" Then
      ValidName = False
      Exit Sub
    End If

    char = Asc(Left$(namestr, 1))
    If char >= 48 && char <= 57 Then
      InfoBox.Message("Invalid Name", """" & namestr & """ contains an illegal character!")
      ValidName = False
      Exit Function
    End If

    For i = 1 To Len(namestr)
      char = Asc(Mid$(namestr, i, 1))
      If (char < 65 || char > 90) && (char < 97 || char > 122) Then
        If (char < 48 || char > 57) && (char <> 95) Then
          InfoBox.Message("Invalid Name", """" & namestr & """ contains an illegal character!")
          ValidName = False
          Exit Function
        End If
      End If
    Next i
    ValidName = True
  End Function

End Type

Type PropertySheetMaster
  Dim SheetFont As New Font
  Type Page From Form
    Property CurrentTab Get GetCurrentTab As PropertySheetMaster.Ptab
    Dim Supress As Boolean
    Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hFont As Long) As Long
    Type TabGroup From Group

      ' METHODS for object: PropertySheetMaster.Page.TabGroup
      Sub AdjustTabPositions()
        Dim i As Integer
        Dim ps As PropertySheetMaster.Sheet
        Dim pt, prevtab As PropertySheetMaster.Ptab
        Dim Edge As Single
        Dim NewTop As SIngle

        ' No reason to adjust tabs if there are none
        If Count = 0 Then Exit Sub

        ' Adjust tab tops
        NewTop = Me(0).sheet.Top - (Me(0).Height - 30)

        ' Look at the CurrentGroup and adjust tabs accordingly
        For i = 0 To Count - 1
          pt = Me(i)
          If i < 1 Then
            Edge = 150
          Else
            prevtab = ObjectAt(i - 1)
            Edge = prevtab.Left + prevtab.Width
          End If
          pt.Move Edge, NewTop, pt.Width, pt.Height
        Next i

        pt = Me(0).page.CurrentTab
        ' Supress refresh and toggle status of all controls
        ' This makes pt current, all others non current
        pt.SupressRefresh = True

        Me.ToggleStatus(pt)

        ' Unhide the current property sheet
        pt.sheet.Show

        ' Hide all the non-current sheets
        Me.HideNonCurrent

      End Sub

      Sub HideNonCurrent()
        Dim i As Integer
        For i = 0 To Count - 1
          If Not Me(i).currenttab && Me(i).sheet.Visible Then Me(i).sheet.Hide
        Next i
      End Sub

      Function RightEdge() As Single
        Dim ptab As PropertySheetMaster.Ptab

        If Count = 0 Then
          RightEdge = 150
        Else
          ptab = ObjectAt(Count - 1)
          RightEdge = ptab.Left + ptab.Width
        End If
      End Function

      Sub ToggleStatus(pt As PropertySheetMaster.Ptab)
        Dim i As Integer
        Dim o As PropertySheetMaster.Ptab

        For i = 0 To Count - 1
          o = Me(i)
          If o <> pt Then
            If o.currenttab = -1 Then
              ' Toggle the tab to off
              o.currenttab = 0
              o.TabFont.Bold = False
              o.Refresh
            End If
          Else
            If o.currenttab = 0 Then
              o.currenttab = -1
            End If
            ' I always refresh myself if I'm clicked
            If o.SupressRefresh Then
              o.SupressRefresh = False
            Else
              o.TabFont.Bold = True
              o.Refresh
            End If
          End If
        Next i
      End Sub

      Sub TrackSize(ByVal psleft, pstop, pswidth, psheight As Single)
        Dim i, j As Integer
        Dim pgroup As PropertySheetMaster.TabGroup

        If Count = 0 Then Exit Sub

        HostObject(Me).Supress = True
        For i = 0 To Count - 1
          Me(i).sheet.Move(psleft, pstop, pswidth, psheight)
        Next i

        HostObject(Me).Supress = False
      End Sub

    End Type

    ' METHODS for object: PropertySheetMaster.Page
    Function DetailedEdit() As Boolean
      DetailedEdit = False
      Try
        If FindObject("PropertySheetEditor") Then
          DetailedEdit = PropertySheetEditor.EditFocus(Me)
        End If
      Catch
      End Try
    End Function

    Function Edit() As Boolean
      Try
        Edit = PropertSheetEditor.EditFocus(Me)
      Catch
      End Try

    End Function

    Function GetCurrentTab() As PropertySheetMaster.Ptab
      Dim hop As Integer
      Dim pointer As object

      With TabGroup
        For hop = 0 To .Count - 1
          pointer = .ObjectAt(hop)
          If pointer.currenttab Then
            GetCurrentTab = pointer
            Exit Function
          End If
        Next hop
      End With ' TabGroup

      GetCurrentTab = Nothing
    End Function

    Function MoveLeft As Integer
      ' use pos to hold position of Sheet to be made current after delete
      Dim pos, newpos As Integer
      Dim pt As PropertySheetMaster.Ptab

      With TabGroup
        pos = .ObjectIndex(CurrentTab)
        newpos = pos - 1
        pt = .RemoveAt(pos)
        .InsertAt(pt, newpos)
        .AdjustTabPositions
      End With ' TabGroup
    End Function

    Function MoveRight As Integer
      ' use pos to hold position of Sheet to be made current after delete
      Dim pos, newpos As Integer
      Dim pt As PropertySheetMaster.Ptab

      With TabGroup
        pos = .ObjectIndex(CurrentTab)
        newpos = pos + 1
        pt = .RemoveAt(pos)
        If newpos = .Count Then
          .Append(pt)
        Else
          .InsertAt(pt, newpos)
        End If
        .AdjustTabPositions
      End With ' TabGroup

    End Function

    Function NewSheet (name As String, title as String) As PropertySheetMaster.Sheet
      Dim ptw, pth, i As Integer
      Dim ps, prevsheet As PropertySheetMaster.Sheet
      Dim pt As PropertySheetMaster.Ptab

      ' Verify that we don't already have sheet with this name
      If FindEmbed(Me, name) Then Throw DuplicateSheet(name)

      ' Supress Resize event, otherwise all sheets will revert to
      ' default size.
      Supress = True

      ' Embed a property tab in the property page
      pt = EmbedObject(Me, PropertySheetMaster.Ptab, name & "Tab")

      ' Move the property sheet Prototype into position
      With PropertySheetMaster.Sheet
        .Move(150, ScaleHeight - .Height - 150, .Width, .Height)
      End With

      ' Embed a property sheet in the property page
      ps = EmbedObject(Me, PropertySheetMaster.Sheet, name)

      ' Font bug work-around
      pt.TabFont.FaceName = PropertySheetMaster.Ptab.TabFont.FaceName
      pt.TabFont.Size = PropertySheetMaster.Ptab.TabFont.Size
      pt.TabFont.Bold = PropertySheetMaster.Ptab.TabFont.Bold

      ' connect the font to the tab so tab can be sized to caption
      SelectObject(pt.hDC, pt.TabFont.HFont)
      pt.GetTextExtent(pt.hDC, title, ptw, pth)

      ' get the tab into position
      pt.Move(TabGroup.RightEdge, ps.Top - (pt.Height - 30), ptw + 180, pt.Height)

      ' Connect pointer in the sheet to its tab
      ps.ptab = pt
      ' Save away the name of the sheet in the property sheets caption
      ps.Caption = title

      ' Let the property tab connect to the property page. Send it the
      ' sheet so it can set its sheet reference
      pt.ConnectToPage(Me, ps)

      ' Hide the existing sheets if there are any
      If TabGroup.Count > 1 Then
        prevsheet = TabGroup(TabGroup.Count - 2).sheet
        With prevsheet
          ps.Move(.Left, .Top, .Width, .Height)
        End With ' prevsheet
        TabGroup.HideNonCurrent
      End If

      ' Unsupress the Resize Event
      Supress = False

      ' Set the CurrentTab
      SetCurrentTab(pt)

      ' Return the new property sheet
      NewSheet = ps
    End Function

    Sub RemoveSheet()
      ' use pos to hold position of Sheet to be made current after delete
      Dim pos As Integer
      Dim oldpt, newpt As PropertySheetMaster.Ptab

      ' FInd the new CurrentTab
      With TabGroup
        ' look through the sheets to find our current one or bail
        pos = .ObjectIndex(CurrentTab)
        If pos = -1 Then Exit Sub
        If pos = 0 Then
          newpt = IIf(.Count <> 1, .ObjectAt(pos + 1), Nothing)
        Else
          newpt = .ObjectAt(pos - 1)
        End If
      End With ' TabGroup

      ' Remove this tab from the group
      oldpt = TabGroup.RemoveAt(pos)

      ' Destroy the tab's sheet
      DestroyObject(oldpt.sheet)

      ' Destroy the tab
      DestroyObject(oldpt)


      If TabGroup.Count > 0 Then
        SetCurrentTab(IIf(newpt, newpt, Nothing))
      Else
        SetCurrentTab(Nothing)
      End If

      ' Update the tab positions if more than one tab
      If TabGroup.Count > 1 Then TabGroup.AdjustTabPositions
    End Sub

    Sub Resize()
      Dim i As Integer

      For i = 0 To TabGroup.Count - 1
        With TabGroup(i).sheet
          .Move(.Left, ScaleHeight - .Height - 150, .Width, .Height)
        End With ' TabGroup(i).sheet
      Next i
      TabGroup.AdjustTabPositions
    End Sub

    Sub SetCurrentTab(o As PropertySheetMaster.Ptab)

      If o = CurrentTab Then Exit Sub
      If o && TypeOf o Is PropertySheetMaster.Ptab Then
        SendEvent o.Click
      End If
    End Sub

    Sub SwapTabs(NewColumn As Integer, OldColumn As Integer)
      ' This method is on Page because it is much easier to work with
      ' the required references here.
      Dim temp1, temp2 As PropertySheetMaster.Ptab

      ' Make sure Column and Row contain acceptable values
      ValidatePosition(NewColumn)

      ' Correct for change in position caused by removal of old tab
      If NewColumn > OldColumn Then NewColumn = NewColumn - 1

      ' remove the current tab and hang on to it
      temp1 = TabGroup.RemoveAt(OldColumn)
      ' remove the tab being replaced and hang on to it.
      temp2 = TabGroup.RemoveAt(NewColumn)

      ' Put the current tab in it's new spot
      TabGroup.InsertAt(temp1, NewColumn)

      ' put the old tab in the spot left empty by the current tab
      TabGroup.InsertAt(temp2, OldColumn)

      TabGroup.AdjustTabPositions ' repaint tabs
      SetCurrentTab(temp2)
    End Sub

    Sub UpdateDisplay (pt As PropertySheetMaster.Ptab)
      ' Display the propertysheet
      pt.sheet.Show

      ' Bring the propertysheet to the top of the pile.
      ' This is a bug work-around
      pt.sheet.BringToTop
      pt.ZOrder = 1

      ' Hide all the sheets
      TabGroup.HideNonCurrent
    End Sub

    Sub ValidatePosition(c As Integer)
      If c < 0 Then
        c = 0
      ElseIf c > TabGroup.Count - 1 Then
        c = TabGroup.Count - 1
      End If
    End Sub

  End Type
  Type Sheet From Form
    Dim ptab As PropertySheetMaster.Ptab
    Event OK(ok as Boolean)
    Event Cancel(ok as Boolean)

    ' METHODS for object: PropertySheetMaster.Sheet
    Sub Destruct()
      ' If the sheet has a tab, remove the tab's sheet reference and
      ' destroy the tab.
      If ptab <> Nothing Then
        ptab.sheet = Nothing
        DestroyObject(ptab)
      End If

      Parent.TabGroup.AdjustTabPositions
    End Sub

    Function DetailedEdit() As Boolean
      DetailedEdit = False
      Try
        If Parent Then
          Parent.SetCurrentTab(Me.ptab)
          If FindObject("PropertySheetEditor") Then
            DetailedEdit = PropertySheetEditor.EditFocus(Parent)
          End If
        End If
      Catch
      End Try
    End Function

    Sub Resize()
      If Parent.Supress Then Exit Sub

      Parent.TabGroup.TrackSize(Left, Top, Width, Height)
      Parent.TabGroup.AdjustTabPositions
    End Sub

  End Type
  Type Ptab From PictureBox
    Declare Function GetTabbedTextExtent Lib "User32.dll" Alias "GetTabbedTextExtentA" (ByVal hdc As Long, ByVal lpsz As String, ByVal cchString As Long, ByVal nTabPos As Long, ByVal lpnTabStopPos As Long) As Long
    Dim SupressRefresh As Boolean
    Dim page As PropertySheetMaster.Page
    Dim sheet As PropertySheetMaster.Sheet
    Dim currenttab As Integer
    Dim TabFont As New Font

    ' METHODS for object: PropertySheetMaster.Ptab
    Sub Click()

      ' If my tab is already forward, do nothing
      If currenttab = -1 Then Exit Sub

      ' Tell other tabs to turn themselves off
      Parent.TabGroup.ToggleStatus(Me)
      Parent.UpdateDisplay(Me)
    End Sub

    Sub ConnectToPage (pp as PropertySheetMaster.Page, ps As PropertySheetMaster.Sheet)

      ' connect the tab to its sheet
      sheet = ps

      ' connect the tab to the page
      page = pp

      ' Append us to the end of the group of tabs
      page.TabGroup.Append(Me)

      ' Set the name of the tab caption
      Caption = ps.Caption
    End Sub

    Sub Destruct()

      Parent.TabGroup.RemoveObject(Me)

      ' If the tab has a sheet, remove the sheet's tab reference and
      ' destroy the sheet.
      If sheet <> Nothing Then
        sheet.ptab = Nothing
        DestroyObject(sheet)
      End If

      ' If we're embeded in a page, reset it's current tab
      If page Then
        Dim newpt As PropertySheetMaster.Ptab
        newpt = IIf(page.TabGroup(0), page.TabGroup(0), Nothing)
        If newpt Then page.SetCurrentTab(newpt)
      End If

      Parent.TabGroup.AdjustTabPositions
    End Sub

    Function DetailedEdit() As Boolean
      DetailedEdit = False
      Try
        If Parent Then
          Parent.SetCurrentTab(Me)
          If FindObject("PropertySheetEditor") Then
            DetailedEdit = PropertySheetEditor.EditFocus(Parent)
          End If
        End If
      Catch
      End Try
    End Function

    Sub DisconnectFromPage()
      ' If we don't have a propertypage, our caller made a mistake
      If Not page Then Throw TabNotConnected

      ' Remove us from the group of sheets in our parent
      page.TabGroup.RemoveObject(Me)
    End Sub

    Sub GetTextExtent(dc As Long, s As String, width, height as Integer)
      dim result as long

      result = GetTabbedTextExtent(dc, s, Len(s), 0, 0)
      ' The results are stored in the upper word and lower word of return value as pixels,
      ' convert these numbers to twips before returning.
      width = (result And &Hffff) * Screen.TwipsPerPixelX
      height = ((result And &Hffff0000) / &H10000) * Screen.TwipsPerPixelY
    End Sub

    Sub Paint()
      Static line1x(10), line1y(10) As Single
      Static line2x(10), line2y(10) As Single
      Static line3x(10), line3y(10) As Single
      Static line4x(10), line4y(10) As Single
      Static line5x(10), line5y(10) As Single
      Static line6x(10), line6y(10) As Single
      Static line7x(10), line7y(10) As Single
      Static line8x(10), line8y(10) As Single
      Dim chamfer, crnr, inwidth As Single
      Dim width, height, offset, soffset As Single

      chamfer = Height * 0.1
      offset = 20
      soffset = 1
      width = Width - 1
      height = Height - 1
      crnr = chamfer + soffset
      inwidth = width - chamfer - soffset
      line1x(0) = soffset : line1y(0) = height
      line1x(1) = soffset : line1y(1) = crnr
      line1x(2) = crnr : line1y(2) = soffset
      line1x(3) = inwidth : line1y(3) = soffset
      line1x(4) = width : line1y(4) = crnr
      line1x(5) = width : line1y(5) = height + 15

      line2x(0) = offset : line2y(0) = height
      line2x(1) = offset : line2y(1) = chamfer + offset
      line2x(2) = chamfer + offset : line2y(2) = offset
      line2x(3) = width - chamfer - offset : line2y(3) = offset

      line3x(0) = width - chamfer - offset : line3y(0) = offset
      line3x(1) = width - offset : line3y(1) = crnr
      line3x(2) = width - offset : line3y(2) = height - offset + 30

      ' Draw the Black tab border
      DrawColor = 0
      Polyline(line1x, line1y, 6)
      ' Draw the inner White tab border
      DrawColor = RGB(255, 255, 255)
      Polyline(line2x, line2y, 4)
      ' Draw the inner Gray tab border
      DrawColor = RGB(128, 128, 128)
      Polyline(line3x, line3y, 3)

      ' If there is a caption, display it
      If Caption <> "" Then
        Dim tw, th As Integer
        DrawColor = ForeColor
        page.SelectObject(hDC, Font.HFont)
        GetTextExtent(hDC, Caption, tw, th)
        MoveTo((Width - tw) / 2, (Height - th) / 2)
        Print (Caption)
      End If
    End Sub

  End Type
  Type ConfigForm From Form
    Dim lblName As New Label
    Dim lblPosition As New Label
    Dim txtSheetName As New TextBox
    Dim txtNewPosition As New TextBox
    Dim btnOk As New Button
    Dim btnCancel As New Button
    Dim ReturnID As Long
    Dim TextBoxFont As New Font

    ' METHODS for object: PropertySheetMaster.ConfigForm
    Sub btnCancel_Click()
      Hide
      ReturnID = IDCANCEL
    End Sub

    Sub btnOk_Click()
      Hide
      ReturnID = IDOK
    End Sub

    Sub txtNewColumn_KeyPress(keyAscii As Integer)
      ' accept Backspace and Enter keys
      If keyAscii = 8 || keyAscii = 10 Then Exit Sub
      ' Don't accept any other keys other than 0 - 9
      If keyAscii < 48 || keyAscii > 57 Then keyAscii = 0
    End Sub

    Sub txtNewPosition_KeyPress(keyAscii As Integer)
      ' accept Backspace and Enter keys
      If keyAscii = 8 || keyAscii = 10 Then Exit Sub
      ' Don't accept any other keys other than 0 - 9
      If keyAscii < 48 || keyAscii > 57 Then keyAscii = 0
    End Sub

    Sub txtSheetName_KeyPress(keyAscii As Integer)
      ' accept Backspace and Enter keys
      If keyAscii = 8 || keyAscii = 10 Then Exit Sub
      ' accept A-Z, a-z, 0-9, and _
      If (keyAscii < 65 || keyAscii > 90) && (keyAscii < 97 || keyAscii > 122) Then
        If (keyAscii < 48 || keyAscii > 57) && (keyAscii <> 95) Then
          keyAscii = 0
        End If
      End If
    End Sub

  End Type

  ' METHODS for object: PropertySheetMaster
  Function NewPage(name As String, title As String) As PropertySheetMaster.Page
    Dim p As PropertySheetMaster.Page

    ' Verify that the name is open
    If (FindObject(name)) Then Throw DuplicatePage(name)

    ' Create a top level object with the given name as a kind of property page
    p = CopyObject(Page, name)

    ' Set the property pages title
    p.Caption = title

    ' Set the CurrentTab to Nothing
    p.SetCurrentTab(Nothing)

    ' Return the new property page
    NewPage = p

  End Function

End Type

Begin Code
' Reconstruction commands for object: PropertySheetEditor
'
  With PropertySheetEditor
    .Caption := "Editing: "
    .Move(8940, 6840, 5265, 850)
    With .ObToolBar
      .ZOrder := 1
      .Move(0, 0, 3300, 450)
      .LayoutStyle := "ToolBar"
      .Visible := True
      With .AddSheetGadget
        .Enabled := False
        .Position := 2
        .HintText := "Add a New Property Sheet"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 0
        End With  'PropertySheetEditor.ObToolBar.AddSheetGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.AddSheetGadget
      With .DeleteSheetGadget
        .Enabled := False
        .Position := 3
        .HintText := "Delete a Property Sheet"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 392
        End With  'PropertySheetEditor.ObToolBar.DeleteSheetGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.DeleteSheetGadget
      With .MoveLeftGadget
        .Enabled := False
        .Position := 5
        .HintText := "Move Selected Sheet Left"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 784
        End With  'PropertySheetEditor.ObToolBar.MoveLeftGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.MoveLeftGadget
      With .MoveRightGadget
        .Enabled := False
        .Position := 6
        .HintText := "Move Selected Sheet Right"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 1176
        End With  'PropertySheetEditor.ObToolBar.MoveRightGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.MoveRightGadget
      With .ToggleEditorGadget
        .Enabled := False
        .Position := 7
        .ButtonType := "NonExclusive"
        .HintText := "Toggle Property Sheet Editor On/Off"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 1568
        End With  'PropertySheetEditor.ObToolBar.ToggleEditorGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.ToggleEditorGadget
      With .NewPageGadget
        .Position := 1
        .HintText := "Create A New Property Page"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 1960
        End With  'PropertySheetEditor.ObToolBar.NewPageGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.NewPageGadget
      With .ConfigureSheetGadget
        .Enabled := False
        .Position := 4
        .HintText := "Configure Current Sheet"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 2352
        End With  'PropertySheetEditor.ObToolBar.ConfigureSheetGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.ConfigureSheetGadget
      With .ResizeGadget
        .Enabled := False
        .Position := 8
        .State := "Down"
        .ButtonType := "NonExclusive"
        .HintText := "Toggle Page Resize On/Off"
        With .bitmap
          .FileName := "pseditor.ero"
          .ResId := 2744
        End With  'PropertySheetEditor.ObToolBar.ResizeGadget.bitmap
      End With  'PropertySheetEditor.ObToolBar.ResizeGadget
    End With  'PropertySheetEditor.ObToolBar
    With .CmbSheetViewer
      .ZOrder := 2
      .Move(3375, 75, 1695, 360)
      .Style := "DropdownList"
      .SupressClick := False
    End With  'PropertySheetEditor.CmbSheetViewer
  End With  'PropertySheetEditor
' Reconstruction commands for object: PropertySheetMaster
'
  With PropertySheetMaster
    With .SheetFont
      .FaceName := "MS Sans Serif"
      .Size := 8.000000
      .Bold := True
      .Italic := False
      .Strikethru := False
    End With  'PropertySheetMaster.SheetFont
    With .Page
      .Move(3210, 1260, 8610, 5790)
      .MaxButton := False
      .MinButton := False
      .Supress := False
      With .TabGroup
      End With  'PropertySheetMaster.Page.TabGroup
    End With  'PropertySheetMaster.Page
    With .Sheet
      .Font := PropertySheetMaster.SheetFont
      .Move(150, 1500, 7200, 3735)
      .BevelInner := "Raised"
      .BevelOuter := "Line"
      .BevelWidth := 1
      .ptab := Nothing
    End With  'PropertySheetMaster.Sheet
    With .Ptab
      .ForeColor := 3289650
      .Font := PropertySheetMaster.Ptab.TabFont
      .Move(4170, 900, 1800, 345)
      .DrawColor := 8421504
      .SupressRefresh := False
      .page := Nothing
      .sheet := Nothing
      .currenttab := 0
      With .TabFont
        .FaceName := "MS Sans Serif"
        .Size := 9.000000
        .Bold := False
        .Italic := False
        .Strikethru := False
      End With  'PropertySheetMaster.Ptab.TabFont
    End With  'PropertySheetMaster.Ptab
    With .ConfigForm
      .Caption := "Configure Sheet"
      .Move(6855, 3540, 2805, 2220)
      .DefaultButton := PropertySheetMaster.ConfigForm.btnOk
      .ReturnID := 1
      With .lblName
        .Caption := "Name:"
        .ZOrder := 1
        .Move(150, 675, 900, 300)
      End With  'PropertySheetMaster.ConfigForm.lblName
      With .lblPosition
        .Caption := "Position:"
        .ZOrder := 2
        .Move(150, 150, 900, 300)
      End With  'PropertySheetMaster.ConfigForm.lblPosition
      With .txtSheetName
        .Font := PropertySheetMaster.ConfigForm.TextBoxFont
        .ZOrder := 3
        .Move(1050, 675, 1425, 300)
      End With  'PropertySheetMaster.ConfigForm.txtSheetName
      With .txtNewPosition
        .Font := PropertySheetMaster.ConfigForm.TextBoxFont
        .ZOrder := 4
        .Move(1050, 150, 375, 300)
      End With  'PropertySheetMaster.ConfigForm.txtNewPosition
      With .btnOk
        .Caption := "Ok"
        .ZOrder := 5
        .Move(150, 1200, 1050, 450)
      End With  'PropertySheetMaster.ConfigForm.btnOk
      With .btnCancel
        .Caption := "Cancel"
        .ZOrder := 6
        .Move(1500, 1200, 975, 450)
      End With  'PropertySheetMaster.ConfigForm.btnCancel
      With .TextBoxFont
        .FaceName := "MS Sans Serif"
        .Size := 9.000000
        .Bold := True
        .Italic := False
        .Strikethru := False
      End With  'PropertySheetMaster.ConfigForm.TextBoxFont
    End With  'PropertySheetMaster.ConfigForm
  End With  'PropertySheetMaster
End Code