Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

array(adresse) an type weitergeben

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 17.11.2015, 08:56    Titel: array(adresse) an type weitergeben Antworten mit Zitat

hallo mal wieder Leute,

ich würde gern in einem Record eines Types die Adresse eines Typearrays speichern um aus dem Type später darauf zu zugreifen. Leider bekomme ich es nicht hin ein Pointer auf das Array zu erzeugen.

Code:
Type paket
  As String    text
  As Integer   posX, posY
End Type
dim as paket   textA(2)

dim as paket ptr txtp = @textA()


Print "UB " & UBound(*txtp(2))


sleep

_________________
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win64 (64bit)
OS: Windows NT 6.2 (build 9200)
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Elor



Anmeldungsdatum: 12.07.2013
Beiträge: 205
Wohnort: Konstanz

BeitragVerfasst am: 17.11.2015, 11:54    Titel: Antworten mit Zitat

Bei der zuweissung des Attay-Zeiger's musst Du ein Index angeben. Beispiel:
Code:

dim as paket Ptr txtp = @textA(0)

Ein zugriff mit uBound auf txtp ist meines wissends nicht moeglich, so umgestrickt wuerde dein Codeschnipsel funkrionieren.

Code:

Type paket
  As String    text
  As Integer   posX, posY
End Type
dim as paket   textA(2)

dim as paket Ptr txtp = @textA(0)

   textA(1).text= "Index 1"
   
Print "UB   " & UBound(textA)
Print "Text " & txtp[1].text

getkey
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1874
Wohnort: D59192

BeitragVerfasst am: 18.11.2015, 23:09    Titel: Antworten mit Zitat

Hi braesident,
was du genau machen möchtest sehe ich noch nicht.
Hier etwas zur Anregung:
Code:
'vertauschen der Reihenfolge erleichtert die Pointer-Dereferenzierung
Type paket
  As Long   posX, posY
  As String    text
End Type
Dim As paket textA(2)

'Array mit Werten füllen
textA(0).text= "Index 0"
textA(0).posX= 1
textA(0).posY= 2
textA(1).text= "Index 1"
textA(1).posX= 11
textA(1).posY= 12
textA(2).text= "Index 2"
textA(2).posX= 21
textA(2).posY= 22

Dim As Long Ptr lptr(UBound(textA))

For i As Long = 0 To UBound(textA)
  'Pointer anzeigen
  Print  @textA(i).posX, @textA(i).posY, @textA(i).text
  'ersten Pointer merken
  lptr(i) = @textA(i).posX
  'Pointer-Dereferenzierung
  Print *lptr(i), *lptr(i)+1, *Cast(String Ptr,lptr(i)+2)
Next

GetKey

_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 19.11.2015, 08:36    Titel: Antworten mit Zitat

Danke elor und volta

ich brauche die Adresse von 'Dim As paket textA(2)' um sie in einem großen Type für ein Objekt zu speichern, um aus einer darin deklarierten Sub oder Funktion zu zugreifen.

War das verständlich? grinsen
Code:
Type paket
  As Long   posX, posY
  As String    text
End Type
Dim As paket textA(2)

Type objectListView
  ''...jede menge Variablen
 
  ''hier meine lösung nach elor seinem Tipp
  As paket Ptr  txtPtr          '' adresse
  As Integer    UB_txtPtr     '' UBound-Grenze die über setTxtArray ermittelt wird
  declare Sub  setTxtArray( txtArray() As olvText )
  declare Sub  listeTextAuf  '' wird vom Programm dann aufgerufen wenn das Objekt gezeichnet werden soll
 
  ''noch andere Subs
End Type



bis hier funktioniert das schon ganz gut ist aber noch nicht vollständig.
Ich werde den Code vom ganzen Objekt dann in den nächsten Tagen nochmal posten. Dann würde ich mich nochmal über eure Meinung freuen, ob das dann so OK ist oder ob ich da ein Ram-Crasher gebastelt habe grinsen
_________________
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win64 (64bit)
OS: Windows NT 6.2 (build 9200)
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Elor



Anmeldungsdatum: 12.07.2013
Beiträge: 205
Wohnort: Konstanz

BeitragVerfasst am: 19.11.2015, 12:13    Titel: Antworten mit Zitat

Also wenn ich das richtig verstanden habe, meinst Du das so:
Code:

Type paket
  As Long   posX, posY
  As String    text
End Type
Dim As paket textA(2)

   textA(0).posX= 1: textA(0).posY= 1: textA(0).text= "Erster Satz"
   textA(1).posX= 10: textA(1).posY= 3: textA(1).text= "Zweiter Satz"
   textA(2).posX= 19: textA(2).posY= 5: textA(2).text= "Dritter Satz"

Type objectListView
  ''...jede menge Variablen
 
  ''hier meine lösung nach elor seinem Tipp
  As paket Ptr  txtPtr          '' adresse
  As Integer    UB_txtPtr     '' UBound-Grenze die über setTxtArray ermittelt wird
  declare Sub  setTxtArray( txtArray() As paket) '' olvText
  declare Sub  listeTextAuf  '' wird vom Programm dann aufgerufen wenn das Objekt gezeichnet werden soll
 
  ''noch andere Subs
End Type

Dim App As objectListView

   App.setTxtArray (textA())
   App.listeTextAuf ()
   
   GetKey ()

Sub objectListView.setTxtArray (txtArray() As paket)
   txtPtr= @txtArray(0)
   UB_txtPtr= UBound(txtArray)
End Sub

Sub objectListView.listeTextAuf ()
   For I As Integer= 0 To UB_txtPtr
      Locate(txtPtr[I].posY, txtPtr[I].posX)
      Print txtPtr[I].text, txtPtr+ I* SizeOf(paket)
   Next I
End Sub

Ist der UDT "paket" teil von objectListView mit fester groesse? Oder ist er Variable, wird er von mehreren Objekten benutzt?
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
RockTheSchock



Anmeldungsdatum: 04.04.2007
Beiträge: 138

BeitragVerfasst am: 19.11.2015, 21:37    Titel: Antworten mit Zitat

Also es gibt ja auch schon fertige Listenklassen wie z.B. mit mdTypes

https://www.freebasic-portal.de/downloads/bibliotheken/mdtypes-308.html


Evt. ist das ja was für dich.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 20.11.2015, 19:33    Titel: Antworten mit Zitat

Ja genau Elor, so in etwa sehen meine Subs aus. Es soll schon variabel bleiben damit mehrere Objekte erzeugt werden können.

Hi RockTheSchock, ja für Anreize ist das was. Ich glaube auch das es eine erstklassige Bibliothek ist. Ich habe mir allerdings schon eine GUI angelegt mit den gängisten Elementen. Dort soll dann das ListView-element mit eingefügt werden, sobald ich damit zufrieden bin.

Soweit bin ich erstmal. Es funktioniert aber es fehlt auch noch einiges.
Code:
screenRes 600, 700, 32
''#include once "\module\jpeg4fb.bas"

Type olvStyle
  As Integer   high(1)={ 30 , 30 }
  As Integer   color(1)={ &heeeeee , &heeeeee }
  As Any Ptr   pic(1)
  Declare Sub  setPicByPtr( picPtr As Any Ptr , nr As Integer = 0 )
  Declare Sub  setPicByStr( picStr As String  , nr As Integer = 0 )
End Type

Type olvMap
  As Integer   wide, high
End Type

Type olvText
  As String    text
  As Integer   posX, posY
End Type

Type objectListView
  As Integer   posx, posy, wide=150, high=200
  Declare Sub  setSize( newwide As Integer , newhigh As Integer )
  As Byte      hide=0, active=-1
  As Integer   entrys=0
  As Integer   entryAlpha=127
  As olvStyle  style
  As Byte      styleMode=0 ''0=style_0  1=style_1  2=abwechselnd  3=eigenereihenfolge
  As String    styleString ''zB "00011000010"
 
  As Integer   bg_color=&hffffff, no_bg=0, no_el_bg=0
  As Any Ptr   bg_pic, bg_original
  As String    bg_string
  Declare Sub  setNoBg
  Declare Sub  showBg
  Declare Sub  setNoElBg
  Declare Sub  showElBg
  Declare Sub  setBgPicByPtr( picPtr As Any Ptr )
  Declare Sub  setBgPicByStr( picStr As String )
 
  As olvText Ptr  txtPtr
  As Integer   UB_txtPtr
  Declare Sub  setTxtArray( txtArray() As olvText )
 
  As Any Ptr   map
  As olvMap    mapSize
  Declare Sub  createListMap
  Declare Sub  destroyList
 
  Declare Sub  drawList
End Type
Dim As objectListView   objectList()


Dim As Any Ptr   imgTmp
Dim As olvText   textA(2)
textA(1).text = "text 1.1|text 1.2|text 1.3|4|5|6|7|8|9|10|11|12": textA(1).posX = 10: textA(1).posY = 3
textA(2).text = "text 2.1|text 2.2|text 2.3": textA(2).posX = 20: textA(2).posY = 15

ReDim objectList(1)

With objectList(1)
  .style.high(1) = 15
  .style.color(0) = &Hff0000
  .style.color(1) = &Hffff00
  .styleMode = 2
  .entryAlpha=200
  ''.styleString = "011101"
  .entrys = 5
  .posX = 10
  .posY = 10
  ''.setNoElBg
  ''.setNoBg
 
  ''imgTmp = ImageCreate( 100 , .high , &H0000ff )
  ''.setBgPicByPtr( imgTmp ): imageDestroy imgTmp
  .setBgPicByStr("C:\ProgramData\Microsoft\User Account Pictures\Default Pictures\usertile12.bmp")
 
  .setSize( 100 , 100 )

  cls
  .setTxtArray( textA() )
  .createListMap
  ScreenLock
    .drawList
  ScreenUnLock

  .destroyList
End With

sleep
end


Sub objectListView.setNoBg: no_bg = -1: End Sub
Sub objectListView.showBg: no_bg = 0: End Sub
Sub objectListView.setNoElBg: no_el_bg = -1: End Sub
Sub objectListView.showElBg: no_el_bg = 0: End Sub


Sub  objectListView.setTxtArray( txtArray() As olvText )
  UB_txtPtr = UBound(txtArray) '' Strings pro feld
  If   UB_txtPtr > 0   Then
    txtPtr = @txtArray(0)
   
    entrys = 0
    For i As Integer = 1 To UB_txtPtr
      Dim As Integer   idxCnt = IIF( txtPtr[i].text <> "" , 1 , 0 )
      For index As Integer = 0 To Len( txtPtr[i].text )-1
        If   txtPtr[i].text[index] = 124   Then   idxCnt += 1
      Next
      If   idxCnt > entrys   Then   entrys = idxCnt
    Next
  End If
 
End Sub


Sub  olvStyle.setPicByPtr( picPtr As Any Ptr , nr As Integer )
  Dim As Integer  picPtrW, picPtrH
  ImageInfo picPtr, picPtrW, picPtrH
 
  pic(nr) = imageCreate( picPtrW , picPtrH )
  Get picPtr, ( 0, 0 ) - Step( picPtrW-1, picPtrH-1 ), pic(nr)

End Sub


Sub  olvStyle.setPicByStr( picStr As String , nr As Integer )
  If picStr <> "" Then
   
    Dim as Integer bgW, bgH, bgff
    If       LCase( Mid( picStr , Len( picStr )-2 ) ) = "bmp"   Then
     
      bgff = FreeFile
      Open picStr For Binary As #bgff
       Get #bgff, 19, bgW 'Breite aus der BMP-Datei holen
       Get #bgff, 23, bgH  'Höhe aus der BMP-Datei holen
      Close #bgff
      pic(nr) = Imagecreate( bgW , bgH )
      Bload picStr, pic(nr)
     
'    ElseIf   LCase( Mid( picStr , Len((picStr))-2 ) ) = "jpg" Or _
'             LCase( Mid( picStr , Len((picStr))-3 ) ) = "jpeg"   Then
'     
'      pic(nr) = jpegget((picStr))
'      bgW = jpeg.cols
'      bgH = jpeg.rows
'     
    End If
   
  End If
 
End Sub


Sub objectListView.setSize( newwide As Integer , newhigh As Integer )
  wide = newwide: high = newhigh
 
  If      bg_pic <> 0  AndAlso  bg_string <> ""   Then
    imageDestroy( bg_pic )
    setBgPicByStr( bg_string )
   
  ElseIf  bg_pic <> 0  AndAlso  bg_original <> 0   Then
    imageDestroy( bg_pic )
    setBgPicByPtr( bg_original )
   
  End If
 
End Sub


Sub  objectListView.setBgPicByPtr( picPtr As Any Ptr )
  Dim As Integer  picPtrW, picPtrH
  ImageInfo picPtr, picPtrW, picPtrH
 
  If   bg_original = 0   Then
    bg_original = imageCreate( picPtrW , picPtrH )
    put bg_original, ( 0, 0 ), picPtr, pset
   
  End If
 
  bg_pic = imageCreate( wide , high )
  Get picPtr, ( 0, 0 ) - Step( IIF( picPtrW > wide , wide , picPtrW )-1, IIF( picPtrH > high , high , picPtrH )-1 ), bg_pic

End Sub


Sub  objectListView.setBgPicByStr( picStr As String )
  If picStr <> "" Then
    bg_string = picStr
   
    Dim As Any Ptr   tmpPic
    Dim as Integer   bgW, bgH, bgff
   
    If       LCase( Mid( picStr , Len( picStr )-2 ) ) = "bmp"   Then
     
      bgff = FreeFile
      Open picStr For Binary As #bgff
       Get #bgff, 19, bgW 'Breite aus der BMP-Datei holen
       Get #bgff, 23, bgH  'Höhe aus der BMP-Datei holen
      Close #bgff
      tmpPic = imageCreate( bgW , bgH )
      Bload picStr, tmpPic
      bg_pic = imageCreate( wide , high )
      Get tmpPic, ( 0, 0 ) - Step( IIF( bgW > wide , wide , bgW )-1, IIF( bgH > high , high , bgH )-1 ), bg_pic
     
'    ElseIf   LCase( Mid( picStr , Len((picStr))-2 ) ) = "jpg" Or _
'             LCase( Mid( picStr , Len((picStr))-3 ) ) = "jpeg"   Then
'      tmpPic = jpegget( picStr )
'      bgW = jpeg.cols
'      bgH = jpeg.rows
'      bg_pic = imageCreate( wide , high )
'      Get tmpPic, ( 0, 0 ) - Step( IIF( bgW > wide , wide , bgW )-1, IIF( bgH > high , high , bgH )-1 ), bg_pic
'     
'    End If
'    imageDestroy( tmpPic )
   
  End If
 
End Sub


Sub objectListView.createListMap
  If   Not map  AndAlso  entrys > 0   Then
    Dim As Integer thisHigh = 0, nextMode=0, lastMode=1
    Dim As Byte    styleNr
    If   styleMode = 3  AndAlso  Len(styleString) < entrys   Then   styleString += String( entrys-Len(styleString), "0" )
   
    For i As Integer = 1 To entrys
      styleNr = IIF( styleMode < 3 , IIF( styleMode < 2 , styleMode , nextMode ) , Val(Chr(styleString[i-1])) )
      styleNr = IIF( styleNr > 1 , 0 , styleNr )
     
      thisHigh += style.high(styleNr)
      Swap nextMode, lastMode
    Next i
   
    mapSize.wide = wide: mapSize.high = thisHigh
   
    map = ImageCreate(mapSize.wide, mapSize.high)
   
    Dim As olvText   textA2(UB_txtPtr)
    If   UB_txtPtr > 0   Then
      For i As Integer = 1 To UB_txtPtr
        textA2(i) = txtPtr[i]
      Next
    End If
   
   
    thisHigh = 0: nextMode=0: lastMode=1
    For i As Integer = 1 To entrys
      styleNr = IIF( styleMode < 3 , IIF( styleMode < 2 , styleMode , nextMode ) , Val(Chr(styleString[i-1])) )
      styleNr = IIF( styleNr > 1 , 0 , styleNr )
     
      If   Not style.pic(styleNr)  AndAlso  Not no_el_bg   Then
        Line map, ( 0 , thisHigh ) - Step( wide-1, style.high(styleNr)-2 ), style.color(styleNr), bf
       
      End If
     
      If   UB_txtPtr > 0   Then
        For i2 As Integer = 1 To UB_txtPtr
         
          If   style.high(styleNr) > 8 + txtPtr[i2].posY   Then
            Draw String map, ( txtPtr[i2].posX , txtPtr[i2].posY + thisHigh ), Mid( textA2(i2).text , 1 , InStr( textA2(i2).text , "|" )-1 )
           
          End If
         
          If   inStr( textA2(i2).text , "|" ) = 0   Then
            textA2(i2).text = ""
          Else
            textA2(i2).text = Mid( textA2(i2).text , InStr( textA2(i2).text , "|" ) + 1 )
          End If
         
        Next
      End If
     
      thisHigh += style.high(styleNr)
      Swap nextMode, lastMode
    Next i
   
  End If
 
End Sub


Sub objectListView.destroyList
  If   bg_original <> 0   Then
    imageDestroy bg_original
    bg_original = 0
  End If
  If   map <> 0   Then
    imageDestroy map
    map = 0
  End If
  If   bg_pic <> 0   Then
    imageDestroy bg_pic
    bg_pic = 0
  End If
  If   style.pic(0) <> 0   Then
    imageDestroy style.pic(0)
    style.pic(0) = 0
  End If
  If   style.pic(1) <> 0   Then
    imageDestroy style.pic(1)
    style.pic(1) = 0
  End If
 
End Sub


Sub objectListView.drawList
    If   Not hide  AndAlso  active  AndAlso  entrys > 0   Then
     
      If       bg_pic = 0  AndAlso  Not no_bg   Then
        Line( posX, posY ) - Step( wide, high ), bg_color, bf
       
      ElseIf   bg_pic  AndAlso  Not no_bg   Then
        Static As Any Ptr   bg_copy
        Static As Integer   bgWC, bgHC
        If   bg_copy <> bg_pic   Then
          bg_copy = bg_pic
          ImageInfo bg_pic, bgWC, bgHC
        End If
       
        put( posX , posY ), bg_pic,( 0 , 0 ) - Step( IIF( bgWC > wide , wide , bgWC )-1 , IIF( bgHC > high , high , bgHC )-1 ), pSet
        ''put( posX , posY ), bg_pic, pSet
       
      End If
     
      put( posX , posY ), map,( 0 , 0 ) - Step( IIF( mapSize.wide < wide , mapSize.wide , wide )-1 , IIF( mapSize.high < high , mapSize.high , high )-1 ), Alpha, entryAlpha
      ''put( posX , posY ), map( 1 , 1 ) - Step( 5 , 5 ), Alpha, 127
      ''
    End If
   
End Sub


_________________
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win64 (64bit)
OS: Windows NT 6.2 (build 9200)
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz