1 Attachment(s)
Dithering form with two colors
I needed to dither my form with two different colors but I didn't see any examples to do that here so I went ahead and threw something together. I hope it helps someone here. If you see anthing I can do to improve the code please let me know. I don't need to be reinventing the wheel but it was fun learning something new.
http://www.vbforums.com/attachment.php?s=&postid=881928
In a new project add the following
Code:
Option Explicit
Public Sub Dither(ByRef vForm As Form, _
ByVal SR As Integer, _
ByVal SG As Integer, _
ByVal SB As Integer, _
ByVal ER As Integer, _
ByVal EG As Integer, _
ByVal EB As Integer)
Dim i As Integer
Dim RDelta As Integer
Dim GDelta As Integer
Dim BDelta As Integer
Dim LineR(255) As Integer
Dim LineG(255) As Integer
Dim LineB(255) As Integer
' Make sure the colors are all valid values.
If SR < 0 Or SG < 0 Or SB < 0 Or ER < 0 Or EG < 0 Or EB < 0 Then Exit Sub
If SR > 255 Or SG > 255 Or SB > 255 Or ER > 255 Or EG > 255 Or EB > 255 Then Exit Sub
' We need To find the largest delta between the starting And ending RGB values. We need To
' scale these up up so they can be stepped through 256 times On one loop.
RDelta = Abs(SR - ER)
GDelta = Abs(SG - EG)
BDelta = Abs(SB - EB)
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
' Fill In the color values For the form.
For i = 0 To 255
If ER > SR Then
LineR(i) = SR + (RDelta / 255) * i
Else
LineR(i) = SR - (RDelta / 255) * i
End If
Next i
For i = 0 To 255
If EG > SG Then
LineG(i) = SG + (GDelta / 255) * i
Else
LineG(i) = SG - (GDelta / 255) * i
End If
Next i
For i = 0 To 255
If EB > SB Then
LineB(i) = SB + (BDelta / 255) * i
Else
LineB(i) = SB - (BDelta / 255) * i
End If
Next i
For i = 0 To 255
If LineR(i) < 0 Then LineR(i) = 0
If LineG(i) < 0 Then LineG(i) = 0
If LineB(i) < 0 Then LineB(i) = 0
If LineR(i) > 255 Then LineR(i) = 255
If LineG(i) > 255 Then LineG(i) = 255
If LineB(i) > 255 Then LineB(i) = 255
vForm.Line (0, i)-(Screen.Width, i - 1), RGB(LineR(i), LineG(i), LineB(i)), B
Next i
End Sub
Private Sub Form_Paint()
Call Dither(Me, 255, 0, 0, 0, 100, 100)
End Sub
