Gambas France BETA


Pas de compte ? Incription

Multimedia

CDPlayer



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
' Gambas class file

' Simple CDplayer
' Carlier Laurent - (c) 2005
' Under GNU GPL V2 or Later
'
' Done for Testing the sdl component
' CDROM part

STATIC mycd AS CDRom
STATIC HaveCD AS BOOLEAN

PUBLIC SUB Form_open()

IF CDRoms.Count > 0 THEN
TRY mycd = NEW CDRom
IF NOT IsNull(mycd) THEN
Volume.Value = Abs(mycd.Volume - Volume.MaxValue)
TrackPos.Value = 0
ME.Center
Timer1.Enabled = TRUE
ELSE
Message.Warning(("I Could not load cd-rom drive"))
ME.Close
ENDIF
ELSE
Message.Warning(("Your PC does not have cd-rom drive"))
ME.Close
ENDIF

END

PUBLIC SUB SButton_Click()

mycd.Stop()
PButton.Text = ("&Play")
TrackPos.Value = 0

END

PUBLIC SUB PTButton_Click()

IF NOT HaveCD THEN
RETURN
ENDIF

mycd.Tracks[TrackInfo.Index + 1].Play()

END

PUBLIC SUB Timer1_Timer()

DIM trckloop AS INTEGER
DIM string1 AS STRING
DIM string2 AS STRING

IF NOT mycd.Ready THEN
TrackInfo.Clear()
TextBox1.Text = ("No CD in Drive")
HaveCD = FALSE
RETURN
ENDIF

IF mycd.Stopped THEN
string1 = mycd.Tracks.Count & " " & ("Tracks")
string2 = ("Total Length :") & " " & ToTime(mycd.Length)
TextBox1.Text = string1 & Space$(41 - (Len(string1) + Len(string2))) & string2
TrackPos.Value = 0
ENDIF

IF mycd.Playing OR mycd.Paused THEN
TrackPos.Value = (mycd.Tracks[mycd.Tracks.Current].Position) / mycd.Tracks[mycd.Tracks.Current].length
TextBox1.Text = ("Playing Track") & " " & mycd.Tracks.Current
ENDIF

IF HaveCD THEN
RETURN
ENDIF

TrackInfo.Clear()
FOR trckloop = 1 TO mycd.Tracks.Count
string1 = ("Track") & " " & trckloop
string2 = "<" & ToTime(mycd.Tracks[trckloop].Length) & ">"
TrackInfo.Add(string1 & Space$(49 - (Len(string1) + Len(string2))) & string2)
NEXT

Volume.Value = Abs(mycd.Volume - 255)
HaveCD = TRUE

END

PUBLIC FUNCTION ToTime(length AS INTEGER) AS STRING

DIM myString AS STRING

mystring = Format$(length \ 60, "00") & ":" & Format$((length MOD 60), "00")
RETURN myString

END

PUBLIC SUB Volume_Change()

mycd.Volume = Abs(Volume.Value - Volume.MaxValue)

END

PUBLIC SUB PButton_Click()

IF NOT HaveCD THEN
PButton.Text = ("&Play")
RETURN
ENDIF

IF mycd.Stopped THEN
mycd.Play()
PButton.Text = ("&Pause")
RETURN
ENDIF

IF mycd.Playing THEN
mycd.Pause()
PButton.Text = ("&Resume")
RETURN
ENDIF

IF mycd.Paused THEN
mycd.Resume()
PButton.Text = ("&Pause")
ENDIF

END

PUBLIC SUB EButton_Click()

TRY mycd.Eject
HaveCD = FALSE
PButton.Text = ("&Play")
TrackPos.Value = 0

END

MediaPlayer



MoviePlayer



MusicPlayer



MyWebCam



WaveGenerator



WebCam


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
' Gambas class file

PRIVATE hWebcam AS VideoDevice
PRIVATE OnSet AS BOOLEAN
PRIVATE Fps AS DATE
PRIVATE nFps AS INTEGER

PUBLIC SUB Button1_Click()

DIM num AS INTEGER
DIM Buf AS STRING
DIM sSize AS STRING

IF hWebCam THEN
Bright.Enabled = FALSE
Contrast.Enabled = FALSE
Hue.Enabled = FALSE
Whiteness.Enabled = FALSE
Colour.Enabled = FALSE
cmbSize.Enabled = FALSE
FreqUp.Enabled = FALSE
FreqDown.Enabled = FALSE
TxtDevice.Enabled = TRUE
BtnTakeShot.Enabled = FALSE
Button2.Enabled = FALSE
hWebCam = NULL
Tmr.Enabled = FALSE
Button1.Caption = ("Capture")
RETURN
END IF

TRY hWebCam = NEW VideoDevice(TxtDevice.Text)
IF ERROR THEN
Message.Error(("Unable to open video device"))
RETURN
END IF
hWebCam.Source = hWebCam.TV + hWebCam.PAL

Button1.Caption = ("Stop")
BtnTakeShot.Enabled = TRUE
Button2.Enabled = TRUE
Bright.Enabled = TRUE
Contrast.Enabled = TRUE
Hue.Enabled = TRUE
Whiteness.Enabled = TRUE
Colour.Enabled = TRUE
cmbSize.Enabled = TRUE
sSize = CStr(hWebCam.Width) & "x" & CStr(hWebCam.Height)
IF cmbSize.Find(sSize) < 0 THEN cmbSize.Add(sSize)
TRY cmbSize.Text = sSize
FreqUp.Enabled = TRUE
FreqDown.Enabled = TRUE
TxtDevice.Enabled = FALSE
OnSet = TRUE
Bright.Value = hWebcam.Bright
Contrast.Value = hWebcam.Contrast
Hue.Value = hWebCam.Hue
Whiteness.Value = hWebCam.Whiteness
Colour.Value = hWebCam.Color
LblFreq.Text = ("Tuner frequency:") & " " & hWebCam.Tuner.Frequency

WAIT 0.001
OnSet = FALSE
Tmr.Delay = 10
Tmr.Enabled = TRUE
ME.Caption = hWebCam.Name
Fps = Now()
nFps = 0

END

PUBLIC SUB Bright_Change()

IF OnSet THEN RETURN
hWebCam.Bright = Bright.Value

END

PUBLIC SUB Contrast_Change()

IF OnSet THEN RETURN
hWebCam.Contrast = Contrast.Value

END

PUBLIC SUB Whiteness_Change()

IF OnSet THEN RETURN
hWebCam.Whiteness = Whiteness.Value

END

PUBLIC SUB Colour_Change()

IF OnSet THEN RETURN
hWebcam.Color = Colour.Value

END

PUBLIC SUB Hue_Change()

IF OnSet THEN RETURN
hWebCam.Hue = Hue.Value

END

PUBLIC SUB cmbSize_Click()

DIM aSize AS String[]

aSize = Split(cmbSize.Text, "*x*")
hWebcam.Resize(CInt(aSize[0]), CInt(aSize[1]))

END

PUBLIC SUB Tmr_Timer()

DIM T1 AS DATE
DIM sBuf AS STRING
DIM hPict AS Picture

Tmr.Enabled = FALSE

'Try PictureBox1.Picture = hWebCam.Picture
Draw.Begin(dwgVideo)
hPict = hWebCam.Image.Picture
Draw.Picture(hPict, (dwgVideo.W - hPict.W) \ 2, (dwgVideo.H - hPict.H) \ 2)
Draw.End

IF NOT ERROR THEN
nFps = nFps + 1
T1 = Now() - Fps
IF Second(T1) >= 1 THEN
ME.Caption = hWebCam.Name & " (" & nFps & " " & ("fps") & ")"
Fps = Now()
nFps = 0
END IF
END IF
Tmr.Enabled = TRUE

END

PUBLIC SUB Form_Close()

Tmr.Enabled = FALSE
hWebCam = NULL

END

PUBLIC SUB FreqUP_Click()

hWebCam.Tuner.Frequency = hWebCam.Tuner.Frequency + 5
LblFreq.Text = ("Tuner frequency:") & " " & hWebCam.Tuner.Frequency

END

PUBLIC SUB FreqDown_Click()

hWebCam.Tuner.Frequency = hWebCam.Tuner.Frequency - 5
LblFreq.Text = ("Tuner frequency:") & " " & hWebCam.Tuner.Frequency

END

PUBLIC SUB Button2_Click()

DIM sCad AS STRING

sCad = ("Device Bus:") & " " & hWebCam.Bus & "\n"
sCad = sCad & ("Device Driver:") & " " & hWebCam.Driver & " " & ("Version:") & " " & hWebCam.Version & "\n"
sCad = sCad & ("Device Name:") & " " & hWebCam.Name & "\n"
sCad = sCad & ("Max. Resolution:") & " " & hWebCam.MaxWidth & "x" & hWebCam.MaxHeight & "\n"
sCad = sCad & ("Min. Resolution:") & " " & hWebCam.MinWidth & "x" & hWebCam.MinHeight & "\n"

Message.Info(sCad)

END

PUBLIC SUB BtnTakeShot_Click()

TRY hWebCam.Save(User.Home & "/webcam_shot.png")
IF NOT ERROR THEN Message.Info(("Image saved as ") & User.Home & "/webcam_shot.png")

END

PUBLIC SUB Panel2_MouseDown()

END


====================

Navigation :



<-- Accueil du WIKI : <--

====================

Documentation :



==============================