SQLite Blob (Speicherfehler?)

[ProgOldie]

Hallo,
ich habe mit PB5.1 eine Datenbank von Darstellerbildern(Actors). Jeder Actor gehört einem Ensemble an.
Nun lade ich die Bilder in die Datenbank und zeige sie an. Das klappt wie gewünscht. Nur: Nach dem Laden eines neuen Darstellers mit 'loadActor' treten die Probleme auf, obwohl das Bild richtig in die DB kommt und auch von dort korrekt angezeigt wird:
1. Übersetze ich das PB-Programm noch einmal, antwortet der Debugger nicht.
2. Nach Beenden von PB treten im gesamten Windows Vista unerklärlich lange Ladezeiten bei allen Programmen auf.

Kurzum: Das riecht nach einem Speicherzuordnungsfehler. Ich finde ihn aber trotz tagelangen Suchens nicht!
Den Code von 'loadActor' habe ich nach dem SQLITE3-Einsteigertutorial von TS-Soft erstellt und m.E. auch verstanden.

Wo ist der Fehler?

Code: Alles auswählen

Procedure.i getEnsembleID()
  ;Bestimmt die ID des gerade aktuellen Ensembles
  Protected EnsembleName.s,EnsembleID.i,DBQuery.s
  UseGadgetList(WindowID(#ActorsWin))
  EnsembleName=GetGadgetText(#SelEnsembleGad)
  DBQuery="SELECT EnsID,EnsName FROM ensembles WHERE  EnsName = "+"'"+EnsembleName+"'"
  If DatabaseQuery(#Databasenum,DBQuery)
    If NextDatabaseRow(#Databasenum)
      EnsembleID=Val(GetDatabaseString(#Databasenum,0))
      ;MessageRequester(Ensemblename+"  "+GetDatabaseString(#Databasenum,0),"")
    EndIf
  Else
     EnsembleID=0
  EndIf
  FinishDatabaseQuery(#Databasenum)  
  ProcedureReturn EnsembleID
EndProcedure

Procedure loadActor(ActWin.i)
  ; Lade ein neues Bild ins Actorfenster
  ;nach TS-Soft:SQLITE3-Einsteigertutorial
  Protected Filename.s,ImNr.i,ImResizedNr.i,ImCopyNr.i,ImGadget.i,TBHeight.i,DBQuery.s,ActTypes.s,EnsembleName.s,EnsembleID.i
  Protected *mem, size.q,id.i, item
  Static DefaultFile.s
  ;Hier später noch andre Datentypen 
  ActTypes="(*.bmp,*.jpg,*.tiff,*.png,*.tga)|*.bmp;*.jpg;*.tiff;*.png;*.tga|All Files (*.*)|*.*"
  FileName = OpenFileRequester("Open Image", DefaultFile, ActTypes, 0)
  ;Option #PB_Requester_MultiSelection) noch nicht, weil anders auswerten
  ;Filename steht zunächst Pfad+Name
  DefaultFile = FileName  
  
  EnsembleID=getEnsembleID()
  If ReadFile(0, Filename)
    size = Lof(0)
    If size
      *mem = AllocateMemory(size)
      If *mem
        ReadData(0, *mem, size)
        ; SetDatabaseBlob bereitet die Daten für unseren DatabaseUpdate vor.
        ; Der zweite parameter ist nicht die Spalte (row), sondern der Index des Statements,
        ; also der wievielte Blob (das wievielte Fragezeichen). Dieser Index beginnt bei 0!
        SetDatabaseBlob(#Databasenum, 0, *mem, size)
        DBQuery= "INSERT INTO actors (ActName,Ensemble,ActData) VALUES ("
        DBQuery=DBQuery+ "'"+GetFilePart(Filename) +"',"+"'"+ Str(EnsembleID)+"', ?)"
        If DatabaseUpdate(#Databasenum, DBQuery)
           If DatabaseQuery(#Databasenum, "SELECT last_insert_rowid()")
            NextDatabaseRow(#Databasenum)
            id = GetDatabaseLong(#Databasenum, 0)
            FinishDatabaseQuery(#Databasenum)
            item = CountGadgetItems(#ActorsListIcon)
            AddGadgetItem(#ActorsListIcon, item, ""+Chr(10)+Str(id)+Chr(10)+GetFilePart(Filename))
            SetGadgetItemData(#ActorsListIcon, item, id)
            ;Bild anzeigen
            ;SetGadgetState(#ActorsListIcon, item)
            ;ZeigeBild(id)
            EndIf
        EndIf 
        FinishDatabaseQuery(#Databasenum)  
       Else
          Debug DatabaseError()
       EndIf
       FreeMemory(*mem)
    EndIf
  EndIf
    CloseFile(0)
    ;showActors(GetGadgetText(#SelEnsembleGad))
EndProcedure

[HeX0R]

Du solltest echt mehr Leerzeichen benutzen, wenn man Kopfweh hat (wie ich heute) ist der Code wirklich anstrengend...

Das einzige was mir auffällt, ist ein doppeltes FinishDataBaseQuery().
Das liegt daran, weil Du die ganzen CloseFile, FreeMemory und FinishDatabaseQuerys nicht da platzierst, wo sie eigentlich hingehören.
Z.B. würdest Du auch dann eine Datei schliessen, wenn sie gar nicht geöffnet werden konnte.
Genauso würdest du Speicher freigeben, der gar nicht reserviert wurde.
usw.

Und welchen Zweck hat das hier?

Code: Alles auswählen

UseGadgetList(WindowID(#ActorsWin))

Ich habe das mal ein wenig angepasst (und auch die Leerzeichen hinzugefügt).
Aber da das ja nun mal kein lauffähiges Beispiel war, weiss ich nicht, ob dadurch Dein Fehler behoben ist.

Code: Alles auswählen

Procedure.i getEnsembleID()
	;Bestimmt die ID des gerade aktuellen Ensembles
	Protected EnsembleName.s, EnsembleID.i, DBQuery.s
	UseGadgetList(WindowID(#ActorsWin))
	EnsembleName = GetGadgetText(#SelEnsembleGad)
	DBQuery      = "SELECT EnsID, EnsName FROM ensembles WHERE  EnsName = '" + EnsembleName + "'"
	If DatabaseQuery(#Databasenum, DBQuery)
		If NextDatabaseRow(#Databasenum)
			EnsembleID = Val(GetDatabaseString(#Databasenum, 0))
			;MessageRequester(Ensemblename+"  "+GetDatabaseString(#Databasenum,0),"")
		EndIf
		FinishDatabaseQuery(#Databasenum)
	Else
		EnsembleID = 0
	EndIf

	ProcedureReturn EnsembleID
EndProcedure

Procedure loadActor(ActWin.i)
	; Lade ein neues Bild ins Actorfenster
	;nach TS-Soft:SQLITE3-Einsteigertutorial
	Protected Filename.s, ImNr.i, ImResizedNr.i, ImCopyNr.i, ImGadget.i, TBHeight.i, DBQuery.s, ActTypes.s, EnsembleName.s, EnsembleID.i
	Protected *mem, size.q, id.i, item
	Static DefaultFile.s
	;Hier später noch andre Datentypen
	ActTypes = "(*.bmp,*.jpg,*.tiff,*.png,*.tga)|*.bmp;*.jpg;*.tiff;*.png;*.tga|All Files (*.*)|*.*"
	FileName = OpenFileRequester("Open Image", DefaultFile, ActTypes, 0)
	;Option #PB_Requester_MultiSelection) noch nicht, weil anders auswerten
	;Filename steht zunächst Pfad+Name
	DefaultFile = FileName

	EnsembleID = getEnsembleID()
	If ReadFile(0, Filename)
		size = Lof(0)
		If size
			*mem = AllocateMemory(size)
			If *mem
				ReadData(0, *mem, size)
				; SetDatabaseBlob bereitet die Daten für unseren DatabaseUpdate vor.
				; Der zweite parameter ist nicht die Spalte (row), sondern der Index des Statements,
				; also der wievielte Blob (das wievielte Fragezeichen). Dieser Index beginnt bei 0!
				SetDatabaseBlob(#Databasenum, 0, *mem, size)
				DBQuery = "INSERT INTO actors (ActName, Ensemble, ActData) VALUES ("
				DBQuery = DBQuery + "'" + GetFilePart(Filename) + "', '" + Str(EnsembleID) + "', ?)"
				If DatabaseUpdate(#Databasenum, DBQuery)
					If DatabaseQuery(#Databasenum, "SELECT last_insert_rowid()")
						NextDatabaseRow(#Databasenum)
						id = GetDatabaseLong(#Databasenum, 0)
						item = CountGadgetItems(#ActorsListIcon)
						AddGadgetItem(#ActorsListIcon, item, "" + Chr(10) + Str(id) + Chr(10) + GetFilePart(Filename))
						SetGadgetItemData(#ActorsListIcon, item, id)
						;Bild anzeigen
						;SetGadgetState(#ActorsListIcon, item)
						;ZeigeBild(id)
						FinishDatabaseQuery(#Databasenum)
					EndIf
				EndIf
				FreeMemory(*mem)
			Else
				Debug DatabaseError()
			EndIf
		EndIf
		CloseFile(0)
	EndIf
	;showActors(GetGadgetText(#SelEnsembleGad))
EndProcedure

[ProgOldie]

Zunächst 'mal Dank für die Bemühungen.

Das liegt daran, weil Du die ganzen CloseFile, FreeMemory und FinishDatabaseQuerys nicht da platzierst, wo sie eigentlich hingehören.

O.k. Ich war davon ausgegangen, dass allein schon der Aufruf von z.B. databasequery Speicher benötigt. Offenbar wird also der Speicher wieder freigegeben, der vom Ergebnis(!) der Abfrage belegt wird. Und wenn sie scheitert, muss eben nichts mehr freigegeben werden.

Welchen Sinn hat : UseGadgetList(WindowID(#ActorsWin))

Es wird doch zu jedem Fenster eine Gadgetliste angelegt. Ich wollte damit also bei mehreren benutzten Fenstern nur sicherstellen, dass bei dem anschließend benutzten Gadget auch die richtige Gadgetgetliste benutzt wird.


Insgesamt aber löst das alles mein Problem nicht. Nach wie vor wird nach dem Aufruf von 'loadActor' sämtliche Arbeit mit dem Betriebssystem extrem langsam, so dass ein Neustart erforderlich ist.

Hat jemand noch eine Idee, woran es liegen könnte?

[HeX0R]

Welchen Sinn hat : UseGadgetList(WindowID(#ActorsWin))

Es wird doch zu jedem Fenster eine Gadgetliste angelegt. Ich wollte damit also bei mehreren benutzten Fenstern nur sicherstellen, dass bei dem anschließend benutzten Gadget auch die richtige Gadgetgetliste benutzt wird.

Mit UseGadgetList stellst du sicher, dass die folgenden Gadgets, die du erstellen möchtest auf dem richtigen Fenster platziert sind.
Auslesen, Status ändern, was auch immer machst du einfach über die eindeutige Konstante ohne Dir Gedanken über das Fenster auf dem sie sitzen machen zu müssen.

Insgesamt aber löst das alles mein Problem nicht. Nach wie vor wird nach dem Aufruf von 'loadActor' sämtliche Arbeit mit dem Betriebssystem extrem langsam, so dass ein Neustart erforderlich ist.

Hat jemand noch eine Idee, woran es liegen könnte?

Aber da das ja nun mal kein lauffähiges Beispiel war, weiss ich nicht, ob dadurch Dein Fehler behoben ist.

[bobobo]

die prozeduren sehen ok aus

da dürfte was anderes klemmen.

[ProgOldie]

Hallo,
wie gewünscht der PB-Code. Das Programm selbst ist noch sehr unvollständig. Ziel ist es, Bilder(Actors) aus einer Tabelle auf die Bühne ziehen zu können und dort zu positionieren (PPoint ähnlich).
Mit vielen Kleinigkeiten haben ich mich noch nicht beschäftigt, weil eben die geschilderten Datenbankprobleme auftreten. Beispielsweise muss man zum Beenden des Programms 'MainWin' schließen und kann bei der Detailansicht der Bilder auch noch das zugehörige Fenster nicht schließen. Auch ist noch nicht entschieden, ob ich eventuell eine andere Datenbank nehme.
Mir geht es allein darum, wo der geschilderte (Speicher-)Fehler liegt, der in der Folge zu einem unerträglich langsamen Betrieb bei allen Programmen führt, die erst nach einem Neustart des Betriebssystems weg sind.


Dank schon 'mal vorab für die Mühe.

Code: Alles auswählen

EnableExplicit

UseSQLiteDatabase()
UseJPEGImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
InitMovie()

#Wallsize=16  ;Kachelgröße bei Actors-Ansicht

Define  aktDir.s, DatabaseFile.s
#PBWin_MinMax=#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget

Enumeration
  #MainWin
  #ActorsWin    ;Fenster für die Tabelle der Bilder
  #StageWin     ;Fenster für die Bühne
  #TimeWin
  #TimeLine
  #Databasenum
  #MainMenu
  #ActorsMenu
  #Menu_Open
  #Menu_New
  #Menu_Delete
  #Image
  #ActorsListIcon
  #SelEnsembleGad
EndEnumeration

Structure Actor
  Name.s
  Source.s
  OriginalSize.i  
EndStructure

aktDir=GetCurrentDirectory()
;Die sqlite-Datei mit allen Informationen
DatabaseFile=aktdir+"/Data/"+"DatabaseFile.sqlite"

Procedure.i createDB(DBFile.s)
   Protected DBQuery.s,RET.i
     RET = #False
    ;sqlite Tabelle anlegen
      If CreateFile(#Databasenum,DBFile)
        CloseFile(#Databasenum)
           If OpenDatabase(#Databasenum, DBFile, "", "",#PB_Database_SQLite)   
             DatabaseUpdate(#Databasenum, "CREATE TABLE settings (WinNr INT,WinX INT,WinY INT,WinWidth INT,WinHeight INT)")
             DatabaseUpdate(#Databasenum, "INSERT INTO settings (WinNr,WinX,WinY,WinWidth,WinHeight) VALUES ("+Str(#MainWin)+",'0','0','400','500')")
             DatabaseUpdate(#Databasenum, "INSERT INTO settings (WinNr,WinX,WinY,WinWidth,WinHeight) VALUES ("+Str(#ActorsWin)+",'1000','0','90','600')")
             DatabaseUpdate(#Databasenum, "INSERT INTO settings (WinNr,WinX,WinY,WinWidth,WinHeight) VALUES ("+Str(#StageWin)+",'0','0','900','800')")
             DatabaseUpdate(#Databasenum, "INSERT INTO settings (WinNr,WinX,WinY,WinWidth,WinHeight) VALUES ("+Str(#TimeWin)+",'0','600','900','100')")           
             DatabaseUpdate(#Databasenum, "CREATE TABLE actors (ActID integer primary key,ActName VarChar(200),Ensemble INT NOT Null,ActData BLOB)")
             DatabaseUpdate(#Databasenum, "CREATE TABLE ensembles (EnsID integer primary key,EnsName VarChar(50))")
             ; Ein Ensemble ist immer 'Media'
             DatabaseUpdate(#Databasenum,"INSERT INTO ensembles (EnsName) VALUES ('Media')")

             CloseDatabase(#Databasenum)
           RET = #True 
          EndIf
      EndIf
      ProcedureReturn RET  
EndProcedure

Procedure saveWinParams(WindowNr.i,DBNum.i)
  Protected DBQuery.s
  ;Setzt für Fenster WindowNr die Fensterparameter
  DBQuery="UPDATE settings SET WinX="+Str(WindowX(WindowNr))+",WinY="+Str(WindowY(WindowNr))
  DBQuery=DBQuery +",WinWidth="+Str(WindowWidth(WindowNr))+",WinHeight="+Str(WindowHeight(WindowNr))
  DBQuery=DBQuery +" WHERE WinNr="+Str(WindowNr)
  If DatabaseUpdate(DBNum,DBQuery)
  Else
    MessageRequester("WindowParams:Fehler",DatabaseError())
  EndIf
  FinishDatabaseQuery(DBNum)

EndProcedure


Procedure.i getEnsembleID()
  ;Bestimmt die ID des gerade aktuellen Ensembles
  Protected EnsembleName.s,EnsembleID.i,DBQuery.s
  UseGadgetList(WindowID(#ActorsWin))
  EnsembleName=GetGadgetText(#SelEnsembleGad)
  DBQuery="SELECT EnsID,EnsName FROM ensembles WHERE  EnsName = "+"'"+EnsembleName+"'"
  If DatabaseQuery(#Databasenum,DBQuery)
    If NextDatabaseRow(#Databasenum)
      EnsembleID=Val(GetDatabaseString(#Databasenum,0))
    EndIf
    FinishDatabaseQuery(#Databasenum)
  Else
     EnsembleID=0
  EndIf
  ;FinishDatabaseQuery(#Databasenum)  
  ProcedureReturn EnsembleID
EndProcedure

Procedure.i getWinParams(DB.i)
  ;Liest für alle Fenster der Tabelle settings die Werte ein
  If DatabaseQuery(DB, "SELECT WinNr,WinX,WinY,WinWidth,WinHeight FROM settings") 
    While NextDatabaseRow(DB) 
      ;setze für das jeweilige Fenster dessen Kenngrößen
      ResizeWindow(Val(GetDatabaseString(DB, 0)),Val(GetDatabaseString(DB, 1)),Val(GetDatabaseString(DB, 2)),Val(GetDatabaseString(DB, 3)),Val(GetDatabaseString(DB, 4)))
    Wend
    FinishDatabaseQuery(DB)
  Else
    MessageRequester("Fehler", "Abfrage in getWinParams nicht ausführbar: "+DatabaseError())
  EndIf
EndProcedure


Procedure showActors(Ensemble.s)
  ;lädt die in der Tabelle images gespeicherten Bilder als Kacheln ins Actorsfenster
  ;ActNum gibt die Nr des Bildes an (ab 0)
  ;ggf. noch: Vorher alle Items des Gadgets löschen
  ;Es werden alle angezeigt, die zu dem Ensemble mit dem als String übergebenen Namen gehören
  Protected ActNum.i,index.i,DBQuery.s,ImNr.i,TBHeight.i,ImGadget.i,ImCopyNr.i,ImResizedNr.i,EnsID.s,size, *mem
  
  EnsID=Str(getEnsembleID())
  
  DBQuery="SELECT ActID, ActName,Ensemble,ActData FROM actors WHERE Ensemble="+"'"+EnsID+"'"+" ORDER BY ActID "
  If DatabaseQuery(#Databasenum,DBQuery)=0
    MessageRequester("Error",DBQuery+Chr(10)+DatabaseError())
  Else
    UseGadgetList(WindowID(#ActorsWin))
    TBHeight=ToolBarHeight(#ActorsMenu)+GadgetHeight(#SelEnsembleGad)
    ListIconGadget(#ActorsListIcon, 0, TBHeight, #Wallsize+280,WindowHeight(#Actorswin)-TBHeight,"Actor", 50,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_MultiSelect)
    AddGadgetColumn(#ActorsListIcon, 1, "ID", 30)
    AddGadgetColumn(#ActorsListIcon,2,"Name",100)
    AddGadgetColumn(#ActorsListIcon,3,"Type",50)
    While NextDatabaseRow(#Databasenum) 
      ;falls es sich um ein Bild handelt
      size = DatabaseColumnSize(#Databasenum,DatabaseColumnIndex(#Databasenum,"ActData"))
      *mem = AllocateMemory(size)
      If *mem
       ;Bilddaten in Speicher laden
        If GetDatabaseBlob(#Databasenum,DatabaseColumnIndex(#Databasenum,"ActData"), *mem, size)
         CatchImage(0, *mem,size)
         ;SetGadgetState(#gad_Image, ImageID(0))
         AddGadgetItem(#ActorsListIcon, -1, Chr(10)+GetDatabaseString(#Databasenum,0)+Chr(10)+GetDatabaseString(#Databasenum,1)+Chr(10)+GetExtensionPart(GetDatabaseString(#Databasenum,1)))
        EndIf
        FreeMemory(*mem)
      EndIf
    Wend
    FinishDatabaseQuery(#Databasenum)
  EndIf
EndProcedure


Procedure loadActor(ActWin.i)
  ; Lade ein neues Bild ins Actorfenster
  ;nach TS-Soft:SQLITE3-Einsteigertutorial
  Protected Filename.s,ImNr.i,ImResizedNr.i,ImCopyNr.i,ImGadget.i,TBHeight.i,DBQuery.s,ActTypes.s,EnsembleName.s,EnsembleID.i
  Protected *mem, size.q,id.i, item
  Static DefaultFile.s
  ;Hier später noch andre Datentypen 
  ActTypes="(*.bmp,*.jpg,*.tiff,*.png,*.tga)|*.bmp;*.jpg;*.tiff;*.png;*.tga|All Files (*.*)|*.*"
  FileName = OpenFileRequester("Open Image", DefaultFile, ActTypes, 0)
  ;Option #PB_Requester_MultiSelection) noch nicht, weil anders auswerten
  ;Filename steht zunächst Pfad+Name
  DefaultFile = FileName  
  
  EnsembleID=getEnsembleID()
  If ReadFile(0, Filename)
    size = Lof(0)
    If size
      *mem = AllocateMemory(size)
      ;MessageRequester("size,allocate",Str(size)+Chr(10)+Str(MemorySize(*mem)))

      If *mem
        ReadData(0, *mem, size)
        ; SetDatabaseBlob bereitet die Daten für unseren DatabaseUpdate vor.
        ; Der zweite parameter ist nicht die Spalte (row), sondern der Index des Statements,
        ; also der wievielte Blob (das wievielte Fragezeichen). Dieser Index beginnt bei 0!
        SetDatabaseBlob(#Databasenum, 0, *mem, size)
        DBQuery= "INSERT INTO actors (ActName,Ensemble,ActData) VALUES ("
        DBQuery=DBQuery+ "'"+GetFilePart(Filename) +"',"+"'"+ Str(EnsembleID)+"', ?)"
        If DatabaseUpdate(#Databasenum, DBQuery)
           If DatabaseQuery(#Databasenum, "SELECT last_insert_rowid()")
            NextDatabaseRow(#Databasenum)
            id = GetDatabaseLong(#Databasenum, 0)
            FinishDatabaseQuery(#Databasenum)
            item = CountGadgetItems(#ActorsListIcon)
            AddGadgetItem(#ActorsListIcon, item, ""+Chr(10)+Str(id)+Chr(10)+GetFilePart(Filename))
            SetGadgetItemData(#ActorsListIcon, item, id)
            ;Bild anzeigen
            ;SetGadgetState(#ActorsListIcon, item)
            ;ZeigeBild(id)
            FinishDatabaseQuery(#Databasenum)
            EndIf
        EndIf 
        ;FinishDatabaseQuery(#Databasenum)  
        FreeMemory(*mem)
       Else
          Debug DatabaseError()
       EndIf
       ;FreeMemory(*mem)
     EndIf
     CloseFile(0)
  EndIf
    ;CloseFile(0)
    ;showActors(GetGadgetText(#SelEnsembleGad))
EndProcedure

Procedure deleteActor(ActWin.i)
  ;Löschen der ausgewählten Zeile(n) in Gadget und DBank
  Protected DelNr.i,DelID.s
  UseGadgetList(WindowID(#Actorswin))
  Repeat
   DelNr=GetGadgetState(#ActorsListIcon)
    If DelNr<>-1
      DelID=GetGadgetItemText(#ActorsListIcon,DelNr,1)
      RemoveGadgetItem(#ActorsListIcon,DelNr)
     ;Nun noch DB-Eintrag mit ActID=DelID löschen  
     If DatabaseUpdate(#Databasenum,"DELETE FROM actors WHERE ActID="+DelID)
       Else
          MessageRequester("Error(Löschen)",DatabaseError())
     EndIf
   EndIf 
   Until DelNr=-1
 EndProcedure
 
 
 
 Procedure showDetails(ActID.i)
   ;nach TS-Soft:SQLITE3-Einsteigertutorial
   ;Aus der Datenbank Details lesen
   ;falls Bild: Dieses anzeigen
   ;falls Movie: abspielen  
   Protected DBQuery.s,size.q,*mem,RNum.i,ImNum.i,ImResizedNum.i,ImGadget.i,W.i,H.i,FormFaktor.q
   
   DBQuery="SELECT ActName,ActID,ActData FROM actors WHERE ActID="+Str(ActID)
   If DatabaseQuery(#Databasenum,DBQuery)
     
     If NextDatabaseRow(#Databasenum)
       RNum=DatabaseColumnIndex(#Databasenum,"ActData")
       size = DatabaseColumnSize(#Databasenum,RNum)
       ;MessageRequester("Details","ID="+Str(ActID)+"  Filename="+GetDatabaseString(#Databasenum,0)+"size="+Str(size))
       *mem = AllocateMemory(size)
       If *mem
         If GetDatabaseBlob(#Databasenum,RNum, *mem, size)
           ImNum=CatchImage(#PB_Any, *mem,size)
           W=ImageWidth(ImNum)
           H=ImageHeight(ImNum)
           FormFaktor=W/800
           OpenWindow(#PB_Any,30,30,900,700,"Bildbetrachtung",#PB_Window_WindowCentered|#PB_Window_SystemMenu)
           ImGadget=ImageGadget(#PB_Any,40,40,900,700,ImNum) 
           ;ImResizedNum=ResizeImage(ImNr,#Wallsize,#Wallsize)
           ImResizedNum=ResizeImage(ImNum,Int(W/FormFaktor),Int(H/FormFaktor))
           SetGadgetState(ImGadget,ImResizedNum)
         EndIf
         ;**************** fehlt noch: Schließen des Fensters
       EndIf
       FreeMemory(*mem)
    Else
      Debug DatabaseError()
    EndIf     
    FreeImage(ImNum)
    ;FreeImage(ImResizedNum)
  Else
     MessageRequester("DBQuery nicht ausführbar",DBQuery)
  EndIf
   FinishDatabaseQuery(#Databasenum)
 EndProcedure

 
 Procedure createActor()
   ;erstellt einen neuen Actor als Image oder Text
   MessageRequester("Menu ActorsWin","create")
   
   
 EndProcedure
 
Procedure EvReaction()
 Protected Event.i,EvGad.i,EvMenu.i,EvWin.i,selActor.i,selActID.i 
   Repeat
     Event=WaitWindowEvent()
     EvGad=EventGadget()
     EvWin=EventWindow()
     
     ;vorab für alle Fenster
     If (Event=#PB_Event_SizeWindow) Or (Event=#PB_Event3D_MoveWindow)
       saveWinParams(EvWin,#Databasenum)
     EndIf
     Select EvWin    
        Case #ActorsWin
          UseGadgetList(WindowID(#ActorsWin))
          Select Event
              Case #PB_Event_Gadget
                If EvGad=#SelEnsembleGad 
                  ;Darsteller des Ensembles anzeigen
                  If GetGadgetText(#SelEnsembleGad)<>""
                    showActors(GetGadgetText(#SelEnsembleGad))
                  EndIf
                EndIf
                If EventType()=#PB_EventType_DragStart
                  ; *********************************Folgendes noch sehr fehlerhaft;   32 ist hier beliebig**************
                  ;UseGadgetList(#StageWin)
                   EnableGadgetDrop(32,#PB_Drop_Image,#PB_Drag_Copy)
                  ;DragImage(ImageID(  ))
                  ;*********************************************************
                EndIf
              Case #PB_Event_Menu
                Select EventMenu()
                  Case 0  ; Neuen Actor creieren
                    createActor()
                  Case 1  ; Actor hinzufügen
                      loadActor(#ActorsWin)
                  Case 2  ; Actor(s) entfernen 
                      deleteActor(#Actorswin)
                  Case 3 ; Details              
                      selActor=GetGadgetState(#ActorsListIcon)
                      If selActor<>-1
                        selActID=Int(Val(GetGadgetItemText(#ActorsListIcon,selActor,1)))
                       showDetails(selActID)
                      EndIf  
                EndSelect
          EndSelect
         
        Case #TimeWin
          
          
        Case #StageWin
         
     EndSelect 
   Until (Event = #PB_Event_CloseWindow) And (EvWin=#MainWin)
 
 EndProcedure
 
 Procedure getEnsembles()
   ;Liest die ensembles aus der Datenbank und schreibt
   ;sie in das Gadget #SelEnsebleGad
   UseGadgetList(WindowID(#ActorsWin))
   Protected DBQuery.s
   DBQuery="SELECT EnsID,EnsName FROM ensembles ORDER BY EnsID"
   If DatabaseQuery(#Databasenum,DBQuery)=0
    MessageRequester("Error:Read Ensemble",DatabaseError())
   Else
    ClearGadgetItems(#SelEnsembleGad)
    While NextDatabaseRow(#Databasenum) 
      ;setze für das jeweilige Fenster dessen Kenngrößen
      AddGadgetItem(#SelEnsembleGad,-1,GetDatabaseString(#Databasenum,1))
    Wend
    If CountGadgetItems(#SelEnsembleGad) ;gibt's Einträge
     SetGadgetState(#SelEnsembleGad,0)  ; ersten Eintrag anzeigen
     ;MessageRequester("Ensembles",GetGadgetText(#SelEnsembleGad))
    EndIf
   EndIf
   FinishDatabaseQuery(#Databasenum) 
 EndProcedure

 Procedure check_Database(DBFile.s)
   ;prüft, ob Unterordner Data und darin die DB vorhanden. GGf. Neuanlage 
   ExamineDirectory(0,GetPathPart(DBFile),"")
   NextDirectoryEntry(0)
   If IsDirectory(0)
     MessageRequester("","Unterordner 'Data' vorhanden")  
   Else
     MessageRequester("","Unterordner 'Data' wird neu angelegt'")
     CreateDirectory(GetPathPart(DBFile))
   EndIf
   FinishDirectory(0)

   If OpenDatabase(#Databasenum,DBFile,"","",#PB_Database_SQLite)=0
    MessageRequester("SQLite-Systemtabelle","Die Tabelle existiert nicht:Neuanlage")
    If createDB(DBFile)  
    Else
      MessageRequester("Neuanlage der DB","gescheitert")
    EndIf
  Else   
    MessageRequester("Datenbank vorhanden","")
   EndIf
EndProcedure




;Datenbank vorhanden? Sonst neu anlegen
check_Database(DatabaseFile)

OpenWindow(#MainWin,0,0,20,20,"Hauptprogramm",#PBWin_MinMax)
If CreateMenu(#MainMenu, WindowID(#MainWin))
    MenuTitle("File") ; ----------------------
    MenuItem(#MENU_New, "New")
    MenuItem(#MENU_Open, "Add")
    MenuItem(#MENU_Delete, "Delete")  
EndIf
  
OpenWindow(#Actorswin,200,20,300,600,"Actors",#PBWin_MinMax)
   If CreateToolBar(#ActorsMenu,WindowID(#Actorswin))
     ToolBarStandardButton(0, #PB_ToolBarIcon_New)
     ToolBarStandardButton(1, #PB_ToolBarIcon_Open)
     ToolBarStandardButton(2, #PB_ToolBarIcon_Delete)
     ToolBarStandardButton(3, #PB_ToolBarIcon_Properties)
     ToolBarToolTip(#ActorsMenu, 0, "create Actor")
     ToolBarToolTip(#ActorsMenu, 1, "Load Actor")
     ToolBarToolTip(#ActorsMenu, 2, "Remove selected Actors")
     ToolBarToolTip(#ActorsMenu, 3, "Details")
   EndIf
   ComboBoxGadget(#SelEnsembleGad, 0, 1+ToolBarHeight(#ActorsMenu), 150, 20)
   OpenWindow(#StageWin,2,2,800,600,"Stage",#PBWin_MinMax)
     ; der Wert 32 ist ausgedacht
     ImageGadget(32,100,100,20,23,0,#PB_Image_Border)
   OpenWindow(#TimeWin,2,2,800,400,"Time",#PBWin_MinMax)
   TrackBarGadget(#TimeLine,0,0,950,20,0,200,#PB_TrackBar_Ticks)
   
    
   OpenDatabase(#Databasenum,DatabaseFile,"","",#PB_Database_SQLite)
   getWinParams(#Databasenum)
   getEnsembles()
    If GetGadgetText(#SelEnsembleGad)<>""
      ;zeige die Darsteller des ersten Ensembles
      showActors(GetGadgetText(#SelEnsembleGad))
    EndIf
    EvReaction() 
   CloseDatabase(#Databasenum)

[ts-soft]

Erste Hinweise:

Du sprengst das Forumslayout, füge bitte mehr Leerzeichen in Deinem Code ein!

Zeile 356:
Das angegebene #Directory ist nicht initialisiert (es fehlt die Überprüfung ob ExamineDirectory geklappt hat).

Zeile 38:
aktDir=GetCurrentDirectory(), CurrentDirectory verweist nur auf Dein Programm-Verzeichnis, wenn der aufrufende
Process dieses so gesetzt hat (ist zwar beim Explorer immer der Fall, aber ansonsten nicht).
Besser: aktDir = GetPathPart(ProgramFilename())
Aber Achtung: Beim Debuggen in der IDE solltest Du aktivieren, das die Datei im SourceDir erzeugt wird!

Gruß
Thomas

[ProgOldie]

Hallo,
danke für die schnelle Antwort.
Ich habe das jetzt alles umgesetzt:
1.

Code: Alles auswählen

aktDir=GetPathPart(ProgramFilename())

2.

Code: Alles auswählen

If ExamineDirectory(0,GetPathPart(DBFile),"")
     NextDirectoryEntry(0)
     If IsDirectory(0)
       MessageRequester("","Unterordner 'Data' vorhanden")  
     Else
       MessageRequester("","Unterordner 'Data' wird neu angelegt'")
       CreateDirectory(GetPathPart(DBFile))
     EndIf
     FinishDirectory(0)
   Else
     MessageRequester(GetPathPart(DBFile),"Verzeichnis nicht aufindbar")
   EndIf 

3. Außerdem habe ich unter Compiler/Compiler Options/CompileRun/ das Häkchen bei
"create temp executable in source directory" eingestellt.

Trotzdem tritt der Fehler immer noch auf: Bilder lassen sich korrekt neu in die DB aufnehmen und auch anzeigen. Danach aber kann man das Programm nicht mehr übersetzen. Fehlermeldung: 10s lang kein Kontak zum Debugger.
Und anschließend lahmen alle weiteren Programme.

[Kiffi]

Danach aber kann man das Programm nicht mehr übersetzen. Fehlermeldung: 10s lang kein Kontak zum Debugger.
Und anschließend lahmen alle weiteren Programme.

welchen Virenscanner benutzt Du? Schalte den testweise mal aus oder
richte eine Ausnahme für die Ordner ein, in denen das Kompilat erzeugt wird.

Grüße ... Kiffi

[ProgOldie]

Hallo Kiffi,

nun bin ich aber platt. Bei mir läuft Kaspersky und - beim Ausschalten läuft alles plötzlich wie gewünscht.

Aber: Was mache ich in Zukunft? Kasperky meldet auch keinen Fehler. Ich kann den Virenscanner doch nicht immer ausschalten.

Dank,Dank,Dank!!