Delphi-PRAXiS - Delphi Programm schliesst sich nicht mehr!!!!! Hilfe bitte

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.