1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:

unit Player;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, MPlayer, ExtCtrls,
  MMSystem, ComCtrls, XPMan, SRValEdt, Scope2;

type
  TForm1 = class(TForm)
    OpenBitBtn1: TBitBtn;
    MediaPlayer: TMediaPlayer;
    PlayListBox: TListBox;
    OpenDialog: TOpenDialog;
    Panel: TPanel;
    TrackPosBar: TTrackBar;
    Timer: TTimer;
    OptionenBox: TGroupBox;
    LoopCheckBox: TCheckBox;
    Button1: TButton;
    VolumeScroll: TSliderEdit;
    XPManifest1: TXPManifest;
    indicator21: Tindicator2;
    procedure VolumeScrollClick(Sender: TObject; Button: TUDBtnType);
    procedure OpenBitBtn1Click(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure TrackPosBarChange(Sender: TObject);
    procedure LoopCheckBoxClick(Sender: TObject);
    procedure PlayListBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MediaPlayerNotify(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SendCopyData(hTargetWnd: HWND; ACopyDataStruct:TCopyDataStruct);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  procedure AddToPlayList(s:string);
  procedure PlayFile(s:string);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//Lautstärke- Funktionen:
const
  MCI_SETAUDIO = $0873;
  MCI_DGV_SETAUDIO_VOLUME = $4002;
  MCI_DGV_SETAUDIO_ITEM = $00800000;
  MCI_DGV_SETAUDIO_VALUE = $01000000;
  MCI_DGV_STATUS_VOLUME = $4019;

type
  MCI_DGV_SETAUDIO_PARMS = record
    dwCallback: DWORD;
    dwItem: DWORD;
    dwValue: DWORD;
    dwOver: DWORD;
    lpstrAlgorithm: PChar;
    lpstrQuality: PChar;
  end;

type
  MCI_STATUS_PARMS = record
    dwCallback: DWORD;
    dwReturn: DWORD;
    dwItem: DWORD;
    dwTrack: DWORD;
  end;

procedure SetVolume(MP: TMediaPlayer; Volume: Integer);
  { Volume: 0 - 1000 }
var
  p: MCI_DGV_SETAUDIO_PARMS;
begin
  { Volume: 0 - 1000 }
  p.dwCallback := 0;
  p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
  p.dwValue := Volume;
  p.dwOver := 0;
  p.lpstrAlgorithm := nil;
  p.lpstrQuality := nil;
  mciSendCommand(MP.DeviceID, MCI_SETAUDIO,
    MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p));
end;

function GetVolume(MP: TMediaPlayer): Integer;
var 
  p: MCI_STATUS_PARMS;
begin
  p.dwCallback := 0;
  p.dwItem := MCI_DGV_STATUS_VOLUME;
  mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p));
  Result := p.dwReturn;
  { Volume: 0 - 1000 }
end;
//Ende Lautstärke
var
  FileName: String;
  PlayList: TStringList;
  zeile   : Integer;

// Sender: Daten an Brennmodul Schicken (Für den Fehler unwichtig
// hier wird noch gebastelt.)
procedure TForm1.SendCopyData(hTargetWnd: HWND; ACopyDataStruct:TCopyDataStruct);
begin
  if hTargetWnd <> 0 then
    SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@ACopyDataStruct))
  else
    ShowMessage('Das Modul wurde nicht gefunden!');
end;

procedure TForm1.AddToPlayList(s:string);
begin
//Daten zur Playliste hinzufügen
   playList.Add(s);
   PlayListBox.Items.Add(s);
end;

procedure TForm1.PlayFile(s:string);
begin
mediaplayer.filename := s;
panel.caption := s;
mediaplayer.open;
mediaplayer.play;
trackposbar.Max := mediaplayer.Length;
timer.Enabled := true;
end;

procedure TForm1.OpenBitBtn1Click(Sender: TObject);
begin
if OpenDialog.execute then begin
filename := OpenDialog.FileName;
addtoplaylist(Filename);
playfile(FileName);
end
end;

procedure TForm1.PlayListBoxClick(Sender: TObject);
//Hier wird noch gearbeitet
  for i := 0 to listbox1.Count - 1 do
    if listbox1.Selected[i] then break;
  if fileexists(Playlist.Strings[i]) then  PlayFile(Playlist.Strings[i]);
  end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
//TrackBar auf MPlayer- Position setzen
trackposbar.position := mediaplayer.position;
end;

procedure TForm1.TrackPosBarChange(Sender: TObject);
begin
mediaplayer.position := trackposbar.Position;
end;

procedure TForm1.LoopCheckBoxClick(Sender: TObject);
begin
LoopCheckBox.Checked;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
PlayList:= TStringList.Create; // Instanz der playlist erzeugen
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
PlayList.Free; // Instanz der playlist wieder freigeben
end;

procedure TForm1.MediaPlayerNotify(Sender: TObject);
var
Loop    : Boolean;
begin
if LoopCheckBox.Checked then loop := true;
//Hier kommt noch Playlist- Code.
mediaplayer.Notify := Loop;
if MediaPlayer.Notify = True then
  begin
    MediaPlayer.Play;
  end else
  begin
      MediaPlayer.Stop;
  end;
end;

procedure TForm1.VolumeScrollClick(Sender: TObject; Button: TUDBtnType);
var
Volume: Integer;
begin
Volume := VolumeScroll.value;
SetVolume(MediaPlayer, Volume);
end;
//Jetzt kommt für den Fehler unwichtiges, weil es aber wichtig sein //könnte habbichs hinzugefügt:

procedure TForm1.Button1Click(Sender: TObject);
// Daten von PlayListBox an andere Anwendung schicken
var
  MyCopyDataStruct: TCopyDataStruct;
  hTargetWnd: HWND;
begin
//Als erstes BurnIN.exe aufrufen:

{Hier Open- Code hinzufügen (Kommt später)}

  // TCopyDataStruct mit den Sende-Daten Infos ausfüllen
  with MyCopyDataStruct do
  begin
    dwData := 0;
    cbData := StrLen(PChar(PlayListBox.Items)) + 1;  //Need to transfer terminating #0 as well
    lpData := PChar(PlaylistBox.Items)
  end;
  // Empfänger Fenster anhand des Titelzeilentextes suchen
  hTargetWnd := FindWindow(nil,PChar('Merkur Player- CD Brennen'));
  // Daten Senden
  SendCopyData(hTargetWnd, MyCopyDataStruct);
end;

end.