'首先新建一个工程，添加两个picturebox插件Option ExplicitPrivate Type GUIDData1 As LongData2 As IntegerData3 As IntegerData4(0 To 7) As ByteEnd TypePrivate Type GdiplusStartupInputGdiplusVersion As LongDebugEventCallback As LongSuppressBackgroundThread As LongSuppressExternalCodecs As LongEnd TypePrivate Type EncoderParameterGUID As GUIDNumberOfValues As Longtype As LongValue As LongEnd TypePrivate Type EncoderParametersCount As LongParameter As EncoderParameterEnd TypePrivate Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As LongPrivate Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As LongPrivate Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As LongPrivate Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As LongPrivate Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, Bitmap As Long) As LongPrivate Declare Function GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color As Long) As Long'---------------------------------------------------------------------------------Private Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 100) As Boolean '这里的100是指图片的压缩率,越低压缩程度越高,若使用VB自带的保存函数，生成的BMP图片格式会大4倍以上Dim tSI As GdiplusStartupInputDim lRes As LongDim lGDIP As LongDim lBitmap As Long'初始化 GDI+tSI.GdiplusVersion = 1lRes = GdiplusStartup(lGDIP, tSI, 0)If lRes = 0 Then'从句柄创建 GDI+ 图像lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)If lRes = 0 ThenDim tJpgEncoder As GUIDDim tParams As EncoderParameters'初始化解码器的GUID标识CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder'设置解码器参数tParams.Count = 1With tParams.Parameter ' Quality'得到Quality参数的GUID标识CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID.NumberOfValues = 1.type = 4.Value = VarPtr(quality)End With'保存图像lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)'销毁GDI+图像GdipDisposeImage lBitmapEnd If'销毁 GDI+GdiplusShutdown lGDIPEnd IfIf lRes ThenPictureBoxSaveJPG = FalseElsePictureBoxSaveJPG = TrueEnd IfEnd FunctionPrivate Sub Form_Load()Dim I As LongDim J As LongMe.ScaleMode = 3Picture1.ScaleMode = 3Picture2.ScaleMode = 3Picture2.AutoRedraw = TruePicture1.AutoRedraw = TruePicture1.AutoSize = TruePicture1.BorderStyle = 0Picture2.BorderStyle = 0Set Picture1.Picture = LoadPicture(App.Path & "\1-1.jpg")Picture2.Width = Picture1.ScaleWidth * 5'设置合成的总宽度Picture2.Height = Picture1.ScaleHeight * 5'设置合成的总高度For I = 1 To 5 For J = 1 To 5 Set Picture1.Picture = LoadPicture(App.Path & "\" & CStr(I) & "-" & CStr(J) & ".jpg")'这里按照从左上角到右下角的顺序拼接，左上角是1-1，右下角是5-5 Picture2.PaintPicture Picture1.Picture, J * Picture1.ScaleWidth, I * Picture1.ScaleHeight'最后两个参数是图片的位置，若另有所需可以适当调整 NextNext PictureBoxSaveJPG Picture2.Image, App.Path & "\Combination.jpg"'合并的图片输出到当前目录End Sub 0 0
