vbAccelerator - Contents of code file: frmPreview.frm

VERSION 5.00
Begin VB.Form frmPreview 
   Caption         =   "Form1"
   ClientHeight    =   4056
   ClientLeft      =   2184
   ClientTop       =   1812
   ClientWidth     =   9204
   Icon            =   "frmPreview.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4056
   ScaleWidth      =   9204
   Begin VB.PictureBox picScroll 
      Height          =   3975
      Left            =   0
      ScaleHeight     =   3924
      ScaleWidth      =   2520
      TabIndex        =   0
      Top             =   0
      Width           =   2565
      Begin VB.Image imgPreview 
         Height          =   2655
         Left            =   60
         Top             =   120
         Width           =   2115
      End
   End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' ===========================================================================
' Name:     frmPreview
' Author:   Mark Grimes, Steve McMahon
' Date:     11 November 1999
' Requires: CMDLGD.DLL,
'           mDeclares.Bas
'
' ---------------------------------------------------------------------------
' Copyright  1999 Mark Grimes, Steve McMahon
' Visit vbAccelerator - free, advanced source code for VB programmers.
'     http://vbaccelerator.com
' ---------------------------------------------------------------------------
'
' Demonstrates how to create a file open dialog with picture preview
' using the CommonDialog/Direct component.
'
' ===========================================================================

Public WithEvents cD As cCommonDialog
Attribute cD.VB_VarHelpID = -1
Private WithEvents m_cScroll As cScrollBars
Attribute m_cScroll.VB_VarHelpID = -1

Private m_hwnd As Long
Private m_fOwner As Form

Public Property Let OwnerForm(ByRef frmThis As Form)
   Set m_fOwner = frmThis
End Property

Private Sub pSetScrollBars()
Dim lLC As Long, lSC As Long
Dim lMax As Long

   If imgPreview.Width > picScroll.ScaleWidth Then
      With m_cScroll
         .Value(efsHorizontal) = 0
         lMax = (imgPreview.Width - picScroll.ScaleWidth) \
          Screen.TwipsPerPixelX
         .Max(efsHorizontal) = lMax
         lLC = picScroll.ScaleWidth \ Screen.TwipsPerPixelX
         If .Max(efsHorizontal) > lLC Then
            .LargeChange(efsHorizontal) = lLC
         Else
            .LargeChange(efsHorizontal) = 32
         End If
         lSC = 32
         If .Max(efsHorizontal) > 32 Then
            .SmallChange(efsHorizontal) = lSC
         Else
            .SmallChange(efsHorizontal) = 1
         End If
         .Visible(efsHorizontal) = True
      End With
   Else
      With m_cScroll
         .Value(efsHorizontal) = 0
         .Visible(efsHorizontal) = False
      End With
   End If
   
   If imgPreview.Height > picScroll.ScaleHeight Then
      With m_cScroll
         .Value(efsVertical) = 0
         lMax = (imgPreview.Height - picScroll.ScaleHeight) \
          Screen.TwipsPerPixelY
         .Max(efsVertical) = lMax
         lLC = picScroll.ScaleHeight \ Screen.TwipsPerPixelY
         If .Max(efsVertical) > lLC Then
            .LargeChange(efsVertical) = lLC
         Else
            .LargeChange(efsVertical) = 32
         End If
         lSC = 32
         If .Max(efsVertical) > 32 Then
            .SmallChange(efsVertical) = lSC
         Else
            .SmallChange(efsVertical) = 1
         End If
         .Visible(efsVertical) = True
      End With
   Else
      With m_cScroll
         .Value(efsVertical) = 0
         .Visible(efsVertical) = False
      End With
   End If
End Sub

Private Sub cD_DialogClose()
   SetParent picScroll.hwnd, Me.hwnd
   m_hwnd = 0
End Sub

Private Sub cD_FileChange(ByVal hDlg As Long)
Dim sFileName As String
Dim sExt As String
 
On Error Resume Next
   
   sFileName = GetCDlgFileName(hDlg)
   
   sExt = right(sFileName, 3)
   
   Select Case UCase(sExt)
   Case "BMP", "GIF", "JPG", "ICO"
       imgPreview.Picture = LoadPicture(sFileName)
       pSetScrollBars

   Case Else
      Set imgPreview.Picture = Nothing
      pSetScrollBars
   End Select
   
End Sub


Private Sub cD_InitDialog(ByVal hDlg As Long)
Dim tR As RECT
Dim lBorderSize  As Long
    
   m_hwnd = GetParent(hDlg)
   GetWindowRect m_hwnd, tR
   
   lBorderSize = GetSystemMetrics(SM_CXDLGFRAME)
   MoveWindow m_hwnd, 0&, 0&, tR.right - tR.left + picScroll.Width \
    Screen.TwipsPerPixelX + lBorderSize * 2, tR.bottom - tR.top, 1
   If m_fOwner Is Nothing Then
      cD.CentreDialog hDlg, Screen
   Else
      cD.CentreDialog hDlg, m_fOwner
   End If
   
   SetParent picScroll.hwnd, m_hwnd
   MoveWindow picScroll.hwnd, tR.right - tR.left - lBorderSize, 4&,
    picScroll.Width \ Screen.TwipsPerPixelX, tR.bottom - tR.top -
    GetSystemMetrics(SM_CYCAPTION) - GetSystemMetrics(SM_CYDLGFRAME) * 2 - 6, 1
    
End Sub

Private Sub Form_Load()
   imgPreview.Move 0, 0
   Set m_cScroll = New cScrollBars
   m_cScroll.Create picScroll.hwnd
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Set m_fOwner = Nothing
End Sub

Private Sub m_cScroll_Change(eBar As EFSScrollBarConstants)
   m_cScroll_Scroll eBar
End Sub

Private Sub m_cScroll_Scroll(eBar As EFSScrollBarConstants)
   If eBar = efsHorizontal Then
      imgPreview.left = -m_cScroll.Value(eBar) * Screen.TwipsPerPixelX
   Else
      imgPreview.top = -m_cScroll.Value(eBar) * Screen.TwipsPerPixelY
   End If
End Sub