Top posters
Admin (41075)
41075 Số bài - 95%
kukukakaka (785)
785 Số bài - 2%
alibattuv (736)
736 Số bài - 2%
NTLongHo (549)
549 Số bài - 1%
armata229 (79)
79 Số bài - 0%
60 Số bài - 0%
typhon2 (52)
52 Số bài - 0%
33 Số bài - 0%
29 Số bài - 0%
boy747bhp (22)
22 Số bài - 0%
Top posting users this week
Top posting users this month
Tìm kiếm
Display results as :
Advanced Search

Share
Xem chủ đề cũ hơnGo downXem chủ đề mới hơn
Ban quản trị
Ban quản trị
Chủng tộc : SONGOKU
Tổng số bài gửi : 41075
Độ nổi tiếng : 846
Join date : 14/11/2011
Age : 25
Xem lý lịch thành viênhttp://truyenhay.forumvi.com

Thủ tục co ảnh VB

on Thu Jan 03, 2013 4:06 pm
Code:
Public Sub Resize(newWidth As Integer, newHeight As Integer)
   If newWidth <> 0 AndAlso newHeight <> 0 Then
      Dim temp As Bitmap = DirectCast(_currentBitmap, Bitmap)
      Dim bmap As New Bitmap(newWidth, newHeight, temp.PixelFormat)

      Dim nWidthFactor As Double = DirectCast(temp.Width, Double) / DirectCast(newWidth, Double)
      Dim nHeightFactor As Double = DirectCast(temp.Height, Double) / DirectCast(newHeight, Double)

      Dim fx As Double, fy As Double, nx As Double, ny As Double
      Dim cx As Integer, cy As Integer, fr_x As Integer, fr_y As Integer
      Dim color1 As New Color()
      Dim color2 As New Color()
      Dim color3 As New Color()
      Dim color4 As New Color()
      Dim nRed As Byte, nGreen As Byte, nBlue As Byte

      Dim bp1 As Byte, bp2 As Byte

      Dim x As Integer = 0
      While x < bmap.Width
         Dim y As Integer = 0
         While y < bmap.Height

            fr_x = CInt(Math.Floor(x * nWidthFactor))
            fr_y = CInt(Math.Floor(y * nHeightFactor))
            cx = fr_x + 1
            If cx >= temp.Width Then
               cx = fr_x
            End If
            cy = fr_y + 1
            If cy >= temp.Height Then
               cy = fr_y
            End If
            fx = x * nWidthFactor - fr_x
            fy = y * nHeightFactor - fr_y
            nx = 1.0 - fx
            ny = 1.0 - fy

            color1 = temp.GetPixel(fr_x, fr_y)
            color2 = temp.GetPixel(cx, fr_y)
            color3 = temp.GetPixel(fr_x, cy)
            color4 = temp.GetPixel(cx, cy)

            ' Blue
            bp1 = DirectCast(nx * color1.B + fx * color2.B, Byte)

            bp2 = DirectCast(nx * color3.B + fx * color4.B, Byte)

            nBlue = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

            ' Green
            bp1 = DirectCast(nx * color1.G + fx * color2.G, Byte)

            bp2 = DirectCast(nx * color3.G + fx * color4.G, Byte)

            nGreen = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

            ' Red
            bp1 = DirectCast(nx * color1.R + fx * color2.R, Byte)

            bp2 = DirectCast(nx * color3.R + fx * color4.R, Byte)

            nRed = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

            bmap.SetPixel(x, y, System.Drawing.Color.FromArgb(255, nRed, nGreen, nBlue))
            System.Threading.Interlocked.Increment(y)
         End While
         System.Threading.Interlocked.Increment(x)
      End While
      _currentBitmap = DirectCast(bmap.Clone(), Bitmap)
   End If
End Sub

๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Truyện hay♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑ ๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Forumi.com♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑
Đăng nhập để có 1 link download đúng lol! lol!
Ban quản trị
Ban quản trị
Chủng tộc : SONGOKU
Tổng số bài gửi : 41075
Độ nổi tiếng : 846
Join date : 14/11/2011
Age : 25
Xem lý lịch thành viênhttp://truyenhay.forumvi.com

Re: Thủ tục co ảnh VB

on Thu Jan 03, 2013 4:42 pm
Public Sub Resize(newWidth As Integer, newHeight As Integer)
If newWidth <> 0 AndAlso newHeight <> 0 Then
Dim temp As Bitmap = DirectCast(_currentBitmap, Bitmap)
Dim bmap As New Bitmap(newWidth, newHeight, temp.PixelFormat)

Dim nWidthFactor As Double = DirectCast(temp.Width, Double) / DirectCast(newWidth, Double)
Dim nHeightFactor As Double = DirectCast(temp.Height, Double) / DirectCast(newHeight, Double)

Dim fx As Double, fy As Double, nx As Double, ny As Double
Dim cx As Integer, cy As Integer, fr_x As Integer, fr_y As Integer
Dim color1 As New Color()
Dim color2 As New Color()
Dim color3 As New Color()
Dim color4 As New Color()
Dim nRed As Byte, nGreen As Byte, nBlue As Byte

Dim bp1 As Byte, bp2 As Byte

Dim x As Integer = 0
While x < bmap.Width
Dim y As Integer = 0
While y < bmap.Height

fr_x = CInt(Math.Floor(x * nWidthFactor))
fr_y = CInt(Math.Floor(y * nHeightFactor))
cx = fr_x + 1
If cx >= temp.Width Then
cx = fr_x
End If
cy = fr_y + 1
If cy >= temp.Height Then
cy = fr_y
End If
fx = x * nWidthFactor - fr_x
fy = y * nHeightFactor - fr_y
nx = 1.0 - fx
ny = 1.0 - fy

color1 = temp.GetPixel(fr_x, fr_y)
color2 = temp.GetPixel(cx, fr_y)
color3 = temp.GetPixel(fr_x, cy)
color4 = temp.GetPixel(cx, cy)

' Blue
bp1 = DirectCast(nx * color1.B + fx * color2.B, Byte)

bp2 = DirectCast(nx * color3.B + fx * color4.B, Byte)

nBlue = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

' Green
bp1 = DirectCast(nx * color1.G + fx * color2.G, Byte)

bp2 = DirectCast(nx * color3.G + fx * color4.G, Byte)

nGreen = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

' Red
bp1 = DirectCast(nx * color1.R + fx * color2.R, Byte)

bp2 = DirectCast(nx * color3.R + fx * color4.R, Byte)

nRed = DirectCast(ny * DirectCast(bp1, Double) + fy * DirectCast(bp2, Double), Byte)

bmap.SetPixel(x, y, System.Drawing.Color.FromArgb(255, nRed, nGreen, nBlue))
System.Threading.Interlocked.Increment(y)
End While
System.Threading.Interlocked.Increment(x)
End While
_currentBitmap = DirectCast(bmap.Clone(), Bitmap)
End If
End Sub

๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Truyện hay♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑ ๑۩۞۩๑[♥๑۩۞۩๑ (¯`•♥Forumi.com♥•´¯) ๑۩۞۩๑[♥๑۩۞۩๑
Đăng nhập để có 1 link download đúng lol! lol!
Xem chủ đề cũ hơnVề Đầu TrangXem chủ đề mới hơn
Permissions in this forum:
Bạn không có quyền trả lời bài viết