17-01-2010, 11:04 AM
أقدم لكم هذه المجموعة من الأكواد للمهتمين بموضوع الميديا (برمجة برامج الصوتيات) وقد قمت بجمعها من مجموعة من المواقع فهي ليست مني بل هي منقولة ولكني قمت بجمعها لأعضاء المنتدى :
كود كتم الصوت الخاص بكرت الصوت الخاص بالجهاز:
تفعيل أو إلغاء تفعيل خاصية ال AutoPlay الخاصة بال CD :
ضبط حجم الصوت في الأجهزة :
تغيير حجم صوت كرت الصوت:
فحص إذا كان كرت الصوت موجود على الجهاز :
فحص إذا كان ال audio-cd موجود ضمن السواقة الليزرية :
تحويل ملفات ال SWF إلى EXE
هذه هي المجموعة الأولى والمجوعة القادمة قريباً إنشاء الله .مع التحيات للجميع .
كود كتم الصوت الخاص بكرت الصوت الخاص بالجهاز:
PHP كود :
uses
MMSystem;
function GetMasterMute(
Mixer: hMixerObj;
var Control: TMixerControl): MMResult;
// Returns True on success
var
Line: TMixerLine;
Controls: TMixerLineControls;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Result := mixerGetLineInfo(Mixer, @Line,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then
begin
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := @Control;
Result := mixerGetLineControls(Mixer, @Controls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
end;
end;
procedure SetMasterMuteValue(
Mixer: hMixerObj;
Value: Boolean);
var
MasterMute: TMixerControl;
Details: TMixerControlDetails;
BoolDetails: TMixerControlDetailsBoolean;
Code: MMResult;
begin
Code := GetMasterMute(0, MasterMute);
if Code = MMSYSERR_NOERROR then
begin
with Details do
begin
cbStruct := SizeOf(Details);
dwControlID := MasterMute.dwControlID;
cChannels := 1;
cMultipleItems := 0;
cbDetails := SizeOf(BoolDetails);
paDetails := @BoolDetails;
end;
LongBool(BoolDetails.fValue) := Value;
Code := mixerSetControlDetails(0, @Details,
MIXER_SETCONTROLDETAILSF_VALUE);
end;
if Code <> MMSYSERR_NOERROR then
raise Exception.CreateFmt('SetMasterMuteValue failure, '+
'multimedia system error #%d', [Code]);
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off
end;
تفعيل أو إلغاء تفعيل خاصية ال AutoPlay الخاصة بال CD :
كود :
uses
Registry;
procedure CDSetAutoPlay(SioNo: Boolean);
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('Software\Classes\AudioCD\') then
if Reg.OpenKey('Software\Classes\AudioCD\Shell\', False) then
if SioNo then Reg.WriteString('', 'play')
else
Reg.WriteString('', '');
finally
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
{Activate AutoPlay}
CDSetAutoPlay(True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
{Deactivate Autoplay}
CDSetAutoPlay(False);
end;ضبط حجم الصوت في الأجهزة :
كود :
uses
MMSystem;
function GetLineInHandle(AudioType: Integer): Integer;
var
i: Integer;
AudioCaps: TAuxCaps;
begin
Result := 0;
for i := 0 to auxGetNumDevs - 1 do
begin
auxGetDevCaps(i, @AudioCaps, SizeOf(AudioCaps));
if AudioCaps.wTechnology = AudioType then
begin
Result := i;
Break;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
v: DWORD;
begin
AuxGetVolume(GetLineInHandle(AUXCAPS_CDAUDIO), @v);
Edit1.Text := IntToStr(LoWord(v));
Edit2.Text := IntToStr(HiWord(v));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
v: DWORD;
begin
v := MakeLong(Word(StrToInt(Edit1.Text)),
Word(StrToInt(Edit2.Text)));
AuxSetVolume(GetLineInHandle(AUXCAPS_CDAUDIO), v);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
v: DWORD;
begin
AuxGetVolume(GetLineInHandle(AUXCAPS_AUXIN), @v);
Edit3.Text := IntToStr(LoWord(v));
Edit4.Text := IntToStr(HiWord(v));
end;
procedure TForm1.Button4Click(Sender: TObject);
var
v: DWORD;
begin
v := MakeLong(Word(StrToInt(Edit3.Text)),
Word(StrToInt(Edit4.Text)));
AuxSetVolume(GetLineInHandle(AUXCAPS_AUXIN), v);
end;تغيير حجم صوت كرت الصوت:
كود :
uses
MMSystem;
procedure SetVolume(const volL, volR: Word);
var
hWO: HWAVEOUT;
waveF: TWAVEFORMATEX;
vol: DWORD;
begin
// init TWAVEFORMATEX
FillChar(waveF, SizeOf(waveF), 0);
// open WaveMapper = std output of playsound
waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
vol := volL + volR shl 16;
// set volume
waveOutSetVolume(hWO, vol);
waveOutClose(hWO);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetVolume(14000, 14000);
end;
{************************************************}
{2.}
{by Serhiy Perevoznyk}
uses
MMSystem;
function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint;
var mxc: TMixerControl): Boolean;
var
mxl: TMixerLine;
mxlc: TMixerLineControls;
rc: Longint;
begin
Result := False;
FillChar(mxl, SizeOf(TMixerLine), 0);
mxl.cbStruct := SizeOf(TMixerLine);
mxl.dwComponentType := componentType;
{Obtain a line corresponding to the component type}
rc := mixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if rc = MMSYSERR_NOERROR then
begin
with mxlc do
begin
cbStruct := SizeOf(TMixerLineControls);
dwLineID := mxl.dwLineID;
dwControlType := ctrlType;
cControls := 1;
cbmxctrl := SizeOf(TMixerLine);
pamxctrl := @mxc;
pamxctrl^.cbStruct := SizeOf(TMixerControl);
end;
mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
rc := mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
Result := rc = MMSYSERR_NOERROR;
end;
end;
function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volume: Longint): Boolean;
var
mxcd: TMixerControlDetails;
vol: TMixerControlDetails_Unsigned;
rc: MMRESULT;
begin
FillChar(mxcd, SizeOf(mxcd), 0);
with mxcd do
begin
cbStruct := SizeOf(TMixerControlDetails);
dwControlID := mxc.dwControlID;
cbDetails := SizeOf(TMixerControlDetails_Unsigned);
paDetails := @vol;
cMultipleItems := 0;
cChannels := 1;
end;
vol.dwValue := volume;
rc := mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
Result := rc = MMSYSERR_NOERROR;
end;
function InitMixer: HMixer;
var
Err: MMRESULT;
begin
Err := mixerOpen(@Result, 0, 0, 0, 0);
if Err <> MMSYSERR_NOERROR then
Result := 0;
end;
// Example:
procedure SetMasterVolumeToZero;
var
MyMixerHandle: HMixer;
MyVolCtrl: TMixerControl;
begin
MyMixerHandle := InitMixer;
if MyMixerHandle <> 0 then
try
FillChar(MyVolCtrl, SizeOf(MyVolCtrl), 0);
if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
begin
{The last parameter (0) here is the volume level}
if SetVolumeControl(MyMixerHandle, MyVolCtrl, 0) then
ShowMessage('Volume should now be set to zero');
end;
finally
mixerClose(MyMixerHandle);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SetMasterVolumeToZero
end;فحص إذا كان كرت الصوت موجود على الجهاز :
كود :
uses
MMSystem;
function SoundCardAvailable: Boolean;
begin
Result := WaveOutGetNumDevs > 0;
end;فحص إذا كان ال audio-cd موجود ضمن السواقة الليزرية :
كود :
function IsAudioCD(Drive: Char): Boolean;
var
DrivePath: string;
MaximumComponentLength: DWORD;
FileSystemFlags: DWORD;
VolumeName: string;
OldErrorMode: UINT;
DriveType: UINT;
begin
Result := False;
DrivePath := Drive + ':\';
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
DriveType := GetDriveType(PChar(DrivePath));
finally
SetErrorMode(OldErrorMode);
end;
if DriveType <> DRIVE_CDROM then
Exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),
PChar(VolumeName),
Length(VolumeName),
nil,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
if lStrCmp(PChar(VolumeName), 'Audio-CD') = 0 then Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsAudioCD('D') then
ShowMessage('Audio-CD found in drive D.')
else
ShowMessage('No Audio-CD found in drive D.');
endتحويل ملفات ال SWF إلى EXE
كود :
function Swf2Exe(S, D, F: string): string;
//S = Source file (swf)
//D = Destionation file (exe)
//F = Flash Player
var
SourceStream, DestinyStream, LinkStream: TFileStream;
flag: Cardinal;
SwfFileSize: Integer;
begin
Result := 'something error';
DestinyStream := TFileStream.Create(D, fmCreate);
try
LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(LinkStream, 0);
finally
LinkStream.Free;
end;
SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(SourceStream, 0);
flag := $FA123456;
DestinyStream.WriteBuffer(flag, SizeOf(Integer));
SwfFileSize := SourceStream.Size;
DestinyStream.WriteBuffer(SwfFileSize, SizeOf(Integer));
Result := '';
finally
SourceStream.Free;
end;
finally
DestinyStream.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Swf2Exe('c:\somefile.swf', 'c:\somefile.exe',
'c:\Program Files\Macromedia\Flash MX\Players\SAFlashPlayer.exe');
end;هذه هي المجموعة الأولى والمجوعة القادمة قريباً إنشاء الله .مع التحيات للجميع .