-
Notifications
You must be signed in to change notification settings - Fork 0
/
Form1.frm.twin
196 lines (135 loc) · 6.38 KB
/
Form1.frm.twin
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
[FormDesignerId("231FAFAA-E7A2-400E-8A25-1CC55F885E7A")]
[ClassId("18E8756B-ED81-4D11-BB3A-344A8E8FBA4B")]
[InterfaceId("628A7A83-4BEF-49B3-93BF-8C4CBAF65AF9")]
[EventInterfaceId("E7654A71-41AB-4112-930D-C78AEF5BD5E3")]
Class Form1
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Autor: F. Schüler (frank@activevb.de)
' Datum: 12/2020
'Updates for WinDevLib/x64 compatibility and
'additional features by Jon Johnson, 05/2024
Option Explicit
Private MaxThumbnailWidth As Long
Private strJpgFile As String
Private strVideoFile As String
Private curDuration As LongLong
Private cVideoThumbnail As clsVideoThumbnail
Private Sub Form_Load()
MaxThumbnailWidth = 256
Dim strDuration As String
strJpgFile = App.Path & "\test-" & Format$(Now, "yyyymmdd-HhnnSs") & ".jpg"
strVideoFile = App.Path & "\file_example_MP4_1280_10MG.mp4"
Set cVideoThumbnail = New clsVideoThumbnail
' Scollbar Parameter und deaktivieren
With hscPos
.Max = 100
.Min = 0
.Enabled = False
End With
' Button deaktivieren
cmdSaveAsJpg.Enabled = False
' Video zuweisen
' (alle von der Media Foundation unterstüten Videoformate)
cVideoThumbnail.SetVideoFile = strVideoFile
' Video geladen und vorbereitet?
If cVideoThumbnail.IsVideoLoaded = True Then
' Spielzeit des Videos ermitteln
curDuration = cVideoThumbnail.GetVideoDuration
' Thumbnail vom Video erstellen.
' Wenn MaxWidth = 0 oder nicht angegeben, wird die volle
' Breite und Höhe des Videos verwendet
Me.Picture = cVideoThumbnail.GetVideoThumbnail(CalcDispWidth())
' ist ein Handle vorhanden
If Me.Picture.Handle <> 0& Then
' Button aktivieren
cmdSaveAsJpg.Enabled = True
End If
' kann eine neue Position im Video gesetzt werden?
If cVideoThumbnail.IsVideoSeekable = True Then
' ist eine Spielzeit vorhanden
If curDuration > 0 Then
' Laufzeit speichern
strDuration = cVideoThumbnail.Time2String(curDuration)
' Anzeige im Label
lblPos.Caption = "Position: " & cVideoThumbnail.Time2String(0) & _
" of " & cVideoThumbnail.Time2String(curDuration)
' Scollbar aktivieren
hscPos.Enabled = True
End If
Else
Debug.Print "NON_SEEKABLE"
End If
' Dimensionen des Videos anzeigen
Me.Caption = "Original: " & CStr(cVideoThumbnail.GetVideoWidth) & " x " & _
CStr(cVideoThumbnail.GetVideoHeight) & " Pixel / Display: " & _
CStr(CLng(Me.ScaleX(Me.Picture.Width, vbHimetric, vbPixels))) & " x " & _
CStr(CLng(Me.ScaleY(Me.Picture.Height, vbHimetric, vbPixels))) & _
" Pixel / Duration: " & strDuration
End If
End Sub
Private Function CalcDispWidth() As Long
'Display width is:
'-The full video, if both width and height fit
'-The form width, if the width is larger than the height
'-The largest width that will fit the max height
Dim cx As Long = cVideoThumbnail.GetVideoWidth
Dim cy As Long = cVideoThumbnail.GetVideoHeight
Dim cxMax As Long = Me.ScaleWidth - 10
Dim cyMax As Long = Me.ScaleHeight - (Me.ScaleHeight - Label1.Top) - 10
'Debug.Print "CalcDispWidth() cx=" & cx ", cy=" & cy & ", cxMax=" & cxMax & ", cyMax=" & cyMax
If (cx <= cxMax) And (cy <= cyMax) Then Return cx
If cy <= cyMax Then
'Debug.Print "CalcDispWidth() Returning cxMax"
Return cxMax
Else
Dim ar As Single
ar = cx / cy
If cy <= cx Then
Return Round(cyMax * ar, 0)
Else
Return Round(cxMax * ar, 0)
End If
End If
End Function
Private Sub hscPos_Scroll()
Call hscPos_Change
End Sub
Private Sub hscPos_Change()
Dim curPos As LongLong
' Position berechnen
curPos = (curDuration * hscPos.Value) / hscPos.Max
' Anzeige im Label
lblPos.Caption = "Postion: " & cVideoThumbnail.Time2String(curPos) & _
" of " & cVideoThumbnail.Time2String(curDuration)
' neue Position im Video setzen
cVideoThumbnail.SetVideoPos = curPos
' Thumbnail vom Video erstellen
Me.Picture = cVideoThumbnail.GetVideoThumbnail(CalcDispWidth())
End Sub
Private Sub cmdSaveAsJpg_Click()
Dim strInf As String
Dim oPicture As StdPicture
If ckFullSize.Value = vbChecked Then
Set oPicture = cVideoThumbnail.GetVideoThumbnail
strInf = "The image from the video was saved in full size as a JPG."
Else
Set oPicture = cVideoThumbnail.GetVideoThumbnail(MaxThumbnailWidth)
strInf = "The thumbnail from the video was saved as a JPG."
End If
' speichert das Thumbnail vom Video als JPG
If cVideoThumbnail.SaveVideoThumbnailAsJPG(oPicture.Handle, strJpgFile) = True Then
MsgBox strInf, vbOKOnly Or vbInformation, "VideoThumbnail"
End If
Set oPicture = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set cVideoThumbnail = Nothing
End Sub
Private Sub Text1_Change() Handles Text1.Change
MaxThumbnailWidth = CLng(Text1.Text)
End Sub
End Class