Bitmaps + SetPixel = Fail

AliveDevil · 2. August 2011, 22:07

Hi,

mal wieder ich,
dieses mal habe ich ein Problem mit Bitmaps und SetPixel...ja...SetPixel

ich habe eine Funktion, die mir ein Array aus 4 Bytes in ein Image presst.
Der Code:

VB.NET-Quellcode

Public Function GetImage() As Drawing.Bitmap
Dim bitmap As Drawing.Bitmap = New Drawing.Bitmap(_width, _height)
For x = 0 To _width
For y = 0 To _height
bitmap.SetPixel(x, y, colors(x, y).Color)
Next
Next
Return bitmap
End Function

_height = 50
_width = 50

alles wunderschön, nur...wenn ich dann mit der Funktion

VB.NET-Quellcode

Dim bla As New MyImage(50, 50)
bla.SetColor(0,0, New MyColor(255,255,255,255))
bla.SetColor(50, 50, New MyColor(255, 255, 255, 255))
Me.BackgroundImage = Bla.GetImage

VB.NET-Quellcode

Public Sub SetColor(ByVal x As Integer, ByVal y As Integer, ByVal color As MyColor)
If colors(x, y) IsNot Nothing Then
colors(x, y) = color
End If
End Sub

Das Bild auf die Form zeichne, wird der Punkt "50,50" nicht gezeichnet.
Benutzt ich statt "50,50", "49,49" wird ein "großes" 1 Px großes Rechteck in die untere Ecke gezeichnet.
Der Punkt "0,0" wird aber auf das Image gezeichnet...so..bin ich nun zu dämlich..oder ist ein Bitmap zu bescheuert, den Punkt unten rechts richtig anzumalen?

Gibts eine Lösung, dass zu umgehen, bzw. zu fixen?

Niko Ortner · 2. August 2011, 22:59

Im ersten Codeschnipsel wird bei Zeile 2 ein Bitmap Objekt mit der Höhe und Breite 50 erzeugt.
Das heißt die Pixel gehen von 0 bis 49. Wenn jetzt versucht wird ab 50, 50 etwas zu zeichnen befindet sich das natürlich nicht mehr auf dem Bitmap Objekt. Ich weiß nicht genau, was ein MyImage Objekt ist aber wenn Du auf eine Bitmap mit der Größe 50, 50 zeichnen willst muss Du bei 0, 0 beginnen und bei 49, 49 aufhören.

AliveDevil · 3. August 2011, 09:17

naja...das Problem dabei ist nur, dass ich dann ein Bild habe...das oben links einen kleinen Punkt als Pixel hat, und bei 49 49 ein riesengroßes Rechteck...
MyImage ist eine eigene Klasse wegen eines Bildformates...GetImage und SetColor sind teil von dem MyImage
Bild:holzshots.fessifi.de/holzshare/images/436b313.png

du siehst..49,49 macht Probleme...
das hier ist nur ein 5x5 Bild, damit man das besser sieht...Effekt ist aber derselbe

RodFromGermany · 3. August 2011, 09:50

Was ist MyImage?
Was ist MyColor?

AliveDevil · 3. August 2011, 09:56

MyImage ist eine eigens erstellte Klasse, damit ich Bilder in einem Spiel besser handlen kann
MyColor ist ebenfalls eine eigene Klasse, damit ich ebenfalls die Bilder in dem Spiel besser handlen kann

Sehr groß

VB.NET-Quellcode

Option Strict On
Imports FastGraphicsLib
Public Class MyImage
Private _width As Integer
Private _height As Integer
Private colors As MyColor(,)
Public Function WriteToFile(ByVal file As String) As Boolean
Dim stream As IO.FileStream = New IO.FileStream(file, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
Dim array() As Byte = New Byte() {&HAA, CType(_width, Byte), &HAA, CType(_height, Byte), CType(Asc("|"c), Byte)}
For Each item In array
stream.WriteByte(item)
Next
For x = 0 To _width
For y = 0 To _height
'writer.Write(color(x, y).R & color(x, y).G & color(x, y).B & color(x, y).Alpha & CType(x, Byte) & CType(y, Byte) & CType(Asc("|"c), Byte))
If Not colors(x, y) Is Nothing Then
stream.WriteByte(CType(x, Byte))
stream.WriteByte(CType(Asc(":"c), Byte))
stream.WriteByte(CType(y, Byte))
stream.WriteByte(CType(Asc(":"c), Byte))
stream.WriteByte(colors(x, y).R)
stream.WriteByte(colors(x, y).G)
stream.WriteByte(colors(x, y).B)
stream.WriteByte(colors(x, y).Alpha)
stream.WriteByte(CType(Asc("|"c), Byte))
End If
Next
Next
stream.Flush()
stream.Close()
stream.Dispose()
Return True
End Function
Public Function WriteToByteArray() As Byte()
Dim temparray As New List(Of Byte)
With temparray
.Add(&HAA)
.Add(CType(_width, Byte))
.Add(&HAA)
.Add(CType(_height, Byte))
.Add(CType(Asc("|"c), Byte))
For x = 0 To _width
For y = 0 To _height
'writer.Write(color(x, y).R & color(x, y).G & color(x, y).B & color(x, y).Alpha & CType(x, Byte) & CType(y, Byte) & CType(Asc("|"c), Byte))
If Not colors(x, y) Is Nothing Then
.Add(CType(x, Byte))
.Add(CType(Asc(":"c), Byte))
.Add(CType(y, Byte))
.Add(CType(Asc(":"c), Byte))
.Add(colors(x, y).R)
.Add(colors(x, y).G)
.Add(colors(x, y).B)
.Add(colors(x, y).Alpha)
.Add(CType(Asc("|"c), Byte))
End If
Next
Next
End With
Dim bytes(temparray.Count - 1) As Byte
Dim stream As New IO.MemoryStream(bytes, True)
stream.Write(temparray.ToArray, 0, temparray.Count - 1)
stream.Flush()
stream.Close()
stream.Dispose()
Return bytes
End Function
Sub New(ByVal width As Integer, ByVal height As Integer)
_width = width
_height = height
ReDim colors(_width, _height)
For x = 0 To _width
For y = 0 To _height
colors(x, y) = New MyColor
Next
Next
End Sub
Public Function GetImage() As Drawing.Bitmap
Dim bitmap As Drawing.Bitmap = New Drawing.Bitmap(_width, _height)
'Dim g As Drawing.Graphics = Drawing.Graphics.FromImage(bitmap)
For x = 0 To _width - 1
For y = 0 To _height - 1
'g.FillRectangle(New Drawing.SolidBrush(colors(x, y).Color), New Drawing.Rectangle(x, y, 1, 1))
bitmap.SetPixel(x, y, colors(x, y).Color)
Next
Next
Return bitmap
End Function
Public Sub ReadFromByteArray(ByVal bytes() As Byte)
Dim halt As Boolean = False
Dim position As Integer = 0
If Not bytes(position) = &HAA Then
Throw New NotSupportedException("The fileformat is not supported")
End If
position += 1
Dim width As Integer = 0
Do Until halt
If bytes(position) = &HAA Then
halt = True
Else
width += bytes(position)
End If
position += 1
Loop
halt = False
'If Not bytes(position) = &HAA Then
' Throw New NotSupportedException("The fileformat is not supported")
'End If
Dim height As Integer = 0
Do Until halt
If bytes(position) = CType(Asc("|"c), Byte) Then
halt = True
Else
height += bytes(position)
End If
position += 1
Loop
halt = False
Dim colors(width, height) As MyColor
Dim x As Integer = 0
Dim y As Integer = 0
Dim r As Integer = 0
Dim g As Integer = 0
Dim b As Integer = 0
Dim a As Integer = 0
Dim state As String = "x"
Do Until position > bytes.Length - 1
If state = "x" Then
If bytes(position) <> CType(Asc(":"c), Byte) Then
x += bytes(position)
Else
state = "y"
End If
ElseIf state = "y" Then
If bytes(position) <> CType(Asc(":"c), Byte) Then
y += bytes(position)
Else
state = "r"
End If
ElseIf state = "r" Then
r = bytes(position)
state = "g"
ElseIf state = "g" Then
g = bytes(position)
state = "b"
ElseIf state = "b" Then
b = bytes(position)
state = "a"
ElseIf state = "a" Then
a = bytes(position)
state = ""
Else
If bytes(position) = CType(Asc("|"c), Byte) Then
colors(x, y) = New MyColor(CByte(r), CByte(g), CByte(b), CByte(a))
x = 0
y = 0
r = 0
g = 0
b = 0
a = 0
state = "x"
End If
End If
position += 1
Loop
End Sub
Public Sub ReadFromFile(ByVal file As String)
Dim stream As IO.FileStream = New IO.FileStream(file, IO.FileMode.Open, IO.FileAccess.Read)
Dim bytes(CInt(stream.Length - 1)) As Byte
stream.Read(bytes, 0, CInt(stream.Length - 1))
ReadFromByteArray(bytes)
End Sub
Public Sub SetColor(ByVal x As Integer, ByVal y As Integer, ByVal color As MyColor)
If colors(x, y) IsNot Nothing Then
colors(x, y) = color
End If
End Sub
End Class
Public Class MyColor
Private _R As Byte
Private _G As Byte
Private _B As Byte
Private _Alpha As Byte
Sub New()
Me.New(0, 0, 0, 255)
End Sub
Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte, ByVal alpha As Byte)
_R = r
_G = g
_B = b
_Alpha = alpha
End Sub
Public Function Color() As Drawing.Color
Dim tcolor As Drawing.Color = Nothing
tcolor = Drawing.Color.FromArgb(_Alpha, _R, _G, _B)
Return tcolor
End Function
Public Property R As Byte
Get
Return _R
End Get
Set(ByVal value As Byte)
_R = value
End Set
End Property
Public Property G As Byte
Get
Return _G
End Get
Set(ByVal value As Byte)
_G = value
End Set
End Property
Public Property B As Byte
Get
Return _B
End Get
Set(ByVal value As Byte)
_B = value
End Set
End Property
Public Property Alpha As Byte
Get
Return _Alpha
End Get
Set(ByVal value As Byte)
_Alpha = value
End Set
End Property
End Class

RodFromGermany · 3. August 2011, 10:06

Wie ist colors deklariert?

AliveDevil · 3. August 2011, 10:08

colors ist ein zweidimensionales Array von MyColor^^

VB.NET-Quellcode

Dim colors As MyColor(,)

das ReDimme ich dann später

RodFromGermany · 3. August 2011, 10:12

Bei mir sieht das so aus:
Wie ist bei Dir BackgroundImageLayout eingestellt?

AliveDevil · 3. August 2011, 10:13

ist bei mir Stretched

RodFromGermany · 3. August 2011, 10:17

Mit Stretch ist mein Bild völlig schwarz.
Teste mal einige der Eigenschaften und dann beschreib Dein Problem mit diesem Wissen noch einmal.

AliveDevil · 3. August 2011, 10:28

also...
Stretch war natürlich völlig falsch..hab Zoom...naja

Mein Code zur generierung:

VB.NET-Quellcode

Dim bla As New MyImage(5, 5)
bla.SetColor(0, 0, New MyColor(255, 255, 255, 255))
'bla.SetColor(49, 49, New MyColor(255, 255, 255, 255))
bla.SetColor(4, 4, New MyColor(255, 255, 255, 255))
Me.BackgroundImage = Bla.GetImage

und die Sachen geben an:
SetColor(x, y, MyColor(weiß))

mit dem Code ist unten Rechts ein großes Rechteck
oben Links ein kleiner Punkt
mit SetColor(5,5,New MyColor(255,255,255,255))
wird unten Rechts nichts gezeichnet.

RodFromGermany · 3. August 2011, 11:12

Alles klar. scheiß Visual Basic.
Wenn Du Redim xxx(5) machst, werden die Indizes 0 bis 5, also 6 stück, erzeugt, deswegen knallt es nicht. Wegen Kompatibilität zu älteren VB-Versionen.
Die Bitmap jedoch hat die Pixel 0 bis 4 in beiden Richtungen:

VB.NET-Quellcode

Public Function GetImage() As Drawing.Bitmap
Dim bitmap As Drawing.Bitmap = New Drawing.Bitmap(_width, _height)
'Dim g As Drawing.Graphics = Drawing.Graphics.FromImage(bitmap)
For x = 0 To _width - 1 ' Deswegen
For y = 0 To _height - 1 ' Deswegen
'g.FillRectangle(New Drawing.SolidBrush(colors(x, y).Color), New Drawing.Rectangle(x, y, 1, 1))
bitmap.SetPixel(x, y, colors(x, y).Color)
Next
Next
Return bitmap
End Function

Dein Code.

AliveDevil · 3. August 2011, 11:14

ja...hatte ich auch schon...aber dann habe ich den selben Effekt wie, wenn ich SetColor(4,4) mache

RodFromGermany · 3. August 2011, 11:16

Ja. (4, 4) ist rechts unten.
Nun verstehe ich aber Dein Problem nicht mehr. Es sollte doch nun alles klar sein. Oder?

AliveDevil · 3. August 2011, 11:43

ja nein.

ich wollte ja wissen, wie ich dieses große rechteck unten rechts entfernen kann...wenn ich setpixel benutze

Vatter · 3. August 2011, 11:53

Kann dieser Effect mit dem verschwommenen Riesenpix was mit Antialiasing zum tun haben?

RodFromGermany · 3. August 2011, 12:02

Gib ihm die Farbe Schwarz.

jvbsl · 3. August 2011, 15:12

Kann dieser Effect mit dem verschwommenen Riesenpix was mit Antialiasing zum tun haben?

de.wikipedia.org/wiki/Skalierung_%28Computergrafik%29

hier wird wohl die Bikubische Interpolation verwendet...
(Ist bei GDI+ denke ich mit InterpolationMode einstellbar)...

AliveDevil · 3. August 2011, 19:16

okay...so ich habs hinbekommen...dank RodFromGermany

ich musste zwar noch etwas am Code ändern...aber jetzt funktioniert es...

mit ein bisschen Manipulation des Auslese Codes..funktioniert nun auch das Anzeigen richtig...

Am Ende nochmals Vielen Dank an alle, die sich die Mühe gemacht haben, mir bei meiner Dummheit zu helfen..

Bitmaps + SetPixel = Fail

Bitmaps + SetPixel = Fail

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Ähnliche Themen

5 Benutzer haben hier geschrieben