unit main;
interface
uses
sharemem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, Bass, SDL_RasterLab;
type
TForm2 =
class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Panel3: TPanel;
Image6: TImage;
Image7: TImage;
Image8: TImage;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
Image9: TImage;
Image10: TImage;
Image11: TImage;
Image12: TImage;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
Panel4: TPanel;
CheckBox4: TCheckBox;
GroupBox2: TGroupBox;
CheckBox5: TCheckBox;
Panel5: TPanel;
Image13: TImage;
TrayIcon1: TTrayIcon;
opmu: TOpenDialog;
Listboxm2: TListBox;
GroupBox3: TGroupBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
listboxm1: TListView;
TabSheet5: TTabSheet;
Label5: TLabel;
listboxv1: TListView;
listboxv2: TListBox;
opvu: TOpenDialog;
GroupBox4: TGroupBox;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label9: TLabel;
Edit4: TEdit;
Label10: TLabel;
Edit5: TEdit;
Button2: TButton;
Label11: TLabel;
labelbitrate: TLabel;
Label12: TLabel;
RasterLab1: TRasterLab;
RasterLab2: TRasterLab;
Label1: TLabel;
Timer1: TTimer;
Label13: TLabel;
Label14: TLabel;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
GroupBox5: TGroupBox;
ComboBox1: TComboBox;
GroupBox6: TGroupBox;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Button1: TButton;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label21: TLabel;
GroupBox7: TGroupBox;
Image14: TImage;
ScrollBar1: TScrollBar;
CheckBox9: TCheckBox;
Timer2: TTimer;
procedure Image3Click(Sender: TObject);
procedure Image13Click(Sender: TObject);
procedure Image8Click(Sender: TObject);
procedure TrayIcon1DblClick(Sender: TObject);
procedure Image9Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Listboxm12DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image6Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure listboxm1DblClick(Sender: TObject);
procedure Image10Click(Sender: TObject);
procedure listboxm1Changing(Sender: TObject; Item: TListItem;
Change: TItemChange;
var AllowChange: Boolean);
procedure Image11Click(Sender: TObject);
procedure listboxv1DblClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure listboxm1Click(Sender: TObject);
procedure Image12Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure listboxv1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
const
ECHBUFLEN = 1200;
// buffer length
FLABUFLEN = 350;
// buffer length
private
strs:
array[0..128]
of HSTREAM;
strc: Integer;
procedure Error(msg:
string);
var pause:bool;
tempc,tempv,tempsel:integer;
first:bool;
tempfilename:
string;
setp,mause:boolean;
public
{ Public-Deklarationen }
end;
var
Form2: TForm2;
floatable: DWORD;
// floating-point channel support?
chan: DWORD;
// the channel... HMUSIC or HSTREAM
implementation
procedure addtemp(filename:
string);
stdcall;
external '
db_main.dll';
function savedbvideo(dbcount:Integer;Titel,Lenght,Bitrate,path:tstrings):boolean;
stdcall;
external '
db_main.dll';
function additem(
Name,Path,Interpret,Bitrate:
string):boolean;
stdcall;
external '
db_main.dll';
function savedb(dbcount:Integer;
Name,Path,Bitrate,Interpret:tstrings):boolean;
stdcall;
external '
db_main.dll';
function inifnset(Filename :
String):integer;
stdcall;
external '
db_main.dll';
function ID3(Filename:
string):Tstrings;
stdcall;
external '
ax_main.dll';
function listdbn():tstringlist;
stdcall;
external '
db_main.dll';
function listdbp():tstringlist;
stdcall;
external '
db_main.dll';
function listdbi():tstringlist;
stdcall;
external '
db_main.dll';
procedure omp(filename:
string);
stdcall;
external '
ax_main.dll';
function mpeg(Filename:
string):Tstrings;
stdcall;
external '
ax_main.dll';
function additemvideo(Titel,Lenght,Bitrate,path:
string):boolean;
stdcall;
external '
db_main.dll';
function inifnsetvideo(Filename :
String):integer;
stdcall;
external '
db_main.dll';
function listdbvt():tstringlist;
stdcall;
external '
db_main.dll';
function listdbvl():tstringlist;
stdcall;
external '
db_main.dll';
function listdbvb():tstringlist;
stdcall;
external '
db_main.dll';
function listdbvp():tstringlist;
stdcall;
external '
db_main.dll';
function saveid3(descriptions:tstrings):boolean;
stdcall;
external '
ax_main.dll';
function updsection(section:integer;setings:tstrings):boolean;
stdcall;
external '
db_main.dll';
function listdbb():tstringlist;
stdcall;
external '
db_main.dll';
{$R *.dfm}
procedure TForm2.Button2Click(Sender: TObject);
var desc:tstringlist;
begin
desc := tstringlist.Create;
////////////////////////ID3Tag Speichern/////////////////////////
desc.Add(Edit1.Text);
desc.Add(Edit2.Text);
desc.Add(Edit3.Text);
desc.Add(Edit4.Text);
desc.Add(Edit5.Text);
desc.Add(tempfilename);
saveid3(desc);
desc.Clear;
desc.Add(Edit1.Text);
desc.Add(Edit2.Text);
desc.Add(tempfilename);
desc.Add(labelbitrate.Caption);
updsection(tempsel,desc);
desc.Free;
////////////////////////END ID3 Speichern////////////////////////
end;
procedure TForm2.Error(msg:
string);
var
s:
string;
begin
s := msg + #13#10 + '
(Error code: ' + IntToStr(BASS_ErrorGetCode) + '
)';
MessageBox(
Handle, PChar(s),
nil, 0);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
if not opmu.Execute
then Exit;
end;
procedure TForm2.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Bass_Free;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
tempc:=inifnset('
testdb.ini');
tempv:=inifnsetvideo('
testvideodb.ini');
first := true;
// modc := 0; // music module count
// samc := 0; // sample count
strc := 0;
// stream count
// check the correct BASS was loaded
if (HIWORD(BASS_GetVersion) <> BASSVERSION)
then
begin
MessageBox(0,'
An incorrect version of BASS.DLL was loaded',
nil,MB_ICONERROR);
Halt;
end;
// Initialize audio - default device, 44100hz, stereo, 16 bits
if not BASS_Init(-1, 44100, 0,
Handle,
nil)
then
Error('
Error initializing audio!');
pause := false;
end;
procedure TForm2.FormShow(Sender: TObject);
var
ListItem: TListItem;
i:integer;
begin
if first = true
then begin
listboxm2.Items.AddStrings(listdbp());
i := 0;
repeat
begin
with listboxm1
do
begin
ListItem := Items.Add;
ListItem.Caption := listdbn.Strings[i];
ListItem.SubItems.Add(listdbi.Strings[i]);
ListItem.SubItems.Add(listdbb.Strings[i]);
end;
end;
i := i + 1;
until i = tempc;
label5.Caption := '
Datenbank erfolgreich geladen';
///////////////video Listing
listboxv2.Items.AddStrings(listdbvp());
i := 0;
repeat
begin
with listboxv1
do
begin
ListItem := Items.Add;
ListItem.Caption := listdbvt.Strings[i];
ListItem.SubItems.Add(listdbvb.Strings[i]);
end;
end;
i := i + 1;
until i = tempv;
//label5.Caption := 'Datenbank erfolgreich geladen';
end;
first := false;
end;
procedure TForm2.Image10Click(Sender: TObject);
var
i,ii:integer;
sln,sli,slb:tstringlist;
begin
if listboxm1.Items.Count = 1
then begin
MessageBox(0,'
You cant delet the last File!!',
nil,MB_ICONERROR);
exit;
end;
i := listboxm1.ItemIndex;
sln := tstringlist.Create;
sli := tstringlist.Create;
slb := tstringlist.Create;
////////Listboxen säubern :D/////
listboxm2.Items.Delete(i);
listboxm1.Items.Delete(i);
////////////////////////////////
ii := listboxm1.Items.Count;
i := 0;
///tempc beinhaltet die vorherige anzahl an items also eins mehr als jetzt vorhanden sind :D
repeat
sln.Add(listboxm1.Items.Item[i].Caption);
sli.Add(listboxm1.Items[i].SubItems[0]);
slb.Add(listboxm1.Items[i].SubItems[1]);
//ShowMessage('"' + listboxm1.Items[i].SubItems[0] + '"'); DEBUGGING !!!!! ;-)
i := i + 1;
until i = ii;
savedb(ii,sln,listboxm2.Items,slb,sli);
sln.Free;
sli.Free;
slb.Free;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TForm2.Image11Click(Sender: TObject);
var länge,Bitrate,
{newfilename, <-- Aufgeräumt}titel :
string;
listitem:tlistitem;
//i,ii:integer; Aufgeräumt :D
begin
Try
opvu.execute;
//ii := 0; <--- Aufgeräumt
//showmessage(inttostr(opmu.Files.Count));
bitrate := mpeg(opvu.FileName).Strings[2];
länge := mpeg(opvu.FileName).Strings[0];
titel := (ExtractFileName(opvu.FileName));
begin
with listboxv1
do
begin
ListItem := Items.Add;
ListItem.Caption := titel;
ListItem.SubItems.Add(länge);
end;
end;
listboxv2.Items.Add(opvu.FileName);
additemvideo(titel,länge,bitrate,opvu.FileName);
Finally
End;
end;
procedure TForm2.Image12Click(Sender: TObject);
var
i,ii:integer;
sln,sli:tstringlist;
begin
if listboxv1.Items.Count = 1
then begin
MessageBox(0,'
You cant delet the last File!!',
nil,MB_ICONERROR);
exit;
end;
i := listboxv1.ItemIndex;
sln := tstringlist.Create;
sli := tstringlist.Create;
////////Listboxen säubern :D/////
listboxv2.Items.Delete(i);
listboxv1.Items.Delete(i);
////////////////////////////////
ii := listboxv1.Items.Count;
i := 0;
///tempc beinhaltet die vorherige anzahl an items also eins mehr als jetzt vorhanden sind :D
repeat
sln.Add(listboxv1.Items.Item[i].Caption);
sli.Add(listboxv1.Items[i].SubItems[0]);
//ShowMessage('"' + listboxm1.Items[i].SubItems[0] + '"'); DEBUGGING !!!!! ;-)
i := i + 1;
until i = ii;
savedbvideo(ii,sln,sli,sli,listboxv2.Items);
////WICHTIG!!! Temporärer Fehler Länge wird mit Bitrate gefüllt!!!!!
sln.Free;
sli.Free;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TForm2.Image13Click(Sender: TObject);
begin
Form2.Height := 420;
Image13.Visible := False;
Image3.Visible := True;
end;
procedure TForm2.Image3Click(Sender: TObject);
begin
Form2.Height := 84;
Image3.Visible := False;
Image13.Visible := True;
end;
procedure TForm2.Image5Click(Sender: TObject);
begin
{if pause = true then begin
BASS_ChannelPlay(chan,false);
Label14.Caption := 'Play';
pause := false;
exit;
end;
if pause = false then begin
BASS_ChannelPause(chan);
Label14.Caption := 'Paused';
pause := true;
end; }
end;
procedure TForm2.Image6Click(Sender: TObject);
begin
BASS_ChannelStop(strs[0]);
end;
procedure TForm2.Image8Click(Sender: TObject);
begin
Form2.Hide;
TrayIcon1.Visible := True;
end;
procedure TForm2.Image9Click(Sender: TObject);
var titel,artist,bitrate :
string;
listitem:tlistitem;
//i,ii:integer; <--- Aufgeräumt :D
begin
Try
//opmu.Files.Capacity := 0;
opmu.execute;
//ii := 0; <---- Aufgeräumt ;-)
showmessage(inttostr(opmu.Files.Count));
titel := ID3(opmu.FileName).Strings[1];
artist := ID3(opmu.FileName).Strings[0];
bitrate := mpeg(opmu.FileName).Strings[2]+'
KBit/s';
//Bitrate
if ID3(opmu.FileName).Strings[1] = '
'
then begin
titel := (ExtractFileName(opmu.FileName));
artist:='
No ID3v2 Tag';
end;
begin
with listboxm1
do
begin
ListItem := Items.Add;
ListItem.Caption := titel;
ListItem.SubItems.Add(artist);
ListItem.SubItems.Add(bitrate);
end;
end;
listboxm2.Items.Add(opmu.FileName);
additem(Titel,opmu.FileName,artist,Bitrate);
Finally
End;
end;
procedure TForm2.Listboxm12DblClick(Sender: TObject);
var i:integer; f:PChar;
begin
i := listboxm1.ItemIndex;
BASS_ChannelStop(chan);
strc := 0;
f := PChar(listboxm2.Items.Strings[i]);
strs[strc] := BASS_StreamCreateFile(False, f, 0, 0, 0);
BASS_ChannelPlay(strs[0],false);
end;
procedure TForm2.listboxm1Changing(Sender: TObject; Item: TListItem;
Change: TItemChange;
var AllowChange: Boolean);
begin
showmessage('
jjj');
end;
procedure TForm2.listboxm1Click(Sender: TObject);
var i:integer;
begin
try
i := listboxm1.ItemIndex;
tempsel := i;
tempfilename := listboxm2.Items.Strings[i];
Edit1.Text := ID3(Tempfilename).Strings[1];
Edit2.Text := ID3(Tempfilename).Strings[0];
labelbitrate.Caption := mpeg(Tempfilename).Strings[2]+'
Kbit/s';
Edit3.Text := ID3(Tempfilename).Strings[4];
Edit4.Text := ID3(Tempfilename).Strings[5];
Edit5.Text := ID3(Tempfilename).Strings[6];
except
end;
end;
procedure TForm2.listboxm1DblClick(Sender: TObject);
var i:integer; f:PChar;
begin
try
i := listboxm1.ItemIndex;
Label14.Caption := '
Play';
BASS_ChannelStop(strs[0]);
strc := 0;
f := PChar(listboxm2.Items.Strings[i]);
chan := BASS_StreamCreateFile(False, PChar(f), 0, 0, floatable
or BASS_SAMPLE_LOOP);
strs[strc] := BASS_StreamCreateFile(False, f, 0, 0, 0);
BASS_ChannelPlay(strs[0],false);
Scrollbar1.Max := BASS_channelgetlength(chan) + 1;
showmessage (inttostr(scrollbar1.Max));
Rasterlab2.Text := listboxm1.Items.Item[i].Caption + '
- ' + listboxm1.Items[i].SubItems[0];
except
end;
end;
procedure TForm2.listboxv1Click(Sender: TObject);
begin
try
except
end;
end;
procedure TForm2.listboxv1DblClick(Sender: TObject);
var
i:integer;
begin
try
i := listboxv1.ItemIndex;
addtemp(listboxv2.Items.Strings[i]);
omp(listboxv2.Items.Strings[i]);
except
end;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
Label1.Caption := '
CPU: '+FloatToStrF(BASS_GetCPU, ffFixed, 4, 2)+'
%';
end;
procedure TForm2.Timer2Timer(Sender: TObject);
begin
//if setp = false then scrollbar1.Position := BASS_ChannelgetPosition(chan);
end;
procedure TForm2.TrayIcon1DblClick(Sender: TObject);
begin
Form2.Show;
TrayIcon1.Visible := False;
end;
end.
Programmierung allgemein
Antwort
12. Okt 2007, 20:49
Zitat
Linear-Darstellung
