Выключить звук и монитор в 2000 Win

← →
Стил (2002-11-30 22:06) [0]

Здравствуйте. Я муаюсь уже около недели. как программно выключить и вклюить монитор и звук, но так, чтобы это работало и в 2000 Windows. Спасибо огромное.

← →
Diamond Cat (2002-11-30 23:07) [1]

sendmessage(handle,wm_syscommand,sc_monitorpower,1); //выкл
sendmessage(handle,wm_syscommand,sc_monitorpower,-1);//вкыл
со звуком сложнее вот тебе код, из него выдерещь, что надо.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
Label1: TLabel;
Label2: TLabel;
TrackBar3: TTrackBar;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar3Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
uses mmsystem;

function GetWaveVolume: DWord;
var
Woc : TWAVEOUTCAPS;
Volume : DWord;
begin
result:=0;
if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
MMSYSERR_NOERROR then
if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
begin
WaveOutGetVolume(WAVE_MAPPER,@Volume);
Result := Volume;
end;
end;

procedure SetWaveVolume(const AVolume: DWord);
var
Woc : TWAVEOUTCAPS;
begin
if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
MMSYSERR_NOERROR then
if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
WaveOutSetVolume(WAVE_MAPPER, AVolume);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Beep;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
LeftVolume: Word;
RightVolume: Word;
begin
LeftVolume :=TrackBar1.Position*655;
RightVolume := TrackBar2.Position*655;
SetWaveVolume(MakeLong(LeftVolume, RightVolume));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Caption := IntToStr(GetWaveVolume);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Label3.Caption:=IntTostr(TrackBar1.Position);
if TrackBar1.Position>TrackBar2.position then TrackBar3.Position:=TrackBar1.position;
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
TrackBar1.Position:=TrackBar3.position;
TrackBar2.Position:=TrackBar3.position;
Label3.Caption:=IntTostr(TrackBar1.Position);
Label4.Caption:=IntTostr(TrackBar2.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
Label4.Caption:=IntTostr(TrackBar2.Position);
if TrackBar2.Position>TrackBar1.position then TrackBar3.Position:=TrackBar2.position;
end;

end.

← →
Стил (2002-12-01 09:23) [2]

Спасибо большое. Все сделал наконец :)
Странно, в яндексе искал, везде говорилось:
sendmessage(handle,wm_syscommand,sc_monitorpower, 0); //выкл
Поэтому оно и не работало.
Спасибо еще раз.

Выключить звук и монитор в 2000 Win Найти похожие ветки