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