Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Programm schliesst sich nicht mehr!!!!! Hilfe bitte (https://www.delphipraxis.net/101361-programm-schliesst-sich-nicht-mehr-hilfe-bitte.html)

dominikkv 12. Okt 2007 20:49

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
wie initialisierst du die bass.dll?
hast du die neuste version?
hast du auch mal versucht die komplette bass.dll aus deinem programm auszuklammern?
mach mal ein neues projekt (mit bass.dll) and schau ob da auch der fehler auftaucht.
das programm kannst du mit haltepunkten debuggen

hedie 12. Okt 2007 20:56

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
Hmmm haltepunkte mal sehen, muss mal ein wenig experimentieren, mit debuging hatte ich bis jetzt noch nichts zu tun

Das is die ausgabe des debugers beim Schliessen (nich vergessen programm schliesst sich ja doch nicht)

Code:
Thread-Ende: Thread-ID: 2276. Prozess MyTuRe.exe (3060)
Thread-Ende: Thread-ID: 3548. Prozess MyTuRe.exe (3060)
Thread-Ende: Thread-ID: 2056. Prozess MyTuRe.exe (3060)
Thread-Ende: Thread-ID: 3880. Prozess MyTuRe.exe (3060)
Thread-Ende: Thread-ID: 2892. Prozess MyTuRe.exe (3060)
Modul entladen: SHDOCVW.dll. Prozess MyTuRe.exe (3060)
Modul entladen: CRYPTUI.dll. Prozess MyTuRe.exe (3060)
Modul entladen: WLDAP32.dll. Prozess MyTuRe.exe (3060)
Modul entladen: GrooveSystemServices.dll. Prozess MyTuRe.exe (3060)
Modul entladen: GrooveShellExtensions.DLL. Prozess MyTuRe.exe (3060)
Modul entladen: GrooveUtil.DLL. Prozess MyTuRe.exe (3060)
Modul entladen: ATL80.DLL. Prozess MyTuRe.exe (3060)
Modul entladen: GrooveNew.DLL. Prozess MyTuRe.exe (3060)
Modul entladen: MSVCR80.dll. Prozess MyTuRe.exe (3060)
Modul entladen: WININET.dll. Prozess MyTuRe.exe (3060)
Modul entladen: MSXML3.dll. Prozess MyTuRe.exe (3060)
Thread-Ende: Thread-ID: 2504. Prozess MyTuRe.exe (3060)
Sehe ich richtig, das da auch noch eine Bass.dll entladen werden müsste?

Das mit dem ausklammer wird mein nächster schritt sein

Danke schonmal

EDIT:
Neue Meldung beim Debuging und beenden des Programm:

Code:
Erste Gelegenheit für Exception bei $7C812A5B. Exception-Klasse EInvalidOperation mit Meldung 'Element 'Panel2' hat kein übergeordnetes Fenster'. Prozess MyTuRe.exe (3392)

lbccaleb 12. Okt 2007 21:27

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
setz jede zeile des quellcodes mit einem haltepunkt, und dann gehst du mit f8 schritt für schritt durch das programm und dann wirst/müsstest du eigentlich sehen wo er sich fest hängt!!! den haltepunke der zeile setzt du wenn du vorne im fenster raufklickst...

hedie 12. Okt 2007 21:46

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
hab ich gemacht

Es kommt beim schliessen zu einer Acces Violation an diesem punkt (weiss nicht ob das was nützt)

Code:
7C91EDDC 53               push ebx

turboPASCAL 12. Okt 2007 21:53

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
Nö, nüzt jetzt nix so richtig. :gruebel:

Es gibt doch aber bestimmt ein Runtimeerror. Den kannst du ja identifizieren.

hedie 12. Okt 2007 21:55

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
nee hab nix gesehen kan nur Acces Violation bei adresse .... beim schreiben von ....

Mehr kam da net

hedie 12. Okt 2007 23:30

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
Hab was rausgekriegt

HABS Geschafft das es sich wieder nur um den anfänglichen Bug handelt

Das Problem war (das es überhaupt nicht mehr zu ging)
Eine Seite beim TPageControl

Auf dieser Seite befanden sich 2 Groupboxen eine mit DreiLabels und eine mit EinemLabel, einem Edit und einem Button

Zudem war da noch eine RadioGroup drauf

Als ich diese Seite komplett entfernt habe, hat es wieder geklappt, dass wenn ich ein Lied abgespielt habe das ich es dann schliessen kann

semo 13. Okt 2007 09:38

Re: Programm schliesst sich nicht mehr!!!!! Hilfe bitte
 
was ein chaos.
magst du mal den code posten, so dass wir das nachvollziehen können?

hedie 13. Okt 2007 09:44

Re: 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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:07 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz