VFP 愛用者社區

sunghsia · 註冊時間: 2003-06-13 文章: 52 來自: 台北 第 1 樓

在貼<主音量>的時候, 有一些文字好像會被吃掉,執行程式時,會發生錯誤!!

有拷備<主音量>的人,請利用記事本:

將: repl(chr(0),4 && 結構 MIXERLINE_TARGET, 48 byte
換成: repl(chr(0),4 Cool

&& 結構 MIXERLINE_TARGET, 48 byte

*********************************************************
* 縮短主音量的程式碼
*********************************************************

ouserform=CREATEOBJECT ("userform")
ouserform.SHOW

DEFINE CLASS userform AS form
name="Form1"
caption="Form1"
left=47
top=46
width=100
height=142
maxbutton=.F.
closable=.F.
showwindow=2
visible=.T.

add object label1 AS Label with left=12,top=8 , autosize=.T. ,caption=[Master Volumn]
add object label2 AS Label with left=12,top=26 , autosize=.T. ,caption=[音量]
add object shape1 AS shape with left=4,top=24,width=90,height=2, specialEffect=0
add object timer1 AS Timer

PROCEDURE ACTIVATE
_screen.windowstate=1
_screen.visible=.F.
READ EVENTS
ENDPROC

PROCEDURE CLICK &&離開
= GlobalFree (hmem)
RELEASE DLL
CLEAR EVENTS
_screen.visible=.T.
_screen.windowstate=2
ENDPROC

PROCEDURE ERROR
LPARAMETERS nError, cMethod, nLine
messagebox("錯誤碼: "+ltrim(str(nError))+chr(13)+Message()+chr(13)+chr(13)+"將 PROCEDURE INIT 事件裏的 COMCTL.Slider.1 換成 MSComctlLib.Slider.2 試試",16)
QUIT
ENDPROC

PROCEDURE INIT
this.addobject ("VSlider" , "Slider" , "COMCTL.Slider.1") &&建立 Slider物件
this.VSlider.move(42,42,90,90)
this.VSlider.tickStyle=3
this.VSlider.orientation=1

DECLARE INTEGER mixerOpen IN winmm INTEGER @ phmx, INTEGER uMxId, INTEGER dwCallback, INTEGER dwInstance, INTEGER fdwOpen
DECLARE INTEGER mixerGetLineInfo IN winmm INTEGER hmxobj, STRING @ pmxl, INTEGER fdwInfo
DECLARE INTEGER mixerGetLineControls IN winmm INTEGER hmxobj, STRING @ pmxlc, INTEGER fdwControls
DECLARE INTEGER mixerGetControlDetails IN winmm INTEGER hmxobj, STRING @ pmxcd, INTEGER fdwDetails
DECLARE INTEGER mixerSetControlDetails IN winmm INTEGER hmxobj, STRING @ pmxcd, INTEGER fdwDetails
DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem
DECLARE INTEGER GlobalLock IN kernel32 INTEGER hMem
DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
DECLARE RtlMoveMemory IN kernel32 As CopyMemory STRING @ Destination, INTEGER Source, INTEGER nLength

public hmixer, hmem, mxc, mxcd, 最大音量

hmixer=0
= mixerOpen(@hmixer, 0, 0, 0, 0) &&開啟預設裝置

* --------------------------------------------------------------------
componentType = 4 && MIXERLINE_COMPONENTTYPE_DST_SPEAKERS &&主音量的參數
ctrlType = 1342177280 + 196608 + 1 && MIXERCONTROL_CONTROLTYPE_VOLUME
* --------------------------------------------------------------------

mxl = this.num2dword(168) + repl(chr(0),20) + this.num2dword(componentType) + repl(chr(0),140)
= mixerGetLineInfo (hmixer, @mxl, 3) && MIXER_GETLINEINFOF_COMPONENTTYPE

mxc = this.num2dword(152) + repl(chr(0),148)
hMem = GlobalAlloc(64, len(mxc))
_add = GlobalLock(hMem)

dwLineID = substr(mxl, 13, 4)
mxlc = this.num2dword(24) + dwLineID + this.num2dword(ctrlType) + this.num2dword(1) + this.num2dword(len(mxc)) + this.num2dword(_add)
= mixerGetLineControls(hmixer, @mxlc, 2) &&MIXER_GETLINECONTROLSF_ONEBYTYPE

= CopyMemory (@mxc , _add , len(mxc))
= GlobalFree (hMem)

最小音量 = this.buf2dword (substr(mxc,101,4))
最大音量 = this.buf2dword (substr(mxc,105,4))
this.VSlider.min = 最小音量
this.VSlider.max = 最大音量

vol = REPL(chr(0),4)
hmem = GlobalAlloc(0, Len(vol))
_add = GlobalLock(hmem)

dwControlID = substr(mxc,5,4)
mxcd = this.num2dword(24) + dwControlID + this.num2dword(1) + this.num2dword(0) + this.num2dword(len(vol)) + this.num2dword(_add)
thisform.取得音量

this.timer1.interval = 200 &&與windows的音量控制同步, 不想的話可以 mark 起來

* ------- 下面程式會開啟windows的音量控制,可以把它mark ------
DECLARE INTEGER ShellExecute IN shell32 INTEGER, STRING, STRING, STRING, STRING, INTEGER
= ShellExecute (0, "open", "Sndvol32.exe", "", "", 1)
ENDPROC

PROCEDURE Timer1.Timer
thisform.取得音量
ENDPROC

PROCEDURE 取得音量
DECLARE RtlMoveMemory IN kernel32 As CopyMemory INTEGER @ Destination, INTEGER Source, INTEGER nLength

= mixerGetControlDetails (hmixer, @mxcd, 0) && MIXER_GETCONTROLDETAILSF_VALUE = 0
_add = this.buf2dword(substr(mxcd,21,4)) &&存放區的地址
vol = 4
= CopyMemory (@vol, _add, vol) &&將 _add指定存放區的值,拷備給vol
this.VSlider.value = 最大音量 - vol
ENDPROC

PROCEDURE 設定音量
DECLARE RtlMoveMemory IN kernel32 As CopyMemory INTEGER Destination, STRING @ Source, INTEGER nLength

_add = this.buf2dword(substr(mxcd,21,4)) &&存放區的地址
vol = this.num2dword(最大音量 - this.VSlider.value) &&設定音量的值
= CopyMemory (_add , @vol , 4) &&將vol的值,拷備至 _add所指的存放區
= mixerSetControlDetails (hmixer, @mxcd, 0)
ENDPROC

PROCEDURE buf2Dword (v) &&接收32位元數值資料,回傳十進位
RETURN ;
asc(substr(v, 1,1)) +;
asc(substr(v, 2,1)) * 256 +;
asc(substr(v, 3,1)) * 65536 +;
asc(substr(v, 4,1)) * 16777216
ENDPROC

PROCEDURE num2Dword (lnValue) &&接收十進位,回傳32位元數值資料
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
LOCAL b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDPROC

ENDDEFINE

DEFINE CLASS Slider AS OLEcontrol
visible=.T.
PROCEDURE Scroll
thisform.設定音量
ENDPROC
ENDDEFINE

sunghsia · 發表於: 星期五九月 30, 2005 2:18 pm 文章主題:

在貼<主音量>的時候, 有一些文字好像會被吃掉,執行程式時,會發生錯誤!!

有拷備<主音量>的人,請利用記事本:

將: repl(chr(0),4 && 結構 MIXERLINE_TARGET, 48 byte
換成: repl(chr(0),4８) && 結構 MIXERLINE_TARGET, 48 byte

garfield · 發表於: 星期五九月 30, 2005 11:47 pm 文章主題:

謝謝分享,
貼文後,某些字會被吃掉,
是因為文章內容預設值是可以有表情符號功能,
類似, Smile

sunghsia · 發表於: 星期六十月 01, 2005 10:09 am 文章主題:

了解, 謝謝解說

css · 註冊時間: 2004-12-31 文章: 33 第 5 樓

這一段代碼確實相當精彩！更換一個值componentType，即找到了其它設備音量調節的手段。非常感謝！

稍覺遺憾的是，缺少了靜音之開啟與關閉。當某一個設備「靜音」時，無論如何調節其音量，均是徒勞的。

sunghsia · 發表於: 星期六十月 01, 2005 1:44 pm 文章主題:

靜音也可以控制..

garfield · 發表於: 星期二十月 04, 2005 9:38 am 文章主題:

請sunghsia, 大師開示如何能切換靜音.

sunghsia · 發表於: 星期二十月 04, 2005 11:03 am 文章主題:

garfield 兄, 近來都在重整資料, 所以沒有貼靜音的控制