PureBasic Forums - English

Code: Select all

;Transfer the Alpha layer into the visible layer.
Procedure MakeAlphaVisibleFilterCallback(x, y, SourceColor, TargetColor)
  ProcedureReturn RGBA(Alpha(SourceColor), Alpha(SourceColor),Alpha(SourceColor),00)
EndProcedure

Code: Select all

;Overlay horizontal scanlines by reducing color and leaving Alpha unchanged
Procedure HorizontalScanlines(x,y,SourceColor,TargetColor)
  If y % 2
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
  Else
    ProcedureReturn TargetColor
  EndIf
EndProcedure


;Overlay vertical scanlines by reducing color and leaving Alpha unchanged
Procedure VerticalScanlines(x,y,SourceColor,TargetColor)
  If x % 2
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
  Else
    ProcedureReturn TargetColor
  EndIf
EndProcedure

Code: Select all

;Overlay diagonal scanlines by reducing color and leaving Alpha unchanged 
Procedure DiagonalScanlines(x,y,SourceColor,TargetColor) 
  If ((x+y) % 3) 
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor)) 
  Else 
    ProcedureReturn TargetColor 
  EndIf 
EndProcedure

;invert color and keep alpha layer
Procedure InvertedColors(x,y,SourceColor,TargetColor) 
    ProcedureReturn  TargetColor ! $FFFFFF
EndProcedure

;convert color to grayscale
Procedure GrayscaleFilter(x,y,SourceColor,TargetColor) 
    grayLevel=(Red(TargetColor)+Green(TargetColor)+Blue(TargetColor))/3 
    ProcedureReturn  RGBA(grayLevel,grayLevel,grayLevel,Alpha(TargetColor))
EndProcedure

Code: Select all

Procedure SetDarkenPercent(percent)
   Global DarkFactor.f
   DarkFactor = 1 - percent / 100.0
   If DarkFactor < 0 : DarkFactor = 0 : EndIf
   If DarkFactor > 1 : DarkFactor = 1 : EndIf
EndProcedure
Procedure DarkenFilter(x, y, SourceColor, TargetColor)
   Global DarkFactor.f
   ProcedureReturn RGBA(Red(TargetColor) * DarkFactor, Green(TargetColor) * DarkFactor, Blue(TargetColor) * DarkFactor, Alpha(TargetColor))
EndProcedure

; SetDarkenPercent(10) ; make image 10% darker

Code: Select all

Procedure SetLightenPercent(percent)
   Global LightFactor.f
   LightFactor =1-percent / 100.0
   If LightFactor < 0 : LightFactor = 0 : EndIf
   If LightFactor > 1 : LightFactor = 1 : EndIf
EndProcedure
Procedure LightenFilter(x, y, SourceColor, TargetColor)
   Global LightFactor.f
   ColorToWhite = $FFFFFF - TargetColor
   ProcedureReturn RGBA(255 - Red(ColorToWhite) * LightFactor, 255 - Green(ColorToWhite) * LightFactor, 255 - Blue(ColorToWhite) * LightFactor, Alpha(TargetColor))
EndProcedure

;SetLightenPercent(20) ;make image 20% lighter

Code: Select all

Procedure SetBlurRadius(radius)
   Global BlurRadius=radius
   Global BlurFactor.f=1 / ((radius * 2 + 1) * (radius * 2 + 1))
   
   Global Dim BlurLayer.l(OutputWidth() - 1, OutputHeight() - 1)
EndProcedure
Procedure BlurFilter(x, y, SourceColor, TargetColor)
   Global BlurRadius
   Global BlurFactor.f
   Shared BlurLayer()
   
   Protected.w r, g, b
   For yn=y - BlurRadius To y + BlurRadius
      For xn=x - BlurRadius To x + BlurRadius
         If xn<0 Or xn>=OutputWidth() Or yn<0 Or yn>=OutputHeight() ;Or (xn=x And yn=y)
            Continue
         EndIf
         
         If Not BlurLayer(xn, yn)
            BlurLayer(xn, yn)=Point(xn, yn)
         EndIf
         cn=BlurLayer(xn, yn)
         ;d=Sqr((xn-x)*(xn-x)+(yn-y)*(yn-y))
         ;k.f=BlurFactor;Cos((d/(1+BlurRadius))*0.5*#PI)
         ak.f=Alpha(cn) / 255         
         r + Red(cn) * BlurFactor * ak
         g + Green(cn) * BlurFactor * ak
         b + Blue(cn) * BlurFactor * ak
      Next
   Next
   res=RGBA(r, g, b, Alpha(TargetColor))
   
   ProcedureReturn res
EndProcedure

; SetBlurRadius(2) ; blur level = 1(normal) 2 (slow) 3 (very slow)

Code: Select all

Procedure.l Color_Interpolate(c1.l, c2.l, t.f)
  
  ; interpolate between two ARGB colors
  ; t should be a float between 0 and 1
  ; when t = 0, c1 will be returned
  ; when t = 1, c2 will be returned
  
  !fld dword [p.v_t]
  !fld1
  !fsub st0,st1
  !mov ecx,[p.v_c1]
  !mov edx,[p.v_c2]
  !mov eax,ecx
  !rol eax,8
  !and eax,$00ff00ff
  !and ecx,$00ff00ff
  !push ecx
  !push eax
  !mov eax,edx
  !rol eax,8
  !and eax,$00ff00ff
  !and edx,$00ff00ff
  !push edx
  !push eax
  !fild word [esp]
  !fmul st0,st2
  !fild word [esp + 8]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 8]
  !fild word [esp + 2]
  !fmul st0,st2
  !fild word [esp + 10]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 10]
  !fild word [esp + 4]
  !fmul st0,st2
  !fild word [esp + 12]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 12]
  !fild word [esp + 6]
  !fmul st0,st2
  !fild word [esp + 14]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 14]
  !fstp st0
  !fstp st0
  !pop eax
  !pop eax
  !pop eax
  !ror eax,8
  !pop ecx
  !or eax,ecx
  ProcedureReturn
EndProcedure

; Color interpolation filter
Procedure ColorInterpolation(x, y, SourceColor, TargetColor)
   ProcedureReturn Color_Interpolate(SourceColor, TargetColor, 0.5)
EndProcedure

Code: Select all

Procedure PixelFilterCallback(x, y, SourceColor, TargetColor) 
   #pixelSize=5
   xn=#pixelSize*(x/#pixelSize)
   yn=#pixelSize*(y/#pixelSize)
   ProcedureReturn Point(xn,yn) 
EndProcedure 
Procedure PixelFilter() 
   CustomFilterCallback(@PixelFilterCallback()) 
EndProcedure