View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Andy Pope Andy Pope is offline
external usenet poster
 
Posts: 2,489
Default Picture Viewer - Copyright Clearance

Hi Mike,

I posted that on the OzGrid forum.
http://www.ozgrid.com/forum/showthread.php?t=21863

Here is the complete code.
You need a userform with the following controls;
3 CommandButtons
1 Image control
1 Frame control.

'------Code start
Option Explicit

Const MAX_ZOOM = 4 ' 400% original size
Const MIN_ZOOM = 0.2 ' 20% original size
Private m_sngWidth As Single
Private m_sngHeight As Single
Private m_sngZoom As Single
Sub LoadImage(Name As String)

If Dir(Name) < "" Then
With Image1
.AutoSize = True
.Picture = LoadPicture(Name)
m_sngHeight = .Height
m_sngWidth = .Width
.AutoSize = False
.PictureSizeMode = fmPictureSizeModeStretch
m_sngZoom = 1
.Left = 1
.Top = 1
End With
SetZoom m_sngZoom
Else
MsgBox "Unable to load image " & Chr(10) & Name, vbExclamation
End If
End Sub
Sub SetZoom(Zoom As Single)

With Image1
.Width = m_sngWidth * Zoom
.Height = m_sngHeight * Zoom
End With
Label1.Caption = "Zoom " & Format(Zoom, "0%")
With Frame1
.ScrollHeight = Image1.Height + 2
.ScrollWidth = Image1.Width + 2
End With

End Sub
Private Sub CommandButton1_Click()

m_sngZoom = m_sngZoom + 0.1
If m_sngZoom MAX_ZOOM Then m_sngZoom = MAX_ZOOM
CommandButton1.Enabled = m_sngZoom < MAX_ZOOM
CommandButton2.Enabled = m_sngZoom < MIN_ZOOM
SetZoom m_sngZoom

End Sub
Private Sub CommandButton2_Click()

m_sngZoom = m_sngZoom - 0.1
If m_sngZoom < MIN_ZOOM Then m_sngZoom = MIN_ZOOM
CommandButton2.Enabled = m_sngZoom < MIN_ZOOM
CommandButton1.Enabled = m_sngZoom < MAX_ZOOM
SetZoom m_sngZoom

End Sub
Private Sub CommandButton3_Click()

Dim vntFile
Dim strFilters As String

strFilters = "All Image files,*.bmp;*.gif;*.jpg;*.jpeg,Bitmap
(*.bmp),*.bmp"
vntFile = Application.GetOpenFilename(strFilters)
If vntFile < "" Then
TextBox1.Text = vntFile
LoadImage TextBox1.Text
End If
End Sub
Private Sub UserForm_Initialize()
Image1.BorderStyle = fmBorderStyleNone
End Sub
'-----Code End

Cheers
Andy

Mike wrote:

Hello,

Some time ago, I downloaded or copied/pasted an Excel
file/routine that contains various macros and an Excel
Form. The Form contains a browse button that allows a
user to browse to a directory and select a picture. The
picture is shown in an image control on the Form, which
also contains "Zoom" buttons that allows a user to
expand/reduce the selected picture.

I cannot remember where I got the routine. The purpose of
this post is to identify the author as I need to obtain
copyright clearance.

The macros behind the Form include the following:

Option Explicit

Const MAX_ZOOM = 4 ' 400% original size
Const MIN_ZOOM = 0.2 ' 20% original size
Private m_sngWidth As Single
Private m_sngHeight As Single
Private m_sngZoom As Single


Sub LoadImage(Name As String)

If Dir(Name) < "" Then
With Image1
.AutoSize = True
.Picture = LoadPicture(Name)
m_sngHeight = .Height
m_sngWidth = .Width
.AutoSize = False
.PictureSizeMode = fmPictureSizeModeStretch
m_sngZoom = 1
.Left = 1
.Top = 1
End With
SetZoom m_sngZoom
Else
MsgBox "Unable to load image " & Chr(10) & Name,
vbExclamation
End If
End Sub

Does anyone recognize the above?

BTW, it is not Mr. Andy Pope's "PicViewer" or Mr. JE
McGimpsey's "lookuppics" routine.

Regards,

Mike


--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info