ich versuche gerade eine Texture umfärben su lassen. Klappt soweit ganz gut aber mir ist die ganze sache noch etwas zu langsam. Ich habe ein Bild/Texture von 2048*2048 welche ich umfärben will.
Vllt hat ja der ein oder andere eine Idee wie man es schneller machen kann.
Code: Alles auswählen
Global H.d,S.d,V.d
Procedure RGB_To_HSV(ColorRed.d,ColorGreen.d,ColorBlue.d)
MinColor.d
MaxColor.d
ColorRed / 255
ColorGreen / 255
ColorBlue / 255
If ColorRed < ColorGreen
MinColor = ColorRed
Else
MinColor = ColorGreen
EndIf
If MinColor > ColorBlue
MinColor = ColorBlue
EndIf
If ColorRed > ColorGreen
MaxColor = ColorRed
Else
MaxColor = ColorGreen
EndIf
If MaxColor < ColorBlue
MaxColor = ColorBlue
EndIf
If MaxColor = MinColor
H = 0
ElseIf MaxColor = ColorRed
H = 60 * ((ColorGreen-ColorBlue)/(MaxColor-MinColor))
ElseIf MaxColor = ColorGreen
H = 60 * (2+((ColorBlue-ColorRed)/(MaxColor-MinColor)))
ElseIf MaxColor = ColorBlue
H = 60 * (4+((ColorRed-ColorGreen)/(MaxColor-MinColor)))
EndIf
If MaxColor = 0
S = 0
H = 0
Else
S = (MaxColor-MinColor)/MaxColor
EndIf
V = MaxColor
EndProcedure
Procedure.l HSV_To_RGB()
ColorRed.d
ColorGreen.d
ColorBlue.d
If S = 0
ColorRed = V
ColorGreen = V
ColorBlue = V
Else
hi.d = H/60
l = Round(hi, #PB_Round_Down)
f.d = hi-l
p.d = V * (1-S)
q.d = V * (1-S*f)
t.d = V * (1-S*(1-f))
If l = 1
ColorRed = q
ColorGreen = V
ColorBlue = p
ElseIf l = 2
ColorRed = p
ColorGreen = V
ColorBlue = t
ElseIf l = 3
ColorRed = p
ColorGreen = q
ColorBlue = V
ElseIf l = 4
ColorRed = t
ColorGreen = p
ColorBlue = V
ElseIf l = 5
ColorRed = V
ColorGreen = p
ColorBlue = q
Else
ColorRed = V
ColorGreen = t
ColorBlue = p
EndIf
EndIf
ProcedureReturn Color.l = RGB(ColorRed * 255,ColorGreen * 255,ColorBlue * 255)
EndProcedure
Procedure ChangeColor(Grad)
StartTime = ElapsedMilliseconds()
If IsImage(1) = 0
LoadImage(1,"media\CarTexture.bmp")
LoadImage(3,"media\TailLight.png")
CreateImage(2,ImageWidth(1),ImageHeight(1),ImageDepth(1))
Global Dim Color(ImageWidth(1),ImageHeight(1))
StartDrawing(ImageOutput(1))
For i = 0 To ImageHeight(1)-1
For j = 0 To ImageWidth(1)-1
Color(j, i) = Point(j, i)
Next j
Next
StopDrawing()
EndIf
i = 0
j = 0
StartDrawing(ImageOutput(2))
For i = 0 To ImageHeight(1)-1
For j = 0 To ImageWidth(1)-1
RGB_To_HSV(Red(Color(j,i)),Green(Color(j,i)),Blue(Color(j,i)))
H + Grad
If H < 0
H + 360
ElseIf H > 360
H - 360
EndIf
Plot(j,i,HSV_To_RGB())
Next j
Next
DrawAlphaImage(ImageID(3), 0, 0)
StopDrawing()
SaveImage(2,"media\NewTexture.bmp",#PB_ImagePlugin_BMP)
Debug ElapsedMilliseconds()-StartTime
EndProcedure
Testsystem:
Win7 Ultimate
PB 4.6 x86
Intel Core 2 Duo T5250 @ 1,5ghz
2GB Ram
Nvidia Gforce 8600M GS 256mb
Gruß Zim