图片批量切割VB源代码.doc

一． 二． PicBmp AotoRedraw属性 ：True AutoSize :：True List1 Style属性：1 Pic Visible属性：Flase 三． ‘标准模块Module1的代码 Option Explicit 类型定义 Type BrowseInfo hwndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type 选择文件夹 Public Declare Function lstrcat Lib kernel32 Alias lstrcatA (ByVal lpString1 As String, ByVal lpString2 As _ String) As Long Public Declare Function SHBrowseForFolder Lib shell32.dll Alias SHBrowseForFolderA (lpBrowseInfo As BrowseInfo) _ As Long Public tBrowseInfo As BrowseInfo Public Declare Function SHGetPathFromIDList Lib shell32.dll Alias SHGetPathFromIDListA (ByVal pidl As Long, _ ByVal pszPath As String) As Long Public szTitle As String Public Const BIF_RETURNONLYFSDIRS = 1 Public Const BIF_DONTGOBELOWDOMAIN = 2 Public Const MAX_PATH = 1024 Public lpIDList As Long Public Function SelectFolder(szTitle As String) As String Dim SBuffer1 As String szTitle = 选择文件夹 Get folder from user With tBrowseInfo .hwndOwner = FrmCut.hWnd .lpszTitle = lstrcat(szTitle, ) .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList) Then CmdSearch.Enabled = True SBuffer1 = Space(MAX_PATH) SHGetPathFromIDList lpIDList, SBuffer1 SBuffer1 = Left(SBuffer1, InStr(SBuffer1, vbNullChar) - 1) If Right(SBuffer1, 1) \ Then SBuffer1 = SBuffer1 \ End If End If SelectFolder = SBuffer1 End Function ‘标准模块MThansJpg的代码 格式转换 Public Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Public Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Public Type EncoderParameter GUID As GUID NumberOfV