Attribute VB_Name = "Module1"
'=================================================================================
'Program Name: DIVAST Version 2.0.0
'Author: Jeremy Pingon
'Email: jpingon@netcourrier.com
'WebSite: www.cit.ie/events/sediment
'Programming Language: Visual Basic 6.0
'Program Functionality: User Friendly Graphical User Interface to use the FORTAN
' program DIVAST that is a Depth Integrated Velocities
' And Solute Transport Calculator
'
'=================================================================================
'
'
'=================================================================================
'File Name: Mod_Picture_Management.bas
'Created: July 2004
'Aim: This module list all the global functions used in the program to manage an
' image into a picture box such as: Using the scroll bars, Zooming In and Out,
' fit the image to the parent picture box or using a zooming window.
' The logic here is to use two picture box (one into
' the other called parent & child) and an image control into the child picture
' box.
'
' These are:
'
'1. Function: InitialisationPicture
' Description:Load the picture, Move the child picture box in the parent and
' resize the child picture box depending of the photo
'
'2. Function: ResizeScrollBar
' Description:This function will check if the scrollbars are necessary,
' it will then display them to the size of
' the picture to be displayed, and will calculate its max value
'
'3. Function: MovePictureVertically & MovePictureHorizontally
' Description:These functions will change the postion of the Child picture
' inside the parent picture as a function of the scroll
' bars values (when the user click on it)
'
'4. Function: FitChildToParentScreen
' Description:This function calculate the ratio by which we have to multiply
' the height and width of the child picture box (and its image by
' the way) in order to fit the parent Picture box. Once these 2
' ratios are calculated, we simply apply a zoom with these ratios
'
'5. Function: Zoom
' Description:This function will increase or decrease the size of the picture
' using a ratio. To use it as a Zoom In, the ratio should be
' > 1, for a Zoom out the ratio should be < 1.
' Recommended values are 1.2 for zoom in and 0.8 for zoom out
' then it will recenter the image using the updated values of
' the scroll bars
'
'6. Function: RecenterPicture
' Description:This function is used by the Zoom to check that,
' when centering the child picture into the parent one, it still
' remain outside the parent picture box
'
''=================================================================================
Option Explicit
'----------------------------------------------------------------------------------
'Public Flag used in the program to state if the grid should be display after zooming
Public FlagDrawGrid As Boolean
'==================================================================================
'1. Function: InitialisationPicture
'==================================================================================
Public Sub InitialisationPicture(UserForm As Form, Pct_Parent As PictureBox, Pct_Child As PictureBox, _
Img_Photo As Image, Hsb_Parent As HScrollBar, Vsb_Parent As VScrollBar, _
PathOfThePicture As String)
'-----------------------------------------------------------------------------------
'Initialisation Of the different picture box, image, and scroll bar
'-----------------------------------------------------------------------------------
'Scale mode
Pct_Child.ScaleMode = vbPixels
Pct_Parent.ScaleMode = vbPixels
UserForm.ScaleMode = vbPixels
'Location of the picture box child, image
'Note that reference is made to the top left corner of Pct_Parent (ie, origin)
Pct_Child.Move 0, 0
'Location of the Horizontal scroll bar
Hsb_Parent.Visible = True
Hsb_Parent.Top = Pct_Parent.Top + Pct_Parent.Height
Hsb_Parent.Left = Pct_Parent.Left
Hsb_Parent.Width = Pct_Parent.Width
'Location of the Vertical scroll bar
Vsb_Parent.Visible = True
Vsb_Parent.Top = Pct_Parent.Top
Vsb_Parent.Left = Pct_Parent.Left + Pct_Parent.Width
Vsb_Parent.Height = Pct_Parent.Height
'-----------------------------------------------------------------------------------
'Get the Photo of the image and load it in the control image
'-----------------------------------------------------------------------------------
'The trick here is to load the picture in a control Image so that we can get it in
'a control Picture box By using PaintPicture
'load picture into the image control
Img_Photo.Picture = LoadPicture(PathOfThePicture)
'As the Img_Photo is the initial picture, we want to preserve its original
'dimension
Img_Photo.Stretch = False
'Make the control image not visible during execution
Img_Photo.Visible = False
'-----------------------------------------------------------------------------------
'Redim the size of the child picture box
'-----------------------------------------------------------------------------------
'Resize the Pct_Child to the size of the image
Pct_Child.AutoSize = True
Pct_Child.Width = Img_Photo.Width
Pct_Child.Height = Img_Photo.Height
'Get scale on the Child picture box
Pct_Child.ScaleWidth = Pct_Child.Width
Pct_Child.ScaleHeight = Pct_Child.Height
'-----------------------------------------------------------------------------------
'Load the picture in the child picture box
'-----------------------------------------------------------------------------------
'Set Autoredraw in order to paint a pemanent Picture
Pct_Child.AutoRedraw = True
'Load the picture in the picture box
'This is the default picture, we don't specify width1 and height1 of Paint Picture
Pct_Child.PaintPicture Img_Photo.Picture, 0, 0
'Set if back to False
Pct_Child.AutoRedraw = False
'-----------------------------------------------------------------------------------
'Once the Picture is loaded, Update the Value of the Scroll bar
'-----------------------------------------------------------------------------------
Call ResizeScrollBar(Pct_Parent, Pct_Child, Img_Photo, _
Hsb_Parent, Vsb_Parent)
End Sub
'==================================================================================
'2. Function: ResizeScrollBar
'==================================================================================
Public Sub ResizeScrollBar(Pct_Parent As PictureBox, Pct_Child As PictureBox, _
Img_Photo As Image, Hsb_Parent As HScrollBar, Vsb_Parent As VScrollBar)
'-----------------------------------------------------------------------------------
'Once picture is loaded, initialisation of the scroll bars
'-----------------------------------------------------------------------------------
'check to Make Vertical scroll bar visible
If Pct_Child.ScaleHeight > Pct_Parent.ScaleHeight Then
Vsb_Parent.Visible = True
Else
Vsb_Parent.Visible = False
End If
'check to Make Horizontal scroll bar visible
If Pct_Child.ScaleWidth > Pct_Parent.ScaleWidth Then
Hsb_Parent.Visible = True
Else
Hsb_Parent.Visible = False
End If
'Horizontal
Hsb_Parent.Min = 0
Hsb_Parent.Max = Pct_Child.ScaleWidth - Pct_Parent.ScaleWidth
Hsb_Parent.LargeChange = 10
Hsb_Parent.SmallChange = 1
'Vertical
Vsb_Parent.Min = 0
Vsb_Parent.Max = Pct_Child.ScaleHeight - Pct_Parent.ScaleHeight
Vsb_Parent.LargeChange = 10
Vsb_Parent.SmallChange = 1
End Sub
'==================================================================================
'3.a Function: MovePictureVertically
'==================================================================================
Public Sub MovePictureVertically(Pct_Child As PictureBox, Vsb_Parent As VScrollBar)
'Change the top position of the Child picture where the origin is the top left
'corner of the parent picture box using the Vertical scroll bar
Pct_Child.Top = -Vsb_Parent.Value
End Sub
'==================================================================================
'3.b Function: MovePictureHorizontally
'==================================================================================
Public Sub MovePictureHorizontally(Pct_Child As PictureBox, Hsb_Parent As HScrollBar)
'Change the Left position of the Child picture where the origin is the top left
'corner of the parent picture box using the Horizontal scroll bar
Pct_Child.Left = -Hsb_Parent.Value
End Sub
'==================================================================================
'4. Function: FitChildToParentScreen
'==================================================================================
Public Sub FitChildToParentScreen(Pct_Parent As PictureBox, Pct_Child As PictureBox, _
Img_Photo As Image, Hsb_Parent As HScrollBar, Vsb_Parent As VScrollBar)
'Declare public Variables used by the subroutine FitChildToParentScreen
Dim ZoomCoefWidth As Double
Dim ZoomCoefHeight As Double
'Get Zoom coefficient in X & Y dir
ZoomCoefWidth = Pct_Parent.ScaleWidth / Pct_Child.ScaleWidth
ZoomCoefHeight = Pct_Parent.ScaleHeight / Pct_Child.ScaleHeight
'Then apply Zoom with these ratios
Call Zoom(Pct_Parent, Pct_Child, Img_Photo, Hsb_Parent, Vsb_Parent, _
ZoomCoefWidth, ZoomCoefHeight, FlagDrawGrid)
End Sub
'==================================================================================
'5. Function: Zoom
'==================================================================================
Public Sub Zoom(Pct_Parent As PictureBox, Pct_Child As PictureBox, Img_Photo As Image, _
Hsb_Parent As HScrollBar, Vsb_Parent As VScrollBar, RatioX As Double, _
RatioY As Double, DrawGrid As Boolean)
'-----------------------------------------------------------------------------------
'Declare Variables used by the subroutine Zoom
'-----------------------------------------------------------------------------------
'These are used to recenter the Picture after Zooming
Dim PhotoBWPx As Double 'Width of Photo in Pixels before Zoom
Dim PhotoBHPx As Double 'Height of Photo in Pixels before Zoom
Dim PhotoAWPx As Double 'Width of Photo in Pixels after Zoom
Dim PhotoAHPx As Double 'Height of Photo in Pixels after Zoom
'-----------------------------------------------------------------------------------
'Apply Zoom to the Child picture box, ie, Increase or decrease its size
'-----------------------------------------------------------------------------------
'Set Autoredraw to true in order to paint a pemanent Picture
Pct_Child.AutoRedraw = True
'Get size before zooming
PhotoBWPx = Pct_Child.Width
PhotoBHPx = Pct_Child.Height
'resize the child picture box to the size of the image
Pct_Child.Width = Pct_Child.Width * RatioX
Pct_Child.Height = Pct_Child.Height * RatioY
'Get size After zooming
PhotoAWPx = Pct_Child.Width
PhotoAHPx = Pct_Child.Height
'Update Scale Height and width
Pct_Child.ScaleWidth = Pct_Child.Width
Pct_Child.ScaleHeight = Pct_Child.Height
'-----------------------------------------------------------------------------------
'Now, paste the photo with Zoom applyied
'-----------------------------------------------------------------------------------
'Clean before pasting the new picture
Pct_Child.Cls
'Load the picture in the picture box
Pct_Child.PaintPicture Img_Photo.Picture, 0, 0, PhotoAWPx, PhotoAHPx
'Set it back to False
Pct_Child.AutoRedraw = False
'-----------------------------------------------------------------------------------
'Recenter the image due to zoom
'-----------------------------------------------------------------------------------
Call RecenterPicture(Pct_Parent, Pct_Child, Pct_Child.Left - ((PhotoAWPx - PhotoBWPx) / 2), _
Pct_Child.Top - ((PhotoAHPx - PhotoBHPx) / 2))
'-----------------------------------------------------------------------------------
'Resize scroll bar
'-----------------------------------------------------------------------------------
'Now that the picture is Zoomed, resize Scroll bar
Call ResizeScrollBar(Pct_Parent, Pct_Child, Img_Photo, Hsb_Parent, Vsb_Parent)
'-----------------------------------------------------------------------------------
'Reinitialisation of the values of the scrollbar
'-----------------------------------------------------------------------------------
'Get the new values for the scrollbar
Hsb_Parent.Value = -Pct_Child.Left
Vsb_Parent.Value = -Pct_Child.Top
'If it is a Zoom out and that the Child picture box is smaller that the parent
'picture box, then put it in the top left corner
If Hsb_Parent.Value < 0 Then
Hsb_Parent.Value = 0
Pct_Child.Left = 0
End If
If Vsb_Parent.Value < 0 Then
Vsb_Parent.Value = 0
Pct_Child.Top = 0
End If
'-----------------------------------------------------------------------------------
'Redraw the grid - depending of the flag
'-----------------------------------------------------------------------------------
'Note that we could have applied The zoom to the grid as well, but it's more
'accurate to redraw it!
If DrawGrid = True Then
Call AfficheUneGrille(Pct_Child)
End If
End Sub
'==================================================================================
'6. Function: RecenterPicture
'==================================================================================
Public Sub RecenterPicture(Pct_Parent As PictureBox, Pct_Child As PictureBox, _
NewLeft As Double, NewTop As Double)
'Check that child picture doesn't come into the parent one (ie will remain outside)
If NewLeft >= 0 Then
NewLeft = 0
End If
If NewLeft <= -(Pct_Child.ScaleWidth - Pct_Parent.ScaleWidth) Then
NewLeft = -(Pct_Child.ScaleWidth - Pct_Parent.ScaleWidth)
End If
'Apply the new left position
Pct_Child.Left = NewLeft
'Check that child picture doesn't come into the parent one (ie will remain outside)
If NewTop >= 0 Then
NewTop = 0
End If
If NewTop <= -(Pct_Child.ScaleHeight - Pct_Parent.ScaleHeight) Then
NewTop = -(Pct_Child.ScaleHeight - Pct_Parent.ScaleHeight)
End If
'Apply the new Top position
Pct_Child.Top = NewTop
End Sub