|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 17.11.2015, 08:56 Titel: array(adresse) an type weitergeben |
|
|
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 |
|
|
Elor
Anmeldungsdatum: 12.07.2013 Beiträge: 205 Wohnort: Konstanz
|
Verfasst am: 17.11.2015, 11:54 Titel: |
|
|
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 |
|
|
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1874 Wohnort: D59192
|
Verfasst am: 18.11.2015, 23:09 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 19.11.2015, 08:36 Titel: |
|
|
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?
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 _________________ 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 |
|
|
Elor
Anmeldungsdatum: 12.07.2013 Beiträge: 205 Wohnort: Konstanz
|
Verfasst am: 19.11.2015, 12:13 Titel: |
|
|
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 |
|
|
RockTheSchock
Anmeldungsdatum: 04.04.2007 Beiträge: 138
|
|
Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 20.11.2015, 19:33 Titel: |
|
|
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 |
|
|
|
|
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.
|
|