zoom_scroll.frm

this is very important file for VB

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6045
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9225
   LinkTopic       =   "Form1"
   ScaleHeight     =   403
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   615
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture2 
      AutoSize        =   -1  'True
      Height          =   3165
      Left            =   1080
      ScaleHeight     =   207
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   472
      TabIndex        =   1
      Top             =   5280
      Visible         =   0   'False
      Width           =   7140
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   4860
      Left            =   360
      ScaleHeight     =   320
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   552
      TabIndex        =   0
      Top             =   240
      Width           =   8340
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DestScaleH As Single, DestScaleW As Single
Dim SourceScaleH As Single, SourceScaleW As Single
Dim SX As Single, SY As Single, New_SourceScaleW As Single, New_SourceScaleH As Single
Dim New_DestScaleW As Single, New_DestScaleH As Single
Dim Dest_X_Start As Single, Dest_Y_Start As Single
Dim CenterW As Single, CenterH As Single
Dim aspect_src As Single
'Private Const PathPic As String = "c:\EVSth.bmp"
Private Const PathPic As String = "c:\outputDA.bmp"



Private Sub Draw_Picture()

  Picture1.PaintPicture Picture2.Picture, CenterW, CenterH, New_DestScaleW, New_DestScaleH, SX, SY, New_SourceScaleW, New_SourceScaleH

End Sub

Private Sub Form_Load()

Picture2.Picture = LoadPicture(PathPic)

  
  SourceScaleH = Picture2.ScaleHeight
  SourceScaleW = Picture2.ScaleWidth
  
   aspect_src = SourceScaleW / SourceScaleH 'ratio of picture

  DestScaleH = Picture1.ScaleHeight
  DestScaleW = Picture1.ScaleWidth
  
  
    ' Adjust the wid/hgt ratio to match aspect_src.
    If DestScaleW / DestScaleH > aspect_src Then
        ' The area is too short and wide.
        ' Make it narrower.
        DestScaleW = aspect_src * DestScaleH
    Else
        ' The area is too tall and thin.
        ' Make it shorter.
        DestScaleH = DestScaleW / aspect_src
    End If
  
  
  SX = 0
  SY = 0
 
  New_SourceScaleW = SourceScaleW
  New_SourceScaleH = SourceScaleH
  New_DestScaleW = DestScaleW
  New_DestScaleH = DestScaleH
  CenterH = (Picture1.ScaleHeight - DestScaleH) / 2
  CenterW = (Picture1.ScaleWidth - DestScaleW) / 2

  Draw_Picture
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dest_X_Start = X: Dest_Y_Start = Y
  Picture1.AutoRedraw = False
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
  Dim Dest_X_End As Single, Dest_Y_End As Single
  
  If Button = 1 Then
  
    Dest_X_End = Dest_X_Start - X
    
    SX = SX + Dest_X_End
    
    If SX < 0 Then SX = 0
    If SX > SourceScaleW - 10 Then SX = SourceScaleW - 10
    If SX + New_SourceScaleW > SourceScaleW Then SX = SourceScaleW - New_SourceScaleW
    
    Dest_Y_End = Dest_Y_Start - Y
    
    SY = SY + Dest_Y_End
    If SY < 0 Then SY = 0
    If SY > SourceScaleH - 10 * aspect_src Then SY = SourceScaleH - 10 * aspect_src
    If SY + New_SourceScaleH > SourceScaleH Then SY = SourceScaleH - New_SourceScaleH
    
    Draw_Picture
    
    'per ricominciare dal punto precedente vengono salvate le coordinate
    Dest_X_Start = X
    Dest_Y_Start = Y
    
  ElseIf Button = 2 Then
  
    Dest_X_End = Dest_X_Start - X
    
    New_SourceScaleW = New_SourceScaleW + Dest_X_End
    Debug.Print "New_SourceScaleW " & New_SourceScaleW
    If SX + New_SourceScaleW > SourceScaleW Then
    
      New_SourceScaleW = SourceScaleW - SX
      
      SX = SX - Dest_X_End
      If SX < 0 Then SX = 0
      If SX > SourceScaleW - 10 Then SX = SourceScaleW - 10
      If SX + New_SourceScaleW > SourceScaleW Then SX = SourceScaleW - New_SourceScaleW
    
    End If
    
    If SX < 0 Then SX = 0
    If New_SourceScaleW < 10 Then New_SourceScaleW = 10
    
       
    New_SourceScaleH = New_SourceScaleW / aspect_src
       
    If SY + New_SourceScaleH > SourceScaleH Then
      SY = SourceScaleH - New_SourceScaleH
    End If
    
    Draw_Picture
    
    'per ricominciare dal punto precedente vengono salvate le coordinate
    Dest_X_Start = X
    Dest_Y_Start = Y
  End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Picture1.AutoRedraw = True
  Draw_Picture
End Sub