واضح کردن تصویر زوم شده

کد:
[/cod'** Interpolation Antialisa Bicubic Resizing Algorithm **' 

'** Code was writen by Cory Watt(mouak@crosswinds.net) 

'** Use as you wish, just never sell, unless compiled in 

'** a excuting application/program! 

'** Alot of thanx goes to my friend Kim Doo-hyun, Thanx **' 

'public by parsicoders.com 

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 sDrawImage(SrcHDC As Long, OffsetX As Integer, OffsetY As Integer, srcW As Integer, srcH As Integer, dstW1 As Integer, dstH1 As Integer, dOffsetX As Integer, dOffsetY As Integer, DstHDC As Long, DstEdge As Byte) 

Dim dx As Integer, dy As Integer, iX As Integer, iY As Integer, x As Integer, y As Integer 

Dim i11 As Long, i12 As Long, i21 As Long, i22 As Long 

Dim V1 As Integer, V2 As Integer, V3 As Integer, S1 As Integer, S2 As Integer, S3 As Integer, N1 As Integer, N2 As Integer, N3 As Integer, H1 As Integer, H2 As Integer, H3 As Integer, U1 As Integer, U2 As Integer, U3 As Integer, P1 As Integer, P2 As Integer, P3 As Integer 

Dim Color11qRed As Integer, Color11qGreen As Integer, Color11qBlue As Integer, _ 

Color21qRed As Integer, Color21qGreen As Integer, Color21qBlue As Integer, _ 

Color22qRed As Integer, Color22qGreen As Integer, Color22qBlue As Integer, _ 

Color12qRed As Integer, Color12qGreen As Integer, Color12qBlue As Integer 

Dim dstW As Integer, dstH As Integer 

Dim iRX As Integer, iOrX As Integer, iRY As Integer, iOrY As Integer, dw As Integer, dh As Integer 

If DstEdge = 1 Then 

dstW = dstW1 + (dstW1 / srcW) 

dstH = dstH1 + (dstH1 / srcH) 

Else 

dstW = dstW1 

dstH = dstH1 

End If 

For dy = 0 To srcH - 1 

iOrY = iRY 

iRY = ((dstH) / srcH) * (dy + 1) 

For dx = 0 To srcW - 1 

iOrX = iRX 

iRX = ((dstW) / srcW) * (dx + 1) 



'(Getting 4 Colors. Of X, upper-left, 

'upper-right, lower-left, lower-right.) 

i11 = GetPixel(SrcHDC, dx + OffsetX, dy + OffsetY) 

i12 = GetPixel(SrcHDC, dx + 1 + OffsetX, dy + OffsetY) 

i21 = GetPixel(SrcHDC, dx + OffsetX, dy + 1 + OffsetY) 

i22 = GetPixel(SrcHDC, dx + 1 + OffsetX, dy + 1 + OffsetY) 





iX = iOrX 

iY = iOrY 

dw = iRX - iOrX 

dh = iRY - iOrY 



'(Get the Three Color values, Red, Green, 

'and blue.) 



'(upper-left) 

Color11qRed = i11 Mod 256 

Color11qGreen = (i11 \ 256) Mod 256 

Color11qBlue = (i11 \ 65536) Mod 256 



'(lower-left) 

Color12qRed = i12 Mod 256 

Color12qGreen = (i12 \ 256) Mod 256 

Color12qBlue = (i12 \ 65536) Mod 256 



'(upper-right) 

Color21qRed = i21 Mod 256 

Color21qGreen = (i21 \ 256) Mod 256 

Color21qBlue = (i21 \ 65536) Mod 256 



'(lower-right) 

Color22qRed = i22 Mod 256 

Color22qGreen = (i22 \ 256) Mod 256 

Color22qBlue = (i22 \ 65536) Mod 256 



'(Red) 

N1 = Color21qRed - Color11qRed 

H1 = Color11qRed 





'(Green) 

N2 = Color21qGreen - Color11qGreen 

H2 = Color11qGreen 



'(Blue) 

N3 = Color21qBlue - Color11qBlue 

H3 = Color11qBlue 



'(Cubic!) 

'(Red) 

U1 = Color22qRed - Color12qRed 

P1 = Color12qRed 



'(Green) 

U2 = Color22qGreen - Color12qGreen 

P2 = Color12qGreen 



'(Blue) 

U3 = Color22qBlue - Color12qBlue 

P3 = Color12qBlue 



For y = 0 To dh - 1 

'(Now begins the Interpolation) 

Color11qRed = H1 + ((N1) / dh) * y 

Color11qGreen = H2 + ((N2) / dh) * y 

Color11qBlue = H3 + ((N3) / dh) * y 



Color12qRed = P1 + ((U1) / dh) * y 

Color12qGreen = P2 + ((U2) / dh) * y 

Color12qBlue = P3 + ((U3) / dh) * y 





'(Red) 

V1 = Color12qRed - Color11qRed 

S1 = Color11qRed 



'(Green) 

V2 = Color12qGreen - Color11qGreen 

S2 = Color11qGreen 



'(Blue) 

V3 = Color12qBlue - Color11qBlue 

S3 = Color11qBlue 





For x = 0 To dw - 1 

Color11qRed = S1 + ((V1) / dw) * x 

Color11qGreen = S2 + ((V2) / dw) * x 

Color11qBlue = S3 + ((V3) / dw) * x 



'(Set a Pixel, may need some changing, 

If DstEdge = 1 Then 

If x + iX < dstW1 And y + iY < dstH1 Then 

SetPixel DstHDC, x + iX + dOffsetX, y + iY + dOffsetY, RGB(Color11qRed, Color11qGreen, Color11qBlue) 

End If 

Else 

SetPixel DstHDC, x + iX + dOffsetX, y + iY + dOffsetY, RGB(Color11qRed, Color11qGreen, Color11qBlue) 

End If 

Next x 

Next y 

If dx = srcW - 1 Then iRX = 0 

Next dx 





'(not need) 

Label1.Caption = dy 

DoEvents 



If dy = srcH - 1 Then iRY = 0 

Next dy 

End Sub 



Private Sub cmdDraw_Click() 

On Error Resume Next 

If txtWidth < 32 Or txtHeight < 32 Then 

MsgBox "Enlarges an Image only (at the moment!)", vbExclamation, "Enlarging!" 

Else 

sDrawImage pctImage.hdc, 0, 0, 32, 32, txtWidth, txtHeight, 0, 0, Me.hdc, chkEdge.Value 

End If 

End Sub