Getpixel / Setpixel

Computer: Software & Programmierung Visual Basic
#1

Hallo,

ich habe eine richtextbox, deren hintergrundfarbe zur laufzeit festgelegt wird.
Danach wird aus einer Ressource etlige Bilder geladen, die dann je nachdem in der Richttexbox angezeigt werden.

Sowie die Hintergrundfarbe von den der Richtextbox geaendert wird, rufe ich die Sub MT auf, die folgendermassen ausschaut

Aufruf über MT textbox.backcolor

public sub MT ( Color as long)
on error resume next
dim k as byte
dim i as long
dim j as long
dim tf as long
for k=0 to picture1.count
picture1(k).scalemode=3
tf = getpixel(picture1(k).hdc,1,1) ’ Tranzparente Farbe festlegen
for i=0 to picture1.scalewidht
for j = o to picture1.scaleheight
if getpixel (picture1(k).hdc,i,j)=tf then setpixel picture1(k).dc,i,j,color)
next j
next i
picture1(k).refresh

Soweit funktioniert alles und die bilder nehme auch die gewünschte die farbe.
Aber wenn ich sie nun in die zwischenablage kopiere und dann wieder einfüge, ist nach wievor der veraenderte Bereich schwarz :frowning:

Weiss jemand woran das liegt oder wie man das abstellen kann?

MFG Alex
next k

#2

Hi Alex,
mal einen Quellcode, der knapp an Deinem Problem vorbei geht, Dein Problem aber wahrscheinlich löst. :smile:

 Picture1.AutoRedraw = True
 For r = 0 To Picture1.Height - 1
 For c = 0 To Picture1.Width - 1
 p = Picture1.Point(c, r)
 If p = 12632256 Then 'grau
 Picture1.PSet (c, r), 0
 End If
 Next
 Next
 Picture1.Picture = Picture1.Image
 Clipboard.SetData Picture1.Picture
 Picture2.Picture = Clipboard.GetData

die wichtigen Zeilen sind dabei

Picture1.AutoRedraw = True

und

Picture1.Picture = Picture1.Image

:wink:

Danach wird das veränderte Blid in die Zwischenablage kopiert und ‚richtig‘ in die zweite Picturebox kopiert. (Bei Dir in die Richtextbox.)

(Ich hoffe, es hilft.)

Gruß, Rainer

#3

Hallo Rainer,

deine variante funzt astrein. Ich dank dir wie verueckt!
Sie dauert zwar maechtig lange, da es insgesamt 65 Bilder sind die geaendert werden muessen, aber naja das nehme ich in kauf :smile:

Weisst du warum meine Variante mit getpixel und setpixel nicht geht?
Kann es sein das die daten nur auf der picturebox geaendert wurden und nicht im speicher und er die daten beim kopieren aus dem speicher nimmt? und das du mit deiner variante die daten im speicher aenderst und durch die anweisung autoRedraw automatisch das picture element aktualisierst?

MFG Alex

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

#4

Hi Alex,

Weisst du warum meine Variante mit getpixel und setpixel nicht
geht?

wissen ist zu viel gesagt. :wink:
Ich rate, daß es an ‚Picture1.Picture = Picture1.Image‘ liegt.
Getpixel - setpixel habe ich noch nie benutzt, keine Ahnung, was da anders ist.

Wegen des Zeitproblems, sieh Dir das mal an.

http://www.planetsourcecode.com/vb/scripts/ShowCode…

Nicht getestet, könnte aber die Lösung für Dich sein.

Gruß, Rainer

#5

Hi Alex,

ich habe das Beispielprogramm gerade mal getestet, ‚sauschnell‘! :wink:

Was ich noch ändern würde. … Nimm statt mehrerer Pictureboxen ein Pictureclip

FloodFill
Picture1.Picture = Picture1.Image
PictureClip1.Picture = Picture1.Picture
Picture2.Picture = PictureClip1.GraphicCell(n)

Dann hast Du nur einen Befehl zum füllen, sollte schneller gehen.

Gruß, Rainer

#6

Hallo Raine,

ich antworte hier mal in einem Posting auf deine 2 Antworten.
Es lag tatsaechlich an der zueisung!
Wenn ich anstatt picture1.picture … Picture1.image nehme geht es!

Was die Sache mit der Zeit angeht.

Ich habe mal schnell was getippelt. Schaue dir mal den Source an.
Ich habe 100 mal in einer Schleife die hintergrundfarbe gewechselt.
Mit der Variante „Get und Setpixel“ brauchte mein Rechner 1 Sekunde.
Mit deiner Variante war er schon bei 116 s.
Ok die zeitmessung ist sehr ungenau. Aber es reicht allemal um den unterschied zu sehen :smile:
Ich dank dir aber trotzdem sehr. Ohne deine Hilfe würde ich immernoch im dunkeln tappen :smile:

MFG Alex

Hier der Source …

Private Declare Function GetPixel Lib „gdi32“ (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib „gdi32“ (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function SendMessage Lib „user32“ Alias „SendMessageA“ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim d1 As Date

Private Sub printbild1(x As Long)
On Error Resume Next
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
Dim i, j, k As Long
k = GetPixel(Picture1.hdc, 0, 0)
For i = 0 To Picture1.ScaleWidth
For j = 0 To Picture1.ScaleHeight
If GetPixel(Picture1.hdc, i, j) = k Then SetPixel Picture1.hdc, i, j, vbBlue
Next j
Next i
Picture1.Refresh
Clipboard.Clear
Clipboard.SetData Picture1.Image
SendMessage RichTextBox1.hwnd, &H302, 0, 0
End Sub

Private Sub printbild2(x As Long)
Picture1.AutoRedraw = True
For r = 0 To Picture1.Height - 1
For c = 0 To Picture1.Width - 1
p = Picture1.Point(c, r)
If p = 13160660 Then 'grau
Picture1.PSet (c, r), vbBlue
End If
Next
Next
Picture1.Picture = Picture1.Image
Clipboard.Clear
Clipboard.SetData Picture1.Image
SendMessage RichTextBox1.hwnd, &H302, 0, 0
End Sub

Private Sub Command1_Click()
d1 = Now
For i = 1 To 100
printbild1 vblue + i
Next i
MsgBox DateDiff(„s“, d1, Now)
End Sub

Private Sub Command2_Click()
d1 = Now
For i = 1 To 100
printbild2 vblue + i
Next i
MsgBox DateDiff(„s“, d1, Now)
End Sub

#7

Hi Alex,

Was die Sache mit der Zeit angeht.

Ich habe mal schnell was getippelt. Schaue dir mal den Source
an.
Ich habe 100 mal in einer Schleife die hintergrundfarbe
gewechselt.
Mit der Variante „Get und Setpixel“ brauchte mein Rechner 1
Sekunde.
Mit deiner Variante war er schon bei 116 s.
Ok die zeitmessung ist sehr ungenau. Aber es reicht allemal um
den unterschied zu sehen :smile:

danke für den Hinweis. Das sehe ich mir gleich ganz genau an!

Da habe ich bisher immer mit dem falschen Befehl gearbeitet.
Wunderbar, dann hat die Aktion uns beide voran gebracht!
Schön, daß Dein Problemchen gelöst ist. Außer dem Denkanstoß konnte ich ja nicht helfen …

Gruß, Rainer