图象平滑放大的Pixel算法总算写出来了！大家共享！

Question

'求上方的颜色
    If j - 1 < 0 Then
      Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2)
    Else
      Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2 - 2) '取得上方的颜色(相对于上方的颜色)
    End If
    Dcolor = GetPixel(PicTo.hdc, i * 2, j * 2) '取得下方的颜色(相对于上方的颜色)
    If j - 1 < 0 Then
      If i - 1 < 0 Then
        Lcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Lcolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2)
      End If
    Else
      If i - 1 < 0 Then
        Lcolor = GetPixel(PicTo.hdc, i * 2, j * 2 - 1)
      Else
        Lcolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2 - 1) '取得左方的颜色(相对于上方的颜色)
      End If
    End If
    If j - 1 < 0 Then
      If i + 1 > Pic.ScaleWidth Then
        Rcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Rcolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2)
      End If
    Else
      If i + 1 > Pic.ScaleWidth Then
        Rcolor = GetPixel(PicTo.hdc, i * 2, j * 2 - 1)
      Else
        Rcolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2 - 1) '取得右方的颜色(相对于上方的颜色)
      End If
    End If
    '在取得颜色的RGB值分量后，进行求平均值运算
    Red = (GetRedValue(Ucolor) + GetRedValue(Rcolor) + GetRedValue(Lcolor) + GetRedValue(Dcolor)) / 4
    Green = (GetGreenValue(Ucolor) + GetGreenValue(Rcolor) + GetGreenValue(Lcolor) + GetGreenValue(Dcolor)) / 4
    Blue = (GetBlueValue(Ucolor) + GetBlueValue(Rcolor) + GetBlueValue(Lcolor) + GetBlueValue(Dcolor)) / 4
    SetPixel PicTo.hdc, i * 2, j * 2 - 1, RGB(Red, Green, Blue) '设置上方的颜色
    '求右方的颜色
    If j - 1 < 0 Then
      If i + 1 > Pic.ScaleWidth Then
        Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Ucolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2)
      End If
    Else
      If i + 1 > Pic.ScaleWidth Then
        Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2 - 1)
      Else
        Ucolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2 - 1) '取得上方的颜色(相对于右方的颜色)
      End If
    End If
    If j + 1 > Pic.ScaleHeight Then
      If i + 1 > Pic.ScaleWidth Then
        Dcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Dcolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2)
      End If
    Else
      If i + 1 > Pic.ScaleWidth Then
        Dcolor = GetPixel(PicTo.hdc, i * 2, j * 2 + 1)
      Else
        Dcolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2 + 1) '取得下方的颜色(相对于右方的颜色)
      End If
    End If
    Lcolor = GetPixel(PicTo.hdc, i * 2, j * 2) '取得左方的颜色(相对于右方的颜色)
    If i + 1 > Pic.ScaleWidth Then
      Rcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
    Else
      Rcolor = GetPixel(PicTo.hdc, i * 2 + 1, j * 2) '取得右方的颜色(相对于右方的颜色)
    End If
    '在取得颜色的RGB值分量后，进行求平均值运算
    Red = (GetRedValue(Ucolor) + GetRedValue(Rcolor) + GetRedValue(Lcolor) + GetRedValue(Dcolor)) / 4
    Green = (GetGreenValue(Ucolor) + GetGreenValue(Rcolor) + GetGreenValue(Lcolor) + GetGreenValue(Dcolor)) / 4
    Blue = (GetBlueValue(Ucolor) + GetBlueValue(Rcolor) + GetBlueValue(Lcolor) + GetBlueValue(Dcolor)) / 4
    SetPixel PicTo.hdc, i * 2 + 1, j * 2, RGB(Red, Green, Blue) '设置右方的颜色
    '求左方的颜色
    If j - 1 < 0 Then
      If i - 1 < 0 Then
        Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Ucolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2)
      End If
    Else
      If i - 1 < 0 Then
        Ucolor = GetPixel(PicTo.hdc, i * 2, j * 2 - 1)
      Else
        Ucolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2 - 1) '取得上方的颜色(相对于左方的颜色)
      End If
    End If
    If j + 1 > Pic.ScaleHeight Then
      If i - 1 < 0 Then
        Dcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
      Else
        Dcolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2)
      End If
    Else
      If i - 1 < 0 Then
        Dcolor = GetPixel(PicTo.hdc, i * 2, j * 2 + 1)
      Else
        Dcolor = GetPixel(PicTo.hdc, i * 2 - 1, j * 2 + 1) '取得下方的颜色(相对于左方的颜色)
      End If
    End If
    If i - 1 < 0 Then
      Lcolor = GetPixel(PicTo.hdc, i * 2, j * 2)
    Else
      Lcolor = GetPixel(PicTo.hdc, i * 2 - 2, j * 2) '取得左方的颜色(相对于左方的颜色)
    End If
    Rcolor = GetPixel(PicTo.hdc, i * 2, j * 2) '取得右方的颜色(相对于左方的颜色)
    '在取得颜色的RGB值分量后，进行求平均值运算
    Red = (GetRedValue(Ucolor) + GetRedValue(Rcolor) + GetRedValue(Lcolor) + GetRedValue(Dcolor)) / 4
    Green = (GetGreenValue(Ucolor) + GetGreenValue(Rcolor) + GetGreenValue(Lcolor) + GetGreenValue(Dcolor)) / 4
    Blue = (GetBlueValue(Ucolor) + GetBlueValue(Rcolor) + GetBlueValue(Lcolor) + GetBlueValue(Dcolor)) / 4
    SetPixel PicTo.hdc, i * 2 - 1, j * 2, RGB(Red, Green, Blue) '设置左方的颜色
  Next j
Next i
PicTo.Height = Pic.Height * 2 - 2 '去除边缘白色
PicTo.Width = Pic.Width * 2 - 2
PicTo.Refresh
End Function
'本段函数仅能对图象进行四倍的放大，实际运用中，可以循环放大到于理想倍数接近的程度，然后用PaintPicture方法或StretchBlt函数进行缩小操作(放大会失真)
'还是要打上“原创”的记号(如要转载请打上“转载”的记号)
'-------------------------------------------------------------------
'Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 1

大家有好算法也贴出来啊！可以加分的。
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 2

如果大家有好的算法也请贴出来吧！可以加分的。
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 3

To sippey(sippey)，因为是用的SetPixel/GetPixel函数，速度肯定不是很快，我感觉和S-Spline的速度差不多，正在写DIB版的。
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 4

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As LongPrivate Sub Command1_Click()'Picture1>>P1
'Picture2>>P2
Dim Ps, r1, g1, b1, r2, g2, b2, l1, l2, l3, w, h, jP2.Width = 2 * P1.Width
P2.Height = 2 * P1.Height
P1.ScaleMode = 3
P2.ScaleMode = 3P2.Refresh
Ps = 2
For h = 0 To P1.ScaleHeight - 1  'Step ps
    For w = 0 To P1.ScaleWidth - 1 'Step ps
     l1 = GetPixel(P1.hdc, w, h)
     l2 = GetPixel(P1.hdc, w + 1, h)
        If l1 > -1 And l2 > -1 Then
            b1 = (l1 \ &H10000) Mod &H100
            g1 = (l1 \ &H100) Mod &H100
            r1 = l1 Mod &H100
            b2 = (l2 \ &H10000) Mod &H100
            g2 = (l2 \ &H100) Mod &H100
            r2 = l2 Mod &H100
            b1 = (b1 + b2) \ 2
            g1 = (g1 + g2) \ 2
            r1 = (r1 + r2) \ 2
       l3 = RGB(r1, g1, b1)
       SetPixel P2.hdc, w * Ps, h * Ps, l1
       SetPixel P2.hdc, w * Ps + 1, h * Ps, l3
       End If
    Next w
    
     For j = 0 To (P1.ScaleWidth - 1) * Ps
      l1 = GetPixel(P2.hdc, j, h * Ps - 2)
      l2 = GetPixel(P2.hdc, j, h * Ps)
         If l1 > -1 And l2 > -1 Then
            b1 = (l1 \ &H10000) Mod &H100
            g1 = (l1 \ &H100) Mod &H100
            r1 = l1 Mod &H100
            b2 = (l2 \ &H10000) Mod &H100
            g2 = (l2 \ &H100) Mod &H100
            r2 = l2 Mod &H100
            b1 = (b1 + b2) \ 2
            g1 = (g1 + g2) \ 2
            r1 = (r1 + r2) \ 2
            l3 = RGB(r1, g1, b1)
            SetPixel P2.hdc, j, h * Ps - 1, l3
        End If
     Next jNext h
 For h = 0 To (P1.ScaleHeight - 1) * Ps Step Ps 
     For j = 0 To (P1.ScaleWidth - 1) * Ps
      l1 = GetPixel(P2.hdc, j, h)
      
      l2 = GetPixel(P2.hdc, j, h + 2)
         If l1 > -1 And l2 > -1 Then
             b1 = (l1 \ &H10000) Mod &H100
            g1 = (l1 \ &H100) Mod &H100
            r1 = l1 Mod &H100
            b2 = (l2 \ &H10000) Mod &H100
            g2 = (l2 \ &H100) Mod &H100
            r2 = l2 Mod &H100
            b1 = (b1 + b2) \ 2
            g1 = (g1 + g2) \ 2
            r1 = (r1 + r2) \ 2
            l3 = RGB(r1, g1, b1)
            SetPixel P2.hdc, j, h + 1, l3
        End If
     Next j          
   
Next h 
End Sub

Answer 5

对不起!
P2.ScaleMode = 3P2.Refresh
应改为:
P2.ScaleMode = 3
P2.Refresh

Answer 6

我也来一份，四方向取色法Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Sub Show2xPicture(ByVal dc1 As Long, ByVal dc2 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal w As Long, ByVal h As Long, ByVal x2 As Long, ByVal y2 As Long)
    Dim i As Integer, j As Integer, k As Integer
    Dim b() As Long, t1 As Long, t2 As Long, t(0 To 3) As Long
    Dim rr As Integer, gg As Integer, bb As Integer, cc As Integer
    Dim x As Integer, y As Integer
    
    ReDim b(w * h * 4 - 1)
    
    For i = x1 To x1 + w - 1
        For j = y1 To y1 + h - 1
            b((i - x1) * 2 * w * 2 + (j - y1) * 2) = GetPixel(dc1, i, j)
        Next
    Next
    
    For i = x1 To x1 + w - 1
        For j = y1 To y1 + h - 1
        
            x = (i - x1) * 2 + 1
            y = (j - y1) * 2            For k = 0 To 3
                t(k) = -1
            Next
            
            If x <> w * 2 - 1 Then t(1) = b((x + 1) * w * 2 + y)
            t(2) = b((x - 1) * w * 2 + y)
            
            cc = 0: rr = 0: bb = 0: gg = 0
            For k = 0 To 3
                If t(k) <> -1 Then
                    rr = (t(k) Mod 256) + rr
                    gg = (t(k) Mod &H10000) \ &H100& + gg
                    bb = (t(k) \ &H10000) + bb
                    cc = cc + 1
                End If
            Next
            b(x * w * 2 + y) = RGB(rr / cc, gg / cc, bb / cc)
                                     
            x = (i - x1) * 2
            y = (j - y1) * 2 + 1
            
            For k = 0 To 3
                t(k) = -1
            Next
            
            If y <> h * 2 - 1 Then t(0) = b(x * w * 2 + y + 1)
            t(1) = b(x * w * 2 + y - 1)
 
            cc = 0: rr = 0: bb = 0: gg = 0
            For k = 0 To 3
                If t(k) <> -1 Then
                    rr = (t(k) Mod 256) + rr
                    gg = (t(k) Mod &H10000) \ &H100& + gg
                    bb = (t(k) \ &H10000) + bb
                    cc = cc + 1
                End If
            Next
            b(x * w * 2 + y) = RGB(rr / cc, gg / cc, bb / cc)
        Next
    Next    y = h * 2 - 1
    For i = 0 To w - 1
        x = (i - x1) * 2
        b(x * w * 2 + y) = b((x) * w * 2 + y - 1)
        b((x + 1) * w * 2 + y) = b((x) * w * 2 + y - 1)
    Next
    
    x = w * 2 - 1
    For i = 0 To h - 2
        y = (i - y1) * 2 + 1
        b(x * w * 2 + y) = b((x - 1) * w * 2 + y)
        b(x * w * 2 + y + 1) = b((x - 1) * w * 2 + y + 1)
    Next
    
    For i = x1 To x1 + w - 2
        For j = y1 To y1 + h - 2
            For k = 0 To 3
                t(k) = -1
            Next
            x = (i - x1) * 2 + 1
            y = (j - y1) * 2 + 1
            
            t(0) = b(x * w * 2 + y + 1)
            t(1) = b(x * w * 2 + y - 1)
            t(2) = b((x + 1) * w * 2 + y)
            t(3) = b((x - 1) * w * 2 + y)            cc = 0: rr = 0: bb = 0: gg = 0
            For k = 0 To 3
                rr = (t(k) Mod 256) + rr
                gg = (t(k) Mod &H10000) \ &H100& + gg
                bb = (t(k) \ &H10000) + bb
                cc = cc + 1
            Next
            b(x * w * 2 + y) = RGB(rr / cc, gg / cc, bb / cc)
        Next
    Next    For i = x2 To x2 + w * 2 - 1
        For j = y2 To y2 + h * 2 - 1
            SetPixel dc2, i, j, b(((i - x2) * w * 2 + (j - y2)))
        Next
    NextEnd Sub
Private Sub Form_Load()
    picDest.Width = picSrc.Width * 2
    picDest.Height = picSrc.Height * 2
    Show2xPicture picSrc.hdc, picDest.hdc, 0, 0, picSrc.Width, picSrc.Height, 0, 0
    picDest.Refresh
End Sub

Answer 7

不必这样吧？
都是研究技术的，别这么客气，让人@!#)(&$(@#&$