关于调节音量

[Sephil]

如果要自己在程序里调节音量，但只是影响自身
其他程序不受影响
该怎么做啊

[wjzhuang]

见
http://www.csdn.net/expert/topic/148/148254.shtm
另外,你可以在程序结束后把音量调回原来的状态,这样就不会影响别的程序.
或者在程序焦点却换时调整.
form有onActive类似的事件(具体的我可能写错了)

[Sephil]

有没有别的办法？？

[Sephil]

我想实现这样的功能，一个多媒体播放软件，点某个按钮就没有声音出现
但如果同时有其他程序如果正在播放声音则无影响
就象一些FLASH动画一样

[Sephil]

还有 QUICKTIME PLAYER 也是

[Sephil]

加分！！

[Sephil]

为什么我的帖子总没人看？？

[PingPingPangPang]

sephil,你见过两个软件同时使用音响的场面吗？？

[Sephil]

推推

[Sephil]

我试试先

[SSTS]

TO：P...P...P...P...OICQ和播放CD的时候。

[SSTS]

下面这个程序是我从网找来的，我不会DELPHI，看不懂啊，里面有关于声音控制的，
希望对你有帮助！
(*************************************************************************)
(* CDPlayer Ver 1.0 *)
(* Author : Sean Hsieh *)
(* E-Mail : [e-mail] *)
(* First Version: 07/11/1996 *)
(*************************************************************************)
unit player;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, MPlayer, ExtCtrls, MMSystem, Danhint, Menus;

type
PTImage = ^TImage;

TCDPlayerForm = class(TForm)
Player: TMediaPlayer;
CDTimer: TTimer;
ImageLedLNum: TImageList; // Led Bitmap list
ImagePlayArrow: TImage;
ImagePlayBtn: TImage;
ImagePauseBtn: TImage;
ImageStopBtn: TImage;
ImageCloseBtn: TImage;
ImageStepBtn: TImage;
ImageBackBtn: TImage;
ImagePrevBtn: TImage;
ImageNextBtn: TImage;
ImageVolumeRBtn: TImage;
ImageVolumeLBtn: TImage;
ImageTimeBtn: TImage;
ImageRandomBtn: TImage;
ImagePreviewBtn: TImage;
ImageRepeatBtn: TImage;
ImageRepeatOnceBtn: TImage;
ImageMinBtn: TImage;
ImageEjectBtn: TImage;
ImagePreview: TImage;
ImageRandom: TImage;
ImageRepeat: TImage;
ImageRepeatOnce: TImage;
DanHint1: TDanHint;
procedure ImageBtnClick(Sender: TObject);
procedure ImagePlayBtnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImagePlayBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
procedure PlayerNotify(Sender: TObject);
procedure CDTimerTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageBtnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

private
{ Private declarations }
public
BeginDrag: boolean; // 视窗开始拖曳旗标
bx: Integer; // 移动横向坐标差值
by: Integer; // 移动纵向坐标差值
BackGround: TBitmap; // 背景图
procedure CDPlay; // 播放
procedure CDPause; // 暂停/恢复
procedure CDStop; // 停止
procedure CDBack; // 往後略过
procedure CDStep; // 往後略过
procedure CDPrev; // 前一个曲目
procedure CDNext; // 下一个曲目
procedure CDVolumeInc; // 增加音量
procedure CDVolumeDec; // 减小音量
procedure CDDoorCtrl; // CDROM 退出/关闭 控制
procedure CDTimeFormat; // 时间显示选择
procedure CDRandom; // 随机播放
procedure CDPreview; // 播放简介
procedure CDRepeat; // 连序播放
procedure CDRepeatOnce; // 单曲重覆播放

procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
procedure CDPlayerAction( Sender: TImage ); // 判断按钮动作
procedure CloseDoor;
procedure DrawTrack; // 显示所有音轨
procedure DrawTrackAndTime; // 显示音轨与播放时间
procedure GetNewCDInfo;
function GetTrackBySecond(sec: Integer): Integer; // 依播放的时间得知目前
// 音轨
procedure GetTotalTime;
function GetTrackIndex(track: Integer): Integer; // 由实际音轨得知逻辑音
// 轨顺序
function GetTrackTime( track: Integer ): Integer;
function GetUserTracks: Integer;
procedure Move( dx: Integer; dy: Integer );
procedure ShowTimeMode;
{ Public declarations }
end;

procedure LoadBtnBmp( image: TImage; const name: string );

const
smTime = 0; // 单轨播过时间
smTotalTime = 1; // 全部播过时间
smRemaining = 2; // 单轨剩馀时间
smTotalRemaining = 3; // 全部剩馀时间
smTotal = 4; // 全部时间
crMyCursor = 2;
// IDM_PLAY = WM_USER + 1;
btnResName1: array[0..16] of String = ( // 按钮正常状态
'playbu', 'pausebu', 'stopbu', 'closebu', 'stepbu', 'backbu', 'prevbu',
'nextbu', 'volumrbu', 'volumlbu', 'timebu', 'randbu', 'previebu', 'rpbu',
'rponcebu', 'minbu', 'ejectbu' );
btnResName2: array[0..16] of String = ( // 按钮押下状态
'playbd', 'pausebd', 'stopbd', 'closebd', 'stepbd', 'backbd', 'prevbd',
'nextbd', 'volumrbd', 'volumlbd', 'timebd', 'randbd', 'previebd', 'rpbd',
'rponcebd', 'minbd', 'ejectbd' );
var
CDPlayerForm: TCDPlayerForm;
tmp: Longint;
oldTime: Longint;
oldTrack: Integer;
PMode: TMPModes; // CDROM 最後状态
TimeMode: Integer; // 播放时间显示状态
FirstShow: boolean; // 主视窗是否第一次显示
PreviewMode: boolean; // 播放简介旗标
RandomMode: boolean; // 随机播放旗标
TotalTime: Integer; // 所有音轨总秒数
LastTrack: Longint; // 最後逻辑音轨
RepeatTrack: Integer; // 重覆播放音轨
startTrack: Integer; // 第一逻辑音轨
TaskIconed: boolean;
PlayTrack: Integer; // 播放中的音轨
TrackOrder: array[1..40] of Integer; // 逻辑音轨顺序
UserTracks: Integer; // 逻辑音轨数目
ddy: Integer;

implementation
// TimeFormat 改变後一定要再改回 tfTMSF;
uses Leg1, Leg2, Leg3, Leg4;

procedure LoadBtnBmp( image: TImage; const name: string );
begin
image.Picture.Bitmap.LoadFromResourceName( HInstance, name );
end;

procedure TCDPlayerForm.GetTotalTime;
var
i: Integer;
begin
Player.TimeFormat := tfMSF;
TotalTime := 0;
for i := 1 to UserTracks do
begin
tmp := Player.TrackLength[TrackOrder[i]];
Inc( TotalTime, Lo(tmp) * 60 );
Inc( TotalTime, Hi(tmp) );
end;
Player.TimeFormat := tfTMSF;
LastTrack := (Player.TrackLength[TrackOrder[i]] shl 8) + TrackOrder[i];
end;

procedure TCDPlayerForm.ShowTimeMode;
var
x: Integer;
s: string;
begin
x := 550;
case TimeMode of
smTime: s := 'TIME';
smTotalTime: s := 'TOTAL TIME';
smRemaining: s := 'REMAINING TIME';
smTotalRemaining: s := 'TOTAL REMAINING TIME';
smTotal: s := 'TOTAL';
end;
with Canvas do
begin
Font.Height := -9;
Font.Size := 5;
Brush.Color := clBlack;
FillRect(Rect(550 - TextWidth( 'TOTAL REMAINING TIME' ), 18, 550, 27 ));
x := x - TextWidth( s );
Font.Color := clLime;
TextOut( x, 18, s );
end;
end;

procedure TCDPlayerForm.CloseDoor;
var
SetParm: TMCI_Set_Parms;
Flags: Longint;
FError: Longint;
begin
Flags := mci_Notify or mci_Set_Door_Closed;
SetParm.dwCallback := Player.Handle;
FError := mciSendCommand( Player.DeviceID, mci_Set, Flags, Longint(@SetParm) );
GetNewCDInfo;
end;

procedure TCDPlayerForm.CDPlay;
begin
if Player.Mode <> mpPlaying then
begin
GetTotalTime;
Player.Play;
PMode := mpPlaying;
ImagePlayArrow.Visible := True;
end;
end;

procedure TCDPlayerForm.CDPause;
begin
if PMode in [mpPlaying,mpPaused] then
begin
if PMode = mpPlaying then
begin
Player.Pause;
ImagePauseBtn.Hint := '恢复';
ImagePlayBtn.Hint := '恢复';
PMode := mpPaused;
end
else
begin
Player.Resume; // 无法再用 Pause 恢复播放, 要用 Resume
ImagePauseBtn.Hint := '暂停';
ImagePlayBtn.Hint := '播放';
PMode := mpPlaying;
end;
end;
end;

procedure TCDPlayerForm.CDStop;
begin
Player.Stop;
PlayTrack := TrackOrder[1];
if RandomMode then
begin
Player.StartPos := Player.TrackPosition[PlayTrack];
Player.Play;
Player.Stop;
end
else
Player.Rewind; // 记得要回到最前面
PMode := mpStopped;
ImagePlayArrow.Visible := False;
LoadBtnBmp( ImagePlayBtn, 'playbu' );
oldTrack := PlayTrack;
DrawTrack;
end;

function TCDPlayerForm.GetTrackBySecond(sec: Integer): Integer;
var
i: Integer;
tmp: Longint;
begin
for i := 1 to Player.Tracks do
begin
tmp := Player.TrackLength[i];
Dec( sec, Lo(tmp) * 60 );
Dec( sec, Hi(tmp) );
if sec <= 0 then
begin
Result := i;
Exit;
end;
end;
end;

procedure TCDPlayerForm.CDBack;
var
tt: Longint;
t: Integer;
f: boolean;
begin
if Player.Mode = mpPlaying then
begin
Player.TimeFormat := tfMilliseconds;
tmp := Player.Position;
if Player.Position < 10000 then // 预设倒退 10 秒
Player.StartPos := 0
else
Player.StartPos := Player.Position - 10000;
if RandomMode then
begin
f := False;
Player.TimeFormat := tfTMSF;
t := GetTrackBySecond( Player.StartPos div 1000 );
if (t <> PlayTrack) or (Player.StartPos = 0) then
begin
t := GetTrackIndex( PlayTrack );
if t = 1 then
begin
PlayTrack := TrackOrder[1];
if ImageRepeat.Visible = False then
f := True;
end
else
PlayTrack := TrackOrder[t - 1];
Player.StartPos := Player.TrackPosition[PlayTrack];
end
else
Player.TimeFormat := tfMilliseconds;
end
else
f := False;
Player.Play;
if f then
Player.Stop;
Player.TimeFormat := tfTMSF;
if not RandomMode then
PlayTrack := Lo( Player.Position );
end;
end;

procedure TCDPlayerForm.CDStep;
var
tt: Longint;
t: Integer;
f: boolean;
begin
if Player.Mode = mpPlaying then
begin
Player.TimeFormat := tfMilliseconds; // 预设前进 10 秒
tmp := Player.Position;
if Player.Position + 10000 > Player.Length then
Player.StartPos := Player.Length - 1000
else
Player.StartPos := Player.Position + 10000;
if RandomMode then
begin
f := False;
Player.TimeFormat := tfTMSF;
t := GetTrackBySecond( Player.StartPos div 1000 );
if t <> PlayTrack then // 播到第一音轨後若无连续播放毕须设
begin // 定停止旗标 f
t := GetTrackIndex( PlayTrack );
if t = UserTracks then
begin
PlayTrack := TrackOrder[1];
if ImageRepeat.Visible = False then
f := True;
end
else
PlayTrack := TrackOrder[t + 1];
Player.StartPos := Player.TrackPosition[PlayTrack];
end
else
Player.TimeFormat := tfMilliseconds;
end
else
f := False;
Player.Play;
if f then
Player.Stop;
Player.TimeFormat := tfTMSF;
if not RandomMode then
PlayTrack := Lo( Player.Position );
end;
end;

procedure TCDPlayerForm.CDPrev;
var
t: Integer;
begin
if RandomMode then
begin
t := GetTrackIndex( PlayTrack );
if t = 1 then
t := UserTracks
else
begin
if UserTracks > 1 then
Dec( t );
end;
PlayTrack := TrackOrder[t];
Player.StartPos := Player.TrackPosition[PlayTrack];
Player.Play;
if PMode <> mpPlaying then
Player.Stop;
end
else
begin
Player.Previous;
PlayTrack := Lo( Player.Position );
end;
end;

procedure TCDPlayerForm.CDNext;
var
t: Integer;
begin
if RandomMode then
begin
t := GetTrackIndex( PlayTrack );
if t = UserTracks then
t := 1
else
begin
if UserTracks > 1 then
Inc( t );
end;
PlayTrack := TrackOrder[t];
Player.StartPos := Player.TrackPosition[PlayTrack];
Player.Play;
if PMode <> mpPlaying then
Player.Stop;
end
else
begin
Player.Next;
PlayTrack := Lo( Player.Position );
end;
end;

procedure TCDPlayerForm.CDVolumeInc;
var
volume: Cardinal;
begin
auxGetVolume( Player.DeviceID, @volume );
if $FFFF - WORD(volume) < $1000 then
begin
volume := $FFFF;
volume := (volume shl 16) + $FFFF;
end
else
volume := volume + $10001000;
auxSetVolume( Player.DeviceID, volume );
end;

procedure TCDPlayerForm.CDVolumeDec;
var
volume: Cardinal;
begin
auxGetVolume( Player.DeviceID, @volume );
if WORD(volume) < $1000 then
volume := 0
else
volume := volume - $10001000;
auxSetVolume( Player.DeviceID, volume );
end;

procedure TCDPlayerForm.CDDoorCtrl;
begin
if Player.Mode = mpOpen then
begin
CloseDoor;
ImageEjectBtn.Hint := '退出';
end
else
begin
LoadBtnBmp( ImagePlayBtn, 'playbu' );
Player.Eject;
ImageEjectBtn.Hint := '进入';
end;
PMode := mpOpen;
end;

procedure TCDPlayerForm.CDTimeFormat;
begin
oldTime := 0;
if TimeMode >= smTotal then
TimeMode := smTime
else
Inc(TimeMode);
ShowTimeMode;
if TimeMode in [smTotalTime, smTotal, smTotalRemaining] then
GetTotalTime;
if PMode <> mpPlaying then
begin
OldTime := 0;
DrawTrackAndTime;
end;
end;

procedure TCDPlayerForm.CDRandom;
var
i, j, r, ts, f: Integer;
begin
ImageRandom.Visible := not ImageRandom.Visible;
RandomMode := ImageRandom.Visible;
ts := UserTracks;
if RandomMode = True then
begin
for i := 1 to ts do
TrackOrder[i] := 0;
for i := 1 to ts do
begin
repeat
f := 1;
r := Random( ts ) + 1;
for j := 1 to i do
if TrackOrder[j] = r then
begin
f := 0;
Break;
end;
until f = 1;
TrackOrder[i] := r;
end;
end
else
for i := 1 to ts do
TrackOrder[i] := i;
if PMode <> mpPlaying then
begin
Player.StartPos := Player.TrackPosition[TrackOrder[1]];
Player.Play;
Player.Stop;
end;
PlayTrack := Lo(Player.Position);
DrawTrackAndTime;
DrawTrack;
GetTotalTime;
end;

procedure TCDPlayerForm.CDPreview;
begin
ImagePreview.Visible := not ImagePreview.Visible;
PreviewMode := ImagePreview.Visible;
ImageRepeatOnce.Visible := False;
end;

procedure TCDPlayerForm.CDRepeat;
begin
ImageRepeat.Visible := not ImageRepeat.Visible;
ImageRepeatOnce.Visible := False;
end;

procedure TCDPlayerForm.CDRepeatOnce;
begin
ImageRepeatOnce.Visible := not ImageRepeatOnce.Visible;
ImagePreview.Visible := False;
ImageRepeat.Visible := False;
PreviewMode := False;
if ImageRepeatOnce.Visible then
RepeatTrack := Lo(Player.Position);
end;

procedure TCDPlayerForm.CDPlayerAction( Sender: TImage );
begin
case Sender.Tag of
0: CDPlay;
1: CDPause;
2: CDStop;
3: Close;
4: CDStep;
5: CDBack;
6: CDPrev;
7: CDNext;
8: CDVolumeInc;
9: CDVolumeDec;
10: CDTimeFormat;{ Time Button }
11: CDRandom;{ Random Button }
12: CDPreview;{ Preview Button }
13: CDRepeat;{ Repeat Button }
14: CDRepeatOnce;{ RepeatOnce Button }
15: { TaskIconed Button }
begin
TaskIconed := True;
Application.Minimize;
{ SendMessage( CDPlayerForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0 );}
{ CDPlayerForm.Visible := False;}
end;
16: CDDoorCtrl;
end;
end;

function TCDPlayerForm.GetTrackTime( track: Integer ): Integer;
var
i, sec, n: Integer;
tmp: Longint;
begin
sec := 0;
n := GetTrackIndex(track) - 1;
for i := 1 to n do
begin
tmp := Player.TrackLength[TrackOrder[i]];
Inc( sec, Lo(tmp) * 60 );
Inc( sec, Hi(tmp) );
end;
Result := sec;
end;

procedure TCDPlayerForm.DrawTrackAndTime;
var
track, min, sec, t, ts: Integer;
tt: Longint;
begin
if FirstShow then
begin
FirstShow := False;
ShowTimeMode;
end;
if Player.Mode in [mpNotReady,mpStopped,mpPlaying,mpRecording,mpSeeking,mpPaused,mpOpen] then
begin
if (PMode = mpPlaying) and (Player.Mode in [mpOpen,mpNotReady]) then
begin
LoadBtnBmp( ImagePlayBtn, 'playbu' );
ImagePlayArrow.Visible := False;
PMode := mpOpen;
end;
if (Player.Mode in [mpOpen,mpNotReady]) and (mpPaused <> PMode) then
tmp := 0
else
tmp := Player.Position;
if oldTime <> tmp then
begin
track := Lo(tmp);
if (ImageRepeatOnce.Visible = True) and (track <> RepeatTrack) then
Exit;
if TimeMode in [smTotalRemaining,smTotalTime] then
t := GetTrackTime( track );
min := Hi(tmp);
sec := Lo(tmp shr 16);
with ImageLedLNum do
begin
if not TaskIconed then
begin
Draw(Canvas, 417, 34, track div 10 );
Draw(Canvas, 435, 34, track mod 10 );
end;
case TimeMode of
smTotalRemaining:
begin
ts := TotalTime - (t + min * 60 + sec);
min := ts div 60;
sec := ts mod 60;
end;
smTotalTime:
begin
ts := t + min * 60 + sec;
min := ts div 60;
sec := ts mod 60;
end;
smRemaining:
begin
tt := Player.TrackLength[track];
ts := Lo(tt) * 60 + Hi(tt) - min * 60 - sec;
min := ts div 60;
sec := ts mod 60;
end;
smTotal:
begin
min := TotalTime div 60;
sec := TotalTime mod 60;
end;
end;
if TaskIconed then
begin
Application.Title := Format( 'Solar HiFi [%2.2d] %2.2d:%2.2d', [track, min, sec] );
end
else
begin
Draw(Canvas, 474, 34, min div 10 );
Draw(Canvas, 492, 34, min mod 10 );
Draw(Canvas, 519, 34, sec div 10 );
Draw(Canvas, 537, 34, sec mod 10 );
end;
end;
oldTime := tmp;
if oldTrack <> track then
begin
oldTrack := track;
if not RandomMode then
PlayTrack := track;
DrawTrack;
end;
end;
end;
end;

procedure TCDPlayerForm.DrawTrack;
var
ot, rx, x, i: Integer;
s, rs: string;
m: TMPModes;
f: boolean;
begin
if TaskIconed then
Exit;
f := False;
{ tracks := Player.Tracks;}
if RandomMode then
begin
for i := 1 to UserTracks do
begin
if oldTrack = TrackOrder[i] then
begin
ot := i;
break;
end;
end;
end
else
ot := oldTrack;
startTrack := (ot - 1) div 12 * 12 + 1;
Canvas.Font.Height := -11;
Canvas.Font.Size := 6;
x := 340;
m := Player.Mode;
Canvas.Font.Color := clYellow;
for i := startTrack to startTrack + 11 do
begin
if (i > UserTracks) or (m in [mpOpen,mpNotReady]) then
s := ' '
else
s := Format( '%2d ', [TrackOrder[i]] );
if TrackOrder[i] = oldTrack then
begin
rx := x;
rs := Format( '%2d', [TrackOrder[i]] );
f := True;
end;
Canvas.TextOut( x, 68, s );
Inc( x, 18 );
end;
if f then
begin
Canvas.Font.Color := clRed;
Canvas.TextOut( rx, 68, rs );
end;
end;

{$R *.DFM}

procedure TCDPlayerForm.ImageBtnClick( Sender: TObject );
begin
// CDPlayerAction(TImage(Sender).Tag);
CDPlayerAction( TImage(Sender) );
end;

procedure TCDPlayerForm.ImagePlayBtnMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Player.Mode = mpPlaying then
LoadBtnBmp( ImagePlayBtn, 'playbau' )
else
LoadBtnBmp( ImagePlayBtn, 'playbu' );
end;

procedure TCDPlayerForm.ImagePlayBtnMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Player.Mode = mpPlaying then
LoadBtnBmp( ImagePlayBtn, 'playbad' )
else
LoadBtnBmp( ImagePlayBtn, 'playbd' );
end;

function TCDPlayerForm.GetUserTracks: Integer;
begin
Result := Player.Tracks;
end;

procedure TCDPlayerForm.FormShow(Sender: TObject);
begin
if FirstShow then
begin
PreviewMode := False;
RandomMode := False;
Canvas.Font.Name := 'Arial';
Color := clWindowText;
{ Color := clNone;}
CDTimer.Enabled := True;
Player.TimeFormat := tfTMSF;
CDTimer.Enabled := False;
try
Player.Open;
except
on EMCIDeviceError do
begin
Application.MessageBox( '请关闭其他使用中的CD播放程式.', 'Solar HiFi',
MB_APPLMODAL + MB_ICONWARNING + MB_OK );
Application.Terminate;
end;
end;
CDTimer.Enabled := True;
UserTracks := GetUserTracks;
GetTotalTime;
oldTime := 0;
oldTrack := 0;
PMode := Player.Mode;
if Player.Mode = mpPlaying then
begin
LoadBtnBmp( ImagePlayBtn, 'playbau' );
ImagePlayArrow.Visible := True;
end
else
LoadBtnBmp( ImagePlayBtn, 'playbu' );
PlayTrack := Lo(Player.Position);
end;
end;

procedure TCDPlayerForm.PlayerNotify(Sender: TObject);
begin
DrawTrackAndTime;
Player.Notify := True;
end;

function TCDPlayerForm.GetTrackIndex(track: Integer): Integer;
var
i: Integer;
begin
for i := 1 to UserTracks do
begin
if track = TrackOrder[i] then
begin
Result := i;
Exit;
end;
end;
end;

procedure TCDPlayerForm.GetNewCDInfo;
begin
while ( Player.Mode in [mpOpen, mpNotReady]) do;
GetTotalTime;
UserTracks := GetUserTracks;
oldTime := 0;
oldTrack := 0;
PMode := Player.Mode;
if RandomMode then CDRandom;
DrawTrackAndTime;
DrawTrack;
end;

procedure TCDPlayerForm.CDTimerTimer(Sender: TObject);
var
t: Integer;
ff, f: boolean;
begin
if (PMode = mpOpen) and (Player.Mode <> mpOpen) then
GetNewCDInfo;
with Player do
begin
tmp := Position;
ff := ((PreviewMode) and ((Hi(tmp) > 1) or (Lo(tmp shr 16) >= 20)));
f := (PlayTrack = TrackOrder[UserTracks]);
{ if ( (PlayTrack = TrackOrder[UserTracks]) and ((PlayTrack <> Lo(tmp)) or (ff)) ) or
( (Position = LastTrack) or ( (ff) and (Lo(tmp) = TrackOrder[UserTracks])) ) then}
{ if ( (PlayTrack = TrackOrder[UserTracks]) and ((PlayTrack <> Lo(tmp)) or (ff)) ) or
( (Position = LastTrack) and (RandomMode = False) ) then}
if ( (f) and ((PlayTrack <> Lo(tmp)) or (ff)) ) or
( (PMode = mpPlaying) and (Player.Mode = mpStopped) ) then
begin
ff := False;
if RandomMode then
begin
t := GetTrackIndex( PlayTrack );
if t <> UserTracks then
StartPos := TrackPosition[TrackOrder[t + 1]]
else
StartPos := TrackPosition[TrackOrder[1]];
Play;
{ Stop;}
end
else
Rewind;

if ImageRepeat.Visible = True then
begin
ImagePlayArrow.Visible := True;
Play;
end
else
begin
Stop;
ImagePlayArrow.Visible := False;
LoadBtnBmp( ImagePlayBtn, 'playbu' );
PMode := mpStopped;
end;
PlayTrack := Lo(Position);
end;
if (ImageRepeatOnce.Visible = True) and (Lo(tmp) <> RepeatTrack) then
begin
StartPos := TrackPosition[RepeatTrack];
Play;
end;
{ if (RandomMode = True) and (Lo(tmp) <> PlayTrack) then}
if ff or ((RandomMode = True) and (Lo(tmp) <> PlayTrack)) then
begin
t := GetTrackIndex( PlayTrack );
PlayTrack := TrackOrder[t + 1];
StartPos := TrackPosition[PlayTrack];
Play;
end;
end;
DrawTrackAndTime;
{ if Player.Mode = mpPlaying then
begin
Top := Top + ddy;
ddy := ddy * -1;
end;}
end;

procedure TCDPlayerForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CDTimer.Enabled := False;
Player.Close;
end;

procedure TCDPlayerForm.FormPaint(Sender: TObject);
begin
if TaskIconed then
begin
TaskIconed := False;
Application.Title := 'Solar HiFi';
oldTime := 0;
oldTrack := 0;
end;
Canvas.Draw( 0, 0, BackGround );
ShowTimeMode;
OldTime := 0;
DrawTrackAndTime;
DrawTrack;
end;

procedure TCDPlayerForm.FormCreate(Sender: TObject);
var
i: Integer;
hMenu: HMENU;
p: Cardinal;
ip: PTImage;
begin
ddy := 1;
for i := 1 to 40 do
TrackOrder[i] := i;
Randomize;
FirstShow := True;
BeginDrag := False;
TaskIconed := False;
BackGround := TBitmap.Create;
BackGround.LoadFromResourceName( HInstance, 'BACKGROUND' );
Screen.Cursors[crMyCursor] := LoadCursor( HInstance, 'CD_CURSOR' );
p := Cardinal( @ImagePlayBtn );
i := 0;
while p <= Cardinal( @ImageEjectBtn ) do
begin
PTImage( p )^.Cursor := crMyCursor;
PTImage( p )^.Tag := i;
Inc( i );
Inc( p, sizeof( PTImage ) );
end;
Application.OnMessage := AppMessage;
{ hMenu := GetSystemMenu( Application.handle, FALSE );
AppendMenu( hMenu, MF_SEPARATOR, 0, NIL );
AppendMenu( hMenu, MF_BITMAP, IDM_PLAY, PChar( ImagePlayArrow.Picture.Bitmap.Handle) );
}
end;

procedure TCDPlayerForm.FormDestroy(Sender: TObject);
begin
DestroyCursor( crMyCursor );
BackGround.Destroy;
end;

procedure TCDPlayerForm.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
BeginDrag := True;
bx := x;
by := y;
end;
end;

procedure TCDPlayerForm.Move( dx: Integer; dy: Integer );
begin
Left := Left + dx;
Top := Top + dy;
Lf1.Left := Left + 7;
Lf1.Top := Top + 137;
Lf2.Left := Left;
Lf2.Top := Top + 136 + 4;
Rf1.Left := Left + 462;
Rf1.Top := Lf1.Top;
Rf2.Left := Left + 455;
Rf2.Top := Lf2.Top;
end;

procedure TCDPlayerForm.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if BeginDrag then
Move( x - bx, y - by );
end;

procedure TCDPlayerForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
BeginDrag := False;
ShowTimeMode;
DrawTrack;
Move( 0, 0 );
ddy := 1;
end;
end;

procedure TCDPlayerForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.message = WM_SYSCOMMAND) and (Msg.wParam = SC_MINIMIZE) and (Msg.hwnd = Application.Handle) then
begin
TaskIconed := True;
end;
end;

procedure TCDPlayerForm.ImageBtnMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
p: PTImage;
begin
p := PTImage( Cardinal(@ImagePlayBtn) + TImage(Sender).Tag * sizeof(PTImage) );
LoadBtnBmp( P^, btnResName2[p^.Tag] );
end;

procedure TCDPlayerForm.ImageBtnMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
p: PTImage;
begin
p := PTImage( Cardinal(@ImagePlayBtn) + TImage(Sender).Tag * sizeof(PTImage) );
LoadBtnBmp( P^, btnResName1[p^.Tag] );
end;

end.

[Sephil]

结！