gdi 保存picturebox中的绘图

Question

我用gdi的方法在picturebox1中绘了一张图，代码如下：
Private Sub Command2_Click()
    Dim ss As StdPicture
    Set ss = Picture1.Image
    Picture2.Picture = ss
    Picture2.Refresh
    
    Set ss = Nothing
End SubPrivate Sub Form_Load()
    Dim GpInput As GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(gdip_Token, GpInput) <> Ok Then MsgBox "GDI初始失败！": Unload Me
    Picture1.AutoRedraw = True
    If GdipCreateFromHDC(Picture1.hDC, gdip_Graphics) <> Ok Then GdiplusShutdown gdip_Token: Unload Me
End SubPrivate Sub Form_Unload(Cancel As Integer)  GdipDisposeImage gdip_pngImage
  GdipDeleteGraphics gdip_Graphics
  GdiplusShutdown gdip_Token  
End SubPrivate Sub Command1_Click()
  On Error GoTo errhandler  Picname = GetShortName("F:\draw相关资料\特效2\mtsc30676副本.gif")
  GdipLoadImageFromFile StrConv(Picname, vbUnicode), gdip_pngImage  If GdipDrawImageRect(gdip_Graphics, gdip_pngImage, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight) <> Ok Then MsgBox "显示失败"
  Picture1.Refresh
errhandler:
  If Err > 0 Then Exit Sub
End SubPrivate Function GetShortName(ByVal sLongFileName As String) As String
  Dim lRetVal&, sShortPathName$
  sShortPathName = Space(255)
  Call GetShortPathName(sLongFileName, sShortPathName, 255)
  If InStr(sShortPathName, Chr(0)) > 0 Then
  GetShortName = Trim(Mid(sShortPathName, 1, InStr(sShortPathName, Chr(0)) - 1))
  Else
  GetShortName = Trim(sShortPathName)
  End If
End Function当我点击command1时成功的在picturebox1中绘了一张图，但是为什么当我点击command2时，picturebox2显示一片黑色，而不是picturebox1中的图片呢？
麻烦各位大侠了，帮帮忙。非常感谢

Answer 1

你的代码都不全，缺少ApI函数声明

Answer 2

声明我没贴上去
Option ExplicitPrivate Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Type GdiplusStartupInput
  GdiplusVersion As Long
  DebugEventCallback As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs As Long
End Type
Private Enum GpStatus
  Ok = 0
  GenericError = 1
  InvalidParameter = 2
  OutOfMemory = 3
  ObjectBusy = 4
  InsufficientBuffer = 5
  NotImplemented = 6
  Win32Error = 7
  WrongState = 8
  Aborted = 9
  FileNotFound = 10
  ValueOverflow = 11
  AccessDenied = 12
  UnknownImageFormat = 13
  FontFamilyNotFound = 14
  FontStyleNotFound = 15
  NotTrueTypeFont = 16
  UnsupportedGdiplusVersion = 17
  GdiplusNotInitialized = 18
  PropertyNotFound = 19
  PropertyNotSupported = 20
End EnumEnum GpUnit
   UnitWorld
   UnitDisplay
   UnitPixel
   UnitPoint
   UnitInch
   UnitDocument
   UnitMillimeter
End EnumPrivate Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus
Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single) As GpStatus
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatusPrivate Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As GpStatus
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As GpStatusPrivate Declare Function GdipGraphicsClear Lib "gdiplus" (ByVal graphics As Long, ByVal lColor As Long) As GpStatusDim gdip_Token&, gdip_pngImage&, gdip_Graphics&, Picname1$, Picname$, gdip_pngImage1&

Answer 3

如果是picturebox1，直接用SavePicture picturebox1.image应该是可以的。以前尝试过在内存绘图并保存，发现不可靠。当然很可能是代码没写好

Answer 4

你说得对，这种方法确实可以，但是我想要一种直接能赋值的方法，而不需要借助savepicture保存，不知道有没有人知道啊？

Answer 5

Option ExplicitPrivate Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Type GdiplusStartupInput
  GdiplusVersion As Long
  DebugEventCallback As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs As Long
End Type
Private Enum GpStatus
  Ok = 0
  GenericError = 1
  InvalidParameter = 2
  OutOfMemory = 3
  ObjectBusy = 4
  InsufficientBuffer = 5
  NotImplemented = 6
  Win32Error = 7
  WrongState = 8
  Aborted = 9
  FileNotFound = 10
  ValueOverflow = 11
  AccessDenied = 12
  UnknownImageFormat = 13
  FontFamilyNotFound = 14
  FontStyleNotFound = 15
  NotTrueTypeFont = 16
  UnsupportedGdiplusVersion = 17
  GdiplusNotInitialized = 18
  PropertyNotFound = 19
  PropertyNotSupported = 20
End EnumEnum GpUnit
  UnitWorld
  UnitDisplay
  UnitPixel
  UnitPoint
  UnitInch
  UnitDocument
  UnitMillimeter
End EnumPrivate Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus
Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single) As GpStatus
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatusPrivate Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As GpStatus
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As GpStatusPrivate Declare Function GdipGraphicsClear Lib "gdiplus" (ByVal graphics As Long, ByVal lColor As Long) As GpStatus
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim gdip_Token&, gdip_pngImage&, gdip_Graphics&, Picname1$, Picname$, gdip_pngImage1&
Private Sub Command2_Click()
  Dim lngP As Long
  Picture2.AutoRedraw = True
  lngP = BitBlt(Picture2.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
            Picture1.hDC, 0, 0, vbSrcCopy)
  Picture2.Refresh
End SubPrivate Sub Form_Load()
  Dim GpInput As GdiplusStartupInput
  GpInput.GdiplusVersion = 1
  If GdiplusStartup(gdip_Token, GpInput) <> Ok Then MsgBox "GDI初始失败！": Unload Me
  Picture1.AutoRedraw = True
  If GdipCreateFromHDC(Picture1.hDC, gdip_Graphics) <> Ok Then GdiplusShutdown gdip_Token: Unload Me
End SubPrivate Sub Form_Unload(Cancel As Integer)
    GdipDisposeImage gdip_pngImage
    GdipDeleteGraphics gdip_Graphics
    GdiplusShutdown gdip_Token
End SubPrivate Sub Command1_Click()
  On Error GoTo errhandler  Picname = GetShortName("E:\文档资料\图片资料\G.Batistuta\1.bmp")
  GdipLoadImageFromFile StrConv(Picname, vbUnicode), gdip_pngImage  If GdipDrawImageRect(gdip_Graphics, gdip_pngImage, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight) <> Ok Then MsgBox "显示失败"
  Picture1.Refresh
errhandler:
  If Err > 0 Then Exit Sub
End SubPrivate Function GetShortName(ByVal sLongFileName As String) As String
  Dim lRetVal&, sShortPathName$
  sShortPathName = Space(255)
  Call GetShortPathName(sLongFileName, sShortPathName, 255)
  If InStr(sShortPathName, Chr(0)) > 0 Then
  GetShortName = Trim(Mid(sShortPathName, 1, InStr(sShortPathName, Chr(0)) - 1))
  Else
  GetShortName = Trim(sShortPathName)
  End If
End Function

Answer 6

我把你的Command2修改了，使用API函数BitBlt是实现的，你看看符合你的要求否

Answer 7

谢谢Veron_04了
但是不是我想要的，为什么可以用savepicture picture1.image保存picture1中的图片，但是赋给别人就不行了呐

Answer 8

这个不是已经实现了Picture2中显示Picture1的内容了吗？

Answer 9

我希望通过picture1.image就可以得到picture1中的图片

Answer 10

有些东西你没有搞清楚，你这个图片不是一个整体，它是分层的，呵呵，我也不知道怎么给你说了。。
使用API函数是正确的方法，明智的，效率也是最高的。

Answer 11

将绘图部分移到Picture1_Paint事件处理中？

Answer 12

不明白你的意思，这样做就能实现？
根据Veron_04的点拨，在开发的项目中换了种思路，也达到了我的要求，在此谢谢各位的帮助了，非常感谢！