关于picturebox

Question

我想实现在picturebox1中的图片中画一个圆，然后将这个圆所包含的图片在另一个picturebox中显示出来，不知怎么做？

Answer 1

谢谢各位，我已经可以实现拷贝了，但现在还有一个问题没解决，就是我在picture1拷贝的圆粘贴到picture2时，粘贴的位置（即坐标）总会与picture1的相同，不知可否实现将圆粘贴在picture2的中心位置。

Answer 2

你可以通过修改bitblt的参数设置拷贝的目标位置啊，详情可以参考MSDN中的帮助。

Answer 3

发现问题所在，我在使用Picture2.ScaleWidth 和 Picture2.ScaleHeight时发现它的单位是缇，我已经在form.load时指定Picture1.ScaleMode = 3 和 Picture2.ScaleMode = 3。我是这样写的：BitBlt Picture2.hdc,Picture2.Width / 2 - r, Picture2.Height / 2 - r, 2 * r, 2 * r, Picture1.hdc, x1, y1, SRCCOPY
其中r是圆的半径，x1,y1是矩形的左上角坐标

Answer 4

ok,问题解决了。谢谢楼上的各位兄弟，谢谢！
顺便想问一下，可不可以实现拷贝的动画显示，也就是从picture1拷贝圆到picture2时有个动画过程

Answer 5

//顺便想问一下，可不可以实现拷贝的动画显示，也就是从picture1拷贝圆到picture2时有个动画过程那你就用我的上面代码吧，把下面两句去掉：Picture2.AutoRedraw = True
Picture2.Refresh

Answer 6

我是想在picture1上画完圆后，然后将该圆copy一份（而不是挖空picture1），该圆就由picture1的位置缓慢移动到picture2的特定位置，再实现粘贴，而不是在picture2上动态画出圆

Answer 7

这个就很麻烦了，你可以创建第3个picturebox，然后将圆先拷贝到这个picturebox中因为拷贝的是圆形，你还需要使picturebox得其它部分透明，然后将picturebox3移动到picturebox2相应的位并拷贝到picturebox2上实现效果。
难点在于picturebox3背景透明而且是移动的，你可以参考一下这个程序：
http://www.applevb.com/sourcecode/Page%20Balloon%20Now%20with%20API%20timer.zip
建立类似气球的屏幕精灵的程序。气球会在屏幕上上升然后停在屏幕顶端。

Answer 8

ok,这个问题确实很难，不过还是非常谢谢您TechnoFantasy(冰儿马甲www.applevb.com)。
看个简单的吧，比如说picture1所画的圆的半径为130（或90），而我在picture2所预留的圆的半径为100,不知可不可以使得picture1的圆按半径比例缩小（或放大）后再粘帖到picture2上

Answer 9

可以直接用API函数StretchBlt来实现缩放拷贝，这个函数相比Bitblt多了nWidthSrc, nHeightSrc 两个参数，可以设置目标大小。

Answer 10

这个API函数得出的效果好像不怎么行，我想要的是在picture1选取了一个圆后，然后对该圆进行放大或缩小

Answer 11

//这个API函数得出的效果好像不怎么行这是当然的
你应该根据一定的算法（如插值法等）对图象进行平滑缩放

Answer 12

你可以通过API函数SetStretchBltMode先设置一下picturebox的缩放拷贝模式。可选择的模式你可以参考MSDN。其中效果最好的模式是HALFTONE。

Answer 13

to rainstormmaster(暴风雨 v2.0):
  不知您有何高见，可否指教指教？

Answer 14

你先用SetStretchBltMode设置一下picturebox的缩放拷贝模式，如果效果不满意的话，可以参考：
http://www.fantasiasoft.net/Zyl910/zScale.zip
主要看看里面的算法

Answer 15

to TechnoFantasy(冰儿马甲www.applevb.com) :
请问SetStretchBltMode的模式HALFTONE怎么定义，我写成：
SetStretchBltMode Picture1.HDC, STRETCH_HALFTONE
提示STRETCH_HALFTONE未定义

Answer 16

Const STRETCH_HALFTONE = 4

Answer 17

我有试过，但0,1,2,3,4的效果都一样---失真严重，还以为设置错了。
这个http://www.fantasiasoft.net/Zyl910/zScale.zip
做得效果很好，但很像很复杂（我水平有限）

Answer 18

//这个http://www.fantasiasoft.net/Zyl910/zScale.zip
做得效果很好，但很像很复杂（我水平有限）慢慢看，总会看明白的，不要着急：）

Answer 19

Zyl910做的东东我基本都看不懂，呵呵

Answer 20

//难点在于picturebox3背景透明而且是移动的，你可以参考一下这个程序：因为是圆的，只要用CreateEllipticRgn和SetWindowRgn就可以将Picture3变成圆的了

Answer 21

不知可否将picturebox换成Image控件，picturebox有没有类似Image的stretch属性

Answer 22

没有。但有一种方法可以实现这种功能。但是必须在2000以上的操作系统中使用，所以通用性不强。贴在这里参考一下：
Private Declare Function SetGraphicsMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal iMode As Long) As Long
Private Declare Function SetWorldTransform Lib "gdi32.dll" (ByVal hdc As Long, lpXform As XFORM) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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 LongPrivate Const GM_ADVANCED As Long = 2
Private Const SRCCOPY As Long = &HCC0020Private Type XFORM
    eM11 As Single
    eM12 As Single
    eM21 As Single
    eM22 As Single
    eDx As Single
    eDy As Single
End Type
Private Sub Form_Click()
Dim hRet As Long, xfTemp As XFORM
hRet = SetGraphicsMode(Picture2.hdc, GM_ADVANCED)
If hRet = 0 Then MsgBox "系统不支持": Exit Sub
With xfTemp
    .eDx = 0
    .eDy = 0
    .eM11 = 0.5
    .eM12 = 0
    .eM21 = 0
    .eM22 = 0.5
End With
SetWorldTransform Picture2.hdc, xfTemp
BitBlt Picture2.hdc, 0, 0, Picture1.Picture.Width, Picture1.Picture.Height, Picture1.hdc, 0, 0, SRCCOPY
End Sub使用方法：放上两个PictureBox，一个Picture1，一个Picture2。给Picture1.Picture赋上一张图片。运行后点击窗体，Picture2中就会有缩小的图像。详情见：http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/cordspac_57cd.asp

Answer 23

经过楼上各位前辈的指点，我对图形方面已有了一点点的了解。现有一想法，经查各方面资料，发现画扇形比较容易，但不知是否可以在知道度数范围（如30—60度）的情况下，截取圆的一扇形,然后在另一个picturebox里显示出来

Answer 24

单纯通过角度创建扇形的话可以结合使用AngleArc以及LineTo函数根据角度来创建一个扇形。具体的代码你可以参考一些MSDN中AngleArc中的一个范例（用C写的，不过并不复杂）
难点在拷贝，如果使用上面的我介绍的创建剪裁区域的方法的话比较麻烦，因为创建一个扇形的区域（特别是通过角度来创建）。你可以考虑创建一个圆形区域以及一个经过圆形的三角形区域，然后将两者通过CombineRgn合并成一个区域，然后将这个区域作为目标PictureBox的剪裁区域，然后将源图像拷贝过去。

Answer 25

差不多还是用这个方法（CreatePolygonRgn+CombineRgn+CreateEllipticRgn+SelectClipRgn）或者用异或码处理。先在目标上画一个黑底白色扇形（Pie函数+FloodFill），用Bitblt PATINVERT异或复制后再盖上一层白色异或复原。

Answer 26

to  TechnoFantasy(冰儿马甲www.applevb.com)
//你可以考虑创建一个圆形区域以及一个经过圆形的三角形区域
这三角形区域怎样可以确定啊？

Answer 27

先用异或覆盖以下（bitblt）。
再设置fillcolor=0，fillstyle=solid，borderwidth=0，用pie，就可以画出实心的黑色扇形（通道）
在用异或覆盖
通道外面的象素两次异或之后复原，通道里面的是盖到黑色上面的，原样显示
pie会用吗？

Answer 28

对啊，怎么把Pie函数给忘记了。

Answer 29

下面是一个扇形拷贝的范例，使用了API中的通道技术。Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 LongPrivate Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As LongPrivate Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FillPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As LongPrivate Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
'8008201859
'8008203800
Private Sub Command1_Click()
    Dim rgn As Long
    Dim oldrgn As Long
    
'    rgn = CreateEllipticRgn(10, 10, 160, 160)
    With Picture2
        BeginPath (.hdc)
        Call Pie(.hdc, 50, 50, 300, 300, 300, 175, 175, 300)
        FillPath (.hdc)
        EndPath (.hdc)
        
        rgn = PathToRegion(.hdc)
    End With    oldrgn = SelectClipRgn(Picture2.hdc, rgn)
    BitBlt Picture2.hdc, 10, 10, 150, 150, Picture1.hdc, 10, 10, SRCCOPY
    Call SelectClipRgn(Picture2.hdc, oldrgn)
    DeleteObject rgn
End Sub

Answer 30

恩，可以用路径通道，但是我来不及查MSDN，以前又没用过:)所以还是被大版主说了

Answer 31

怎么我截下来的都是正方形啊，MSDN上关于Pie是这样定义的：
BOOL Pie(
  HDC hdc,         // handle to DC
  int nLeftRect,   // x-coord of upper-left corner of rectangle 矩形左上角X坐标
  int nTopRect,    // y-coord of upper-left corner of rectangle 矩形左上角Y坐标
  int nRightRect,  // x-coord of lower-right corner of rectangle 矩形右上角X坐标
  int nBottomRect, // y-coord of lower-right corner of rectangle 矩形右下角Y坐标
  int nXRadial1,   // x-coord of first radial's endpoint 扇形第一条直边端点X坐标
  int nYRadial1,   // y-coord of first radial's endpoint 扇形第一条直边端点Y坐标
  int nXRadial2,   // x-coord of second radial's endpoint 扇形第二条直边端点X坐标
  int nYRadial2    // y-coord of second radial's endpoint 扇形第二条直边端点Y坐标
);
以上是我的理解，不知有错没有，请指正。
我现在想做的是，在form1上的picture1截取一个圆，粘贴到form2上的picture2并进行相应的放大或缩小（已经实现了），form2上放置一按钮，单击就截取picture2上圆的30-60度的扇形，粘贴到form3上的picture3的中心位置，不知道这样做有没有问题

Answer 32

看看你是怎么调用的？如果调用正确了，应该不是Pie的问题。否则不会出现正方形。

Answer 33

Dim rgn As Long
    Dim oldrgn As Long
    x0 = Fans.PicBox.ScaleWidth / 2
    y0 = Fans.PicBox.ScaleHeight / 2
    r = 150
    x = r * Math.Cos(30 * PI / 180) + x0
    y = r * Math.Cos(30 * PI / 180) + y0
    With Fans.PicBox
        BeginPath (.hdc)
        Call Pie(.hdc, x0, y, x, y0, r * Math.Cos(30 * PI / 180), r * Math.Cos(60 * PI / 180), r * Math.Cos(60 * PI / 180), r * Math.Cos(30 * PI / 180))
        FillPath (.hdc)
        EndPath (.hdc)
        rgn = PathToRegion(.hdc)
    End With
    oldrgn = SelectClipRgn(Fans.PicBox.hdc, rgn)
    BitBlt Fans.PicBox.hdc, x0, y, 2 * r, 2 * r, Clip.PicBox.hdc, Clip.PicBox.ScaleWidth / 2 - r, Clip.PicBox.ScaleHeight / 2 - r, SRCCOPY
    Call SelectClipRgn(Fans.PicBox.hdc, oldrgn)
    DeleteObject rgn
    Fans.Show vbModal

Answer 34

其中clip.picbox就是上面所说的form2上的picture2,Fans.picbox就是上面所说的form3上的picture3

Answer 35

还有就是我并不能拷贝picture2上的图片

Answer 36

唉，看来我不出手是不行了！Option Explicit
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As LongPrivate Sub Picture2_Click()
Picture2.FillStyle = vbSolid
Picture2.FillColor = 0
Picture2.DrawStyle = vbTransparent
Picture2.PaintPicture Picture1.Picture, 0, 0, , , , , , , vbSrcInvert
Pie Picture2.hdc, 50, 50, 150, 150, 150, 50, 50, 50
Picture2.PaintPicture Picture1.Picture, 0, 0, , , , , , , vbSrcInvert
End Sub

Answer 37

楼上的提供了另外一种思路，就是利用位图的位掩码操作。不过这样就有闪烁，最好是利用一个中间PictureBox作为一个缓冲平台。

Answer 38

to: Ivin(鹅鹅鹅，齐项向天歌) SelectClipRgn必须是在BitBlt前面，就是需要首先设置剪裁区域，然后再执行位图拷贝，这样才能出现效果。另外你的算法可能有问题。

Answer 39

//另外你的算法可能有问题。
此话怎讲？
可能我的理解有错，想问一下在使用pie时，
int nLeftRect,   // x-coord of upper-left corner of rectangle 矩形左上角X坐标
中的矩形是指包含扇形的矩形还是包含圆形的矩形？我想我的坐标可能定错了。

Answer 40

还有一个问题，那扇形直边的原点是矩形的左上角还是picturebox的左上角，picturebox左上角的坐标应该是（0，0）吧？

Answer 41

TO： TechnoFantasy(冰儿马甲www.applevb.com)我的方法不会有闪烁，因为在处理子过程时，不响应wm_paint消息.如果加上doevents就有闪烁了.

Answer 42

to  ColdMooon(月光寒) 
你的代码闪烁的原因不是wm_paint，而是因为你执行了两次Invert Copy。你可以创建一个后台的PictureBox，然后将这两次拷贝放到这个里面执行。然后将最后的结果拷贝到目标图像上面。

Answer 43

TO： TechnoFantasy(冰儿马甲www.applevb.com) 
我以前测试时picture2.autoredraw=true,所以他一直没闪。
刚才设picture2.autoredraw=false，才看到了他会闪。
其实你说的后台的PictureBox，就相当于picture2.hdc,
前台的PictureBox,就相当与getdc(picture2.hwnd).咱们的意思是一样的，只不过我将一些杂碎事交给vb去处理。

Answer 44

扇形拿出来了，但连桌面也一起拿出来了。还有就是，当截取完之后，用鼠标将窗体拖动进入屏幕的边界再拉出来时，picturebox的图形会变得乱七八糟。另外一点需提醒一下的就是：
我现在想做的是，在form1上的picture1截取一个圆，粘贴到form2上的picture2并进行相应的放大或缩小（已经实现了），form2上放置一按钮，单击就截取picture2上圆的30-60度的扇形，粘贴到form3上的picture3的中心位置。
我发现这样做出来的picture2.picture是没有内容的，而picture2.image才有内容。还有想问一下的就是扇形的圆心坐标是在什么地方确定的？

Answer 45

picture2.picture是没有内容的，而picture2.image才有内容是picture2.autoredraw的关系。api画圆用的是一个矩形四个角的坐标吧，如果是这样，那圆心坐标当然就是……可以去问问中学教几何的老师^_^

Answer 46

我也不至于这么低B吧！！
可能是我没把问题说清楚.
现在情况是这样的：在form1上有picture1,当用鼠标在picture1上画完一个圆后，show出form2,form2上有picture2,然后将picture1上的圆形区域粘贴到picture2上，在form2上有一排按钮，分别是“0-30”,“30-60”,“60-90”,.....,“330-360”,代表的是 0度到30度，30度到60度，...，330度到360度，当点击其中的按钮时，就从picture2上截取相应度数区间的扇形并show出form3，将扇形粘贴到form3上的picture3.
现在的问题是：（1）扇形截取出来粘贴到form3的picture3上时不但会有扇形，而且会连屏幕也一起截取了，也就是picture3的底图是屏幕的截屏，然后扇形粘贴在截屏上；（2）当截取完之后，用鼠标将窗体拖动进入屏幕的边界再拉出来时，picturebox的图形会变得乱七八糟。
不知哪位高人可以指点一二？谢谢

Answer 47

Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
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 LongPrivate Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As LongPrivate Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FillPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As LongPrivate Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
'8008201859
'8008203800Private Type POINTAPI
        x As Long
        y As Long
End TypePrivate Function getCenter(x1 As Long, y1 As Long, x2 As Long, y2 As Long) As POINTAPI
    Dim p As POINTAPI
    
    p.x = (x1 + x2) / 2
    p.y = (y1 + y2) / 2
    
    getCenter = p
End FunctionPrivate Function getEndPoint(center As POINTAPI, l As Long, a As Integer) As POINTAPI
    Dim p As POINTAPI
    
    p.x = center.x + Round(l * Cos(a * (3.14 / 180)))
    p.y = center.y - Round(l * Sin(a * (3.14 / 180)))
    getEndPoint = p
End FunctionPrivate Sub Command1_Click()
    Dim rgn As Long
    Dim oldrgn As Long
    Dim cent As POINTAPI
    Dim e1 As POINTAPI
    Dim e2 As POINTAPI
    
    cent = getCenter(50, 50, 300, 300)
    e1 = getEndPoint(cent, 125, 30)
    e2 = getEndPoint(cent, 125, 60)
    
    With Picture2
        BeginPath (.hdc)
        Call Pie(.hdc, 50, 50, 300, 300, e1.x, e1.y, e2.x, e2.y)
        FillPath (.hdc)
        EndPath (.hdc)
        
        rgn = PathToRegion(.hdc)
    End With    oldrgn = SelectClipRgn(Picture2.hdc, rgn)
    BitBlt Picture2.hdc, 50, 50, 250, 250, Picture1.hdc, 10, 10, SRCCOPY
    Call SelectClipRgn(Picture2.hdc, oldrgn)
    DeleteObject rgn
End Sub

Answer 48

上面的代码增加了两个函数，一个是getCenter，该函数可以获得一个正方形的中心。一个是getEndPoint，该函数可以根据圆心、半径以及角度获得扇形该角度的终点。