PictureBox: Resmi Yeniden Boyutlandırmak.
--------------------------------------------------------------------------------
Bildiğiniz gibi Image objesinin Strecth özelliği True yapildiğinda,
obje içindeki resim, Image boyutlarina otomatik olarak genişletiliyor
veya daraltılıyor. Aynı işlemin PictureBox objesine, en temel
yöntemlerle uyarlanmis seklini merak edenler için...
Scale
--------------------------------------------------------------------------------
Scale işlemini, bir çok library veya api(gdi, gdiplus, directx vb...)
ile çok kolay ve hizli bir şekilde yapmak mümkün. Fakat bu dökümanda
scale işleminin en temel hali anlatmak amaciyla asagidaki kodlar
sunulmustur. Islem süresi tatminkar olmayabilir.
Açiklama
--------------------------------------------------------------------------------
Öncelikle, forma PictureBox objesini koyun ve içine istediginiz bir
resmi yükleyin. Asagidaki kodlari formunuza yazin ve uygulamayi
çalistirin.
Option Explicit
Private Sub Form_Load()
'formun ve resmin scale modunu pixel yap
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Picture1.Appearance = 0
Picture1.BorderStyle = 0
Call ScaleImage(Picture1.ScaleWidth, Picture1.ScaleHeight)
End Sub
Public Function CLngX(ByVal dVal As Double) As Long
'Örnek: 0.909 degerini 0 olarak döndürür
'virgülden sonraki degerler kullanilmaz
CLngX = dVal - Abs(CLng(dVal) - dVal)
End Function
Private Sub ScaleImage(ByVal newWidth As Long, ByVal newHeight As Long)
Dim hmX As Single 'HighMetric den pixel'e dönüm katsayisi (X)
Dim hmY As Single 'HighMetric den pixel'e dönüm katsayisi (Y)
Dim nImgW As Long 'Image genişligi
Dim nImgH As Long 'Image yüksekligi
Dim img1 As IPicture 'Image
Dim dScaleX As Double 'Yeni genisligin, eski genislige orani
Dim dScaleY As Double 'Yeni yüksekligin, eski yükselige orani
Dim nPixels() As Long 'Yeni resim datası
Dim nSrcX As Long 'Kaynak Image x koordinatı
Dim nSrcY As Long 'Kaynak Image y koordinatı
Dim nDstX As Long 'Hedef Image x koordinatı
Dim nDstY As Long 'Hedef Image y koordinatı
'Formdaki resim bilgisini aktar
Picture1.AutoSize = True
Set img1 = Picture1.Picture
'HighMetric den pixel'dönüşüm katsayilarini hesapla
hmX = 0.567 / Screen.TwipsPerPixelX
hmY = 0.567 / Screen.TwipsPerPixelY
'resmin boyutunu hesapla
nImgW = img1.Width * hmX
nImgH = img1.Height * hmY
'yeni resim için data alanı ayır
ReDim nPixels(newWidth - 1, newHeight - 1)
'oran degerlerini hesapla
dScaleX = nImgW / newWidth
dScaleY = nImgH / newHeight
For nDstY = 0 To newHeight - 1
nSrcY = CLngX(nDstY * dScaleY)
For nDstX = 0 To newWidth - 1
nSrcX = CLngX(nDstX * dScaleX)
nPixels(nDstX, nDstY) = Picture1.Point(nSrcX, nSrcY)
Next nDstX
Next nDstY
For nDstY = 0 To newHeight - 1
For nDstX = 0 To newWidth - 1
Picture1.PSet (nDstX, nDstY), nPixels(nDstX, nDstY)
Next nDstX
Next nDstY
Erase nPixels
Picture1.AutoSize = False
With Picture1
Call .Move(.Left, .Top, newWidth, newHeight)
End With
End Sub
Nerden
İş/Hobiler
Lakap
Perş. Kas. 05, 2009 1:56 am