Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/getwin1r/zoom.frm

Visual Basic Form | 1999-09-07 | 11.9 KB | 299 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form FormView
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "View Picture With ZOOM"
   ClientHeight    =   3840
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   4455
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   256
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   297
   StartUpPosition =   2  'CenterScreen
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   2040
      Top             =   1680
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327681
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H80000010&
      BorderStyle     =   0  'None
      Height          =   3615
      Left            =   0
      ScaleHeight     =   241
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   281
      TabIndex        =   2
      Top             =   0
      Width           =   4215
      Begin VB.Image Image1
         Enabled         =   0   'False
         Height          =   1410
         Left            =   0
         Stretch         =   -1  'True
         Top             =   0
         Width           =   1260
      End
   End
   Begin VB.VScrollBar VScroll1
      Height          =   3615
      Left            =   4200
      TabIndex        =   1
      Top             =   0
      Width           =   255
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   3600
      Width           =   4215
   End
   Begin VB.Image Image2
      Height          =   615
      Left            =   5040
      Top             =   840
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Menu mnu_file
      Caption         =   "&File"
      Begin VB.Menu mnu_picture
         Caption         =   "Open Picture"
      End
      Begin VB.Menu mnu_spacer
         Caption         =   "-"
      End
      Begin VB.Menu mnu_exit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "FormView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
   Dim TX As Long
   Dim TY As Long
   Dim ZoomDepth As Long
   Private Sub Form_Load()
       'All computer screens (monitors) are NOT the same so
       'we must account for that, and ensure that our
       'software will work properly for every user.
       'Below we set the TX and TY as the first piece of
       'code to be executed.
       'Our Form and PICTURE scalemodes are set at "3" or
       'PIXEL, but when calculating measurements in VB
       'we need to use their dimensions in PIXELS for
       'easier calculation. Our scroll bars work better
       'and quicker in pixels as opposed to TWIPS.
       ' My screen is 15 TWIPS per pixel, so
       'TX and TY will actually equal 15 throughout the
       'entire program. Your screen may be different.
       TX = Screen.TwipsPerPixelX
       TY = Screen.TwipsPerPixelY
   End Sub
   Private Sub HScroll1_Change()
       HScroll1_Scroll
   End Sub
   Private Sub HScroll1_Scroll()
       Image1.Left = -HScroll1.Value
   End Sub
   Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
       On Error GoTo BadZoom
       'Here (button 1 / left mouse button), is where we zoom in
       'on the picture
       If Button = 1 Then
           'I choose 10 as enough times for zooming in
           'and you can change this to a higher or
           'lower number if you want
           If ZoomDepth >= 10 Then Beep: Exit Sub
           'Notice the "Image1.Width / 4" that is used here. This merely
           'increases the image by 25%. You may use a different number
           'than "4" to change your zoom ratio, but make sure you use
           'the same number through your code.
           Image1.Width = Image1.Width + (Image1.Width / 4)
           Image1.Height = Image1.Height + (Image1.Height / 4)
           If Image1.Width < Picture1.Width Then
               Image1.Left = 0
           Else
               'Else, everything seems to be good
               'so we will zoom in as calculated below.
               'NOTICE that this is where we maintain
               'our "point of view". What I mean is,
               'our mouse cursor is pointed at a specific
               'area of the image, so when we zoom in, we
               'want to see that same area at a closer view.
               'The "X" in the code, directly below, is part
               'of the calculation of the horizontal mouse
               'positio, which in turn sets the scroll bar
               'properly. Thus the image has shifted the
               'correct amount.
               Set_Scrolls

               If HScroll1.Value + ((X / TX) / 4) > HScroll1.Max Then
                   'This "IF" statement makes sure that our scroll value
                   'does not exceed our Scroll MAX when zooming
                   'in near the far right of the image. If it does
                   'exceed, we will use the maximum scroll value
                   HScroll1.Value = HScroll1.Max
               Else
                   HScroll1.Value = HScroll1.Value + ((X / TX) / 4)
               End If
           End If
           'The "IF" statement below is the same
           'as the one above, but it will now refer to the
           'image height instead of the width
           If Image1.Height < Picture1.Height Then
           Else
               Set_Scrolls
               If VScroll1.Value + ((Y / TY) / 4) > VScroll1.Max Then
                   VScroll1.Value = VScroll1.Max
               Else
                   VScroll1.Value = VScroll1.Value + ((Y / TY) / 4)
               End If
           End If
           ZoomDepth = ZoomDepth + 1 'To keep track of how many times we soomed in

       ElseIf Button = 2 Then 'Else if button 2 is clicked (right mouse).
           'We will zoom out. The code below is
           'very similar to the code above with
           'some minor changes.
           If Image1.Width <= 10 Then Beep: Exit Sub
           If Image1.Height <= 10 Then Beep: Exit Sub
           Image1.Width = Image1.Width - (Image1.Width / 4)
           Image1.Height = Image1.Height - (Image1.Height / 4)
           If Image1.Width < Picture1.Width Then
               'Do nothing
           Else
               If HScroll1.Value - ((X / TX) / 4) > HScroll1.Max Then
                   HScroll1.Value = HScroll1.Max
               ElseIf HScroll1.Value - ((X / TX) / 4) < 1 Then
                   HScroll1.Value = 1
               Else
                   HScroll1.Value = HScroll1.Value - ((X / TX) / 4)
               End If
           End If
           If Image1.Height < Picture1.Height Then
               Image1.Top = 0
           Else
               If VScroll1.Value - ((Y / TY) / 4) > VScroll1.Max Then
                   VScroll1.Value = VScroll1.Max
               ElseIf VScroll1.Value - ((Y / TY) / 4) < 1 Then
                   VScroll1.Value = 1
               Else
                   VScroll1.Value = VScroll1.Value - ((Y / TY) / 4)
               End If
           End If
           ZoomDepth = ZoomDepth - 1 'Deduct each time we zoom out
       End If
       Set_Scrolls 'Jump to the "Set_Scrolls Sub" here
       'which will determine when to enable
       'or disable a scroll bar.
       Exit Sub
BadZoom:
       Resume Next
   End Sub
   Private Sub mnu_2_Click()
   End Sub
   Private Sub mnu_exit_Click()
       End
   End Sub
   Private Sub mnu_picture_Click()
       'Incase the user clicks the CANCEL button
       'we will exit nicely and do nothing, therefore
       'we set the error that the CANCEL's button
       'produces to TRUE
       CommonDialog1.CancelError = True
       'On any ERROR (mainly the CANCEL ERROR) go to the
       'specified error handler immediately and exit sub.
       On Error GoTo Err_Handler
       CommonDialog1.Filter = "All Image Files (*.bmp;*.jpg;*.gif;*.ico;*.dib;*.wmf)|*.bmp;*.jpg;*.gif;*.ico;*.dib;*.wmf|Bitmap (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|Icon (*.ico)|*.ico|DIB (*.dib)|*.dib|Windows Meta File (*.wmf)|*.wmf"
       CommonDialog1.ShowOpen
       'Incase of a faulty image file, go to
       'the BadPic error handler and exit nicely
       On Error GoTo BadPic
       'Sometimes an image file can not be loaded due to
       'corruption. So we must test it first by placing
       'it into an image box first (Image2 in our sample here).
       'We don't want to chance losing the image in Image1.
       Image2.Picture = LoadPicture(CommonDialog1.filename)
       Image2.Picture = LoadPicture() 'Clear picture to save memory
       'At this point, no error should have occured so we will
       'continue. If an error occured, we would be sent to
       'the BadPic error handler and exited the sub safely.
       'Set the STRETCH propertry to FALSE to ensure proper
       'and proportional size of original picture.
       Image1.Stretch = False
       'Load picture into view here...
       Image1.Picture = LoadPicture(CommonDialog1.filename)
       'Now set the STRETCH to TRUE to get the ZOOM effect.
       Image1.Stretch = True
       'Enable the Image control only because when you first
       'run this program, you have no picture to work with,
       'we don't want the user to ZOOM a blank image and look
       'un-professional.
       Image1.Enabled = True
       Set_Scrolls
       'We reset our scroll bars
       'to 1 so the next picture loaded will
       'not be viewed according to our last
       'picture viewed.
       HScroll1.Value = 1
       VScroll1.Value = 1
       ZoomDepth = 0
       Exit Sub
Err_Handler:
       Exit Sub
BadPic:
       Image2.Picture = LoadPicture() 'Clear picture to save memory
       MsgBox "Cannot use the image file " & CommonDialog1.filename, vbInformation, "Err number " & Err
   End Sub
   Private Sub VScroll1_Change()
       VScroll1_Scroll
   End Sub
   Private Sub VScroll1_Scroll()
       Image1.Top = -VScroll1.Value
   End Sub
   Public Sub Set_Scrolls()
       If Image1.Width > Picture1.Width Then
           'If the Image is wider than the picture box
           'then we want to enable the horizontal
           'scroll bar
           HScroll1.Enabled = True
           'We can set the maximum vale for this scroll bar
           'based on the difference in the width of
           'the picture box and the image.
           'Note: since our scale mode is PIXEL and not TWIP
           'we have a scroll bar that is efficient. TWIPs could
           'very easily make the scroll bar MAX value
           'into the thousands.
           HScroll1.Max = Image1.Width - Picture1.Width
           HScroll1.Min = 1
           HScroll1.SmallChange = 1
           HScroll1.LargeChange = 1
       Else
           'Else, our image is not wider than the picture box and
           'we just dissable the scroll bar.
           HScroll1.Enabled = False
       End If
       'The code below is the same as the above code, but
       'deals with the height.
       If Image1.Height > Picture1.Height Then
           VScroll1.Enabled = True
           VScroll1.Max = Image1.Height - Picture1.Height
           VScroll1.Min = 1
           VScroll1.SmallChange = 1
           VScroll1.LargeChange = 1
       Else
           VScroll1.Enabled = False
       End If
   End Sub