Attribute VB_Name = "PicForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' PicInfo main form ' ©2006 Aivosto Oy (www.aivosto.com) ' ' This file is part of a sample project for Project Analyzer. ' Distribution of this file is only allowed along with Project Analyzer ' according to the Project Analyzer license terms. Option Explicit Private Sub DisplayPictureInfo(ByVal Filename As String) ' Display information about a picture file ' [Filename] Name of picture file Dim IPicInfo As IPicInfo ' Object that implements the IPicInfo interface Dim PicSize As TPicSize ' Picture size in pixels Dim MaxColors As Variant ' Maximum number of colors in this picture ' Determine file type Filename = LCase$(Filename) If Filename Like "*.gif" Then ' GIF file, get a PicGIF object to handle it Set IPicInfo = New PicGIF Else ' Assume it is a bitmap file, get a PicBMP object to handle it Set IPicInfo = New PicBMP End If ' Read the picture file If IPicInfo.ReadFile(Filename) Then ' Retrieve picture size in pixels PicSize = IPicInfo.Size ' Retrieve maximum number of colors in this picture MaxColors = IPicInfo.MaxColors ' Display retrieved information Me.Filename = "File: " & Filename Me.Size = "Size: " & PicSize.Width & " x " & PicSize.Height & " pixels" Me.MaxColors = "Max colors: " & MaxColors ' Display the picture as well Pict.Picture = LoadPicture(Filename) End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 15 Then ' Ctrl+O = Open OpenFile_Click End If End Sub Private Sub Form_Load() ' As the form loads, _ show the program title in the form caption Me.Caption = ProgramTitle ' Global variable access End Sub Private Sub OpenFile_Click() ' User has clicked the "Open picture..." command button Dim Filename As String ' Ask the user to select a picture file Filename = ShowFileOpenDialog(Me.hWnd, "", "Picture files (*.gif;*.bmp)|*.gif;*.bmp") If Len(Filename) Then ' We have received a filename to open DisplayPictureInfo Filename End If End Sub Private Sub Pict_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) ' If user has dropped one or more files on the picture area ' try to load the first file and show its picture info If Data.GetFormat(vbCFFiles) Then Effect = vbDropEffectCopy DisplayPictureInfo Data.Files(1) End If End Sub Private Sub Pict_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) ' If user has dragged one or more files, indicate we will accept them If Data.GetFormat(vbCFFiles) Then Effect = vbDropEffectCopy End If End Sub Private Sub SaveFile_Click() ' Save file not implemented Stop End Sub
Hide code	Visustin flow chart for VB