Seite 1 von 1

Datenbankbrowser

Verfasst: 03.01.2014 18:08
von ProgOldie
Nachfolgend das Grundgerüst eines Tabellenbrowsers mit dem die Ergebnisse einer Query an eine Datenbanktabelle in einem Listicongadget dargestellt werden und geändert werden können. Per Doppelklick auf ein Listenelement wird ein zum Datentyp passendes Gadget sichtbar. (Die Idee, zu jeder Spalte ein Gadget zu erzeugen, das nur bei Bedarf (un-)sichtbar ist, habe ich von hjbremer geklaut.)

Es besteht die Möglichkeit (und Notwendigkeit), den aus der Tabellendefinition ermittelten Datentyp abzuändern. So kann ein VARCHAR-Type durch einfache Angaben in einen Datentyp ENUM umgewandelt werden, bei dem die Werte aus einer ComboBox eingelesen werden.
Bei einer Wertänderung wird gleich eine entsprechende Änderung in der DB vorgenommen
Es gibt eine Reihe von Einschränkungen, die aber nicht prinzipieller Art sind, wie zum Beispiel
- Zunächst nur für SQLITE
- Nicht alle Datentypen werden ausgenutzt
- kleinere Fehler sind auch noch vorhanden
- die hässlichen Arrays in der STRUCTURE werden noch auf Liste umgestellt, damit die Zahl der Spalten beliebig ist.

Prinzipiell nichts ändern kann man an der Bedingung, dass alle Spaltenbezeichner der Query auch Spaltenbezeichner der Tabellendefinition sein müssen (sonst wäre ein Update nicht möglich). Allerdings würde ich in einer folgenden Version einfach solche Spalten für die Eingabe sperren, die z.B. bei ALIAS oder JOINS vorkommen.

Code: Alles auswählen

;Anzeige und Abänderung von Tabellenwerten einer DB  
;Autor:ProgOldie     ;Vorläufig nur für SQLite-DB

EnableExplicit

UseSQLiteDatabase()
UseODBCDatabase()
UsePostgreSQLDatabase()

#maxCols=30   ;max. 30 Spalten

Enumeration
  #SQLITE
  #ODBC_Firebird
  #POSTGRES
  #ODBC_MYSQL
EndEnumeration

Procedure.i make_RAM_SQLite()
  ; Datenbank erstellen und mit Zufallswerten füllen
  Protected Art.s,ArtNr.i,ArtZustand.s,ArtAnzahl.i,DB.i,Zeile.i,Kaufdate.i,ArtAbverkauf.s
  DB = OpenDatabase(#PB_Any, ":memory:", "", "", #PB_Database_SQLite)
  If DatabaseUpdate(DB, "CREATE TABLE Test ('ID' INTEGER PRIMARY KEY  Not NULL  UNIQUE , 'Artikel' CHAR(20), 'ArtikelNr' INTEGER, 'Kaufdatum' DATETIME, 'Artikelzustand' Char(15), 'Anzahl' INTEGER, 'Einzelpreis' FLOAT,'Abverkauf' BOOLEAN)")
  Else
    MessageRequester("DB-Anlage","Fehler")
  EndIf
  For Zeile=1 To 200
    Art=StringField("Schraube|Feile|Nagel|Bohrer|Haken|Seil(10m)|Kette(1m)",Random(7,1),"|")
    ArtNr=Random(12309,4802)
    ArtZustand=StringField("neu|gebraucht|wertlos",Random(3,1),"|")
    ArtAnzahl=Random(500,40)
    ArtAbverkauf=StringField("0|1",Random(2,1),"|")
    DatabaseUpdate(DB,"INSERT INTO Test (Artikel,ArtikelNr,Kaufdatum,Artikelzustand,Anzahl,Einzelpreis,Abverkauf)  VALUES ('"+Art+"','"+Str(ArtNr)+"','13.7.2009','"+ArtZustand+"','"+Str(ArtAnzahl)+"','0.03','"+ArtAbverkauf+"')") 
  Next Zeile
  FinishDatabaseQuery(DB)
  ProcedureReturn DB
EndProcedure

Procedure.i ColHeight(ListIcGadNr.i)
  ;setzt voraus, dass eine Zeile existiert
  ;Autor Fluid Byte
  Protected lrc.RECT
  lrc\left = #LVIR_LABEL
  SendMessage_(GadgetID(ListIcGadNr),#LVM_GETITEMRECT,0,lrc)
  ProcedureReturn lrc\bottom -lrc\top
EndProcedure

Procedure.i headerHeight(GadNr.i) 
  Protected LV_Header.i,RECT.RECT
  LV_Header = SendMessage_(GadgetID(GadNr), #LVM_GETHEADER, 0, 0)
  GetWindowRect_(LV_Header, @RECT)
  ProcedureReturn RECT\Bottom-RECT\Top
EndProcedure

Procedure checkFloatInput(gadget.i)
  ;Autor: Danilo
  Protected start, count, pointcount, new$
  SendMessage_(GadgetID(gadget), #EM_GETSEL, @start, 0)
  Protected txt$ = GetGadgetText(gadget)
  Protected *p.Character = @txt$
  
  While *p\c ; <> 0
    If *p\c = '.'
      pointcount+1
      If pointcount < 2
        new$ + Chr(*p\c)
      Else
        If start>count : start-1 : EndIf
      EndIf
    ElseIf count = 0 And *p\c = '-'
      new$ + Chr('-')
    ElseIf *p\c >= '0' And *p\c <= '9'
      new$ + Chr(*p\c)
    Else
      start - 1
    EndIf
    *p + SizeOf(Character)
    count + 1
  Wend
  
  SetGadgetText(gadget, new$)
  SendMessage_(GadgetID(gadget), #EM_SETSEL, start, start)
EndProcedure

Procedure checkstringInput(gadget.i,vonAsc.i,bisAsc.i,Sonderzeichen.s,Laenge.i)
  ;Abänderung von Danilos checkfloat; Autor:ProgOldie
  Protected start, count, pointcount, new$ 
  SendMessage_(GadgetID(gadget), #EM_GETSEL, @start, 0)
  Protected txt$ = GetGadgetText(gadget)
  Protected *p.Character = @txt$
  While *p\c And Len(new$) < Laenge; alle eingegebenen Zeichen durchlaufen
    If (*p\c >= vonAsc And *p\c <= bisAsc) Or FindString(Sonderzeichen,Chr(*p\c),1)
      new$+Chr(*p\c)
    EndIf
    *p + SizeOf(Character) ; zum nächsten Buchstaben
    count + 1
  Wend   
  SetGadgetText(gadget, new$)
  SendMessage_(GadgetID(gadget), #EM_SETSEL, start, start)  
EndProcedure



Structure DBWin            ;für das Tabellenfenster zur Anzeige der Query-Ergebnisse der DB
  DBNr.i                    ;Die zugehörige Datenbanknr (von #PB_Any erzeugt)
  DBTyp.i                   ;z.B. #SQLITE 
  WinNr.i                   ; Fensternr (von #PB_Any erzeugt)
  WinTitle.s                ; Fensterüberschrift
  WWidth.i                  ;Fensterbreite
  WHeight.i                  ;Fensterhöhe
  ListGadNr.i               ; Nr des ListIconGadgets, in dem die Daten stehen
  Table.s                   ;die Tabelle der DB, deren Daten darzustellen sind
  Query.s                   ;zugrundeliegende Abfrage
  IDCol.i                   ; Spaltennr des Query-Results mit einem eindeutigen ID
  NCols.i                   ;Zahl der tatsächlichen Spalten
  ColWidth.i                ;Breite jeder Tabellenspalte im Listicongadget
  NLines.i                  ;ungefähre Zahl der im ListiconGadget anzuzeigenden Zeilen
  Array GadNum.i(#maxCols) ; Nummern der zunächst unsichtbar erzeugten Gadgets für jede Spalte
  Array ColNames.s(#maxCols);Spaltenbezeichner der Query
  Array ColType.s(#maxCols)
  Array ColPref.s(#maxCols) ; Voreinstellungen für ComboBox
  Array ColLength.i(#maxCols); maximale Länge 
EndStructure

Procedure.i make_Gadget(*DWin.DBWin,DatType.s,Vorgabe.s,maxLen.i)
  ; Erzeugt an der Stelle psx,posy im Fenster ein zum DatTyp passendes Gadget
  ; g ist die Nummer des Gadgets 
  Protected n.i,p.i,res.i,posx.i,posy.i,W.i,H.i,Tip1.s,Tip2.s
  posx=0
  posy=0
  ;Der Wert für H wird später noch automatisch angepasst
  W=*DWin\ColWidth
  Tip1.s="<RET>:Ende <ESC>: Abbruch der Dateneingabe"
  Select DatType 
    Case "TEXT"   ;**Besser einen Typzusatz definieren, nach dem der Wert nicht angezeigt wird (gut in ColPref())
      res=TextGadget(#PB_Any,posx,posy,W,H,"")
      GadgetToolTip(res,"Typ=TEXT;"+Tip1)
    Case "INTEGER"     
      res=StringGadget(#PB_Any, posx,posy, W,H,Vorgabe,#PB_String_Numeric)
      GadgetToolTip(res,"Typ=INTEGER "+Tip1)
      ;Möglich auch:res=SpinGadget(#PB_Any, posx,posy, W,H,-10000000,10000000,#PB_Spin_Numeric)
    Case "VARCHAR"
      res=StringGadget(#PB_Any, posx,posy, W,H,Vorgabe)
      GadgetToolTip(res,"TYP=VARCHAR "+Tip1)
    Case "DATETIME"
      res=DateGadget(#PB_Any,posx,posy, W,H,"%dd.%mm.%yyyy",0)
      GadgetToolTip(res,"Typ=DATETIME")
    Case "ENUM"   
      res=ComboBoxGadget(#PB_Any,posx,posy, W,H)      
      Vorgabe=LTrim(Vorgabe,",")       ; ggf. , am Anfang bzw. Ende eliminieren
      Vorgabe=RTrim(Vorgabe,",")
      p=CountString(Vorgabe,",") +1     ; Zahl der Elemente ermitteln
      For n=1 To p
        AddGadgetItem(res,-1,StringField(Vorgabe,n,","))          
      Next
      GadgetToolTip(res,"Typ=ENUM")
    Case "FLOAT"
      res=StringGadget(#PB_Any, posx,posy, W,H,Vorgabe)
      GadgetToolTip(res,"TYP=FLOAT "+Tip1)
    Case "BOOLEAN"
      res=ComboBoxGadget(#PB_Any,posx,posy, W,H) 
      AddGadgetItem(res,-1,"0")
      AddGadgetItem(res,-1,"1")
      GadgetToolTip(res,"Typ=BOOLEAN")
    Default
      MessageRequester("undef. Spaltenttyp",DatType)
  EndSelect 
  ProcedureReturn res
EndProcedure

Procedure defQuery(*DWin.DBWin,Query.s,Table.s,IDCol.i)
  ;speichert die Querydaten in den Fenstereigenschaften
  With *DWin
    \Query=Query  : \Table=Table  : \IDCol=IDCol
  EndWith
EndProcedure

Procedure setColData(*DWin.DBWin,ColNr.i,Typ.s,Pref.s,Length)
  ; Überschreibt die aus der Datenbank übernommenen Änderungen
  ;setzt Daten für diese Spalte in jedem Fall auf den übergebenen Wert
  ;Typ="" oder Length=0   : Keine Änderung
  With *DWin
    \ColType(ColNr)=Typ 
    If Pref   : \ColPref(ColNr)=Pref      :EndIf
    If Length : \ColLength(ColNr)=Length  :EndIf 
  EndWith
EndProcedure

Procedure.i FieldIndex(FieldStr.s,SearchStr.s,Sep.s)
  ;Bestimmt den Index von Search in Searchstr
  Protected Cols.i,index.i,res.i
  Cols=CountString(FieldStr,Sep)
  For index=1 To Cols
    If StringField(FieldStr,index,Sep)=SearchStr
      res=index
      Break
    EndIf
  Next
  ProcedureReturn res
EndProcedure

Procedure.s getColData(DBNr.i,DBTyp.i,Table.s,Typ.i)
  ;Ordnet den DB-Datentyp einem Spaltentyp zu
  ;Dies ist datenbankspezifisch und kann später vom User genauer bestimmt werden
  ;Die Datenbank muss geöffnet sein
  ;Typ=1:Spaltenbezeichner   Typ=2:Spaltentyp
  Protected res.s,Query.s
  Select DBTyp
    Case #SQLITE
      Query="PRAGMA table_info('"+ Table+ "')"
      ;Die Werte für GetDatabaseString (Werte stehen in Typ)
      ;0:cid(int)  1:name(string)  2:type(string) 3:notnull(int)
      ;4:dflt_value(string) 5: pK(int) [beteiligt am primary key)
      If DatabaseQuery(DBNr,Query)
        While NextDatabaseRow(DBNr)
          res + GetDatabaseString(DBNr,Typ)+"|"
        Wend
        ;RTrim(Res,"|")
      EndIf  
    Case #ODBC_Firebird  ;noch nicht umgesetzt
    Case #POSTGRES       ;noch nicht umgesetzt
    Case #ODBC_MYSQL          ;noch nicht umgesetzt
    Default   ; Datenbanktyp unbekannt
      MessageRequester("DB-Typ unbekannt",Str(DBTyp))
  EndSelect 
  FinishDatabaseQuery(DBNr)
  ProcedureReturn res
EndProcedure

Procedure makeDatWin(*DWin.DBWin,DB,W.i,H.i,Title.s,ColWidth.i,NLines.i)
  Protected QCols.i,Spalte.i,LGadNr.i,LGadWidth.i,LGadHeight.i,DBColNames.s,DBColTypes.s,ColName.s,ind.i,DBColType.s
  
  With *DWin  ;übergebene Fenstereinstellungen in den Fensteigenschaften speichern
    \DBNr=DB  :\WWidth=W  :  \WHeight=H  : \WinTitle=Title  :\NLines=NLines  :\ColWidth=ColWidth
  EndWith
  *DWin\WinNr=OpenWindow(#PB_Any,#PB_Any,#PB_Any,W,H,Title,#PB_Window_SystemMenu|#PB_Window_SizeGadget)
  AddKeyboardShortcut(*DWin\WinNr,#PB_Shortcut_Return,13)  ; RETURN für Übernahme der Gadgeteingabe
  AddKeyboardShortcut(*DWin\WinNr,#PB_Shortcut_Escape,27)  ; ESC für Abbruch der Gadgeteingabe
  DBColNames=getColData(DB,#SQLite,*DWin\Table,1)   ;alle Spaltenbez.  der DB; ***#SQLITE später noch verallgemeinern!!
  DBColTypes=getColData(DB,#SQLite,*DWin\Table,2)   ;alle Spaltentypen der DB
  If DatabaseQuery(DB,*DWin\Query)
    QCols=DatabaseColumns(*DWin\DBNr)  ; Query liefert Cols Spalten
    *DWin\NCols=QCols ;deren Anzahl in den Windowparametern speichern
  EndIf
  For Spalte=1 To QCols  ;alle Queryspalten durchlaufen
    ColName=DatabaseColumnName(DB,Spalte -1)  ;Spaltenname der Query
    ind=FieldIndex(DBColNames,ColName,"|")    ;auch in den Spaltennamen der DB?
    If ind   ;Spaltenbezeichner der Query ex. auch in Datenbanktabelle
      *DWin\ColNames(Spalte)=ColName
      If *DWin\ColType(Spalte)  ; anderer Typ für die Spalte definiert
      Else                   ; dann den Typ übernehmen
        *DWin\ColType(Spalte)=StringField(DBColTypes,ind,"|")
      EndIf
    Else  ;Spaltenbezeichner unbekannt
      MessageRequester("Query",ColName+": Unbekannter Spaltenbezeichner")
    EndIf      
  Next
  LGadWidth=*DWin\ColWidth*QCols+40  ;Gadgetbreite aus Spaltenzahl u. Spaltenbreite;ca. 40 für scroll
  ;Zuerst Listicingadget erzeugen;Höhe wird später angepasst;Überschrift=Spalte 0 der Query
  *DWin\ListGadNr=ListIconGadget(#PB_Any,20,20,LGadWidth,400,DatabaseColumnName(DB,0),*DWin\ColWidth,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
  LGadNr=*DWin\ListGadNr ; zur besseren Lesbarkeit 
  GadgetToolTip(LGadNr,"Doppelklick auf Tabellenelement für Änderungen")
  ;Anpassen der Höhe des ListiconGadgets:zuerst fiktiven Eintrag
  AddGadgetItem(LGadNr,-1,"adb")
  LGadHeight=(NLines-1)*ColHeight(LGadNr)+headerHeight(LGadNr)
  RemoveGadgetItem(LGadNr,0) ;;Zeilenhöhe ermittelt --> fiktive Zeile wieder löschen
  ResizeGadget(*DWin\ListGadNr,#PB_Ignore,#PB_Ignore,#PB_Ignore,LGadHeight)
  For Spalte= 1 To QCols -1  ;Spaltenbezeichner (Spalte 0 schon bei Gadgetanlage gesetzt)
    AddGadgetColumn(LGadNr,Spalte,DatabaseColumnName(DB,Spalte),*DWin\ColWidth)
  Next
  ;Erzeugung des (zunächst) unsichtbaren Gadgets für jede Spalte 
  ; deren Nummernliste zu den Windoweigenschaften
  For Spalte=1 To QCols 
    *DWin\GadNum(Spalte)=make_Gadget(*DWin,*DWin\ColType(Spalte),*DWin\ColPref(Spalte),*DWin\ColLength(Spalte))
    If *DWin\ColLength(Spalte)  ;max. Zeichenzahl gewünscht?
      GadgetToolTip(*DWin\GadNum(Spalte),"Typ "+*DWin\ColType(Spalte)+";"+*DWin\ColLength(Spalte)+" Zeichen max.;RET:Ende der Eingabe")
      ;Else
      ;GadgetToolTip(*DWin\GadNum(Spalte),"Typ "+*DWin\ColType(Spalte)+"; RET:Ende der Eingabe")
    EndIf 
    HideGadget(*DWin\GadNum(Spalte),1)   ; vorläufig unsichtbar machen
  Next
  If *DWin\IDCol  ;ID-Spalte angegeben?
    SendMessage_(GadgetID(*DWin\GadNum(*DWin\IDCol)), #EM_SETREADONLY, 1, 0)
  Else
    MessageRequester("fehlende Angabe","IDCol=?? "+Chr(10)+"Nummer der Spalte, die den Datensatz identifiziert")
  EndIf
EndProcedure


Procedure fillDatWin(*DWin.DBWin,QLine1.i,QLine2.i)
  ;zeigt im ListiconGadget die Queryzeilen von QLine1 bis QLine2
  Protected GadNr.i,Inhalt.s,Cols.i,DB.i,RowNum.i,Zeile.i,Spalte.i
  GadNr=*DWin\ListGadNr
  DB=*DWin\DBNr
  Cols=DatabaseColumns(DB)
  If DatabaseQuery(DB,*DWin\Query)
    RowNum=0
    Zeile=0
    While NextDatabaseRow(DB)
      RowNum=RowNum+1
      If RowNum >=QLine1 And RowNum <=QLine2
        Zeile=Zeile+1
        Inhalt=GetDatabaseString(DB,0)
        For Spalte= 1 To  Cols
          Inhalt=Inhalt+Chr(10)+GetDatabaseString(DB,Spalte)
          ;?? ****** Hier fehlt eine Ausnahme für Typ="Date", weil das Datum als Integer und nicht als String übergeben wird
        Next
        AddGadgetItem(GadNr,-1,Inhalt)
      EndIf
    Wend
  EndIf
EndProcedure

Procedure LvMausclick(lvid,*p.Point)
  ;von hjBremer
  ;Zeile und Spalte des Mausklicks im Gadget mit der ID lvid
  ;ermitteln und in p.Point notieren
  ;Aufrufbeispiel für ListiconGadget mit der Nummer LIG
  ;im Eventhandling bei EventType()=#PB_EventType_LeftClick
  ;LvMausclick(GadgetID(LIG),p)
  ;Wert steht dann in p\x bzw. p\y (Zählung ab Zeile,Spalte =0)
  Protected lvhit.LVHITTESTINFO
  GetCursorPos_(*p)  ;wo ist Maus
  MapWindowPoints_(0, lvid, *p, 1) ;Cursorpos mappen zum LV 
  lvhit\pt\x = *p\x
  lvhit\pt\y = *p\y
  SendMessage_(lvid, #LVM_SUBITEMHITTEST, 0, lvhit)               
  *p\y = lvhit\iItem      ;row ab 0
  *p\x = lvhit\iSubItem   ;col ab 0
EndProcedure 

Procedure.i changed(*DWin.DBWin,GadNr.i,Value.s,Zeile.i,Sp.i)
  Protected Query.s,numValue.s,res.i
  ;Hier werden alle Änderungen in die DB übertragen
  ;Bei erfolgreicher DB-Übernahme wird 1 zurückgereicht
  If Sp <> *DWin\IDCol  ; Keine Rückmeldung bei Änderungen in ID-Spalte
    Query="UPDATE " + *DWin\Table + " SET "+ *DWin\ColNames(Sp)+" ='"+Value+"'"
    Query +" WHERE "+*DWin\ColNames(*DWin\IDCol)+ "="+GetGadgetItemText(*DWin\ListGadNr,Zeile-1,*DWin\IDCol-1)
    ;***** Fehlt noch: Berücksichtigung numerischer Werte FLOAT INTEGER,DATETIME,ENUM? **********
    If DatabaseUpdate(*DWin\DBNr,Query)
      ;MessageRequester("Änderung,Query=",Query)  ;Datenbankübernahme erfolgreich
      res=1
    Else
      MessageRequester("DB-Error",Query)
    EndIf
  EndIf
  FinishDatabaseQuery(*DWin\DBNr)
  HideGadget(GadNr,1)
  ProcedureReturn res
EndProcedure

Procedure changedValues(*DWin.DBWin,GadNr.i,GadTyp.s,Event.i,EvTyp.i,CLength.i,Zeile.i,Spalte.i)
  ;Wartet auf Eingaben im Fenster DatWin und übernimmt sie
  
  Protected dat.i,altWert.s,actWin.i,LIcNr,Datum.s
  LIcNr=*DWin\ListGadNr
  
  Select GadTyp
    Case "TEXT"   ; mache gar nichts ???**************
    Case "DATETIME"  ;Eingabeende nach Auswahl;***Problem:Monatswechsel
      dat=GetGadgetState(GadNr)
      Datum=FormatDate("%dd.%mm.%yyyy", dat)
      changed(*DWin,GadNr,Datum,Zeile,Spalte)
      SetGadgetItemText(LIcNr,Zeile -1,Datum,Spalte-1)
      DisableGadget(LIcNr,0)
      SetActiveGadget(LIcNr)
      ;visGadNr=0
    Case "ENUM"  ;Eingabeende nach Wahl
      If EvTyp=#PB_EventType_Change
        changed(*DWin,GadNr,GetGadgetText(GadNr),Zeile,Spalte)
        SetGadgetItemText(LIcNr,Zeile-1,GetGadgetText(GadNr),Spalte-1)
        DisableGadget(LIcNr,0)
        SetActiveGadget(LIcNr)
        ;visGadNr=0
      EndIf
    Case "BOOLEAN"   ;Eingabeende nach Auswahl
      If EvTyp=#PB_EventType_Change
        changed(*DWin,GadNr,GetGadgetText(GadNr),Zeile,Spalte)
        SetGadgetItemText(LIcNr,Zeile-1,GetGadgetText(GadNr),Spalte-1)
        DisableGadget(LIcNr,0)
        SetActiveGadget(LIcNr)
        ;visGadNr=0
      EndIf
    Case "VARCHAR"  ; Buchstabe oder Ziffer ergänzt;Warten auf RETURN  
      Select EvTyp
        Case #PB_EventType_Change      ; bei Änderung
          If CLength=0:CLength=100:EndIf   ; Keine Angabe --> bis zu 100 Zeichen
          checkstringInput(GadNr,32,122,"äÄöÖüÜ",CLength) ;zuläss. Zeichen + Umlaute;max. Länge
      EndSelect
    Case "INTEGER"   ;Eingabeende mit RETURN
      Select EvTyp
        Case #PB_EventType_Change
          ;max L=9 Ziffern (48<=ASC<>57) für diesen Datentyp
          checkstringInput(GadNr,48,57,"",9)               
      EndSelect          
    Case "FLOAT" ;Änderungen kontrollieren; Eingabeende RETURN       
      If EvTyp=#PB_EventType_Change
        checkfloatInput(GadNr)
      EndIf
  EndSelect
EndProcedure

Procedure showQueryParams(*DWin.DBWin)
  ;Hilfreich bei Fehlersuche z.B. bei Datentypübernahme    
  Protected ind.i,Cols.i,Sp.i,Ausgabe.s,IDCol.s
  Cols=*DWin\NCols
  For Sp=1 To Cols
    Ausgabe+Str(Sp)+ "  "+*DWin\ColNames(Sp)+"  ,"+*DWin\ColType(Sp)+" , "
    Ausgabe +*DWin\ColPref(Sp)+","+Str(*DWin\ColLength(Sp)) 
    If Sp=*DWin\IDCol :Ausgabe+"  * UNIQUE *": EndIf   ;* bei IDSpalte
    Ausgabe+Chr(10)
  Next    
  MessageRequester("Ergebnisspalten",Ausgabe)   
EndProcedure


Procedure handleEvents(*DWin.DBWin)
  Protected Ev.i,EventWin.i,EvType.i,EvGad.i,aktDatWin.i,visGadNr.i,LIcNr.i,p.POINT,ColBeginx.i,RowBeginy.i
  Protected Col.i,topIndex.i,aktColWidth.i
  aktDatWin=*DWin\WinNr
  LIcNr=*DWin\ListGadNr
  Repeat
    Ev=WaitWindowEvent()
    If Ev
      EventWin=EventWindow()
      If EventWin=aktDatWin   ; Ereignis betrifft das Tabellenfenster
        If Ev=#PB_Event_Gadget ; GadgetEvent im Tabellenfenster
          EvType=EventType()
          EvGad=EventGadget()
          Select EvGad
            Case visGadNr  ; das durch Doppelclick erzeugte Gadget wurde angeklickt
              Select EvType
                Case #PB_EventType_Change
                  changedValues(*DWin,visGadNr,*DWin\ColType(1+p\x),Ev,EvType,*DWin\ColLength(1+p\x),1+p\y,1+p\x) 
              EndSelect
            Case LIcNr  ; das Listicongadget wurde angeklickt
              Select EvType
                Case #PB_EventType_LeftDoubleClick  ;Doppelclick auf ListiconGadget
                  LvMausclick(GadgetID(LIcNr),@p.Point)
                  ColBeginx=GadgetX(LIcNr)  ;x-Offset Window-->ListiconGadget
                  RowBeginy=GadgetY(LIcNr)  ;y-Offset Window
                  For Col=0 To p\x -1  ;aktuelle Längen der vorhergehenden Spalten addieren
                    ColBeginx+SendMessage_(GadgetID(LIcNr),#LVM_GETCOLUMNWIDTH,Col,0)
                  Next
                  ;Horizontale Scrollposition abziehen
                  ColBeginx-GetScrollPos_(GadgetID(LIcNr),#SB_HORZ)
                  ;Doppelklick auf Queryliste in Zeile=1+p\y und  Spalte=1+p\x  Zählung jeweils ab 1
                  topIndex=1+SendMessage_(GadgetID(LIcNr), #LVM_GETTOPINDEX, 0, 0);Zählung ab 1
                  RowBeginy+headerHeight(LIcNr)+(1+p\y-topIndex)*ColHeight(LIcNr)
                  aktColWidth=SendMessage_(GadgetID(LIcNr),#LVM_GETCOLUMNWIDTH,p\x,0)
                  ;folgende +2 wg. Umrandung bzw. Linien des Listicongadgets
                  ResizeGadget(*DWin\GadNum(1+p\x),ColBeginx+2,RowBeginy+2,aktColWidth,ColHeight(LIcNr))
                  ;Gadget sichtbar machen, mit Wert aus ListiconGadget vorbelegen und Focus darauf
                  HideGadget(*DWin\GadNum(1+p\x),0)
                  SetGadgetText(*DWin\GadNum(1+p\x),GetGadgetItemText(LIcNr,p\y,p\x))
                  DisableGadget(LIcNr,1)        ; Alle weiteren Aktionen für sichtbar gemachtes Gadget
                  SetActiveGadget(*DWin\GadNum(1+p\x))
                  visGadNr=*DWin\GadNum(1+p\x) 
                  DisableGadget(visGadNr,0)
                Default
                  ;Keine weiteren Events für Listicongadget vorgesehen
              EndSelect    
          EndSelect
        ElseIf Ev=#PB_Event_Menu  ; Menü im Datenfenster aufgerufen 
          Select EventMenu()       
            Case 13 ; Return-Taste gedrückt; Eingabe abgeschlossen;         
              HideGadget(visGadNr,1)
              DisableGadget(LIcNr,0)
              SetActiveGadget(LIcNr)
              If changed(*DWin,visGadNr,GetGadgetText(visGadNr),1+p\y,1+p\x) ;korrekt in DB übernommen?
                SetGadgetItemText(LIcNr,p\y,GetGadgetText(visGadNr),p\x)
              EndIf
              visGadNr=0
            Case 27  ; ESC Abbruch Gadgetwert wird nicht übernommen
              HideGadget(visGadNr,1)
              DisableGadget(LIcNr,0)
              SetActiveGadget(LIcNr)
              visGadNr=0
          EndSelect  
        EndIf
      Else 
        ;****  anderes Fenster als Tabellenfenster 
      EndIf
    EndIf   
  Until EventWin=aktDatWin And Ev = #PB_Event_CloseWindow
EndProcedure

Code: Alles auswählen

;*********************************** Hauptprogramm **************************************

Define.DBWin  DatWin,DB.i

DB=make_RAM_SQLite() ;Musterdatenbank im RAM erzeugen und mit Zufallswerten füllen

If LoadFont(1, "Arial", 10)             ;keine zu kleine Schriftgröße wählen wg. einer Gadgettypen wie Combobox
  SetGadgetFont(#PB_Default, FontID(1))
EndIf
; Reihenfolge beachten: defQuery -->setColData -->makeDatWin--> fillDatWin --> handleEvents
  
;Abfrage mit durcheinandergewürfelten Spalten für Tabelle 'Test'; ID steht hierbei in Spalte 3
defQuery(@DatWin,"SELECT Artikel,Kaufdatum,ID,Abverkauf,ArtikelNr,Einzelpreis,Artikelzustand FROM Test","Test",3)
setColData(@DatWin,1,"VARCHAR","",20)  ; Tabellenspalte 2: CHAR(20) umwandeln in VARCHAR mit Länge 20
setColData(@DatWin,7,"ENUM","neu,gebraucht,wertlos",0) ;Queryspalte 6: Typ und Länge bleiben, aber Auswahl vorgeben
makeDatWin(@DatWin,DB,700,600,"Mein Datenfenster",90,25)     ;Fenster für Datenbank DB einrichten
fillDatWin(@DatWin,1,190)   ; Queryzeilen von 1 bis max. Zeile 190 anzeigen
handleEvents(@DatWin)
;showQueryParams(@DatWin)  hilfreich bei Fehlern in Datentypen oder Namen
Macht es Sinn, in dieser Richtung weiterzuarbeiten?
Manche Fehler fallen nämlich in SQLITE gar nicht auf, weil diese DB keine strikten Typen sondern Typenklassen hat und mit der Eingabe benutzerfreundlich verfährt. So muss z.B. noch berücksichtigt werden, ob beim Update ein String oder ein nummerischer Wert zurückgereicht wird.

Re: Datenbankbrowser

Verfasst: 03.01.2014 18:24
von Kiffi
kleiner Verbesserungsvorschlag:

Code: Alles auswählen

 ElseIf Ev=#PB_Event_Menu  ; Menü im Datenfenster aufgerufen 
  Select EventMenu()       
    Case 13 ; Return-Taste gedrückt; Eingabe abgeschlossen;         
      HideGadget(visGadNr,1)
      [...]
    Case 27  ; ESC Abbruch Gadgetwert wird nicht übernommen
      HideGadget(visGadNr,1)
      [...]
Bevor Du das Gadget versteckst, solltest Du mit IsGadget() prüfen, ob es auch wirklich da ist.

Code: Alles auswählen

If IsGadget(visGadNr)
  HideGadget(visGadNr,1)
Grüße ... Kiffi

Re: Datenbankbrowser

Verfasst: 04.01.2014 13:47
von ProgOldie
Ein Super-Hinweis, danke!
Wenn ich so verfahre wie von Kiffi vorgeschlagen, richte ich bei Spalten, deren Inhalte nicht geändert werden können bzw. sollen (z.B. die ID-Spalte) einfach kein Gadget ein. Dieser Fall wird von der Erweiterung abgefangen.