Tuesday, March 21, 2006

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