VFP 愛用者社區

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

**********************************************
* 拷備至 *.prg 欲離開程式時,點擊[空白的地方]
* 結構資料可查詢 vb 的 Win32api.txt 或 MSDN
************************************************

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 = ; && 結構 MIXERLINE , 需要一些輸入, 其它的都是傳回值
this.num2dword(168) +; && cbStruct 輸入本結構的大小 long=1,4
repl(chr(0),4) +; && dwDestination long=5,4
repl(chr(0),4) +; && dwSource long=9,4
repl(chr(0),4) +; && dwLineID 本線的ID long=13,4
repl(chr(0),4) +; && fdwLine long=17,4
repl(chr(0),4) +; && dwUser lomg=21,4
this.num2dword(componentType) +; &&輸入主音量的值 long=25,4
repl(chr(0),4) +; && cChannels 本線的平衡 1=不能調整 2=可調整 long=29,4
repl(chr(0),4) +; && cConnections 如本線是主音量,就有stereo,Wave,CD,Mic,Aux,Vido..long=33,4
repl(chr(0),4) +; && cControls 本線可控制的的項目數量,如音量,靜音或20db.. long=37,4
repl(chr(0),16) +; && szShortName 線的短名稱 MIXER_SHORT_NAME_CHARS = 16 string=41,16
repl(chr(0),64) +; && szName 線的長名稱 MIXER_LONG_NAME_CHARS = 64 string=57,64
repl(chr(0),48 ) && 結構 MIXERLINE_TARGET, 48 byte
*** 168 byte
*結構 MIXERLINE_TARGET
* repl(chr(0),4) +; && dwType long=121,4
* repl(chr(0),4) +; && dwDeviceID long=125,4
* repl(chr(0),2) +; && wMid integer=129,2
* repl(chr(0),2) +; && wPid integer=131,2
* repl(chr(0),4) +; && vDriverVersion long=133,4
* repl(chr(0),32) && szPname string=137,32 MAXPNAMELEN=32
*** 48 byte

*-------------------------------------------------------------------------------

= mixerGetLineInfo (hmixer, @mxl, 3) && MIXER_GETLINEINFOF_COMPONENTTYPE=3

*-------------------------------------------------------------------------------

mxc = ; && 結構 MIXERCONTROL
this.num2dword(152) +; && cbStruct 輸入本結構的大小 long=1,4
repl(chr(0),4) +; && dwControlID long=5,4
repl(chr(0),4) +; && dwControlType long=9,4
repl(chr(0),4) +; && fdwControl long=13,4
repl(chr(0),4) +; && cMultipleItems long=17,4
repl(chr(0),16) +; && szShortName 短名稱 MIXER_SHORT_NAME_CHARS=16 string=21,16
repl(chr(0),64) +; && szName 長名稱 MIXER_LONG_NAME_CHARS=64 string=37,64
repl(chr(0),4) +; && lMinimum 最小音量 long=101,4
repl(chr(0),4) +; && lMaximum 最大音量 long=105,4
repl(chr(0),44) && reserved 保留 long=109,44
*** 152 byte

*-------------------------------------------------------------------------------

hMem = GlobalAlloc(64, len(mxc)) &&申請一個存放區
_add = GlobalLock(hMem) && _add是存放區的地址

dwLineID = substr(mxl, 13, 4) &&本線的ID

mxlc= ; && 結構 MIXERLINECONTROLS
this.num2dword(24) +; && cbStruct 輸入,本結構大小 long=1,4
dwLineID +; && dwLineID 輸入,mxl線的dwLineID long=5,4
this.num2dword(ctrlType) +; && dwControl long=9,4
this.num2dword(1) +; && cControls mxl的cControls數量 long=13,4
this.num2dword(len(mxc)) +; && cbmxctrl 輸入,存放區的大小 long=17,4
this.num2dword(_add) && pamxctrl 記錄,存放區的地址 long=21,4
*** 24 byte

*-------------------------------------------------------------------------------

= mixerGetLineControls(hmixer, @mxlc, 2) &&MIXER_GETLINECONTROLSF_ONEBYTYPE=2

= CopyMemory (@mxc , _add , len(mxc)) &&將存放區的資料,拷備給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) && _add是存放區的地址

dwControlID = substr(mxc,5,4)

mxcd =; && 結構 MIXERCONTROLDETAILS
this.num2dword(24) +; && cbStruct 輸入本結構的大小 long=1,4
dwControlID +; && dwControlID 輸入mxc的 dwControlID long=5,4
this.num2dword(1) +; && cChannels long=9,4
this.num2dword(0) +; && Item long=13,4
this.num2dword(len(vol)) +; && cbDetails 輸入,存放區的大小 long=17,4
this.num2dword(_add) && 記錄,存放區的地址 long=21,4
*** 24 byte

*-------------------------------------------------------------------------------

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:09 pm 文章主題:

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

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

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

&& 結構 MIXERLINE_TARGET, 48 byte

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

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

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

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