module1.bas

字模点阵浏览器

Attribute VB_Name = "Module1"
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOPENFILENAME As OPENFILENAME) As Long

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

Public Function OpenFile(Optional InitialDir As String = "") As String
  Dim ofn As OPENFILENAME
  Dim rtn As Long
  
  With ofn
    .lStructSize = Len(ofn)
    .hInstance = App.hInstance
    .lpstrFilter = "二进制文件(*.bin)" & vbNullChar & "*.bin" & vbNullChar _
                   & "文本文件(*.txt)" & vbNullChar & "*.txt" & vbNullChar _
                   & "全部文件(*.*)" & vbNullChar & "*.*"
    .nFilterIndex = 3
    .lpstrFile = Space(254)
    .nMaxFile = 255
    .lpstrFileTitle = Space(254)
    .nMaxFileTitle = 255
    If InitialDir <> "" Then .lpstrInitialDir = InitialDir
    .lpstrTitle = "打开文件"
    .flags = 6148
    rtn = GetOpenFileName(ofn)
  End With
  
  OpenFile = IIf(rtn <> 0, Replace(Trim(ofn.lpstrFile), vbNullChar, ""), "")
  
End Function

Public Function SaveFile(Optional InitialDir As String = "") As String
  Dim ofn As OPENFILENAME
  Dim rtn As Long
  
  With ofn
    .lStructSize = Len(ofn)
    .hInstance = App.hInstance
    .lpstrFilter = "二进制文件(*.bin)" & vbNullChar & "*.bin" & vbNullChar _
                   & "文本文件(*.txt)" & vbNullChar & "*.txt" & vbNullChar _
                   & "全部文件(*.*)" & vbNullChar & "*.*"
    .nFilterIndex = 3
    .lpstrFile = Space(254)
    .nMaxFile = 255
    .lpstrFileTitle = Space(254)
    .nMaxFileTitle = 255
    If InitialDir <> "" Then .lpstrInitialDir = InitialDir
    .lpstrTitle = "保存文件"
    .flags = 6148
    rtn = GetSaveFileName(ofn)
  End With
  
  SaveFile = IIf(rtn <> 0, Replace(Trim(ofn.lpstrFile), vbNullChar, ""), "")
  
End Function