如何使Picture1里的图片居中

Question

如何使Picture1里的图片居中,不管是图片的大小大于图片框还是小于图片框,都使图片居中,该如何实现?

Answer 1

Picture1装入图片后，图片的左上角默认座标为Picture1的左上角，即原点座标：(0,0)，这时可以根据图片的高度和宽度调整Picture1的宽度和高度，以刚好装入图片。
假如，非要把图片放到Picture1中央，而Picture1又比图片大的话，那周围不是有很多空白地方，太难看了吧。

Answer 2

如果非要居中的话，先把图片放到剪贴板，然后用API函数BitBlt再复制到Picture1中。复制时，计算好放置时的左上角座标，和高度宽度。

Answer 3

将picture1放在picture2中央：Option Explicit
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
Private Const SRCCOPY = &HCC0020
Private Sub Command1_Click()
        Dim cleft&, cTop&
        Picture1.ScaleMode = 3
        Picture2.ScaleMode = 3
        cleft = (Picture2.ScaleWidth - Picture1.ScaleWidth) / 2
        cTop = (Picture2.ScaleHeight - Picture1.ScaleHeight) / 2
        BitBlt Picture2.hDC, cleft, cTop, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY
End Sub

Answer 4

两种方式
1. 改变Picture的大小和位置
 伪代码： 
pic1.move mX,mY
pic1.width=aa
pic1.height=bb2.DC复制
 伪代码：
set pic2.picture=loadpicturn("xxx.jpg")
bltbit pic1.hdc,x1,y1,w1,h1,pic2.hdc,x2,y2,w2,h2BOOL BitBlt(
  HDC hdcDest, // handle to destination DC
  int nXDest,  // x-coord of destination upper-left corner
  int nYDest,  // y-coord of destination upper-left corner
  int nWidth,  // width of destination rectangle
  int nHeight, // height of destination rectangle
  HDC hdcSrc,  // handle to source DC
  int nXSrc,   // x-coordinate of source upper-left corner
  int nYSrc,   // y-coordinate of source upper-left corner
  DWORD dwRop  // raster operation code
);

Answer 5

加如两个picture,将1放在下,并将其visible 属性设置为 false.
建个模块.
Option Explicit
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
Private Const SRCCOPY = &HCC0020
Private Sub Form_Load()
        Dim a&, b&
        Picture1.ScaleMode = 3
        Picture2.ScaleMode = 3
        a = (Picture2.ScaleWidth - Picture1.ScaleWidth) / 2
        b = (Picture2.ScaleHeight - Picture1.ScaleHeight) / 2
        BitBlt Picture2.hDC, a, b, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY
End Sub

Answer 6

在picture框里放一个一样大小的Image控件，将Image控件的Stretch属性设为True，然后用Image控件显示图片。

Answer 7

图片居中可没楼上几位说的那么单纯,因为图片要完全在PictureBox里面则要考虑到图片的宽度与高度的比例,更要考虑到图片是宽度大于高度,或是高度大于宽度, 再则,图片本身比PictureBox大则要缩小,或图片本身比PictureBox小,则要计算XY座标定位里面图片的尺寸,以便于居中显示, 楼主留下邮箱吧.效果图:
http://p.blog.csdn.net/images/p_blog_csdn_net/cbm666/366646/o_AutoShow.jpg

Answer 8

还可以在里面再放一个PICTURE,是吧?

Answer 9

用api自己装入图像吧，简单的坐标运算。

Answer 10

我倒没想得太复杂，用api读入图像数据，比较图像的长宽与图片框长宽，如果图像比框大，则用api显示图像中部图片框那么大的块贴到图片框（这就是我说的简单的坐标计算），如果图像比图片框小，直接计算该图像该贴哪个位置就行了。
不过看了阁下的示例图片，或许我们理解的居中可能不太一样。

Answer 11

呵呵, 我理解的居中是,不管图片任何大小与比例都要能100%在PictureBox中看得见, 并且以长宽的比例该放大则放大,该缩小则缩小, 并能定位在正中间, 以前在做时最难搞的就是宽度高度比例不见得是标准的 3/4 , 也有可能是 4/3 , 也有可能是 1:1 如此一搞下来, 图片只是缩小但不会变型, 只是会出现左右部份或上下部份在PictureBox中是空白的, 还好 Image本身是透明的, 这倒不会是大问题, 以前也觉得简单, 但一搞下来一个头两个大......

Answer 12

这是很久以前为回复一个csdner贴子写的代码，图像大时可以用鼠标移动图像，有放大功能（这个不太完善）。。楼主看看是不是你要的居中。'模块中：
Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type'程序：
Private Sub Form_Load()
Picture1.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Dim bm As BITMAP
Dim pic As Picture
Set pic = LoadPicture("c:\1.jpg")
GetObject pic.Handle, LenB(bm), bm
w = bm.bmWidth
h = bm.bmHeight
hmemDC = CreateCompatibleDC(Picture1.hDC)
SelectObject hmemDC, pic.Handle
zoom = 1
'StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, 0, 0, Picture1.Width, Picture1.Height, vbSrcCopy
'StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, ((w - Picture1.Width) / 2) / zoom, ((h - Picture1.Height) / 2) / zoom, Picture1.Width, Picture1.Height, vbSrcCopy
xtemp = ((w - Picture1.Width) / 2) / zoom
ytemp = ((h - Picture1.Height) / 2) / zoom
zoom = 4
StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, xtemp + (Picture1.Width - Picture1.Width / zoom) / 2, ytemp + (Picture1.Height - Picture1.Height / zoom) / 2, Picture1.Width / zoom, Picture1.Height / zoom, vbSrcCopy
xtemp = xtemp + (Picture1.Width - Picture1.Width / zoom) / 2
ytemp = ytemp + (Picture1.Height - Picture1.Height / zoom) / 2
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
xnow = x
ynow = y
xchange = 0
ychange = 0
Picture1.AutoRedraw = True
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
xchange = xtemp + (xnow - x) / zoom
ychange = ytemp + (ynow - y) / zoom
If xchange > w - Picture1.Width / zoom Then xchange = w - Picture1.Width / zoom
If ychange > h - Picture1.Height / zoom Then ychange = h - Picture1.Height / zoom
If xchange < 0 Then xchange = 0
If ychange < 0 Then ychange = 0
StretchBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hmemDC, xchange, ychange, Picture1.Width / zoom, Picture1.Height / zoom, vbSrcCopy
Picture1.AutoRedraw = False
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.AutoRedraw = False
xtemp = xchange
ytemp = ychange
End Sub

Answer 13

呵呵, 我理解的居中是,不管图片任何大小与比例都要能100%在PictureBox中看得见, 并且以长宽的比例该放大则放大,该缩小则缩小, 并能定位在正中间,
＝＝＝＝＝＝＝＝＝＝＝＝＝
这个好办。
以前在做时最难搞的就是宽度高度比例不见得是标准的 3/4 , 也有可能是 4/3 , 也有可能是 1:1 如此一搞下来, 图片只是缩小但不会变型, 只是会出现左右部份或上下部份在PictureBox中是空白的, 还好 Image本身是透明的, 这倒不会是大问题, 以前也觉得简单, 但一搞下来一个头两个大......
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
如果图像长宽比例与图片框长宽比例不一致而又要求撑满图片框并居中，失真是必然的。

Answer 14

上面zoom = 4那行注释掉吧，那个应该是当时为了测试放大功能加的。

Answer 15

呵呵, 理解果然不同, 我是为了制作屏保特效才花了几个小时来搞定这个问题.下图中,上面的是一个横型的图,下面的是长型图, 就是要让它100%能见,且又不变型, 这才是难搞的地方.以前写的代码, 上面有些控件不好整, 不然早就贴出来了, 下午要出门到青岛参展,否则就花点时间整理一下贴出来了.效果图:http://p.blog.csdn.net/images/p_blog_csdn_net/cbm666/366646/o_center.jpg

Answer 16

比较合理的方法是先将图片加载到一个stdpicture中，然后调用他的render方法绘制。Private Sub Command1_Click()
    LoadImage "c:\1.bmp", Picture1End SubPublic Sub GetBestFitInfo(StdPic As StdPicture, Pic As PictureBox, ByRef FitX As Long, ByRef FitY As Long, ByRef FitWidth As Long, ByRef FitHeight As Long)
    Dim WidthRatio As Double
    Dim HeightRatio As Double
    Dim Width As Long, Height As Long
    Width = Convert(StdPic.Width, False)
    Height = Convert(StdPic.Height, True)
    Pic.AutoRedraw = True
    Pic.ScaleMode = 3
    If (Width > Pic.ScaleWidth Or Height > Pic.ScaleHeight) Then
        WidthRatio = Pic.ScaleWidth / Width
        HeightRatio = Pic.ScaleHeight / Height
        If WidthRatio < HeightRatio Then
            FitWidth = Pic.ScaleWidth
            FitHeight = Height * WidthRatio
        Else
            FitHeight = Pic.ScaleHeight
            FitWidth = Width * HeightRatio
        End If
    Else
        FitWidth = Width
        FitHeight = Height
    End If
    FitX = (Pic.ScaleWidth - FitWidth) \ 2 + 1
    FitY = (Pic.ScaleHeight - FitHeight) \ 2 + 1
End SubPublic Function LoadImage(Filename As String, Pic As PictureBox) As Boolean
    If Dir(Filename) <> "" Then
        Dim StdPic As StdPicture
        Dim FitX As Long, FitY As Long, FitWidth As Long, FitHeight As Long
        Set StdPic = LoadPicture(Filename)
        If Not StdPic Is Nothing Then
            GetBestFitInfo StdPic, Pic, FitX, FitY, FitWidth, FitHeight
            StdPic.Render Pic.hDC, FitX + 0&, FitY + 0&, FitWidth + 0&, FitHeight + 0&, 0, StdPic.Height, StdPic.Width, -StdPic.Height, ByVal 0
        End If
        Pic.Refresh
        Set StdPic = Nothing
    End If
End FunctionPrivate Function Convert(Value As Long, Horizontally As Boolean) As Long
    If Horizontally Then
        Convert = Value * 1440 / 2540 / Screen.TwipsPerPixelX
    Else
        Convert = Value * 1440 / 2540 / Screen.TwipsPerPixelY
    End If
End Function
你看下效果就知道了。

Answer 17

cbm666 
下图中,上面的是一个横型的图,下面的是长型图, 就是要让它100%能见,且又不变型, 这才是难搞的地方. 
这个不会有什么难搞的吧？？？？GetBestFitInfo 就可以了

Answer 18

laviewpbt 同志的代码是一流的, 效果与我的完全一样, 但代码结构与思路比我的好,这就是我所理解的 "居中" 效果.下面这是以前的代码拿来改的, 去掉了我的放大与屏包切换等特效演示, 可能会有些错误'添加 Picture1 Image1 Timer1 Check1 List1 Command1  CommonDialog1Const MILLICMETERCELL = 26.45836
Dim NewImgWidth&, NewImgHeight&, NewWidth&, NewHeight&, NewLeft&, NewTop&
Dim aa$, PicName$, SchPath$, FileExt$, SelFolder$, i&, jj&, W&, H&, X1&, Y1&, X2&, Y2&, sPrivate Sub Form_Load()
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Picture1.AutoRedraw = True
   Picture1.Width = 4000: Picture1.Height = 3000
   Image1.Stretch = True
   Set Image1.Container = Picture1
   Command1.Caption = "选择图片夹"
   Timer1.Interval = 1000
   Timer1.Enabled = False
End SubPublic Function ResizePic(ByVal P As Picture, BoxWidth&, BoxHeight&) As String
   Dim PicRatio!
   NewImgWidth = Int(P.Width / MILLICMETERCELL + 0.5)
   NewImgHeight = Int(P.Height / MILLICMETERCELL + 0.5)
   PicRatio = Format(NewImgHeight / NewImgWidth, "0.0000")
   If NewImgWidth <= BoxWidth \ 15 And NewImgHeight <= BoxHeight \ 15 Then
      NewImgWidth = NewImgWidth * 15
      NewImgHeight = NewImgHeight * 15
   Else
      If NewImgWidth >= NewImgHeight Then
         NewImgWidth = BoxWidth
         NewImgHeight = Int(NewImgWidth * PicRatio)
         If NewImgHeight > BoxHeight Then
            PicRatio = BoxHeight / NewImgHeight
            NewImgHeight = BoxHeight
            NewImgWidth = NewImgWidth * PicRatio
         End If
      Else
         NewImgHeight = BoxHeight
         NewImgWidth = Int(NewImgHeight / PicRatio)
         If NewImgWidth > BoxWidth Then
            PicRatio = BoxWidth / NewImgWidth
            NewImgWidth = BoxWidth
            NewImgHeight = NewImgHeight * PicRatio
         End If
      End If
   End If
   NewWidth = NewImgWidth
   NewHeight = NewImgHeight
   NewLeft = (BoxWidth - NewWidth) \ 2
   NewTop = (BoxHeight - NewHeight) \ 2
   ResizePic = CStr(NewLeft) & "," & CStr(NewTop) & "," & CStr(NewWidth) & "," & CStr(NewHeight)
End FunctionPrivate Sub Command1_Click()
   On Error GoTo errhandler
   Timer1.Enabled = False
   With CommonDialog1
      .Flags = cdlOFNFileMustExist + cdlOFNReadOnly
      .Filter = "位图格式(*.bmp)|*.bmp|GIF格式(*.gif)|*.gif|JPEG格式(*.jpg)|*.jpg"
      .FilterIndex = 3    ' 显示*.JPG文件列表
      .DialogTitle = "选择图片"
      .ShowOpen   ' 显示"打开"对话框
   End With
   PicName = CommonDialog1.FileName
   Call ShowImage(PicName)
   aa = CommonDialog1.FileName
   SchPath = Mid(aa, 1, InStrRev(aa, "\"))
   FileExt = UCase("*.bmp;*.jpg;*.gif")
   Call AddFileToList(SchPath, FileExt)
   Timer1.Enabled = IIf(Check1.Value = 1, True, False)
errhandler:
   If Err > 0 Then Exit Sub
End SubSub AddFileToList(Spath$, ExtNm$)
   Dim fol, fso, fil, fils, f, fldr
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldr = fso.GetFolder(Spath)
   Set fils = fldr.Files
   List1.Clear
   For Each fil In fils
      aa = UCase(Mid(Spath & fil.Name, InStrRev(Spath & fil.Name, ".")))
      If InStr(ExtNm, aa) > 0 Then List1.AddItem Spath & fil.Name
   Next
End SubPrivate Sub List1_Click()
   If List1.ListCount <> 0 Then
      jj = List1.ListIndex
      PicName = List1.List(jj)
      Call ShowImage(PicName)
   End If
End SubPrivate Sub Check1_Click()
   If List1.ListCount = 0 And Check1.Value = 1 Then Check1.Value = 0
   Timer1.Enabled = IIf(Check1.Value = 1, True, False)
End SubPrivate Sub Timer1_Timer()
   Randomize
   jj = Int(Rnd * List1.ListCount)
   PicName = List1.List(jj)
   Call ShowImage(PicName)
   List1.RemoveItem jj
   If List1.ListCount <= 0 Then Call AddFileToList(SchPath, FileExt)
End SubSub ShowImage(ImgPic$)
   If ImgPic <> "" Then
      Image1.Picture = LoadPicture(ImgPic)
      aa = ResizePic(Image1.Picture, Picture1.Width, Picture1.Height)
      s = Split(aa, ",")
      Image1.Width = Val(s(2)): Image1.Height = Val(s(3))
      Image1.Move Val(s(0)), Val(s(1))
   End If
End Sub

Answer 19

这个也不难吧，把我上面的form_load里的代码改改，加几个判断，根据图形长宽比与图片框长宽比选择对应的缩放方案就可以了，不过已经有人贴出代码我就不献丑了。

Answer 20

留言收到，我上面那段代码就是实现你说的那种居中，只要你把zoom = 4那行代码注释掉或删掉就可以了。