Chip 1998 July/Chip_1998-07_cd.bin/sharewar/envlp14/ENVELOP.3/Program/dialogs.eto

Text File | 1996-07-08 | 38.6 KB | 1,408 lines

Begin Code
  ModuleManager.PublishObjectDLL("evcdlg.dll")
End Code

Type DefaultDialogFont From Font
End Type

Type CommonDialog From CommonDialog
End Type

Type ColorDialog From ColorDialog
End Type

Type WizardMaster
  Const WM_BACK& = 3
  Const WM_NEXT& = 4
  Type StepTraverser
    Dim theStep As WizardMaster.FrmStep

    ' METHODS for object: WizardMaster.StepTraverser
    Sub FindFirstStep(o As Object)
      If TypeOf o Is WizardMaster.FrmStep Then
        If Not o.BackStep Then
          theStep = o
        End If
      End If
    End Sub

    Sub FindLastStep(o As Object)
      If TypeOf o Is WizardMaster.FrmStep Then
        If Not o.NextStep Then
          theStep = o
        End If
      End If
    End Sub

    Sub Init(o As Object)
      If TypeOf o Is WizardMaster.FrmStep Then
        o.initialized = False
      End If
    End Sub

    Sub SetCaption(o As Object)
      If TypeOf o Is WizardMaster.FrmStep Then
        o.Caption = o.wizard.Title
      End If
    End Sub

  End Type
  Type Wizard
    Dim Bitmap As New Bitmap
    Dim title_ As String
    Property Title Get getTitle Set setTitle As String
    Property GraphicFileName Get getGraphicFileName Set setGraphicFileName As String
    Property FirstStep Get getFirstStep Set setFirstStep As WizardMaster.FrmStep
    Property LastStep Get getLastStep Set setLastStep As WizardMaster.FrmStep
    Event Finish(ok As Boolean)
    Event Cancel()

    ' METHODS for object: WizardMaster.Wizard
    Function getFirstStep() As WizardMaster.FrmStep
      Dim t As New WizardMaster.StepTraverser
      EnumObjectEmbeds(Me, t, "FindFirstStep")
      getFirstStep = t.theStep
    End Function

    Function getGraphicFileName() As String
      getGraphicFileName = Bitmap.FileName
    End Function

    Function getLastStep() As WizardMaster.FrmStep
      Dim t As New WizardMaster.StepTraverser
      EnumObjectEmbeds(Me, t, "FindLastStep")
      getLastStep = t.theStep
    End Function

    Function getTitle() as String
      getTitle = title_
    End Function

    Function NewStep(name as String) As WizardMaster.FrmStep
      Dim s as WizardMaster.FrmStep
      Dim prevStep as WizardMaster.FrmStep

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

      ' Cache LastStep prior to embedding new step
      ' (prior to hooking up new step, LastStep is unreliable)
      prevStep = LastStep

      ' Embed a step in the form
      s = EmbedObject(Me, WizardMaster.FrmStep, name)

      ' Let the step connect to us as its containing wizard
      s.ConnectToWizard(Me, prevStep, Nothing)

      ' Return the new step
      NewStep = s
    End Function

    Sub RemoveStep(s as WizardMaster.FrmStep)
      ' Remove this step from the group
      s.DisconnectFromWizard

      ' Destroy the step
      DestroyObject(s)

    End Sub

    Sub RemoveStepByName(name as String)
      Dim s as WizardMaster.FrmStep

      ' Find the step we want to remove, or throw
      s = FindObject(name)
      If Not s Then Throw StepNotFound(name)

      ' Remove this step
      RemoveStep(s)
    End Sub

    Sub setFirstStep(s As WizardMaster.FrmStep)
      Dim currentFirst As WizardMaster.FrmStep

      If Not s || HostObject(s) <> Me Then Exit Sub

      ' Find the current first step
      currentFirst = FirstStep
      If currentFirst = s Then Exit Sub

      ' Disconnect the incoming step from us (the wizard)
      s.DisconnectFromWizard

      ' Hook up the Back & Next steps accordingly
      s.BackStep = Nothing
      s.NextStep = currentFirst

      If currentFirst Then currentFirst.BackStep = s

    End Sub

    Sub setGraphicFileName(n as String)
      Bitmap.FileName = n
    End Sub

    Sub setLastStep(s As WizardMaster.FrmStep)
      Dim currentLast As WizardMaster.FrmStep

      If Not s || HostObject(s) <> Me Then Exit Sub


      ' Find the current last step
      currentLast = LastStep
      If currentLast = s Then Exit Sub

      ' Disconnect the incoming step from us (the wizard)
      s.DisconnectFromWizard

      ' Hook up the Back & Next steps accordingly
      s.BackStep = currentLast
      s.NextStep = Nothing

      If currentLast Then currentLast.NextStep = s
    End Sub

    Sub setTitle(newTitle as String)
      Dim t as WizardMaster.StepTraverser
      title_ = newTitle
      EnumObjectEmbeds(Me, t, "SetCaption")
    End Sub

    Sub Show
      Dim t As New WizardMaster.StepTraverser

      ' If we have no first step, inform user of an empty wizard
      If Not FirstStep Then
        InfoBox.Message("Incomplete Wizard", "Wizard " & Me & " has no steps.")
        Exit Sub
      End If

      ' Set the initialize property of each step to False
      EnumObjectEmbeds(Me, t, "Init")

      ' Display the first step
      FirstStep.Center
      FirstStep.Display(Nothing, "Next", False)
    End Sub

    Function ShowModal As Long
      Dim r as Long
      Dim nextStep, currStep as WizardMaster.FrmStep
      Dim defaultDirection as String
      Dim t As New WizardMaster.StepTraverser

      ' If we have no first step, inform user of an empty wizard
      If Not FirstStep Then
        InfoBox.Message("Incomplete Wizard", "Wizard " & Me & " has no steps.")
        Exit Function
      End If

      ' Set the initialize property of each step to False
      EnumObjectEmbeds(Me, t, "Init")

      ' Until we get a cancel or finish, display steps.
      currStep = Nothing
      nextStep = FirstStep
      defaultDirection = "Next"
      Do
        r = nextStep.Display(currStep, defaultDirection, True)
        currStep = nextStep
        If (r = WizardMaster.WM_BACK) Then
          nextStep = currStep.BackStep
          defaultDirection = "Back"
        ElseIf (r = WizardMaster.WM_NEXT) Then
          nextStep = currStep.NextStep
          defaultDirection = "Next"
        Else
          ShowModal = r
          Exit Function
        End If
      Loop While True

    End Function

  End Type
  Type FrmStep From Form
    Dim wizard As Object
    Dim BtnFinish As New Button
    Dim BtnNext As New Button
    Dim BtnBack As New Button
    Dim BtnCancel As New Button
    Dim ImgGraphic As New Image
    Dim LblInstruction As New Label
    Dim Frame1 As New Frame
    Dim NextStep As Form
    Dim BackStep As Form
    Dim initialized As Long
    Dim inheritImageSize As Long
    Event Cancel()
    Event ValidateBack(ok As Boolean)
    Event ValidateDisplay(ok As Boolean)
    Event ValidateNext(ok As Boolean)
    Event ValidateFinish(ok As Boolean)

    ' METHODS for object: WizardMaster.FrmStep
    Sub BtnBack_Click()
      Dim ok As Boolean

      ' If we have no previous step, throw
      If Not BackStep Then Throw NoBackStep

      ' Raise the back event on the step and its containing wizard
      ok = True
      SendEvent ValidateBack(ok)

      ' Return a WM_BACK result or display prev step if ok
      If ok Then
        If ShownModal Then
          ModalResult WizardMaster.WM_BACK
        Else
          BackStep.Display(Me, "Back", False)
        End If
      End If
    End Sub

    Sub BtnCancel_Click()

      ' Raise the Cancel event on the step and containing wizard
      ' This invokes Me.Cancel or wizard.StepName_Cancel if
      ' either exists
      SendEvent Cancel()

      ' Raise the Cancel event on the wizard alone.
      ' This invokes wizard.Cancel if it exists
      SendEvent wizard.Cancel()

      ' Hide and return a CANCEL result if ok
      Hide
      ModalResult IDCANCEL
    End Sub

    Sub BtnFinish_Click()
      Dim ok As Boolean

      ' Raise the validatefinish event on the step and its containing
      ' wizard
      ' This invokes: Me.ValidateFinish(ok) and
      ' wizard.StepName_ValidateFinish(ok)
      ' if either exists
      ok = True
      SendEvent ValidateFinish(ok)

      ' Also raise finish event on the wizard alone.
      ' This invokes wizard.Finish(ok) if it exists.
      SendEvent wizard.Finish(ok)

      ' Hide and return an OK result if ok
      If ok Then
        Hide
        ModalResult IDOK
      End If
    End Sub

    Sub BtnNext_Click()
      Dim ok As Boolean

      ' If we have no next step, throw
      If Not NextStep Then Throw NoNextStep

      ' Raise the next event on the step and its containing wizard
      ok = True
      SendEvent ValidateNext(ok)

      ' Return a WM_NEXT result or display next step if ok
      If ok Then
        If ShownModal Then
          ModalResult WizardMaster.WM_NEXT
        Else
          NextStep.Display(Me, "Next", False)
        End If
      End If
    End Sub

    Sub ConnectToWizard(w as WizardMaster.Wizard, prevStep as WizardMaster.FrmStep, nextStep as WizardMaster.FrmStep)

      ' Cache away the wizard parent pointer
      wizard = w

      ' Insert us between the steps
      BackStep = prevStep
      NextStep = nextStep

      ' Fix up preceding and next steps if there
      If nextStep Then nextStep.BackStep = Me
      If prevStep Then prevStep.NextStep = Me

      ' Set step's caption to the name of the wizard
      Caption = wizard.Title

      ' Connect the step's graphic to our default bitmap
      ImgGraphic.Picture = wizard.Bitmap

      ' Initialize the instruction field
      LblInstruction.Caption = "Write instructions for step " & Me & " here..."
    End Sub

    Sub DisconnectFromWizard()

      ' If we don't have a wizard, we are disconnected
      If Not wizard Then Exit Sub

      ' If we had a previous step, fix up his next reference
      If BackStep Then BackStep.NextStep = NextStep

      ' If we have a next step, fix up his previous reference
      If NextStep Then NextStep.BackStep = BackStep

    End Sub

    Function Display (curStep As WizardMaster.FrmStep, direction As String, modal As Boolean) As Long
      Dim ok as Boolean

      ' Enable Next and Back buttons if they lead somewhere
      BtnBack.Enabled = BackStep
      BtnNext.Enabled = NextStep

      ' Set default button based on direction and position
      If direction = "Next" Then
        DefaultButton = IIf(NextStep, BtnNext, BtnFinish)
      Else
        DefaultButton = IIf(BackStep, BtnBack, IIf(NextStep, BtnNext, BtnFinish))
      End If
      DefaultButton.SetFocus

      ' Move me to the same position as curStep form
      If curStep Then Move(curStep.Left, curStep.Top, curStep.Width, curStep.Height)

      ' Validate the show by rasing the ValidateDisplay Event
      ' ok is passed by reference, so we will see any changes
      ' handlers make to it. Load the form prior to validate to
      ' ensure creation of windows for controls we may be initing
      ok = True
      LoadForm
      SendEvent ValidateDisplay(ok)

      ' If Display is not valid, throw
      If Not ok Then Throw InvalidStep

      ' Show me
      Show


      ' If we are coming from somewhare...
      If curStep Then
        ' Hide the curStep form
        curStep.Hide

        ' If we moved forward from this place,
        ' make sure we can get back
        If direction = "Next" Then BackStep = curStep

      End If

      Display = IIf(modal, ShowModal, -1)
    End Function

    Sub Resize()
      Dim hMargin, vMargin As Integer
      Dim btnTop as Integer

      ' Initialize margins
      hMargin = 75 : vMargin = 150

      ' Position Buttons. Use finish size to enforce uniformity
      btnTop = ScaleHeight - vMargin - BtnFinish.Height
      BtnFinish.Move(ScaleWidth - hMargin - BtnFinish.Width, btnTop, BtnFinish.Width, BtnFinish.Height)
      BtnNext.Move(BtnFinish.Left - hMargin - BtnFinish.Width, btnTop, BtnFinish.Width, BtnFinish.Height)
      BtnBack.Move(BtnNext.Left - BtnFinish.Width, btnTop, BtnFinish.Width, BtnFinish.Height)
      BtnCancel.Move(BtnBack.Left - hMargin - BtnFinish.Width, btnTop, BtnFinish.Width, BtnFinish.Height)

      ' Position the Button separator
      Frame1.Move(hMargin, btnTop - (vMargin + hMargin), ScaleWidth - (2 * hMargin), Frame1.Height)

      ' Position the image if we have a wizard and we aren't
      ' the first step
      If wizard && inheritImageSize && wizard.FirstStep Then
        If wizard.FirstStep <> Me Then
          Dim pi As Image
          pi = wizard.FirstStep.ImgGraphic
          ImgGraphic.Move(pi.Left, pi.Top, pi.Width, pi.Height)
        End If
      End If

      ' Position the Instruction label
      LblInstruction.Width = ScaleWidth - LblInstruction.Left - 2 * hMargin
    End Sub

  End Type
  Dim Font As New Font

  ' METHODS for object: WizardMaster
  Function NewWizard(name as String, title as String) As WizardMaster.Wizard
    Dim w as WizardMaster.Wizard

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

    ' Create a top level object with the given name as a kind
    ' of wizard
    w = CopyObject(Wizard, name)

    ' Set wizard's title
    w.Title = title

    ' Return the new wizard
    NewWizard = w
  End Function

End Type

Type SelectDirectoryDialog From Form
  Type BtnOk From Button

    ' METHODS for object: SelectDirectoryDialog.BtnOk
    Sub Click()
      If Parent Then
        Parent.ModalResult IDOK
        Parent.Hide
      End If
    End Sub

  End Type
  Type BtnCancel From Button

    ' METHODS for object: SelectDirectoryDialog.BtnCancel
    Sub Click()
      If Parent Then
        Parent.ModalResult IDCANCEL
        Parent.Hide
      End If
    End Sub

  End Type
  Dim TbDir As New TextBox
  Dim LblDir As New Label
  Dim CbDrives As New FileComboBox
  Dim LblDrive As New Label
  Type LstDirs From IndentedList
    Dim bitmap As New Bitmap
    Dim scratchLevel As Integer
    Dim scratchPos As Integer
    Dim scratchIndex As Integer
    Dim CurrDrive As String
    Dim scratchParent As Integer
    Property SelPath Get GetSelPath Set SetSelPath As String

    ' METHODS for object: SelectDirectoryDialog.LstDirs
    Sub AddExpansionItem(filename As String, attr As Long)
      If attr And &H10 Then  ' It's a directory
        Dim i As Integer
        i = InsertItem(Mid(filename, scratchPos), 0, scratchLevel, scratchIndex)
        SetItemCanExpand(i, True)
        SetItemData(i, scratchParent)
      End If
    End Sub

    Sub Collapsed(ByVal itemIndex as Integer, ByVal itemData as Long, itemObj as Object)
      SetItemIcon(itemIndex, 0)
    End Sub

    Sub Expand(ByVal itemIndex as Integer, ByVal itemData as Long, itemObj as Object)
      Dim path As String
      Dim dir As New Directory
      Dim count As Long
      count = ListCount
      path = GetItemPath(itemIndex, itemData)
      dir.Path = path
      scratchLevel = ItemLevel(itemIndex) + 1
      scratchIndex = itemIndex + 1
      scratchPos = Len(path) + 2
      scratchParent = itemIndex
      dir.EnumContents(Me, "AddExpansionItem", "", False)
      If ListCount > count Then SetItemIcon(itemIndex, 1)
    End Sub

    Function FindDir(path As String) As Integer
      Dim i, l As Integer
      Dim p, r As String
      Dim pos As Integer

      ' Make sure the drive part of path is the same as CurrDrive
      If StrComp(CurrDrive, Left(path, 3), 1) Then
        FindDir = -1
        Exit Function
      End If

      ' For each component of path, find item at successive levels or bail.
      r = Mid(path, 4)
      l = 0 : i = -1
      While r <> ""
        pos = Instr(r, "\")
        If pos Then
          p = Left(r, pos - 1)
          r = Mid(r, pos + 1)
        Else
          p = r
          r = ""
        End If
        ExpandItem(i)
        i = FindItem(p, i + 1, l, False)
        If i < 0 Then
          FindDir = -1
          Exit Function
        Else
          l = l + 1
        End If
      Wend

      ' If we get here, the i'th item matched given path
      FindDir = i
    End Function

    Function FindItem(itemString As String, ByVal startIndex As Integer, ByVal restrictLevel As Integer, ByVal caseSensitive As Boolean) As Integer
      Dim i, l, n As Integer
      i = startIndex
      n = ListCount
      While i < n
        l = ItemLevel(i)
        If l < restrictLevel Then
          i = n ' Exit loop and fail
        ElseIf restrictLevel = -1 || l = restrictLevel Then
          If StrComp(itemString, ItemString(i), Not caseSensitive) = 0 Then
            FindItem = i
            Exit Function
          End If
        End If
        i = i + 1
      Wend
      FindItem = -1
    End Function

    Function GetItemPath(ByVal itemIndex As Integer, ByVal itemData As Long) As String
      Dim path As String
      path = ItemString(itemIndex)
      While itemData >= 0
        path = ItemString(itemData) & "\" & path
        itemData = ItemData(itemData)
      Wend
      GetItemPath = CurrDrive & path
    End Function

    Function GetSelPath() As String
      Dim i As Integer
      i = ListIndex
      GetSelPath = IIf(i >= 0, GetItemPath(i, ItemData(i)), "")
    End Function

    Sub ResetDrive(newDrv As String)
      Dim dir As New Directory
      Clear
      scratchPos = 4
      scratchIndex = 0
      scratchLevel = 0
      scratchParent = -1
      CurrDrive = newDrv & "\"
      dir.Path = CurrDrive
      dir.EnumContents(Me, "AddExpansionItem", "", False)
    End Sub

    Sub SetSelPath(path As String)
      ListIndex = FindDir(path)
    End Sub

  End Type
  Dim dir As New Directory
  Dim ignoreClick As Boolean
  Dim dirMustExist As Boolean

  ' METHODS for object: SelectDirectoryDialog
  Sub AddRootDirItem(filename As String, attr As Long)
    If attr And &H10 Then  ' It's a directory
      LstDirs.AddItem(Mid(filename, 4), 0)
    End If
  End Sub

  Sub CbDrives_Click()
    Dim drvCurrDir, saveCurrDir, newDrv As String

    ' Find current dir for the new drive, reset to show that dir.
    newDrv = CbDrives.SelPath
    saveCurrDir = dir.CurrentDir
    dir.CurrentDir = newDrv
    drvCurrDir = dir.CurrentDir
    dir.CurrentDir = saveCurrDir
    TbDir.Text = drvCurrDir

    ' Init dirs list with top-level directories on new drive.
    LstDirs.ResetDrive(newDrv)
    LstDirs.SelPath = drvCurrDir
  End Sub

  Sub CreateDirectory(path As String)
    ' For each element of path, ensure dir exists or make it.
    ' If can't ensure/make any element, bail with a message box.
    Dim s, p, r As String
    Dim pos As Integer

    ' For each component of path, find item at successive levels or bail.
    p = Left(path, 3)
    r = Mid(path, 4)
    While r <> ""
      pos = Instr(r, "\")
      If pos Then
        s = Left(r, pos)
        r = Mid(r, pos + 1)
      Else
        s = r
        r = ""
      End If
      p = p & s
      dir.Path = p
      If Not dir.Exists Then dir.Create
      If Not dir.Exists Then
        Dim errBox As New MessageBox
        errBox.SetIconExclamation
        errBox.Message("Error", "Unable to create directory:^M" & path)
        Exit Sub
      End If
    Wend

  End Sub

  Function Execute(initialPath As String, mustExist As Boolean, promptToCreate As Boolean) As String
    '
    ' Returns empty string on ANY cancel, dir path on OK.
    '
    ' If 'mustExist', then user can only select existing dirs, and 'promptToCreate' is ignored.
    ' If not 'mustExist', then:
    ' - If 'promptToCreate' and selected dir doesn't exist, user is asked whether to create it.
    '
    Dim r As Long
    LoadForm
    dir.Path = initialPath
    dirMustExist = mustExist
    BtnOk.Enabled = True
    ReconfigLists
    r = ShowModal
    If r = IDOK Then
      Dim text As String
      text = TbDir.Text
      If Not mustExist && promptToCreate Then
        dir.Path = text
        If Not dir.Exists Then
          Dim ync As New YesNoCancelBox
          ync.title = "Create directory"
          ync.message = "Directory:^M" & text & "^Mdoes not exist.^M^MCreate directory?"
          Select Case ync.Execute
            Case IDYES
              CreateDirectory(text)
            Case IDNO
            ' Do nothing, Execute will still return selected directory.
            Case Else ' IDCANCEL or error
              ' Cancel entire directory select.
              Execute = ""
              Exit Function
          End Select
        End If
      End If
      Execute = text
    Else
      Execute = ""
    End If
  End Function

  Sub LstDirs_Click()
    If Not ignoreClick Then TbDir.Text = LstDirs.SelPath
  End Sub

  Sub ReconfigLists
    Dim path As String
    path = dir.FullPathName
    If path = "" Then path = dir.CurrentDir
    CbDrives.SelectDrive(Left(path, 2))
    CbDrives_Click
    TbDir.Text = path
  End Sub

  Sub Resize()
    Dim m, mm, l, t, w, h, effWidth As Single
    m = 75 : mm = 150
    effWidth = IIf(ScaleWidth < 3000, 3000, ScaleWidth)
    w = BtnOk.Width
    l = effWidth - m - w
    t = BtnOk.Top
    h = BtnOk.Height
    BtnOk.Move(l, t, w, h)
    t = t + h + m
    BtnCancel.Move(l, t, w, h)
    t = t + h + mm
    LblDrive.Move(l, t, w, h - m)
    t = t + h
    CbDrives.Move(l, t, w, h)

    TbDir.Width = l - mm - TbDir.Left
    LstDirs.Width = l - mm - LstDirs.Left
    LstDirs.Height = ScaleHeight - m - LstDirs.Top
    Refresh
  End Sub

  Sub TbDir_Change()
    Dim text As String
    text = TbDir.Text
    ignoreClick = True : LstDirs.SelPath = text : ignoreClick = False
    If dirMustExist Then
      dir.Path = text
      BtnOk.Enabled = dir.Exists
    End If
  End Sub

End Type

Type MessageBox
  Dim result As Long
  Dim hWndOwner As Long
  Dim style As Long
  Dim title As String
  Dim message As String

  ' METHODS for object: MessageBox
  Function Execute() as long
    dim m, t as string
    dim s, autobusy as long
    If Len(message) > 0 Then m = message Else m = "Never mind"
    If Len(title) > 0 Then t = title Else t = Me
    App.EnableDialog3dEffects(True)
    autobusy = App.AutoBusySignal
    App.AutoBusySignal = False

    ' If there's no owner, then ensure MB_TASKMODAL style (exclusive).
    s = style
    If hWndOwner = 0 Then
      s = (s And (Not User32.MB_SYSTEMMODAL)) Or User32.MB_TASKMODAL
    End If

    ' Assure that any capture is released
    If User32.GetCapture() Then User32.ReleaseCapture()

    result = User32.MessageBox(hWndOwner, m, t, s)

    App.AutoBusySignal = autobusy
    App.EnableDialog3dEffects(False)
    Execute = result
  End Function

  Function Message(titleStr as string, msg as string) as long
    title = titleStr
    message = msg
    Message = Execute
  End Function

  Function Msg(msg as string) as long
    message = msg
    Msg = Execute
  End Function

  Sub ResetStyle()
    style = User32.MB_OK
  End Sub

  Sub SetIconExclamation()
    SetIconNone
    style = style Or User32.MB_ICONEXCLAMATION
  End Sub

  Sub SetIconInfo()
    SetIconNone
    style = style Or User32.MB_ICONINFORMATION
  End Sub

  Sub SetIconNone()
    style = style And (Not User32.MB_ICONMASK)
  End Sub

  Sub SetIconQuestion()
    SetIconNone
    style = style Or User32.MB_ICONQUESTION
  End Sub

  Sub SetIconStop()
    SetIconNone
    style = style Or User32.MB_ICONSTOP
  End Sub

End Type

Type AbortRetryIgnoreBox From MessageBox

  ' METHODS for object: AbortRetryIgnoreBox
  Sub ResetStyle()
    style = User32.MB_ABORTRETRYIGNORE
    SetIconStop()
  End Sub

End Type

Type InputDialog From Form
  Dim TEResponse As New TextBox
  Dim BtnOK As New Button
  Dim BtnCancel As New Button
  Dim LblPrompt As New Label
  Dim ControlMargin As Single
  Dim Response As Long
  Property Text Get getText Set setText As String

  ' METHODS for object: InputDialog
  Sub BtnCancel_Click()
    Hide
    ModalResult IDCANCEL
  End Sub

  Sub BtnOK_Click()
    Hide
    ModalResult IDOK
  End Sub

  Function Execute(title, prompt, defaultResponse As String) As Long
    If hWnd = 0 Then LoadForm
    Response = IDCANCEL
    Caption = title
    LblPrompt.Text = prompt
    TEResponse.Text = defaultResponse
    TEResponse.SelStart = 0
    TEResponse.SelLength = -1
    ' Must be visible for any SetFocus to work.
    Show()
    TEResponse.SetFocus
    Response = ShowModal()
    Execute = Response
  End Function

  Function getText As String
    getText = IIf(Response = IDOK, TEResponse.Text, "")
  End Function

  Sub Load
    Caption = ""
    Response = IDCANCEL
  End Sub

  Sub MoveMinimumSize(ByVal newLeft as Single, ByVal newTop as Single)
    Dim minWidth, minHeight As Single
    Dim fudgeWidth, fudgeHeight As Single
    If hWnd = 0 Then
      LoadForm
      Resize
    End If
    fudgeWidth = Width - ScaleWidth
    fudgeHeight = Height - ScaleHeight
    minWidth = (BtnOK.Width * 3) + (ControlMargin * 3) + fudgeWidth
    minHeight = (BtnOK.Height * 2) + TEResponse.Height + (ControlMargin * 4) + fudgeHeight
    Move(newLeft, newTop, minWidth, minHeight)
  End Sub

  Sub Resize()
    Dim m, mm, mmm, bx, lw, lh, ty, th as single
    Dim useWidth, useHeight as single

    ' Set up local margin variables for convenience
    m = ControlMargin : mm = m + m : mmm = mm + m

    ' Calculate effective form width (min. is double button width plus margin)
    useWidth = BtnOK.Width * 3 + mmm
    If useWidth < ScaleWidth Then useWidth = ScaleWidth

    ' Calculate effective form height (min 2 btn ht. + text ht. + margin)
    useHeight = BtnOK.Height * 2 + TEResponse.Height + mmm + m
    If useHeight < ScaleHeight Then useHeight = ScaleHeight

    ' bx is the left edge of the two buttons, lw is label width.
    bx = useWidth - BtnOK.Width - m
    lw = bx - mm
    th = TEResponse.Height
    ty = useHeight - th - m
    lh = ty - mm
    LblPrompt.Move(m, m, lw, lh)
    BtnOK.Left = bx
    BtnCancel.Left = bx
    TEResponse.Move(m, ty, useWidth - mm, th)
    Refresh
  End Sub

  Sub setText(t as String)
    TEResponse.Text = t
  End Sub

End Type

Type MultiLineInputDialog From InputDialog

  ' METHODS for object: MultiLineInputDialog
  Sub Resize()
    Dim m, mm, mmm, bx, lw, lh, ty, th as single
    Dim useWidth, useHeight as single

    ' Set up local margin variables for convenience
    m = ControlMargin : mm = m + m : mmm = mm + m

    ' Calculate effective form width (min. is triple button width plus margin)
    useWidth = BtnOK.Width * 3 + mmm
    If useWidth < ScaleWidth Then useWidth = ScaleWidth

    ' Calculate effective form height (min 4 btn ht. + margins)
    useHeight = BtnOK.Height * 4 + mmm + mm
    If useHeight < ScaleHeight Then useHeight = ScaleHeight

    ' bx is the left edge of the two buttons, lw is label width, etc.
    bx = useWidth - BtnOK.Width - m
    lw = bx - mm
    BtnOK.Left = bx
    BtnCancel.Left = bx
    lh = BtnCancel.Top + BtnCancel.Height - m
    LblPrompt.Move(m, m, lw, lh)
    th = useHeight - mmm - lh
    ty = lh + mm
    TEResponse.Move(m, ty, useWidth - mm, th)
    Refresh
  End Sub

End Type

Type OKCancelBox From MessageBox

  ' METHODS for object: OKCancelBox
  Sub ResetStyle()
    style = User32.MB_OKCANCEL
    SetIconQuestion()
  End Sub

End Type

Type OpenDialog From OpenDialog
End Type

Type InfoBox From MessageBox

  ' METHODS for object: InfoBox
  Sub ResetStyle()
    style = User32.MB_OK
    SetIconInfo()
  End Sub

End Type

Type RetryCancelBox From MessageBox

  ' METHODS for object: RetryCancelBox
  Sub ResetStyle()
    style = User32.MB_RETRYCANCEL
    SetIconQuestion()
  End Sub

End Type

Type YesNoCancelBox From MessageBox

  ' METHODS for object: YesNoCancelBox
  Sub ResetStyle()
    style = User32.MB_YESNOCANCEL
    SetIconQuestion()
  End Sub

End Type

Type FindDialog From FindDialog
End Type

Type SaveAsDialog From SaveAsDialog
End Type

Type YesNoBox From MessageBox

  ' METHODS for object: YesNoBox
  Sub ResetStyle()
    style = User32.MB_YESNO
    SetIconQuestion()
  End Sub

End Type

Type SimpleMultiLineDialog From Form
  Dim TbText As New TextBox
  Property Text Get GetText Set SetText As String

  ' METHODS for object: SimpleMultiLineDialog
  Sub Execute(ByVal title As String, ByVal readOnly As Boolean, ByVal wordWrap As Boolean)
    LoadForm
    Caption = title
    TbText.ReadOnly = readOnly
    TbText.WordWrap = wordWrap
    ShowModal
  End Sub

  Sub ExecuteFile(fileName As String, ByVal readOnly As Boolean, ByVal wordWrap As Boolean)
    Dim f As New TextFile
    f.FileName = fileName
    If f.Exists Then
      Text = f.ContentsAsString
    Else
      Text = "File: " & f.FullPathName & " not found."
    End If
    Execute(fileName, readOnly, wordWrap)
  End Sub

  Function GetText() As String
    GetText = TbText.Text
  End Function

  Sub KeyDown(keyCode As Integer, ByVal shift As Integer)
    ' Take us down on ESC or (<Enter> && ReadOnly)
    If keyCode = 27 || (TbText.ReadOnly && keyCode = 13) Then Hide
  End Sub

  Sub Resize()
    TbText.Move(-2, -2, ScaleWidth + 2, ScaleHeight + 2)
  End Sub

  Sub SetText(text As String)
    LoadForm
    TbText.Text = text
  End Sub

End Type

Type FontDialog From FontDialog
End Type

Begin Code
' Reconstruction commands for object: DefaultDialogFont
'
  With DefaultDialogFont
    .FaceName := "MS Sans Serif"
    .Size := 8.000000
    .Bold := True
    .Italic := False
    .Strikethru := False
  End With  'DefaultDialogFont
' Reconstruction commands for object: CommonDialog
'
  With CommonDialog
    .Title := ""
  End With  'CommonDialog
' Reconstruction commands for object: ColorDialog
'
  With ColorDialog
    .Color := 16777216
  End With  'ColorDialog
' Reconstruction commands for object: WizardMaster
'
  With WizardMaster
    With .StepTraverser
      .theStep := Nothing
    End With  'WizardMaster.StepTraverser
    With .Wizard
      .title_ := ""
      .Title := ""
      .GraphicFileName := ""
      .FirstStep := Nothing
      .LastStep := Nothing
      With .Bitmap
      End With  'WizardMaster.Wizard.Bitmap
    End With  'WizardMaster.Wizard
    With .FrmStep
      .ForeColor := 0
      .Font := WizardMaster.Font
      .Move(4290, 3300, 7155, 4815)
      .BevelInner := "Raised"
      .DefaultButton := WizardMaster.FrmStep.BtnNext
      .CancelButton := WizardMaster.FrmStep.BtnCancel
      .BorderStyle := "Fixed Single"
      .MaxButton := False
      .MinButton := False
      .ControlBox := False
      .wizard := Nothing
      .NextStep := Nothing
      .BackStep := Nothing
      .initialized := 0
      .inheritImageSize := -1
      With .BtnFinish
        .Caption := " &Finish"
        .ZOrder := 4
        .Move(6225, 4050, 825, 300)
      End With  'WizardMaster.FrmStep.BtnFinish
      With .BtnNext
        .Caption := " &Next>"
        .ZOrder := 3
        .Move(5325, 4050, 825, 300)
      End With  'WizardMaster.FrmStep.BtnNext
      With .BtnBack
        .Caption := " <&Back"
        .ZOrder := 2
        .Move(4500, 4050, 825, 300)
      End With  'WizardMaster.FrmStep.BtnBack
      With .BtnCancel
        .Caption := " Cancel"
        .ZOrder := 1
        .Move(3600, 4050, 825, 300)
      End With  'WizardMaster.FrmStep.BtnCancel
      With .ImgGraphic
        .Caption := "ImgGraphic"
        .ZOrder := 7
        .Move(225, 225, 2475, 3150)
      End With  'WizardMaster.FrmStep.ImgGraphic
      With .LblInstruction
        .ZOrder := 6
        .Move(2850, 225, 4125, 1500)
      End With  'WizardMaster.FrmStep.LblInstruction
      With .Frame1
        .ZOrder := 5
        .Move(75, 3825, 6975, 75)
      End With  'WizardMaster.FrmStep.Frame1
    End With  'WizardMaster.FrmStep
    With .Font
      .FaceName := "MS Sans Serif"
      .Size := 8.000000
      .Bold := True
      .Italic := False
      .Strikethru := False
    End With  'WizardMaster.Font
  End With  'WizardMaster
' Reconstruction commands for object: SelectDirectoryDialog
'
  With SelectDirectoryDialog
    .Caption := "Select Directory"
    .Font := DefaultDialogFont
    .Move(5700, 2412, 4656, 3144)
    .DefaultButton := SelectDirectoryDialog.BtnOk
    .CancelButton := SelectDirectoryDialog.BtnCancel
    .MaxButton := False
    .MinButton := False
    .ignoreClick := False
    .dirMustExist := False
    With .BtnOk
      .Caption := "OK"
      .ZOrder := 6
      .Move(3585, 84, 900, 300)
    End With  'SelectDirectoryDialog.BtnOk
    With .BtnCancel
      .Caption := "Cancel"
      .ZOrder := 5
      .Move(3585, 459, 900, 300)
    End With  'SelectDirectoryDialog.BtnCancel
    With .TbDir
      .ZOrder := 4
      .Move(516, 96, 2919, 276)
    End With  'SelectDirectoryDialog.TbDir
    With .LblDir
      .Caption := "Dir:"
      .ZOrder := 5
      .Move(120, 150, 330, 225)
    End With  'SelectDirectoryDialog.LblDir
    With .CbDrives
      .ZOrder := 3
      .ShowFiles := False
      .ShowDrives := True
      .Move(3585, 1209, 900, 288)
    End With  'SelectDirectoryDialog.CbDrives
    With .LblDrive
      .Caption := "Drive:"
      .ZOrder := 2
      .Move(3585, 909, 900, 225)
    End With  'SelectDirectoryDialog.LblDrive
    With .LstDirs
      .ZOrder := 1
      .Move(96, 516, 3336, 2184)
      .ExpandOnDblClick := True
      .IconBitmap := SelectDirectoryDialog.LstDirs.bitmap
      .IconHeight := 16
      .IconWidth := 20
      .Sorted := True
      .HighlightStyle := "FullLine"
      .scratchLevel := 1
      .scratchPos := 8
      .scratchIndex := 14
      .CurrDrive := "w:\"
      .scratchParent := 13
      .SelPath := ""
      With .bitmap
        .LoadType := "MemoryBased"
        .FileName := "Dialogs.ero"
        .ResId := 0
      End With  'SelectDirectoryDialog.LstDirs.bitmap
    End With  'SelectDirectoryDialog.LstDirs
    With .dir
    End With  'SelectDirectoryDialog.dir
  End With  'SelectDirectoryDialog
' Reconstruction commands for object: MessageBox
'
  With MessageBox
    .result := 0
    .hWndOwner := 0
    .style := 0
    .title := ""
    .message := ""
  End With  'MessageBox
' Reconstruction commands for object: AbortRetryIgnoreBox
'
  With AbortRetryIgnoreBox
    .style := 18
  End With  'AbortRetryIgnoreBox
' Reconstruction commands for object: InputDialog
'
  With InputDialog
    .Caption := "Rename Object"
    .Font := DefaultDialogFont
    .Move(3720, 1800, 4116, 1656)
    .DefaultButton := InputDialog.BtnOK
    .CancelButton := InputDialog.BtnCancel
    .ControlMargin := 60
    .Response := 1
    .Text := "AboutEnvelopForm"
    With .TEResponse
      .ZOrder := 1
      .Move(60, 912, 3900, 312)
    End With  'InputDialog.TEResponse
    With .BtnOK
      .Caption := "&OK"
      .ZOrder := 2
      .Move(3096, 60, 864, 324)
    End With  'InputDialog.BtnOK
    With .BtnCancel
      .Caption := "&Cancel"
      .ZOrder := 3
      .Move(3096, 444, 864, 324)
    End With  'InputDialog.BtnCancel
    With .LblPrompt
      .ZOrder := 4
      .Move(60, 60, 2976, 792)
    End With  'InputDialog.LblPrompt
  End With  'InputDialog
' Reconstruction commands for object: MultiLineInputDialog
'
  With MultiLineInputDialog
    .Caption := "Enter comment"
    .Move(3636, 1824, 4980, 3432)
    .DefaultButton := MultiLineInputDialog.BtnOK
    .CancelButton := MultiLineInputDialog.BtnCancel
    .Text := ""
    With .TEResponse
      .Move(60, 828, 4764, 2172)
      .WordWrap := True
      .MultiLine := True
      .ScrollBars := "Vertical"
    End With  'MultiLineInputDialog.TEResponse
    With .BtnOK
      .Move(3960, 60, 864, 324)
    End With  'MultiLineInputDialog.BtnOK
    With .BtnCancel
      .Move(3960, 444, 864, 324)
    End With  'MultiLineInputDialog.BtnCancel
    With .LblPrompt
      .Move(60, 60, 3840, 708)
    End With  'MultiLineInputDialog.LblPrompt
  End With  'MultiLineInputDialog
' Reconstruction commands for object: OKCancelBox
'
  With OKCancelBox
    .style := 33
  End With  'OKCancelBox
' Reconstruction commands for object: OpenDialog
'
  With OpenDialog
    .DefaultExtension := ""
    .FileMustExist := True
    .FileName := ""
    .Filter := "|"
    .FilterIndex := 0
    .InitialDir := ""
    .NoNetworkButton := False
    .NoChangeDir := True
    .PathMustExist := True
  End With  'OpenDialog
' Reconstruction commands for object: InfoBox
'
  With InfoBox
    .style := 64
  End With  'InfoBox
' Reconstruction commands for object: RetryCancelBox
'
  With RetryCancelBox
    .style := 53
  End With  'RetryCancelBox
' Reconstruction commands for object: YesNoCancelBox
'
  With YesNoCancelBox
    .style := 35
  End With  'YesNoCancelBox
' Reconstruction commands for object: FindDialog
'
  With FindDialog
    .FindString := ""
    .DisableUpDown := False
    .DisableMatchCase := False
    .DisableWholeWord := False
    .HideUpDown := False
    .HideMatchCase := False
    .HideWholeWord := False
    .MatchCase := False
    .MatchWholeWord := False
    .SearchDown := True
  End With  'FindDialog
' Reconstruction commands for object: SaveAsDialog
'
  With SaveAsDialog
    .DefaultExtension := ""
    .FileName := ""
    .Filter := "|"
    .FilterIndex := 0
    .InitialDir := ""
    .NoNetworkButton := False
    .NoChangeDir := False
    .PathMustExist := True
  End With  'SaveAsDialog
' Reconstruction commands for object: YesNoBox
'
  With YesNoBox
    .style := 36
  End With  'YesNoBox
' Reconstruction commands for object: SimpleMultiLineDialog
'
  With SimpleMultiLineDialog
    .Move(1068, 324, 6756, 6552)
    .KeyPreview := True
    .ScaleMode := "Pixel"
    .Text := ""
    With .TbText
      .ZOrder := 1
      .Move(-2, -2, 557, 517)
      .Ctrl3d := False
      .MultiLine := True
      .ReadOnly := True
      .ScrollBars := "Vertical"
    End With  'SimpleMultiLineDialog.TbText
  End With  'SimpleMultiLineDialog
' Reconstruction commands for object: FontDialog
'
  With FontDialog
    .Title := "AboutEnvelopForm.btnStory.Font"
    .FaceName := "System"
    .Size := 12
    .Bold := True
    .Italic := False
    .Strikethru := False
    .Underline := False
    .Color := -1
    .OnlyAnsi := False
    .OnlyFixedPitch := False
    .OnlyTrueType := False
    .AllowEffects := True
    .AllowFaceSelect := True
    .AllowStyleSelect := True
    .AllowSizeSelect := True
    .LimitSize := False
    .SizeMin := 0
    .SizeMax := 0
    .Font := Nothing
  End With  'FontDialog
End Code