Visual Basic Software Sampler/Visual_Basic_Software_Sampler_Visual_Basic_Programmers_Journal_June_1996.iso/issues/04apr96/code/p105.txt

Text File | 1996-04-24 | 7KB | 322 lines

Listing 1 [[VB4]]


VERSION 1.0 CLASS
BEGIN
    MultiUse = -1    'True
END
Attribute VB_Name = "CommonDialog"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

#If Win32 Then
    Private Type OPENFILENAME
            lStructSize As Long
            hwndOwner As Long
            hInstance As Long
            lpstrFilter As String
            lpstrCustomFilter As String
            nMaxCustFilter As Long
            nFilterIndex As Long
            lpstrFile As String
            nMaxFile As Long
            lpstrFileTitle As String
            nMaxFileTitle As Long
            lpstrInitialDir As String
            lpstrTitle As String
            Flags As Long
            nFileOffset As Integer
            nFileExtension As Integer
            lpstrDefExt As String
            lCustData As Long
            lpfnHook As Long
            lpTemplateName As String
    End Type

    Private Declare Function GetOpenFileName Lib _
        "comdlg32.dll" Alias "GetOpenFileNameA" _
        (pOPENFILENAME As OPENFILENAME) As Long
    Private Declare Function GetSaveFileName Lib _
        "comdlg32.dll" Alias "GetSaveFileNameA" _
        (pOPENFILENAME As OPENFILENAME) As Long
    Private Declare Function GetShortPathName Lib _
        "kernel32" Alias "GetShortPathNameA" (ByVal _
        lpszLongPath As String, ByVal lpszShortPath As _
        String, ByVal cchBuffer As Long) As Long
    Private Declare Function GetActiveWindow Lib _
        "user32" () As Long
#Else
    Private Type OPENFILENAME
            lStructSize As Long
            hwndOwner As Integer
            hInstance As Integer
            lpstrFilter As String
            lpstrCustomFilter As String
            nMaxCustFilter As Long
            nFilterIndex As Long
            lpstrFile As String
            nMaxFile As Long
            lpstrFileTitle As String
            nMaxFileTitle As Long
            lpstrInitialDir As String
            lpstrTitle As String
            Flags As Long
            nFileOffset As Integer
            nFileExtension As Integer
            lpstrDefExt As String
            lCustData As Long
            lpfnHook As Long
            lpTemplateName As String
    End Type

    Private Declare Function GetOpenFileName Lib _
        "commdlg.dll" (pOPENFILENAME As OPENFILENAME) _
        As Long
    Private Declare Function GetSaveFileName Lib _
        "commdlg.dll" (pOPENFILENAME As OPENFILENAME) _
        As Long
    Private Declare Function GetActiveWindow Lib "user" _
        () As Integer
#End If

'here are some direct properties
Public DefaultExt As String
Public DialogTitle As String
Public Filter As String
Public FilterIndex As String
Public Flags As Integer
Public InitDir As String

'member variables
Dim mCMDLG As Object
Dim mFileName As String
Dim mFileTitle As String
Dim mhOwner As Long

Dim NullChar As String

Public Property Let Action(Index As Integer)
    Dim OFN As OPENFILENAME, sFile As String, lResult _
        As Long, iDelim As Integer
    Dim zTemp As String, Temp As Variant
    Dim i As Integer

    If Index > 2 Then Exit Property    'get out if invalid

    OFN.lStructSize = Len(OFN)
    If mhOwner = 0 Then mhOwner = GetActiveWindow()
    OFN.hwndOwner = mhOwner
    OFN.Flags = Flags

    OFN.lpstrDefExt = DefaultExt

    'set the initial directory, otherwise uses current
    Temp = InitDir
    OFN.lpstrInitialDir = Temp

    'retrieve the default file name\
    'first check for wild cards
    Temp = mFileName

    #If Win32 Then
        If (InStr(Temp, "*") = 0) And InStr(Temp, "?") _
            = 0 Then
            'try to convert it to a long file name
            zTemp = Dir(OFN.lpstrInitialDir & "\" & Temp)
            If Len(zTemp) Then 'we found a match
                Temp = zTemp
            End If
        End If
    #End If

    OFN.lpstrFile = Temp & String$(255 - Len(Temp), 0)
    OFN.nMaxFile = 255

    OFN.lpstrFileTitle = String$(255, 0)
    OFN.nMaxFileTitle = 255

    'file type filter
    'we need to replace pipes with nulls
    zTemp = Filter
    For i = 1 To Len(zTemp)
        If Mid(zTemp, i, 1) = "|" Then Mid(zTemp, i, 1) _
            = NullChar
    Next
    zTemp = zTemp & String$(2, 0)
    OFN.lpstrFilter = zTemp
    OFN.nFilterIndex = FilterIndex

    OFN.lpstrTitle = DialogTitle

    If Index = 1 Then 'they want File Open dialog
        lResult = GetOpenFileName(OFN)
    Else                'Save As... dialog
        lResult = GetSaveFileName(OFN)
    End If

    If lResult <> 0 Then
        iDelim = InStr(OFN.lpstrFileTitle, NullChar)
        If iDelim > 0 Then
            mFileTitle = Left$(OFN.lpstrFileTitle, _
                iDelim - 1)
        End If
        iDelim = InStr(OFN.lpstrFile, NullChar)
        If iDelim > 0 Then
            mFileName = Left$(OFN.lpstrFile, iDelim - 1)
        End If
    End If
End Property

Public Property Set CMDLGControl(C As Object)
    Set mCMDLG = C
    FileName = mCMDLG.FileName
    DefaultExt = mCMDLG.DefaultExt
    Filter = mCMDLG.Filter
    FilterIndex = mCMDLG.FilterIndex
    Flags = mCMDLG.Flags
    InitDir = mCMDLG.InitDir
    mhOwner = mCMDLG.Parent.hWnd
End Property

Public Property Let FileName(S As String)
    mFileName = S
End Property

Public Property Get FileName() As String
    FileName = mFileName
End Property

Public Property Get ShortFileTitle() As String
    ShortFileTitle = Long2Short(mFileTitle)
End Property

Public Property Get FileTitle() As String
    FileTitle = mFileTitle
End Property

Private Function Long2Short(ByVal S As String) As String
    Dim Buff As String
    Dim r As Integer

    #If Win32 Then
        If Dir(S) = "" Then
            Open S For Output As #1
            Close
        End If
        Buff = Space(256)
        r = GetShortPathName(S, Buff, 256)
        Long2Short = Left(Buff, r)
    #Else
        Long2Short = S
    #End If
End Function

Public Property Get ShortFileName() As String
    ShortFileName = Long2Short(mFileName)
End Property

Private Sub Class_Initialize()
    NullChar = Chr(0)
End Sub




Listing 2 [[VB4]]

VERSION 4.00
Begin VB.Form Form1
    Caption         =    "Form1"
    ClientHeight    =    4140
    ClientLeft        =    1545
    ClientTop        =    1830
    ClientWidth     =    6690
    Height            =    4830
    Left            =    1485
    LinkTopic        =    "Form1"
    ScaleHeight     =    4140
    ScaleWidth        =    6690
    Top             =    1200
    Width            =    6810
    Begin VB.TextBox Text1
        Height            =    1815
        Left            =    2040
        MultiLine        =    -1    'True
        ScrollBars        =    3    'Both
        TabIndex        =    0
        Text            =    "TEST.frx":0000
        Top             =    720
        Width            =    2655
    End
    Begin MSComDlg.CommonDialog CD
        Left            =    840
        Top             =    1320
        _version        =    65536
        _extentx        =    847
        _extenty        =    847
        _stockprops     =    0
        defaultext        =    "TXT"
        dialogtitle     =    "Test Dialog"
        filename        =    "*.TXT"
        filter            =    "Text Files (*.txt)|*.txt|All _
            Files (*.*)|*.*"
        filterindex     =    1
        initdir         =    "C:\VB4"
    End
    Begin VB.Menu mnuFile
        Caption         =    "&File"
        Begin VB.Menu mnuFileOpen
         Caption         =    "&Open"
        End
        Begin VB.Menu mnuFileSaveAs
         Caption         =    "Save &As..."
        End
    End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False

Dim zRealFile As String
Dim zFileName As String

Private Sub Form_Resize()
    Text1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub mnuFileOpen_Click()
    Dim C As Object

    Set C = CreateObject("cmdlgX.CommonDialog")
    Set C.CMDLGControl = CD

    C.Action = 1
    zFileName = C.filename
    If Len(zFileName) Then
        Me.Caption = "Notepad - " & zFileName
        zRealFile = C.ShortFileName
        Open zRealFile For Binary As #1
        Text1.Text = Input(LOF(1), 1)
        Close
    End If
End Sub

Private Sub mnuFileSaveAs_Click()
    Dim C As Object

    Set C = CreateObject("cmdlgX.CommonDialog")
    Set C.CMDLGControl = CD

    C.Action = 2
    zFileName = C.FileTitle
    If Len(zFileName) Then
        Me.Caption = "Notepad - " & zFileName
        zRealFile = C.ShortFileName
        Open zRealFile For Binary As #1
        Put #1, , Text1.Text
        Close
    End If

End Sub