Programm schliesst sich nicht mehr!!!!! Hilfe bitte

[hedie]

Ok hier der Gesamte code (rund 430 Zeilen)

Delphi-Quellcode:

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.