एक तस्वीर को vb6 में एक निश्चित आकार में आकार देना - छवि, छवि-प्रसंस्करण, vb6, चित्र बॉक्स

Im एक ऐसा फंक्शन बनाने की कोशिश कर रहा है जो छवियों को आकार देता है और उन्हें एक पिक्चरबॉक्स में लोड करता है ...

अब तक मैंने ऐसा किया है:

Function ResizeImage(Picture As ImageFile, Width As Integer, Height As Integer) As ImageFile
Dim ratioWidth, ratioHeight, ratio As Double
Dim newWidth, newHeight As Integer
Dim img As ImageFile
Set img = Picture

"Calgulate AspectRatio
ratioWidth = (Width / Picture.Width)
ratioHeight = (Height / Picture.Height)

"Choose the smaller ratio
If ratioWidth > ratioHeight Then
ratio = ratioHeight
Else
ratio = ratioWidth
End If

"Calgulate newWidth and newHeight
newWidth = Picture.Width * ratio
newHeight = Picture.Height * ratio

"Return resized image
ResizeImage = img.ARGBData.Picture(newWidth, newHeight)
End Function

समारोह के रूप में बुलाया:

picResim.Picture = LoadPicture(PicturePath) "Show picture first
Set PrintImg = New ImageFile                "Create a background picture
PrintImg.LoadFile PicturePath               "to process on
picResim.Picture = ResizeImage(PrintImg, 40, 30) "Show resized picture

लेकिन जैसा कि आप देख सकते हैं कि मुझे एक भारी डिबग की आवश्यकता है, क्या मैं गलत कर रहा हूं मैं इसे कैसे हल कर सकता हूं?

उत्तर:

जवाब के लिए 3 № 1

मुझे यकीन नहीं है कि आपने पिक्चरबॉक्स में एक छवि क्यों रखी है और फिर दूसरे को वहां रखा है, लेकिन शायद यह आपकी मदद करेगा?

Option Explicit
"Needs reference to:
"Microsoft Windows Image Acquisition Library 2.0

Private Function ResizeImage( _
ByVal Original As WIA.ImageFile, _
ByVal WidthPixels As Long, _
ByVal HeightPixels As Long) As WIA.ImageFile

"Scale the photo to fit supplied dimensions w/o distortion.
With New WIA.ImageProcess
.Filters.Add .FilterInfos!Scale.FilterID
With .Filters(1).Properties
"!PreserveAspectRatio = True by default, so just:
!MaximumWidth = WidthPixels
!MaximumHeight = HeightPixels
End With
Set ResizeImage = .Apply(Original)
End With
End Function

Private Sub cmdBrowse_Click()
Dim imgPhoto As WIA.ImageFile

With dlgOpen
.FileName = ""
"Other CommonDialog properties were set at design-time.
On Error Resume Next
.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
On Error GoTo 0

Set imgPhoto = New WIA.ImageFile
imgPhoto.LoadFile .FileName
End With

With Picture1
Set imgPhoto = ResizeImage(imgPhoto, _
ScaleX(.ScaleWidth, .ScaleMode, vbPixels), _
ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
Set .Picture = imgPhoto.FileData.Picture
End With
End Sub

संबंधित सवाल
सबसे लोकप्रिय