image fix dimension
Set im.Picture = LoadPicture("D:\_MIKE_DOCUMENT_\My Pictures\no-strings-attached.bmp")
'Set ImgXCtrl1.Picture = LoadPicture("D:\_MIKE_DOCUMENT_\My Pictures\cebo.jpg")
'Set ImgXCtrl1.Picture = LoadPicture("D:\_MIKE_DOCUMENT_\My Pictures\adidas.jpg")
'Set ImgXCtrl1.Picture = LoadPicture("D:\_MIKE_DOCUMENT_\My Pictures\nike.jpg")
MsgBox ""
Dim ObtainPercentX As Double
Dim ObtainPercentY As Double
Dim FixDimension As Integer
FixDimension = 200
im.Move im.Left, im.Top, FixDimension * Screen.TwipsPerPixelX, FixDimension * Screen.TwipsPerPixelY
If im.Image.Width > FixDimension Or im.Image.Height > FixDimension Then
Dim AspectRatio As Double
If im.Image.Width > im.Image.Height Then
AspectRatio = FixDimension / im.Image.Width
im.Effects.Resize FixDimension, AspectRatio * im.Image.Height
Else
AspectRatio = FixDimension / im.Image.Height
im.Effects.Resize AspectRatio * im.Image.Width, FixDimension
End If
End If
0 Comments:
Post a Comment
<< Home