unit main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.Ani,
FMX.Objects, Windows, Messages, WinInet, ShellAPI,
IdBaseComponent, IdComponent, IdTCPConnection, IdHTTP, Bass,
GetXML, XMLIntf, XMLDoc, IdTCPClient, FMX.Grid;
type
TfrmMain =
class(TForm)
StyleUnit: TStyleBook;
panDisplay: TPanel;
pbVolumeWheel: TArcDial;
btPlay: TButton;
btStop: TButton;
btMute: TButton;
btRec: TButton;
btConfig: TButton;
btTracklist: TButton;
btOverview: TButton;
lbLcdName: TLabel;
lbInfoStream: TLabel;
lbLcdArtist: TLabel;
bg_tile: TBrushObject;
panNavi: TImageControl;
panPlayer: TLayout;
glyphPlay: TImage;
glyphStop: TImage;
glyphMute: TImage;
glyphRec: TImage;
imgControlBackground: TImage;
imgHeader: TImage;
panMain: TLayout;
imgPortBG: TImage;
imgPort: TImage;
IdHTTP1: TIdHTTP;
TtUpdate: TTimer;
panOverview: TLayout;
imgPort1: TImageControl;
imgPort2: TImageControl;
imgPort3: TImageControl;
imgPort4: TImageControl;
imgPort5: TImageControl;
imgPort6: TImageControl;
lbVolMax: TLabel;
lbVolMin: TLabel;
lbStreamBit: TLabel;
Label1: TLabel;
sgOverview: TStringGrid;
sgCell1: TStringColumn;
sgCell2: TStringColumn;
sgCell3: TStringColumn;
sgCell4: TStringColumn;
sgCell5: TStringColumn;
sgCell6: TStringColumn;
panMainOut: TFloatAnimation;
panOverviewOut: TFloatAnimation;
panMainIn: TFloatAnimation;
panOverviewIn: TFloatAnimation;
imgHeaderIn: TFloatAnimation;
imgHeaderOut: TFloatAnimation;
btClose: TButton;
lbStreamDuration: TLabel;
lbStreamListener: TLabel;
pbDuration: TProgressBar;
lbStreamTime: TLabel;
aniIndicator: TAniIndicator;
aniIndicatorFadeOut: TFloatAnimation;
aniIndicatorFadeIn: TFloatAnimation;
procedure FormCreate(Sender: TObject);
procedure btCloseClick(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure btTracklistClick(Sender: TObject);
procedure imgPortClick(Sender: TObject);
procedure TtUpdateTimer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btMuteClick(Sender: TObject);
procedure btConfigClick(Sender: TObject);
procedure btPlayClick(Sender: TObject);
procedure imgPort1Click(Sender: TObject);
procedure btRecClick(Sender: TObject);
procedure pbVolumeWheelChange(Sender: TObject);
procedure btOverviewClick(Sender: TObject);
procedure panMainInFinish(Sender: TObject);
procedure imgHeaderOutFinish(Sender: TObject);
// --
procedure InitBassPlugin;
procedure RegisterHotkeys;
procedure LoadConfig;
procedure LoadTracklist;
procedure InsertIntoTracklist(radio:integer; artist, song:
string);
private
{ Private-Deklarationen }
//procedure WmHotkey(var Msg: TMessage); message WM_HOTKEY;
public
{ Public-Deklarationen }
end;
type
TAccount =
record
email,
password :
string[100];
end;
type
THotkey =
record
key : integer;
modifier :
string[5];
end;
type
TCfg =
record
// Allg Opt
progcheck,
hotkeys,
profilelink,
visualize,
// Stream Opt
autoupdate,
short_tracklist,
nowplaying,
// Autostart Opt
autostart,
autoplay,
showsplash,
minimized : boolean;
// Arrays/Records/Misc
account : TAccount;
hotkeylist :
array[0..100]
of THotkey;
autoplradio,
volume,
metaintervall : integer;
logdir,
recdir :
string[255];
stream_codec :
string[3];
end;
type
TProgramm =
record
version,
build :
string[5];
end;
type
TTracklist =
record
moderator,
show,
artist,
song,
time,
date :
string[50];
end;
type
TRadio =
record
name,
moderator,
show,
start,
stop,
artist,
song,
listener :
string[50];
modpicurl,
profileurl :
string;
tracklist :
array of TTracklist;
end;
var
// Multithreading
cthread : DWORD = 0;
mthread : DWORD = 0;
// Form
frmMain : TfrmMain;
mHandle : THandle;
// Radiodata
playID : integer = 0;
showID : integer = 1;
// Saving the actual playing Radio Infos
cfg : TCfg;
temp :
string;
rdata :
array[1..6]
of TRadio;
{ 1. Technobase.FM 2. HouseTime.FM 3. HardBase.FM 4. TranceBase.FM 5. CoreTime.FM 6. ClubBase.FM 0. NO RADIO PLAYING}
// Visual
portrait :
array [1..6]
of TImageControl;
// --
chan : HSTREAM = 0;
fRec : TFileStream;
DoRec : boolean = False;
IsMute : boolean = False;
const
WM_INFO_UPDATE = WM_USER + 101;
dax:
string = ('
http://tray.technobase.fm/radio.xml');
// URL to Datafile
tlx:
array[1..6]
of string = (
'
http://tray.technobase.fm/tracklist-5.xml',
'
http://tray.technobase.fm/tracklist-6.xml',
'
http://tray.technobase.fm/tracklist-7.xml',
'
http://tray.technobase.fm/tracklist-8.xml',
'
http://tray.technobase.fm/tracklist-10.xml',
'
http://tray.technobase.fm/tracklist-11.xml');
prog: TProgramm = (version : '
2.20'; build : '
1250');
// ---
hq_mp3_url:
array[1..6]
of AnsiString = (
// URLs to NetRadio Stream -> HD Quality MP3 Codec
'
http://listen.technobase.fm/dsl.pls',
'
http://listen.housetime.fm/dsl.pls',
'
http://listen.hardbase.fm/dsl.pls',
'
http://listen.trancebase.fm/dsl.pls',
'
http://listen.coretime.fm/dsl.pls',
'
http://listen.clubtime.fm/dsl.pls');
hq_aac_url:
array[1..6]
of AnsiString = (
// URLs to NetRadio Stream -> HD Quality AAC Codec
'
http://listen.technobase.fm/aacplus.pls',
'
http://listen.housetime.fm/aacplus.pls',
'
http://listen.hardbase.fm/aacplus.pls',
'
http://listen.trancebase.fm/aacplus.pls',
'
http://listen.coretime.fm/aacplus.pls',
'
http://listen.clubtime.fm/aacplus.pls');
implementation
{$R *.fmx}
uses config, error, splash, minimode, tracklist;
{---
--
Section for Playing & Recording the Internet Streams
--
---}
function GetRecFileName:
string;
var stream:
string;
begin
case playID
of
1: stream:='
tb';
2: stream:='
ht';
3: stream:='
hb';
4: stream:='
trb';
5: stream:='
ct';
6: stream:='
clt';
else stream:='
none';
end;
// Create Record Dir in case its not already there
if not DirectoryExists(cfg.recdir)
then
CreateDir(cfg.recdir);
// Callback the Filename
Result:=cfg.recdir+FormatDateTime('
yyyy.mm.dd', Now)+'
_'+FormatDateTime('
hh-nn', Now)+'
_'+stream+'
.mp3'
end;
function CalculateDurationLeft(start, stop:
string):
string;
var sto_int, now_h_int, now_m_int, h_left, m_left:integer;
begin
sto_int:=strtoint(stop);
now_h_int:=strtoint(FormatDateTime('
hh', Now));
now_m_int:=strtoint(FormatDateTime('
nn', Now));
h_left:=(sto_int-now_h_int) - 1;
m_left:=60-now_m_int;
Result:=inttostr(h_left)+'
:'+inttostr(m_left);
end;
function CalculateDurationPercent(start, stop:
string):integer;
var sto_int, sta_int, dura, now_h_int, now_m_int, h_left, m_left:integer;
begin
sto_int:=strtoint(stop);
sta_int:=strtoint(start);
now_h_int:=strtoint(FormatDateTime('
hh', Now));
now_m_int:=strtoint(FormatDateTime('
nn', Now));
dura:=(sto_int-sta_int)*60;
h_left:=(sto_int-now_h_int) - 1;
m_left:=(h_left*60)+(60-now_m_int);
Result:=round((1-(m_left / dura))*100);
end;
procedure StatusProc(buffer: Pointer; len, user: DWORD);
stdcall;
begin
{---
Recording the Internet Streams
---}
if not DoRec
then
begin
fRec.Free;
fRec:=nil;
// change Button skin
frmMain.btRec.StaysPressed:=False;
exit;
end else
begin
// change Button skin
frmMain.btRec.StaysPressed:=True;
end;
if (fRec =
nil)
then
fRec:= TFileStream.Create(GetRecFileName, fmCreate);
// create the file
if (buffer =
nil)
then
begin
fRec.Free;
// finished recording
fRec:=nil;
end else
fRec.
Write(buffer^, len);
end;
function OpenURL(
url: PAnsiChar): Integer;
var
icy: PAnsiChar;
Len, Progress: DWORD;
i: integer;
radname:
string;
begin
// frmMain.pgBufferBar.Enabled:=False;
Result := 0;
progress := 0;
// frmMain.lbInfosend.Caption := 'Status: -';
chan := BASS_StreamCreateURL(
url, 0, BASS_STREAM_STATUS, @StatusProc,
NIL);
if (chan = 0)
then
begin
//lets catch the error here inside the Thread
// frmMain.lbInfosend.Caption := 'Status: -';
end
else
begin
// Progress
repeat
len := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END);
if (len = DW_Error)
then break;
progress := (BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) -
BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT)) * 100
div len;
// percentage of buffer filled
until progress > 99;
// get the broadcast name and bitrate
icy := BASS_ChannelGetTags(chan, BASS_TAG_ICY);
while (icy^ <> #0)
do
begin
if (Copy(icy, 1, 9) = '
icy-name:')
then
begin
RadName:=StringReplace(Copy(icy, 10, MaxInt),'
&','
and',[rfReplaceAll, rfIgnoreCase]);
// frmMain.lbInfosend.Caption := 'Status: '+RadName;
end
else if (Copy(icy, 1, 7) = '
icy-br:')
then
frmMain.lbStreamBit.Text :='
Bitrate: '+Copy(icy, 8, MaxInt)+'
k';
icy := icy + Length(icy) + 1;
end;
// frmMain.pgBufferBar.Position:=volpeak;
// play it!
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, 0);
BASS_ChannelPlay(chan, FALSE);
BASS_ChannelSlideAttribute(chan, BASS_ATTRIB_VOL, (0.5), 3000);
end;
cthread := 0;
// frmMain.pgBufferBar.Enabled:=True;
end;
{---
--
Collecting Information from radio.xml
--
---}
procedure TfrmMain.InsertIntoTracklist(radio: integer; artist, song:
string);
var pos : integer;
begin
if (artist = '
-')
and (song = '
-')
then exit;
if rdata[radio].tracklist =
nil then SetLength(rdata[radio].tracklist, 1);
pos:=length(rdata[radio].tracklist);
if (rdata[radio].tracklist[pos-1].artist <> artist)
or (rdata[radio].tracklist[pos-1].song <> song)
then
begin
setlength(rdata[radio].tracklist, pos+1);
rdata[radio].tracklist[pos].moderator:=rdata[radio].moderator;
rdata[radio].tracklist[pos].show:=rdata[radio].show;
// ---
rdata[radio].tracklist[pos].artist:=artist;
rdata[radio].tracklist[pos].song:=song;
rdata[radio].tracklist[pos].time:=FormatDateTime('
hh:mm', Time);
rdata[radio].tracklist[pos].date:=FormatDateTime('
dd.mm.yyyy', Date);
end;
// Versuche die Tracklist automatisch zu aktualisieren, wenn geöffnet
try
// if frmTracklist.Visible then frmTracklist.LoadTracklist;
except end;
end;
procedure UrlToImage(Img: TImageControl;
URL:
string);
var mStr: TMemoryStream;
begin
try
DeleteUrlCacheEntry(PWideChar(
url));
mStr := TMemoryStream.Create;
frmMain.IdHTTP1.Get(PWideChar(
url), mStr);
mStr.Seek(0, soFromBeginning);
Img.Bitmap.LoadFromStream(mStr);
finally
mStr.Free;
end;
end;
procedure SetHeaderImage(Img: TImage; Radio: integer);
var rStr: TResourceStream;
begin
try
case radio
of
1: rStr := TResourceStream.Create(hInstance, '
TB_logo', RT_RCDATA);
2: rStr := TResourceStream.Create(hInstance, '
HT_logo', RT_RCDATA);
3: rStr := TResourceStream.Create(hInstance, '
HB_logo', RT_RCDATA);
4: rStr := TResourceStream.Create(hInstance, '
TRB_logo', RT_RCDATA);
5: rStr := TResourceStream.Create(hInstance, '
CT_logo', RT_RCDATA);
6: rStr := TResourceStream.Create(hInstance, '
CLT_logo', RT_RCDATA);
end;
rStr.Position:=0;
Img.Bitmap.LoadFromStream(rStr);
finally
rStr.Free;
end;
end;
procedure UpdateDisplay(id: integer);
var I : integer;
begin
// Displaying fetched Information
for i := 1
to 6
do
begin
frmMain.sgOverview.Columns[i-1].Header:=rdata[i].
name;
frmMain.sgOverview.Cells[i-1,0]:=rdata[i].moderator;
frmMain.sgOverview.Cells[i-1,1]:=rdata[i].show;
frmMain.sgOverview.Cells[i-1,2]:=rdata[i].artist;
frmMain.sgOverview.Cells[i-1,3]:=rdata[i].song;
frmMain.sgOverview.Cells[i-1,4]:='
von '+rdata[i].start+'
:00 bis '+rdata[i].stop+'
:00';
end;
SetHeaderImage(frmMain.imgHeader, id);
frmMain.imgPort.Bitmap:=portrait[id].Bitmap;
frmMain.lbLcdName.Text:=rdata[id].moderator+'
- '+rdata[id].show;
frmMain.lbLcdArtist.Text:=rdata[id].artist+'
- '+rdata[id].song;
if (rdata[id].start = '
0')
and (rdata[id].stop = '
0')
then
frmMain.lbStreamDuration.Text:='
Dauer: nicht vorhanden'
else
begin
frmMain.lbStreamTime.Text:=rdata[id].start+'
:00 Uhr bis '+rdata[id].stop+'
:00 Uhr';
frmMain.lbStreamDuration.Text:='
Restzeit: '+CalculateDurationLeft(rdata[id].start, rdata[id].stop);
frmMain.pbDuration.Value:=CalculateDurationPercent(rdata[id].start, rdata[id].stop);
end;
frmMain.lbStreamListener.Text:='
Listener: '+rdata[id].listener;
end;
function UpdateMetatags : integer;
var i : integer;
mStr : TStream;
xmldoc : IXMLDocument;
begin
xmldoc := newXMLDocument;
try
frmMain.IdHTTP1.Request.UserAgent := '
Mozilla/5.0 (Windows NT 6.1; WOW64; rv:2.0) Gecko/20100101 Firefox/4.0';
except
frmMain.IdHTTP1.Request.UserAgent := '
Mozilla/3.0 (compatible; Indy Library)';
end;
try
try
DeleteUrlCacheEntry(PWideChar(dax));
mStr := TMemoryStream.Create;
frmMain.IdHTTP1.Get(PWideChar(dax), mStr);
// ---
xmldoc.LoadFromStream(mStr);
finally
mStr.Free;
end;
except
// Integratet GetXML Tool (collect Info by each WeaReoNe Radio Site) written by Felix Rudat ;)
if not GetMetatagsXML
then
begin
//Abbruch Download & Data Parsing
frmMain.TtUpdate.Enabled:=False;
// Deaktivieren des Autoupdates
frmMain.lbInfoStream.Text:='
Datenquellen nicht erreichbar und Direktabfrage über Hompage fehlgeschlagen.';
exit;
end else
try
xmldoc.LoadFromFile(temp+
xml);
except
//Abbruch Download & Data Parsing
frmMain.TtUpdate.Enabled:=False;
// Deaktivieren des Autoupdates
frmMain.lbInfoStream.Text:='
Datenquellen nicht erreichbar und Direktabfrage über Hompage fehlgeschlagen.';
exit;
end;
end;
// Data Parsing
xmldoc.Active:=True;
for i := 1
to 6
do
begin
rdata[i].
name:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
name'].Text;
rdata[i].moderator:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
moderator'].Text;
rdata[i].show:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
show'].Text;
rdata[i].start:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
starttime'].Text;
rdata[i].stop:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
endtime'].Text;
rdata[i].profileurl:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
link'].Text;
rdata[i].modpicurl:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
picture'].Text;
rdata[i].artist:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
artist'].Text;
rdata[i].song:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
song'].Text;
rdata[i].listener:=xmldoc.DocumentElement.ChildNodes[i-1].ChildNodes['
listener'].Text;
if rdata[i].moderator = '
'
then rdata[i].moderator:='
Playlist';
if rdata[i].show = '
'
then rdata[i].show:='
Mixed Styles';
if rdata[i].artist = '
'
then rdata[i].artist:='
-';
if rdata[i].song = '
'
then rdata[i].song:='
-';
end;
for i := 1
to 6
do
UrlToImage(portrait[i], rdata[i].modpicurl);
// Update Display
UpdateDisplay(showID);
// Insert Song in Tracklist
if not cfg.short_tracklist
then
begin
for i := 1
to 6
do
frmMain.InsertIntoTracklist(i, rdata[i].artist, rdata[i].song);
end else
frmMain.InsertIntoTracklist(playID, rdata[playID].artist, rdata[playID].song);
// Updating the Minitray Infos
try
// frmMinimode.Update;
except
exit;
end;
if mthread <> 0
then mthread:=0;
end;
procedure TfrmMain.TtUpdateTimer(Sender: TObject);
var ThreadId : cardinal;
begin
if (mthread <> 0)
then exit
else mthread := BeginThread(
nil, 0, @UpdateMetatags,
nil, 0, ThreadId);
end;
{---
--
Programm loading Stage!
--
---}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
temp:=GetEnvironmentVariable('
TEMP')+'
\';
portrait[1]:=frmMain.imgPort1;
portrait[2]:=frmMain.imgPort2;
portrait[3]:=frmMain.imgPort3;
portrait[4]:=frmMain.imgPort4;
portrait[5]:=frmMain.imgPort5;
portrait[6]:=frmMain.imgPort6;
// little predefined Trash
panMain.Position.X:=-1000;
imgHeader.Opacity:=0;
sgOverview.Selected:=5;
aniIndicator.Opacity:=0;
try
// load the Config and Hotkeys
LoadConfig;
// load Tracklist
LoadTracklist;
finally
// init the netstream playing plugin BASS
InitBassPlugin;
// register all nescesary hotkeys
RegisterHotkeys;
// Fetching first Streamtags
UpdateMetatags;
// Set last Infos
pbVolumeWheel.value:=cfg.volume;
// Setting up Configs
{ Autoupdate }
TtUpdate.Interval:=cfg.metaintervall;
TtUpdate.Enabled:=cfg.autoupdate;
{ Autoplay }
if cfg.autoplay
then
begin
case cfg.autoplradio
of
1:
begin
imgPort1Click(imgPort1);
btPlayClick(btPlay);
end;
2:
begin
imgPort1Click(imgPort2);
btPlayClick(btPlay);
end;
3:
begin
imgPort1Click(imgPort3);
btPlayClick(btPlay);
end;
4:
begin
imgPort1Click(imgPort4);
btPlayClick(btPlay);
end;
5:
begin
imgPort1Click(imgPort5);
btPlayClick(btPlay);
end;
6:
begin
imgPort1Click(imgPort6);
btPlayClick(btPlay);
end;
end;
end;
end;
end;
procedure TfrmMain.LoadConfig;
var f:
File of TCfg;
begin
try
AssignFile(f, '
config.cfg');
{ READ CONFIG FILE AND ADD }
Reset(f);
read(f, cfg);
CloseFile(f);
except
// Allg Opt
cfg.progcheck:=True;
{ FAIL SAVE DEFAULTS }
cfg.hotkeys:=False;
cfg.profilelink:=True;
cfg.visualize:=False;
cfg.volume:=15;
// Stream Opt
cfg.autoupdate:=True;
cfg.metaintervall:=90000;
cfg.short_tracklist:=False;
cfg.nowplaying:=True;
cfg.stream_codec:='
mp3';
cfg.logdir:=ExtractFilePath(ParamStr(0))+'
log\';
cfg.recdir:=ExtractFilePath(ParamStr(0))+'
record\';
// Account Opt
cfg.account.email:='
';
cfg.account.password:='
';
// Autostart Opt
cfg.autostart:=False;
cfg.autoplay:=False;
cfg.minimized:=False;
cfg.showsplash:=True;
AssignFile(f, '
config.cfg');
Rewrite(f);
write(f, cfg);
CloseFile(f);
ShowMessage('
Keine oder fehlerhafte Konfigurationsdatei gefunden! Standart Datei wurde erstellt.');
end;
end;
procedure TfrmMain.LoadTracklist;
var f :
File of TTracklist;
flist : TStrings;
j,i : integer;
begin
try
try
flist:= TStringList.Create;
flist.Add(#0);
flist.Add(temp+'
tracklist_tb.tmp');
flist.Add(temp+'
tracklist_ht.tmp');
flist.Add(temp+'
tracklist_hb.tmp');
flist.Add(temp+'
tracklist_trb.tmp');
flist.Add(temp+'
tracklist_ct.tmp');
flist.Add(temp+'
tracklist_clt.tmp');
for j := 1
to 6
do
begin
if FileExists(flist[j])
then
begin
i:=0;
AssignFile(f, flist[j]);
Reset(f);
while not EoF(f)
do
begin
SetLength(rdata[j].tracklist, i+1);
read(f, rdata[j].tracklist[i]);
inc(i);
end;
if rdata[j].tracklist[1].date <> datetostr(Date)
then // Erster Datensatz vom gleichen Tag?
begin
rdata[j].tracklist:=
nil;
break;
// Nein? Neue Tracklist!
end;
CloseFile(f);
DeleteFile(PWideChar(flist[j]));
end;
end;
finally
flist.Free
end;
except
// Lade 50 Tracks von WeaReoNe Servern
// frmTracklist.SyncTracklist;
end;
end;
procedure TfrmMain.InitBassPlugin;
begin
// check the correct BASS was loaded
if (HIWORD(BASS_GetVersion) <> BASSVERSION)
then
begin
MessageBox(0, '
Falsche Version der BASS.DLL, eine Neuinstallation könnte das Problem beheben.',
nil, MB_ICONERROR);
Halt;
end;
if (
not BASS_Init(-1, 44100, 0,
Handle,
nil))
then
begin
MessageBox(0, '
Audioausgabegerät konnte nicht initialisiert werden!',
nil, MB_ICONERROR);
Halt;
end;
BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
// enable playlist processing
BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
// minimize automatic pre-buffering, so we can do it (and display it) instead
BASS_SetConfigPtr(BASS_CONFIG_NET_PROXY,
nil);
// setup proxy server location
end;
procedure TfrmMain.RegisterHotkeys;
var i : integer;
begin
if cfg.hotkeys
then
begin
for i := 0
to length(cfg.hotkeylist) - 1
do
begin
if (cfg.hotkeylist[i].modifier <> '
')
and (cfg.hotkeylist[i].key <> 0)
then
begin
if LowerCase(cfg.hotkeylist[i].modifier) = '
kein'
then
RegisterHotKey(
Handle, i, 0, cfg.hotkeylist[i].key);
if LowerCase(cfg.hotkeylist[i].modifier) = '
shift'
then
RegisterHotKey(
Handle, i, MOD_SHIFT, cfg.hotkeylist[i].key);
if LowerCase(cfg.hotkeylist[i].modifier) = '
strg'
then
RegisterHotKey(
Handle, i, MOD_CONTROL, cfg.hotkeylist[i].key);
if LowerCase(cfg.hotkeylist[i].modifier) = '
alt'
then
RegisterHotKey(
Handle, i, MOD_ALT, cfg.hotkeylist[i].key);
end;
end;
end;
end;
{---
--
Object Programming - Hotkeys and its functions
--
---}
{procedure TfrmMain.WmHotkey(var Msg: TMessage);
begin
// Play TechnoBase.FM
if (Msg.WParam = 0) then
begin
btPlayClick(btPlay);
end;
// Play HouseTime.FM
if (Msg.WParam = 1) then
begin
btPlayClick(btPlay);
end;
// Play HardBase.FM
if (Msg.WParam = 2) then
begin
btPlayClick(btPlay);
end;
// Play TranceBase.FM
if (Msg.WParam = 3) then
begin
btPlayClick(btPlay);
end;
// Play CoreTime.FM
if (Msg.WParam = 4) then
begin
btPlayClick(btPlay);
end;
// Play ClubTime.FM
if (Msg.WParam = 5) then
begin
btPlayClick(btPlay);
end;
// Switch to Minimized / TrayIcon
if (Msg.WParam = 6) then
begin
if not IsIconic(Application.Handle) then
begin
frmTrayInfo.spTrayIcon.Visible:=True;
Application.MainForm.Hide;
// fix minitray bug
Application.Minimize;
end else
begin
frmTrayInfo.spTrayIcon.Visible:=False;
Application.MainForm.Show;
// fix minitray bug
Application.Restore;
ForceForegroundWindow(frmMain.Handle);
end;
end;
// Stop Stream
if (Msg.WParam = 7) then
begin
//btStopClick(btStop);
end;
// Controll - Vol louder
if (Msg.WParam = 8) then
begin
if pbVolumeWheel.Enabled then
begin
if cfg.volume <= 95 then
begin
cfg.volume:=cfg.volume+5;
pbVolumeWheel.value:=cfg.volume;
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, (cfg.volume / 100));
end;
end;
end;
// Controll - Vol quiter
if (Msg.WParam = 9) then
begin
if pbVolumeWheel.Enabled then
begin
if cfg.volume >= 5 then
begin
cfg.volume:=cfg.volume-5;
pbVolumeWheel.value:=cfg.volume;
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, (cfg.volume / 100));
end;
end;
end;
// Show Tracklist
if (Msg.WParam = 10) then
begin
if frmTracklist.Visible then frmTracklist.Hide else frmTracklist.Show;
end;
// Start / Stop Recording
if (Msg.WParam = 11) then
begin
if not DoRec then DoRec:=True else DoRec:=False;
end;
end; }
{---
--
Object Programming - Buttons and its functions
--
---}
procedure TfrmMain.btConfigClick(Sender: TObject);
begin
frmConfig.ShowModal;
end;
procedure TfrmMain.btMuteClick(Sender: TObject);
begin
// mute
if IsMute
then
begin
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, (cfg.volume / 100));
btMute.StaysPressed:=True;
pbVolumeWheel.Enabled:=True;
IsMute:=False;
end else
begin
BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, 0);
btMute.StaysPressed:=False;
pbVolumeWheel.Enabled:=False;
IsMute:=True;
end;
end;
procedure TfrmMain.btStopClick(Sender: TObject);
begin
if playID <> 0
then
begin
// Free Channel
BASS_StreamFree(chan);
lbInfoStream.Text:='
Wiedergabe beendet...';
lbStreamBit.Text:='
Bitrate: -';
playID:=0;
end;
end;
procedure TfrmMain.btTracklistClick(Sender: TObject);
begin
//if frmTracklist.Visible then frmTracklist.Hide else frmTracklist.Show;
end;
procedure TfrmMain.btPlayClick(Sender: TObject);
var
ThreadId: Cardinal;
stream : PAnsiChar;
begin
// Double selected? Record!
if showID = playID
then
begin
if not DoRec
then DoRec:=True
else DoRec:=False;
exit;
end;
// Stoppe Record wenn Streamswitch und Record aktiv
if showID <> playID
then
begin
if DoRec
then DoRec:=False;
end;
// Set the Stream declaired in Config
if cfg.stream_codec = '
mp3'
then stream:=PAnsiChar(hq_mp3_url[showID])
else stream:=PAnsiChar(hq_aac_url[showID]);
// Close old Stream
if playID <> 0
then btStopClick(Sender);
if (cthread <> 0)
then exit
else cthread := BeginThread(
nil, 0, @OpenURL, stream, 0, ThreadId);
playID:=showID;
// Setting Up playing Radio
end;
procedure TfrmMain.btRecClick(Sender: TObject);
begin
if DoRec
then DoRec:=False
else DoRec:=True;
end;
{ ---
Overview Panel <3 FireMonkey
--- }
procedure TfrmMain.imgPort1Click(Sender: TObject);
begin
showID:=TImage(Sender).Tag;
UpdateDisplay(showID);
if panOverviewOut.Enabled
then panOverviewOut.Enabled:=False;
if panMainIn.Enabled
then panMainIn.Enabled:=False;
panOverviewOut.Enabled:=True;
panMainIn.Enabled:=True;
end;
procedure TfrmMain.btOverviewClick(Sender: TObject);
begin
if imgHeaderOut.Enabled
then imgHeaderOut.Enabled:=False;
imgHeaderOut.Enabled:=True;
end;
procedure TfrmMain.panMainInFinish(Sender: TObject);
begin
if imgHeaderIn.Enabled
then imgHeaderIn.Enabled:=False;
imgHeaderIn.Enabled:=True;
end;
procedure TfrmMain.imgHeaderOutFinish(Sender: TObject);
begin
if panMainOut.Enabled
then panMainOut.Enabled:=False;
if panOverviewIn.Enabled
then panOverviewIn.Enabled:=False;
panMainOut.Enabled:=True;
panOverviewIn.Enabled:=True;
end;
// Portrait Links -> Open in Favorite Browser
procedure TfrmMain.imgPortClick(Sender: TObject);
begin
if cfg.profilelink
then
ShellExecute(
handle, '
open', PWideChar(rdata[showID].profileurl),
nil,
nil, SW_Show);
end;
{---
--
volpeak Stuff - Statusbar / Trackerbar
--
---}
procedure TfrmMain.pbVolumeWheelChange(Sender: TObject);
var didgit_vol:real;
didgit_val:single;
begin
didgit_val:=pbVolumeWheel.Value;
if didgit_val <= -120
then pbVolumeWheel.Value:= -120;
if didgit_val >= 120
then pbVolumeWheel.Value:= 120;
didgit_vol:= (didgit_val / 240) + 0.5;
if didgit_vol >= 1
then didgit_vol:= 1;
if didgit_vol <= 0
then didgit_vol:= 0;
//BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, didgit_vol);
cfg.volume:=round(didgit_vol * 100);
end;
{---
--
Close and Stop Threads!
--
---}
procedure TfrmMain.FormDestroy(Sender: TObject);
var i,j :integer;
f :
File of TTracklist;
flist : TStrings;
begin
// unleash Bass.dll
Bass_Free;
// Write Tracklists
try
flist:= TStringList.Create;
flist.Add(#0);
flist.Add(temp+'
tracklist_tb.tmp');
flist.Add(temp+'
tracklist_ht.tmp');
flist.Add(temp+'
tracklist_hb.tmp');
flist.Add(temp+'
tracklist_trb.tmp');
flist.Add(temp+'
tracklist_ct.tmp');
flist.Add(temp+'
tracklist_clt.tmp');
for j := 1
to 6
do
begin
AssignFile(f, flist[j]);
Rewrite(f);
if rdata[j].tracklist <>
nil then
begin
for i := 0
to length(rdata[j].tracklist) - 1
do
write(f, rdata[j].tracklist[i]);
end;
CloseFile(f);
end;
finally
flist.Free
end;
// Free Hotkeys
if cfg.hotkeys
then
begin
for i := 0
to length(cfg.hotkeylist) - 1
do
UnRegisterHotkey(
Handle, i);
end;
close;
end;
procedure TfrmMain.btCloseClick(Sender: TObject);
begin
Bass_Free;
close;
end;
// Handle all Exceptions
{procedure TfrmMain.AppEventsException(Sender: TObject; E: Exception);
var f : textfile;
begin
try
AssignFile(f, ExtractFilePath(ParamStr(0))+'errors.log');
if FileExists(ExtractFilePath(ParamStr(0)+'errors.log')) then Append(f) else Rewrite(f);
writeln(f, '['+FormatDateTime('dd.mm.yyyy', Date)+' '+FormatDateTime('hh:mm:ss', Time)+'] '+E.ToString+' ('+SysErrorMessage(GetLastError)+')');
CloseFile(f);
finally
//frmError.RaiseErrorCode(E.ToString, SysErrorMessage(GetLastError));
end;
end; }
// Doppelstarts verhindern
initialization
mHandle:=CreateMutex(
nil,True,'
Programmname');
if GetLastError=ERROR_ALREADY_EXISTS
then
begin
showmessage('
Eine andere Instanz des Programms läuft bereits!');
Halt;
end;
finalization
if mHandle <> 0
then CloseHandle(mHandle)
end.
Antwort
28. Jan 2012, 19:27
Zitat
Zitat:
Cross Platform Libraries with Firemonkey
Linear-Darstellung
