Posts: 484
Threads: 14
Joined: Apr 2005
there are various ways, but i use this
C = RGB(64, 127, 234)
B = C AND &HFF
G = (C AND &HFF00) SHR 8
R = (C AND &HFF0000) SHR 16
Print R, G, B
Sleep
EVEN MEN OF STEEL RUST.
Posts: 3,616
Threads: 287
Joined: Jan 2003
Thanks yetifoot. Bitwise operators to the rescue!
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 3,616
Threads: 287
Joined: Jan 2003
OK, I have some extremely crude code. It does blur, but it makes everything that was blurred look grey.
Code: TYPE Pixel
R AS INTEGER
G AS INTEGER
B AS INTEGER
END TYPE
DECLARE FUNCTION BlurPixel(INTEGER,INTEGER,INTEGER,INTEGER,INTEGER,INTEGER,INTEGER,INTEGER,INTEGER) AS Pixel
SCREENRES 300,200,24
RANDOMIZE TIMER
FOR I=1 TO 1000
CIRCLE (INT(RND*300),INT(RND*200)),INT(RND*15),RGB(INT(RND*255),INT(RND*255),INT(RND*255))
NEXT
SLEEP
DIM AS Pixel NewPixel
FOR X=100 TO 200
FOR Y=50 TO 150
TL=POINT(X-1,Y-1)
TM=POINT(X,Y-1)
TR=POINT(X+1,Y-1)
ML=POINT(X-1,Y)
MM=POINT(X,Y)
MR=POINT(X+1,Y)
BL=POINT(X-1,Y+1)
BM=POINT(X,Y+1)
BR=POINT(X+1,Y+1)
NewPixel=BlurPixel(TL,TM,TR,ML,MM,MR,BL,BM,BR)
PSET (X,Y),RGB(NewPixel.R,NewPixel.G,NewPixel.B)
NEXT
NEXT
SLEEP
FUNCTION BlurPixel(TL AS INTEGER,TM AS INTEGER,TR AS INTEGER,ML AS INTEGER,MM AS INTEGER,MR AS INTEGER,BL AS INTEGER,BM AS INTEGER,BR AS INTEGER) AS Pixel
DIM AS BYTE R,G,B
DIM AS Pixel Pixels(1 TO 9),RetPixel
DIM AS INTEGER I,RTotal,GTotal,BTotal,RetVal
Pixels(1).R=(TL AND &HFF0000) SHR 16
Pixels(2).R=(TM AND &HFF0000) SHR 16
Pixels(3).R=(TR AND &HFF0000) SHR 16
Pixels(4).R=(TM AND &HFF0000) SHR 16
Pixels(5).R=(MM AND &HFF0000) SHR 16
Pixels(6).R=(MR AND &HFF0000) SHR 16
Pixels(7).R=(BL AND &HFF0000) SHR 16
Pixels(8).R=(BM AND &HFF0000) SHR 16
Pixels(9).R=(BR AND &HFF0000) SHR 16
Pixels(1).G=(TL AND &HFF00) SHR 8
Pixels(2).G=(TM AND &HFF00) SHR 8
Pixels(3).G=(TR AND &HFF00) SHR 8
Pixels(4).G=(ML AND &HFF00) SHR 8
Pixels(5).G=(MM AND &HFF00) SHR 8
Pixels(6).G=(MR AND &HFF00) SHR 8
Pixels(7).G=(ML AND &HFF00) SHR 8
Pixels(8).G=(BM AND &HFF00) SHR 8
Pixels(9).G=(BR AND &HFF00) SHR 8
Pixels(1).B=TL AND &HFF
Pixels(1).B=TM AND &HFF
Pixels(1).B=TR AND &HFF
Pixels(1).B=ML AND &HFF
Pixels(1).B=MM AND &HFF
Pixels(1).B=MR AND &HFF
Pixels(1).B=BL AND &HFF
Pixels(1).B=BM AND &HFF
Pixels(1).B=BR AND &HFF
FOR I=1 TO 9
RetPixel.R=RetPixel.R+Pixels(I).R
RetPixel.G=RetPixel.R+Pixels(I).G
RetPixel.B=RetPixel.R+Pixels(I).B
NEXT
RetPixel.R=RetPixel.R/9
RetPixel.G=RetPixel.G/9
RetPixel.B=RetPixel.B/9
RETURN RetPixel
END FUNCTION
I know, I know...But I couldn't think of an elegant way to do it!
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 484
Threads: 14
Joined: Apr 2005
heres some code from an old VB project of mine. Couldn't be bothered to update it yet!
the iDATA array is :first part is for rgb then second and third are x and y
hope it helps, maybe i'll convert it at some point.
Code: Private Sub Smooth()
Dim X As Long, Y As Long
Dim r As Long, G As Long, B As Long
For Y = 2 To PicInfo.bmHeight - 1
For X = 2 To PicInfo.bmWidth - 1
B = CLng(iDATA(1, X, Y)) + _
CLng(iDATA(1, X - 1, Y)) + CLng(iDATA(1, X, Y - 1)) + _
CLng(iDATA(1, X, Y + 1)) + CLng(iDATA(1, X + 1, Y))
B = B \ 5
G = CLng(iDATA(2, X, Y)) + _
CLng(iDATA(2, X - 1, Y)) + CLng(iDATA(2, X, Y - 1)) + _
CLng(iDATA(2, X, Y + 1)) + CLng(iDATA(2, X + 1, Y))
G = G \ 5
r = CLng(iDATA(3, X, Y)) + _
CLng(iDATA(3, X - 1, Y)) + CLng(iDATA(3, X, Y - 1)) + _
CLng(iDATA(3, X, Y + 1)) + CLng(iDATA(3, X + 1, Y))
r = r \ 5
iDATA(1, X, Y) = B
iDATA(2, X, Y) = G
iDATA(3, X, Y) = r
Next X
Next Y
End Sub
EVEN MEN OF STEEL RUST.
Posts: 1,774
Threads: 62
Joined: Aug 2003
I changed a few things out of habit. It's basically what I did on that landmaker algo thing.
Code: Option Explicit
Const Scr_Width As Integer = 320
Const SCR_Height As Integer = 200
Const Bits_Per_Plane As Integer = 24
Screenres Scr_Width,Scr_Height,Bits_Per_Plane
Randomize Timer
Type Pixel
R As Integer
G As Integer
B As Integer
End Type
Declare Function BlurPixel(Byval X As Integer, Byval Y As Integer, Byval Strength As Integer) As Pixel
Dim As Pixel NewPixel
Dim As Integer I, X, Y
For I = 1 To 1000
Circle (Int(Rnd*300),Int(Rnd*200)),Int(Rnd*15),Rgb(Int(Rnd*255),Int(Rnd*255),Int(Rnd*255))
Next
Sleep
For X=100 To 200
For Y=50 To 150
NewPixel = BlurPixel(X, Y, 1)
Pset (X,Y),Rgb(NewPixel.R,NewPixel.G,NewPixel.B)
Next
Next
Sleep
Function BlurPixel(Byval X As Integer, Byval Y As Integer, Byval Strength As Integer) As Pixel
Dim As Integer ScanX, Scany, StartX, EndX, StartY, EndY, TempCol, Hits
Dim TempRGB As Pixel
If Strength <=0 Then
TempCol = Point(X,Y)
TempRGB.R += ((TempCol Shr 16) And &HFF)
TempRGB.G += ((TempCol Shr 8 ) And &HFF)
TempRGB.B += ((TempCol ) And &HFF)
Function = TempRGB
Exit Function
End If
StartY= Y-Strength
EndY = Y+Strength
StartX= X-Strength
EndX = X+Strength
If StartY< 0 Then StartY = 0
If StartX< 0 Then StartX = 0
If EndY>Scr_Height-1 Then EndY=Scr_Height-1
If EndX>Scr_Width-1 Then EndX=Scr_Width-1
For ScanY = StartY To EndY
For ScanX = StartX To EndX
TempCol = Point(ScanX,ScanY)
TempRGB.R += ((TempCol Shr 16) And &HFF)
TempRGB.G += ((TempCol Shr 8 ) And &HFF)
TempRGB.B += ((TempCol ) And &HFF)
Hits+=1
Next
Next
TempRgb.R\=Hits
TempRgb.G\=Hits
TempRgb.B\=Hits
Function = TempRGB
End Function
Posts: 3,616
Threads: 287
Joined: Jan 2003
I don't understand all of it, but it works much better than mine.
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 1,774
Threads: 62
Joined: Aug 2003
What is it that you don't understand? I'd be glad to explain... or I'm sure someone else will. 8)
Posts: 3,616
Threads: 287
Joined: Jan 2003
Well...how it works, for one. It doesn't resemble my code at all.
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 484
Threads: 14
Joined: Apr 2005
his is still the same principle, which is an average of surrounding colours, but his has strength, which is how many pixels are sampled.
EVEN MEN OF STEEL RUST.
Posts: 3,616
Threads: 287
Joined: Jan 2003
Well I looked at every line of the code and I understand it now.
But why does his maintain colour while mine makes everything grey?
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
|