modcmndlg.bas

把图片缩小压缩成jpg格式并保存到sql数据库

Attribute VB_Name = "ModCmnDlg"
'////////////////////////////////////////////////////
'
'                 Common Dialog Module
'                   Written by yidie
'
'////////////////////////////////////////////////////

Option Explicit

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" _
    (pSavefilename As OPENFILENAME) As Long

Private Declare Function lstrlen Lib "kernel32.dll" _
    Alias "lstrlenA" _
    (ByVal lpString As String) As Long

Private Const OFN_DONTADDTORECENT As Long = &H2000000
Private Const OFN_ENABLESIZING As Long = &H800000
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_NOCHANGEDIR As Long = &H8

Public Function GetOpenFile(hwnd As Long) As String
    
    Dim ofn As OPENFILENAME
    Dim rtn As Long
    
    With ofn
        .lStructSize = Len(ofn)
        .hwndOwner = hwnd
        .hInstance = App.hInstance
        .lpstrFilter = "支持的图片文件(gif;bmp;jpg;jpeg;ico;cur;wmf;emf)" & Chr$(0) & "*.gif;*.bmp;*.jpg;*.jpeg;*.ico;*.cur;*.wmf;*.emf"
        .lpstrFilter = ofn.lpstrFilter & "所有文件" & Chr$(0) & "*.*" & Chr$(0)
        .lpstrDefExt = vbNullString
        .lpstrFile = String$(256, 0)
        .nMaxFile = 256
        .nMaxFileTitle = 256
        .lpstrTitle = "打开图片"
        .lpstrInitialDir = vbNullString
        .Flags = OFN_LONGNAMES Or OFN_EXPLORER Or OFN_ENABLESIZING Or OFN_DONTADDTORECENT _
                Or OFN_FILEMUSTEXIST
    
        .lpstrFileTitle = .lpstrFile
    End With
    
    rtn = GetOpenFileName(ofn)
    If rtn > 0& Then
        rtn = lstrlen(ofn.lpstrFile)
        GetOpenFile = Left$(ofn.lpstrFile, rtn)
    End If

End Function

Public Function GetSaveFile(hwnd As Long, Optional ByVal DefExt As String = "BMP") As String
    
    Dim ofn As OPENFILENAME
    Dim rtn As Long
    
    With ofn
        .lStructSize = Len(ofn)
        .hwndOwner = hwnd
        .hInstance = App.hInstance
        If StrComp(DefExt, "bmp", vbTextCompare) = 0 Then
            .lpstrDefExt = "bmp"
            .lpstrFilter = "BMP图片(bmp)" & Chr$(0) & "*.bmp" & Chr$(0) & "所有文件" & Chr$(0) & "*.*"
        Else
            .lpstrDefExt = "jpg"
            .lpstrFilter = "JPG图片(jpg;jpeg)" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & "所有文件" & Chr$(0) & "*.*"
        End If
        .lpstrFile = String$(256, 0)
        .nMaxFile = 256
        .nMaxFileTitle = 256
        .lpstrTitle = "保存图片"
        .lpstrInitialDir = vbNullString
        .Flags = OFN_LONGNAMES Or OFN_EXPLORER Or OFN_ENABLESIZING Or OFN_OVERWRITEPROMPT
    
        .lpstrFileTitle = .lpstrFile
    End With
    
    rtn = GetSaveFileName(ofn)
    If rtn > 0& Then
        rtn = lstrlen(ofn.lpstrFile)
        GetSaveFile = Left$(ofn.lpstrFile, rtn)
    End If

End Function