PicForm.frm
Form missing Icon
Control outside visible area: CommandButton SaveFile - Too far right
1 ' PicInfo main form
2 ' ©2006 Aivosto Oy (www.aivosto.com)
3 '
4 ' This file is part of a sample project for Project Analyzer.
5 ' Distribution of this file is only allowed along with Project Analyzer
6 ' according to the Project Analyzer license terms.
7
8 Option Explicit
9
10 Private Sub DisplayPictureInfo(ByVal Filename As String)
11 ' Display information about a picture file
12 ' [Filename] Name of picture file
13
14 Dim IPicInfo As IPicInfo ' Object that implements the IPicInfo interface
15 Dim PicSize As TPicSize ' Picture size in pixels
16 Dim MaxColors As Variant ' Maximum number of colors in this picture
17
18 ' Determine file type
19 Filename = LCase$(Filename)
20 If Filename Like "*.gif" Then
21 ' GIF file, get a PicGIF object to handle it
22 Set IPicInfo = New PicGIF
23 Else
24 ' Assume it is a bitmap file, get a PicBMP object to handle it
25 Set IPicInfo = New PicBMP
26 End If
27
28 ' Read the picture file
29 If IPicInfo.ReadFile(Filename) Then
30 ' Retrieve picture size in pixels
31 PicSize = IPicInfo.Size
32 ' Retrieve maximum number of colors in this picture
33 MaxColors = IPicInfo.MaxColors
34
35 ' Display retrieved information
36 Me.Filename = "File: " & Filename
37 Me.Size = "Size: " & PicSize.Width & " x " & PicSize.Height & " pixels"
38 Me.MaxColors = "Max colors: " & MaxColors
39
40 ' Display the picture as well
41 Pict.Picture = LoadPicture(Filename)
42 End If
43
44 End Sub
45
Dead procedure - KeyPreview property is False
46 Private Sub Form_KeyPress(KeyAscii As Integer)
47
48 If KeyAscii = 15 Then
Possibly commented-out code
49 ' Ctrl+O = Open
50 OpenFile_Click
51 End If
52
53 End Sub
54
55 Private Sub Form_Load()
56 ' As the form loads, _
57 show the program title in the form caption
58
59 Me.Caption = ProgramTitle ' Global variable access
60
61 End Sub
62
63
64 Private Sub OpenFile_Click()
65 ' User has clicked the "Open picture..." command button
66
67 Dim Filename As String
68
69 ' Ask the user to select a picture file
70 Filename = ShowFileOpenDialog(Me.hWnd, "", "Picture files (*.gif;*.bmp)|*.gif;*.bmp")
71
72 If Len(Filename) Then
73 ' We have received a filename to open
74 DisplayPictureInfo Filename
75 End If
76
77 End Sub
78
79
80 Private Sub Pict_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
81 ' If user has dropped one or more files on the picture area
82 ' try to load the first file and show its picture info
83
84 If Data.GetFormat(vbCFFiles) Then
85 Effect = vbDropEffectCopy
86 DisplayPictureInfo Data.Files(1)
87 End If
88
89 End Sub
90
91 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)
92 ' If user has dragged one or more files, indicate we will accept them
93
94 If Data.GetFormat(vbCFFiles) Then
95 Effect = vbDropEffectCopy
96 End If
97
98 End Sub
99
100
101 Private Sub SaveFile_Click()
102 ' Save file not implemented
103
104 Stop
105
106 End Sub
107
108