Image processing routines

[Dreamland Fantasy]

Some image processing routines:

Code: Select all

;- Includes

XIncludeFile "FastImage.pbi"

;- Constants

#MaxDistance = $FFFFFFF
#MaxDitherMethods = 128
#MaxDitherMatrixSize = 256

Enumeration
  #RotateImageLeft
  #RotateImageRight
EndEnumeration

Enumeration
  #FlipImageHorizontal
  #FlipImageVertical
EndEnumeration

Enumeration
  #GrayscaleImage_Mean
  #GrayscaleImage_Weighted
  #GrayscaleImage_Weighted2
EndEnumeration

;- Structures

Structure hsl
  h.f
  s.f
  l.f
EndStructure

Structure hsv
  h.f
  s.f
  v.f
EndStructure

;- Macros

Macro NormalizeRGB(r, g, b)

  ; ***************************************************************************
  ;
  ; Function: Truncates RGB values to a range of 0 to 255
  ;
  ; ***************************************************************************
  
  If r > 255
    r = 255
  ElseIf r < 0
    r = 0
  EndIf 
  
  If g > 255 
    g = 255
  ElseIf g < 0
    g = 0
  EndIf 
  
  If b > 255 
    b = 255
  ElseIf b < 0
    b = 0
  EndIf 
  
EndMacro

Macro ContrastStretch_CalculateThresholds(Array, min, max)


  ; ***************************************************************************
  ;
  ; Function: Calculate thresholds for performing contrast stretching
  ;
  ; Notes:    Part of the ContrastStretchImage() procedure
  ;
  ; ***************************************************************************

  color = 0
  count = 0
  Repeat
    count + Array(color)
    color + 1
  Until count > lower_target Or color > 255
  min = color - 1
  color = 255
  count = 0
  Repeat
    count + Array(color)
    color - 1
  Until count > upper_target Or color < 0
  max = color + 1
  If max = min
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
  
EndMacro

;- Procedures

Procedure.l AdjustImageBrightness(image_no.l, brightness.l = 0, r_brightness.l = 0, g_brightness.l = 0, b_brightness.l = 0) 

  ; ***************************************************************************
  ;
  ; Function: Adjusts the brightness of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Brightness values can be between -255 and 255
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l 
  Protected color.l, r.l, g.l, b.l 
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If brightness < -255 Or brightness > 255
    ProcedureReturn 0
  EndIf
  
  If r_brightness < -255 Or r_brightness > 255
    ProcedureReturn 0
  EndIf

  If g_brightness < -255 Or g_brightness > 255
    ProcedureReturn 0
  EndIf
  
  If b_brightness < -255 Or b_brightness > 255
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos) 
    r = FastRed(color) + r_brightness + brightness
    g = FastGreen(color) + g_brightness + brightness
    b = FastBlue(color) + b_brightness + brightness
    NormalizeRGB(r, g, b) 
    PokeL(*mem + mem_pos, FastRGB(r, g, b)) 
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1
  
EndProcedure 

Procedure.l AdjustImageContrast(image_no.l, contrast.f = 0, r_contrast.f = 0, g_contrast.f = 0, b_contrast.f = 0)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the contrast of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Contrast values can be between -255 to 255
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected contrast_correction.f
  Protected r_contrast_correction.f
  Protected g_contrast_correction.f
  Protected b_contrast_correction.f

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If contrast < -255 Or contrast > 255
    ProcedureReturn 0
  EndIf
  
  If r_contrast < -255 Or r_contrast > 255
    ProcedureReturn 0
  EndIf
  
  If g_contrast < -255 Or g_contrast > 255
    ProcedureReturn 0
  EndIf
  
  If b_contrast < -255 Or b_contrast > 255
    ProcedureReturn 0
  EndIf

  contrast_correction = (contrast + 255) * 259 / (255 * (259 - contrast))  
  r_contrast_correction = (r_contrast + 255) * 259 / (255 * (259 - r_contrast))
  g_contrast_correction = (g_contrast + 255) * 259 / (255 * (259 - g_contrast))
  b_contrast_correction = (b_contrast + 255) * 259 / (255 * (259 - b_contrast))
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos) 
    r = (FastRed(color) - 128) * r_contrast_correction * contrast_correction + 128
    g = (FastGreen(color) - 128) * g_contrast_correction * contrast_correction + 128
    b = (FastBlue(color) - 128) * b_contrast_correction * contrast_correction + 128
    NormalizeRGB(r, g, b) 
    PokeL(*mem + mem_pos, FastRGB(r, g, b)) 
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1
  
EndProcedure 

Procedure.l AdjustImageGamma(image_no.l, gamma.f = 1, r_gamma.f = 1, g_gamma.f = 1, b_gamma.f = 1) 

  ; ***************************************************************************
  ;
  ; Function: Adjusts the gamma curve of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l 
  Protected gamma_correction.f
  Protected r_gamma_correction.f
  Protected g_gamma_correction.f
  Protected b_gamma_correction.f
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If gamma <= 0 Or gamma >= 8
    ProcedureReturn 0
  EndIf

  If r_gamma <= 0 Or r_gamma >= 8
    ProcedureReturn 0
  EndIf

  If g_gamma <= 0 Or g_gamma >= 8
    ProcedureReturn 0
  EndIf

  If b_gamma <= 0 Or b_gamma >= 8
    ProcedureReturn 0
  EndIf
  
  gamma_correction = 1 / gamma
  r_gamma_correction = 1 / r_gamma
  g_gamma_correction = 1 / g_gamma
  b_gamma_correction = 1 / b_gamma
    
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color) 
    r = 255 * Pow(r / 255, r_gamma_correction)
    r = 255 * Pow(r / 255, gamma_correction)
    g = 255 * Pow(g / 255, g_gamma_correction)
    g = 255 * Pow(g / 255, gamma_correction)
    b = 255 * Pow(b / 255, b_gamma_correction)
    b = 255 * Pow(b / 255, gamma_correction)
    NormalizeRGB(r, g, b) 
    PokeL(*mem + mem_pos, FastRGB(r, g, b)) 
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem)
  
  ProcedureReturn 1 

EndProcedure 

Procedure.l CropImage(image_no.l, x.l, y.l, width.l, height.l)

  ; ***************************************************************************
  ;
  ; Function: Crops an image to given size
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected temp_image_no.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If width = 0 Or height = 0
    ProcedureReturn 0
  EndIf
  
  If x + width > ImageWidth(image_no) Or y + height > ImageHeight(image_no)
    ProcedureReturn 0
  EndIf

  temp_image_no = GrabImage(image_no, #PB_Any, x, y, width, height)
  
  If temp_image_no = 0
    ProcedureReturn 0
  EndIf
  
  FreeImage(image_no)
  CopyImage(temp_image_no, image_no)
  
  ProcedureReturn 1

EndProcedure

Procedure.l ScrollImage(image_no.l, scroll_x.l, scroll_y.l, wrap.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Scrolls an image about with optional wrapping
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem_source.l, *mem_target.l, mem_size.l
  Protected x.l, y.l, target_x.l, target_y.l
  Protected width.l, height.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  width = ImageWidth(0)
  height = ImageHeight(0)
  
  If scroll_x > width Or scroll_y > height
    ProcedureReturn 0
  EndIf

  mem_size = width * height << 2
  *mem_source = AllocateMemory(mem_size)
  If *mem_source = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem_source)
  FreeImage(image_no)
  
  *mem_target = AllocateMemory(mem_size)
  If *mem_target = 0
  
    ; Attempt to restore source image when memory allocation fails
  
    If CreateImage(image_no, width, height, 32)
      CopyMemoryToImage(*mem_source, image_no)
    EndIf
    FreeMemory(*mem_source)
    ProcedureReturn 0
  EndIf
    
  For y = 0 To height - 1
    For x = 0 To width - 1
      Select wrap
        Case 1
          target_x = (x + scroll_x) % width
          target_y = (y + scroll_y) % height        
          If target_x < 0
            target_x = width + target_x
          EndIf
          If target_y < 0
            target_y = height + target_y
          EndIf 
          PokeL(*mem_target + (target_y * width + target_x) << 2, PeekL(*mem_source + (y * width + x) << 2))
        Default
          target_x = (x + scroll_x)
          target_y = (y + scroll_y)
          If target_x >= 0 And target_x < width And target_y >= 0 And target_y < height
            PokeL(*mem_target + (target_y * width + target_x) << 2, PeekL(*mem_source + (y * width + x) << 2))
          EndIf
      EndSelect
    Next
  Next
  
  FreeMemory(*mem_source)
  
  If CreateImage(image_no, width, height, 32) = 0
    FreeMemory(*mem_target)
    ProcedureReturn 0
  EndIf
  
  CopyMemoryToImage(*mem_target, image_no)
  FreeMemory(*mem_target)
  
  ProcedureReturn 1

EndProcedure 

Procedure.l EnhanceEdges(image_no.l, strength.l = 0, outline.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Enhances the edges of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, *mem2.l
  Protected r.l, g.l, b.l 
  Protected r1.l, r2.l, g1.l, g2.l, b1.l, b2.l
  Protected image_info.FASTIMAGEINFO
  Protected image_info2.FASTIMAGEINFO
  Protected x.l, y.l, i.l
  Protected threshold.l
  Protected Dim matrix.l(2, 2, 2), Dim color1.l(2), Dim color2.l(2)

  If strength < 0 Or strength > 100
    ProcedureReturn 0
  EndIf

  threshold = (100 - strength) * (254 - 64) / 100 + 64
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf

  *mem2 = AllocateMemory(mem_size)
  If *mem2 = 0
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  image_info\ptrImageBuffer  = *mem
  image_info\imgWidth        = ImageWidth(image_no)
  image_info\imgHeight       = ImageHeight(image_no)
  image_info\imgDepth        = ImageDepth(image_no)

  CopyImageToMemory(image_no, *mem2) 
  image_info2\ptrImageBuffer  = *mem2
  image_info2\imgWidth        = ImageWidth(image_no)
  image_info2\imgHeight       = ImageHeight(image_no)
  image_info2\imgDepth        = ImageDepth(image_no)

  For y = 0 To image_info\imgHeight - 1
    For x = 0 To image_info\imgWidth - 1
    
      If x <= 0 Or y <= 0 Or x >= image_info\imgWidth Or y >= image_info\imgHeight
        matrix(0, 0, 0) = FastRed(FastPoint(image_info, x, y))
        matrix(1, 0, 0) = FastGreen(FastPoint(image_info, x, y))
        matrix(2, 0, 0) = FastBlue(FastPoint(image_info, x, y))
      EndIf
    
      If x > 0 And y > 0      
        matrix(0, 0, 0) = FastRed(FastPoint(image_info, x - 1, y - 1))
        matrix(1, 0, 0) = FastGreen(FastPoint(image_info, x - 1, y - 1))
        matrix(2, 0, 0) = FastBlue(FastPoint(image_info, x - 1, y - 1))
      EndIf
    
      If y > 0      
        matrix(0, 1, 0) = FastRed(FastPoint(image_info, x, y - 1))
        matrix(1, 1, 0) = FastGreen(FastPoint(image_info, x, y - 1))
        matrix(2, 1, 0) = FastBlue(FastPoint(image_info, x, y - 1))
      EndIf

      If x < image_info\imgWidth - 1 And y > 0
        matrix(0, 2, 0) = FastRed(FastPoint(image_info, x + 1, y - 1))
        matrix(1, 2, 0) = FastGreen(FastPoint(image_info, x + 1, y - 1))
        matrix(2, 2, 0) = FastBlue(FastPoint(image_info, x + 1, y - 1))
      EndIf
      
      If x > 0
        matrix(0, 0, 1) = FastRed(FastPoint(image_info, x - 1, y))
        matrix(1, 0, 1) = FastGreen(FastPoint(image_info, x - 1, y))
        matrix(2, 0, 1) = FastBlue(FastPoint(image_info, x - 1, y))
      EndIf
      
      If x < image_info\imgWidth - 1
        matrix(0, 2, 1) = FastRed(FastPoint(image_info, x + 1, y))
        matrix(1, 2, 1) = FastGreen(FastPoint(image_info, x + 1, y))
        matrix(2, 2, 1) = FastBlue(FastPoint(image_info, x + 1, y))
      EndIf  
      
      If x > 0 And y < image_info\imgHeight - 1
        matrix(0, 0, 2) = FastRed(FastPoint(image_info, x - 1, y + 1))
        matrix(1, 0, 2) = FastGreen(FastPoint(image_info, x - 1, y + 1))
        matrix(2, 0, 2) = FastBlue(FastPoint(image_info, x - 1, y + 1))
      EndIf  

      If y < image_info\imgHeight - 1
        matrix(0, 1, 2) = FastRed(FastPoint(image_info, x, y + 1))
        matrix(1, 1, 2) = FastGreen(FastPoint(image_info, x, y + 1))
        matrix(2, 1, 2) = FastBlue(FastPoint(image_info, x, y + 1))
      EndIf  
      
      If x < image_info\imgWidth - 1 And y < image_info\imgHeight - 1
        matrix(0, 2, 2) = FastRed(FastPoint(image_info, x + 1, y + 1))
        matrix(1, 2, 2) = FastGreen(FastPoint(image_info, x + 1, y + 1))
        matrix(2, 2, 2) = FastBlue(FastPoint(image_info, x + 1, y + 1))
      EndIf  
      
      For i = 0 To 2
        color1(i) = - matrix(i, 0, 0) + matrix(i, 2, 0) - matrix(i, 0, 1) << 1 + matrix(i, 2, 1) << 1 - matrix(i, 0, 2) + matrix(i, 2, 2)
        color2(i) = matrix(i, 0, 0) + matrix(i, 1, 0) << 1 + matrix(i, 2, 0) - matrix(i, 0, 2) - matrix(i, 1, 2) << 1 - matrix(i, 2, 2)
      Next
                     
      r = Abs(color1(0)) + Abs(color2(0))
      g = Abs(color1(1)) + Abs(color2(1))
      b = Abs(color1(2)) + Abs(color2(2))
      
      If r > threshold Or g > threshold Or b > threshold
        FastPlot(image_info2, x, y, 0)
      ElseIf outline
        FastPlot(image_info2, x, y, $FFFFFF)
      Else
        FastPlot(image_info2, x, y, FastPoint(image_info, x, y))
      EndIf
      
    Next
  Next
  CopyMemoryToImage(*mem2, image_no) 
  FreeMemory(*mem)
  FreeMemory(*mem2)
  
  ProcedureReturn 1 

EndProcedure 

Procedure.l RotateImage180(image_no.l) 

  ; ***************************************************************************
  ;
  ; Function: Rotates an image by 180 degrees
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l, temp.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size >> 1 - 1 Step 4
    temp = PeekL(*mem + mem_size - mem_pos - 4)
    PokeL(*mem + mem_size - mem_pos - 4, PeekL(*mem + mem_pos)) 
    PokeL(*mem + mem_pos, temp)
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem)
  
  ProcedureReturn 1

EndProcedure 

Procedure.l RotateImage90(image_no.l, direction.l = #RotateImageLeft)

  ; ***************************************************************************
  ;
  ; Function: Rotates an image by 90 degrees either left or right
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem_source.l, *mem_target.l, mem_size.l
  Protected target.l, width.l, height.l, x.l, y.l
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  If direction <> #RotateImageLeft And direction <> #RotateImageRight
    ProcedureReturn 0
  EndIf
  
  width = ImageWidth(image_no)
  height = ImageHeight(image_no)
  
  mem_size = width * height << 2
  *mem_source = AllocateMemory(mem_size)
  If *mem_source = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem_source)
  FreeImage(image_no)
  
  *mem_target = AllocateMemory(mem_size)
  If *mem_target = 0
  
    ; Attempt to restore source image when memory allocation fails
  
    If CreateImage(image_no, width, height, 32)
      CopyMemoryToImage(*mem_source, image_no)
    EndIf
    FreeMemory(*mem_source)
    ProcedureReturn 0
  EndIf
  
  For y = 0 To height - 1 
    For x = 0 To width - 1 
      Select direction
        Case #RotateImageLeft
          target = (y + ((width - x - 1) * height)) << 2 
        Case #RotateImageRight
          target = ((height - y - 1) + (x * height)) << 2 
      EndSelect
      PokeL(*mem_target + target, PeekL(*mem_source + (y * width + x) << 2)) 
    Next 
  Next 
  
  FreeMemory(*mem_source)
  
  If CreateImage(image_no, height, width, 32) = 0
    FreeMemory(*mem_target)
    ProcedureReturn 0
  EndIf
  
  CopyMemoryToImage(*mem_target, image_no)
  FreeMemory(*mem_target)
  
  ProcedureReturn 1

EndProcedure

Procedure.l FlipImage(image_no.l, direction.l = #FlipImageHorizontal)

  ; ***************************************************************************
  ;
  ; Function: Flips an image either horizontally or vertically
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, temp.l
  Protected source.l, target.l, width.l, height.l, x.l, y.l
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  If direction <> #FlipImageHorizontal And direction <> #FlipImageVertical
    ProcedureReturn 0
  EndIf
  
  width = ImageWidth(image_no)
  height = ImageHeight(image_no)
  
  mem_size = width * height << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem)
  Select direction
    Case #FlipImageHorizontal
      For y = 0 To height - 1
        For x = 0 To width >> 1 - 1
          source = (y * width + x) << 2
          target = ((width - x) + (y * width - 1)) << 2
          temp = PeekL(*mem + target)
          PokeL(*mem + target, PeekL(*mem + source))
          PokeL(*mem + source, temp)
        Next
      Next
    Case #FlipImageVertical
      For y = 0 To height >> 1 - 1 
        For x = 0 To width - 1 
          source = (y * width + x) << 2 
          target = ((height - y - 1) * width + x) << 2
          temp = PeekL(*mem + target)
          PokeL(*mem + target, PeekL(*mem + source))
          PokeL(*mem + source, temp)
        Next 
      Next 
  EndSelect
  
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
  
  ProcedureReturn 1

EndProcedure

Procedure.l GrayscaleImage(image_no.l, method.l = #GrayscaleImage_Weighted)

  ; ***************************************************************************
  ;
  ; Function: Converts an image to grayscale
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size) 
  If *mem = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    Select method
      Case #GrayscaleImage_Mean
        color = (r + g + b) / 3
      Case #GrayscaleImage_Weighted
        color = 0.299 * r + 0.587 * g + 0.114 * b
      Case #GrayscaleImage_Weighted2
        color = 0.3086 * r + 0.6094 * g + 0.0820 * b
      Default
        ProcedureReturn 0
    EndSelect
    PokeL(*mem + mem_pos, FastRGB(color, color, color)) 
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1
  
EndProcedure 

Procedure.l InvertImage(image_no.l)

  ; ***************************************************************************
  ;
  ; Function: Inverts the color of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem, mem_size, mem_pos

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4 
    PokeL(*mem + mem_pos, ~PeekL(*mem + mem_pos))
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1

EndProcedure 

Procedure.l SolarizeImage(image_no.l, lower_threshold.l = 0, upper_threshold.l = 128)

  ; ***************************************************************************
  ;
  ; Function: Produces a solarize effect of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem, mem_size, mem_pos
  Protected color, r.c, g.c, b.c

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  If lower_threshold < 0 Or lower_threshold > upper_threshold Or upper_threshold > 255
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
  
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    If r >= lower_threshold And r <= upper_threshold
      r = ~r
    EndIf
    If g >= lower_threshold And g <= upper_threshold
      g = ~g
    EndIf
    If b >= lower_threshold And b <= upper_threshold
      b = ~b
    EndIf
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1

EndProcedure 

Procedure.l EqualizeImage(image_no.l)

  ; ***************************************************************************
  ;
  ; Function: Equalizes the histogram of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************
  
  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, count.l, i.l, j.l
  Protected Dim f_r.l(255)
  Protected Dim f_g.l(255)
  Protected Dim f_b.l(255)
  Protected Dim cuf_r.l(255)
  Protected Dim cuf_g.l(255)
  Protected Dim cuf_b.l(255)
  Protected Dim feq.l(255)
  Protected Dim cufeq.l(255)
  Protected nearest_value.l, nearest_intensity.l
  Protected Dim output_r.l(255)
  Protected Dim output_g.l(255)
  Protected Dim output_b.l(255)
   
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  
  ; Calculate frequency of intensities
  
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos) 
    f_r(FastRed(color)) + 1
    f_g(FastGreen(color)) + 1
    f_b(FastBlue(color)) + 1
  Next
  
  ; Calculate cumulative frequency distribution
  
  cuf_r(0) = f_r(0)
  cuf_g(0) = f_g(0)
  cuf_b(0) = f_b(0)
  
  For i = 1 To 255
    cuf_r(i) = cuf_r(i - 1) + f_r(i)
    cuf_g(i) = cuf_g(i - 1) + f_g(i)
    cuf_b(i) = cuf_b(i - 1) + f_b(i)
  Next

  ; Calculate equalized frequency distribution
  
  For i = 0 To 255
    feq(i) = mem_size >> 10
  Next
  
  For i = 0 To mem_size >> 2 - mem_size >> 10 << 8 - 1
    feq(i) + 1
  Next
  
  ; Calculate equalized cumulative frequency distribution
  
  cufeq(0) = feq(0)
  
  For i = 1 To 255
    cufeq(i) = cufeq(i - 1) + feq(i)
  Next
  
  ; Map the insensities
  
  i = 0
  Repeat
    nearest_value = cuf_r(255)
    j = 0
    Repeat
      If Abs(cuf_r(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_r(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_r(i) = nearest_intensity
    i + 1
  Until i > 255
  
  i = 0
  Repeat
    nearest_value = cuf_g(255)
    j = 0
    Repeat
      If Abs(cuf_g(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_g(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_g(i) = nearest_intensity
    i + 1
  Until i > 255
  
  i = 0
  Repeat
    nearest_value = cuf_b(255)
    j = 0
    Repeat
      If Abs(cuf_b(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_b(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_b(i) = nearest_intensity
    i + 1
  Until i > 255
  
  ; Transform the image
  
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = output_r(FastRed(color))
    g = output_g(FastGreen(color))
    b = output_b(FastBlue(color))
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem) 
  
  ProcedureReturn 1
  
EndProcedure

Procedure.l ContrastStretchImage(image_no.l, lower_threshold.f = 0.5, upper_threshold.f = 0.5)

  ; ***************************************************************************
  ;
  ; Function: Performs contrast stretching on an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************
  
  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, count.l
  Protected r_min.l = 256, r_max.l = 0
  Protected g_min.l = 256, g_max.l = 0
  Protected b_min.l = 256, b_max.l = 0
  Protected Dim r_histogram.l(255)
  Protected Dim g_histogram.l(255)
  Protected Dim b_histogram.l(255)
  Protected scale.f, lower_target.l, upper_target.l
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos) 
    r_histogram(FastRed(color)) + 1
    g_histogram(FastGreen(color)) + 1
    b_histogram(FastBlue(color)) + 1
  Next

  lower_target = ImageWidth(image_no) * ImageHeight(image_no) * (lower_threshold / 100)
  upper_target = ImageWidth(image_no) * ImageHeight(image_no) * (upper_threshold / 100)
 
  ContrastStretch_CalculateThresholds(r_histogram, r_min, r_max)
  ContrastStretch_CalculateThresholds(g_histogram, g_min, g_max)
  ContrastStretch_CalculateThresholds(b_histogram, b_min, b_max)
    
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos) 
    r = 255 * (FastRed(color) - r_min) / (r_max - r_min)
    g = 255 * (FastGreen(color) - g_min) / (g_max - g_min)
    b = 255 * (FastBlue(color) - b_min) / (b_max - b_min)
    NormalizeRGB(r, g, b) 
    PokeL(*mem + mem_pos, FastRGB(r, g, b)) 
  Next 
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem) 

  ProcedureReturn 1

EndProcedure

Procedure.l NormalizeImage(image_no.l)

  Protected result.l
  
  result = ContrastStretchImage(image_no, 0.02, 0.01)
  
  ProcedureReturn result

EndProcedure

Procedure.l PosterizeImage(image_no.l, levels.l = 256)

  ; ***************************************************************************
  ;
  ; Function: Produces a posterize effect of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected factor.f, correction.f
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  If levels < 2 Or levels > 256
    ProcedureReturn 0
  EndIf
  
  factor = 256 / levels
  correction = 255 / (levels - 1)

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    r = Int(r / factor) * correction
    g = Int(g / factor) * correction
    b = Int(b / factor) * correction
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem)
  
  ProcedureReturn 1 

EndProcedure

Procedure RGBToHSV(color, *colorspace.hsv)

  ; ***************************************************************************
  ;
  ; Function: Converts an RGB color space to HSV
  ;
  ; Returns:  A structure containing the HSV values
  ;
  ; ***************************************************************************

  Protected r.f, g.f, b.f
  Protected r_temp.l, g_temp.l, b_temp.l
  Protected delta.f, min.f

  r_temp = FastRed(color)
  g_temp = FastGreen(color)
  b_temp = FastBlue(color)

  r = r_temp / 255
  g = g_temp / 255
  b = b_temp / 255
  
  If r < g
    min = r
  Else
    min = g
  EndIf
  If b < min
    b = min
  EndIf
  
  If r > g
    *colorspace\v = r
  Else
    *colorspace\v = g
  EndIf
  If b > *colorspace\v
    *colorspace\v = b
  EndIf
  
  delta = *colorspace\v - min

  If *colorspace\v = 0
    *colorspace\s = 0
  Else
    *colorspace\s = delta / *colorspace\v
  EndIf

  If *colorspace\s = 0
    *colorspace\h = 0
  Else
    If r = *colorspace\v
      *colorspace\h = 60 * (g - b) / delta
    ElseIf g = *colorspace\v
      *colorspace\h = 120 + 60 * (b - r) / delta
    ElseIf b = *colorspace\v
      *colorspace\h = 240 + 60 * (r - g) / delta
    EndIf
    If *colorspace\h < 0
      *colorspace\h + 360
    EndIf
  EndIf
    
EndProcedure

Procedure.l HSLToRGB(*colorspace.hsl)

  ; ***************************************************************************
  ;
  ; Function: Converts HSL color space to RGB
  ;
  ; Returns:  The value of RGB
  ;
  ; ***************************************************************************

  Protected r.f, g.f, b.f
  Protected temp1.f, temp2.f
  Protected r_temp.f, g_temp.f, b_temp.f
  Protected h_temp.f
  
  If *colorspace\s = 0
    r = *colorspace\l
    g = *colorspace\l
    b = *colorspace\l
  Else
    If *colorspace\l < 0.5
      temp2 = *colorspace\l * (1 + *colorspace\s)
    Else
      temp2 = *colorspace\l + *colorspace\s - *colorspace\l * *colorspace\s
    EndIf
    
    temp1 = 2 * *colorspace\l - temp2
    
    h_temp = *colorspace\h / 360
    
    r_temp = h_temp + 1 / 3
    g_temp = h_temp
    b_temp = h_temp - 1 / 3
    
    If r_temp < 0
      r_temp + 1
    ElseIf r_temp > 1
      r_temp - 1
    EndIf
    
    If g_temp < 0
      g_temp + 1
    ElseIf g_temp > 1
      g_temp - 1
    EndIf
    
    If b_temp < 0
      b_temp + 1
    ElseIf b_temp > 1
      b_temp - 1
    EndIf
    
    If 6 * r_temp < 1
      r = temp1 + (temp2 - temp1) * 6 * r_temp
    ElseIf 2 * r_temp < 1
      r = temp2
    ElseIf 3 * r_temp < 2
      r = temp1 + (temp2 - temp1) * ((2 / 3) - r_temp) * 6
    Else
      r = temp1
    EndIf
    
    If 6 * g_temp < 1
      g = temp1 + (temp2 - temp1) * 6 * g_temp
    ElseIf 2 * g_temp < 1
      g = temp2
    ElseIf 3 * g_temp < 2
      g = temp1 + (temp2 - temp1) * ((2 / 3) - g_temp) * 6
    Else
      g = temp1
    EndIf
    
    If 6 * b_temp < 1
      b = temp1 + (temp2 - temp1) * 6 * b_temp
    ElseIf 2 * b_temp < 1
      b = temp2
    ElseIf 3 * b_temp < 2
      b = temp1 + (temp2 - temp1) * ((2 / 3) - b_temp) * 6
    Else
      b = temp1
    EndIf
  EndIf
    
  ProcedureReturn FastRGB(Int(r * 255), Int(g * 255), Int(b * 255))

EndProcedure

Procedure.l HSVToRGB(*colorspace.hsv)

  ; ***************************************************************************
  ;
  ; Function: Converts HSV color space to RGB
  ;
  ; Returns:  The value of RGB
  ;
  ; ***************************************************************************

  Protected f.f, i.l, aa.f, bb.f, cc.f
  Protected r.f, g.f, b.f
  Protected h_temp.f
  
  If *colorspace\s = 0
    r = *colorspace\v
    g = *colorspace\v
    b = *colorspace\v
  Else
    If *colorspace\h = 360
      *colorspace\h = 0
    EndIf
    
    h_temp = *colorspace\h / 60
    i = Int(h_temp)
    f = h_temp - i
    
    aa = *colorspace\v * (1 - *colorspace\s)
    bb = *colorspace\v * (1 - (*colorspace\s * f))
    cc = *colorspace\v * (1 - (*colorspace\s * (1 - f)))
    
    Select i
      Case 0
        r = *colorspace\v
        g = cc
        b = aa
      Case 1
        r = bb
        g = *colorspace\v
        b = aa
      Case 2
        r = aa
        g = *colorspace\v
        b = cc
      Case 3
        r = aa
        g = bb
        b = *colorspace\v
      Case 4
        r = cc
        g = aa
        b = *colorspace\v
      Case 5
        r = *colorspace\v
        g = aa
        b = bb
    EndSelect
  EndIf
  
  ProcedureReturn FastRGB(Int(r * 255), Int(g * 255), Int(b * 255))

EndProcedure

Procedure.l AdjustImageHue(image_no.l, value.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the hue of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Hue value can be between -180 and 180
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l 
  Protected color.l, r.l, g.l, b.l
  Protected colorspace.HSV
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If value < -180 Or value > 180
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)
    RGBToHSV(color, @colorspace)
    colorspace\h + value
    If colorspace\h > 360
      colorspace\h - 360
    ElseIf colorspace\h < 0
      colorspace\h + 360
    EndIf
    PokeL(*mem + mem_pos, HSVToRGB(colorspace)) 
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1

EndProcedure

Procedure.l ColorizeImage(image_no.l, *colorspace.hsl)

  ; ***************************************************************************
  ;
  ; Function: Colorizes an image to a particular hue
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l 
  Protected color.l, r.l, g.l, b.l, hsl.hsl
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf

  hsl\h = *colorspace\h
  hsl\s = *colorspace\s
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)

    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)

    color = 0.299 * r + 0.587 * g + 0.114 * b
        
    hsl\l = *colorspace\l * 2 - 1

    If hsl\l < 0
      hsl\l = color / 255 * (hsl\l + 1)
    Else
      hsl\l = color / 255 * (1 - hsl\l) + hsl\l
    EndIf
        
    PokeL(*mem + mem_pos, HSLToRGB(hsl))
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1

EndProcedure

Procedure.l TintImage(image_no.l, tint_color.l, tint_amount.f)

  ; ***************************************************************************
  ;
  ; Function: Tints an image to a particular color
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l 
  Protected color.l, r.l, g.l, b.l, r_tint.l, g_tint.l, b_tint.l
  
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
  
  If tint_amount < 0 Or tint_amount > 100
    ProcedureReturn 0
  EndIf
  
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2 
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  r_tint = FastRed(tint_color)
  g_tint = FastGreen(tint_color)
  b_tint = FastBlue(tint_color)
  tint_amount / 100
   
  CopyImageToMemory(image_no, *mem) 
  For mem_pos = 0 To mem_size - 1 Step 4 
    color = PeekL(*mem + mem_pos)

    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)

    r * (1 - tint_amount) + r_tint * tint_amount
    g * (1 - tint_amount) + g_tint * tint_amount
    b * (1 - tint_amount) + b_tint * tint_amount
       
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next 
  CopyMemoryToImage(*mem, image_no) 
  FreeMemory(*mem) 
  
  ProcedureReturn 1

EndProcedure

FastImage.pbi required for the above routines:

Code: Select all

;- Structures

Structure FASTIMAGEINFO
  ptrImageBuffer.l
  imgWidth.w
  imgHeight.w
  imgDepth.b
EndStructure

;- Macros

Macro FastRGB(r, g, b)

  ; Faster equivalent of RGB(), although only suitable for integers

  (((r << 8 + g) << 8 ) + b)
  
EndMacro

Macro FastRed(color)
  
  ; Faster equivalent of Red(), although only suitable for integers

  ((color & $FF0000) >> 16)
  
EndMacro

Macro FastGreen(color)

  ; Faster equivalent of Green(), although only suitable for integers

  ((color & $FF00) >> 8)
  
EndMacro

Macro FastBlue(color)

  ; Faster equivalent of Blue(), although only suitable for integers

  (color & $FF)
  
EndMacro

Macro ReverseRGB(color)

  ; Changes RGB to BGR or vice versa

  ((color & $FF) << 16 | (color & $FF00) | (color & $FF0000) >> 16)
  
EndMacro

Macro FastPlot(image_info, x, y, color)
  PokeL(image_info\ptrImageBuffer + (image_info\imgWidth * (y) + x) << 2, color)
EndMacro

Macro FastPoint(image_info, x, y)
  (PeekL(image_info\ptrImageBuffer + (image_info\imgWidth * (y) + x) << 2) & $FFFFFF)
EndMacro

;- Procedures

Procedure CopyImageToMemory(image_no.l, *mem)
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO 
    TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null) 
    GetObject_(ImageID(image_no), SizeOf(BITMAP), TemporaryBitmap.BITMAP) 
    TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER) 
    TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth 
    TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight 
    TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
    TemporaryBitmapInfo\bmiHeader\biBitCount    = 32 
    TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
    GetDIBits_(TemporaryDC, ImageID(image_no), 0, TemporaryBitmap\bmHeight, *mem, TemporaryBitmapInfo, #DIB_RGB_COLORS)
    DeleteDC_(TemporaryDC)
  CompilerElse
    Protected x.l, y.l, mem_pos.l
    mem_pos = 0
    StartDrawing(ImageOutput(image_no))
    For y = 0 To ImageHeight(image_no) - 1
      For x = 0 To ImageWidth(image_no) - 1
        PokeL(*mem + mem_pos, ReverseRGB(Point(x, y)))
        mem_pos + 4
      Next
    Next
    StopDrawing()
  CompilerEndIf
EndProcedure

Procedure CopyMemoryToImage(*mem, image_no.l)
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO 
    TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null) 
    GetObject_(ImageID(image_no), SizeOf(BITMAP), TemporaryBitmap.BITMAP) 
    TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER) 
    TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth 
    TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight 
    TemporaryBitmapInfo\bmiHeader\biPlanes      = 1 
    TemporaryBitmapInfo\bmiHeader\biBitCount    = 32 
    TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB 
    SetDIBits_(TemporaryDC, ImageID(image_no), 0, TemporaryBitmap\bmHeight, *mem, TemporaryBitmapInfo, #DIB_RGB_COLORS) 
    DeleteDC_(TemporaryDC)
  CompilerElse
    Protected x.l, y.l, mem_pos.l
    mem_pos = 0
    StartDrawing(ImageOutput(image_no))
    For y = 0 To ImageHeight(image_no) - 1
      For x = 0 To ImageWidth(image_no) - 1
        Plot(x, y, ReverseRGB(PeekL(*mem + mem_pos)))
        mem_pos + 4
      Next
    Next    
    StopDrawing()
  CompilerEndIf
EndProcedure

[Dreamland Fantasy]

If you look at the procedures CopyMemoryToImage() and CopyImageToMemory() in FastImage.pbi I have included generic code that will work under Linux and MacOS. This generic code however is very slow and if anyone knows of a faster way of doing this under Linux and MacOS (ideally something similar to the Windows code) then I would be grateful if you could let me know.

Kind regards,

Francis

[thyphoon]

with the last purebasic beta you can found the image memory address with drawingbuffer() it will be most faster than copy image to another memory !

[Dreamland Fantasy]

Hi thyphoon

I haven't actually looked at the new beta yet, but that sounds as though it will be very useful.

Thanks.

Kind regards,

Francis

[idle]

Thanks for posting that, I'm sure it'll be useful.

[dige]

looks good! thx for sharing

[WilliamL]

Just made a quick effort to RotateImage90() an image, and it worked on a Mac!

Thanks for the code/info. I'll study the code and learn something. A lot of good error checking!

Maybe somebody could post the code for RotateImage90() using drawingbuffer() that thyphoon mentioned.

[luis]

Hi, maybe I'm missing something. But shouldn't your macros move the rgb components around in reverse order ?

Code: Select all

Macro FastBlue(color)
 
  ; Faster equivalent of Red(), although only suitable for integers

  ((color & $FF0000) >> 16)
 
EndMacro

Macro FastGreen(color)

  ; Faster equivalent of Green(), although only suitable for integers

  ((color & $FF00) >> 8)
 
EndMacro

Macro FastRed(color)

  ; Faster equivalent of Blue(), although only suitable for integers

  (color & $FF)
 
EndMacro 

Macro FastRGB(r, g, b)

  ; Faster equivalent of RGB(), although only suitable for integers

  (((b << 8 + g) << 8 ) + r)
 
EndMacro

Debug FastRGB(111,122,133)
Debug RGB(111,122,133)

Debug Red(RGB(111,122,133))
Debug FastRed(RGB(111,122,133))

Debug Green(RGB(111,122,133))
Debug FastGreen(RGB(111,122,133))

Debug Blue(RGB(111,122,133))
Debug FastBlue(RGB(111,122,133))

Otherwise the results from your macros are different from the one resulting from PB's built in functions.

[Dreamland Fantasy]

Hi Luis,

Your code works as expected here on my Windows machine. This the debug output I got:

Code: Select all

8747631
8747631
111
111
122
122
133
133

However, if I remember right, under Linux the values were reversed for some reason.

Kind regards,

Francis

[Dreamland Fantasy]

Just made a quick effort to RotateImage90() an image, and it worked on a Mac!

Thanks for the code/info. I'll study the code and learn something. A lot of good error checking!

Maybe somebody could post the code for RotateImage90() using drawingbuffer() that thyphoon mentioned.

I'm glad that you like the code. I've tested the code out under Windows, Linux and MacOS so there hopefully shouldn't be a problem with any of it over the three platforms.

Kind regards,

Francis

[Michael Vogel]

These routines are brilliant
Because it's already an older thread, I would like to know, if the code is up-to-date or anyone did some changes/optimizations?va

BTW: TintImage(image,#Red,value) will create a blueish result on my Windows PC, even when I use Luis' RGB macros...

[[blendman]]

Hi

It works well with JPG, but with PNG, some procedures don't work (brightness(), enhanceEdge()...).

The procedures don't use the alpha Channel ?

Edit

Your procedure FastRGB inverse some colors.

You have to change the line in some procedures :

Code: Select all

   
 a = Alpha(color)
 r = Red(color) + r_brightness + brightness
 g = Green(color) + g_brightness + brightness
 b = Blue(color) + b_brightness + brightness
 NormalizeRGB(r, g, b)
 PokeL(*mem + mem_pos, RGBA(r, g, b, a))

[dobro]

picture rotation in Degres ...
wait until the image has been rotated on it even

Code: Select all

;Rotate image
;***********************************************
;Titre  :*rotate image
;Auteur  : Dobro
;Date  :30/09/2013
;Heure  :11:31:58
;Version Purebasic :  PureBasic 5.20 LTS (Windows - x8
;Version de l'editeur :EPB V2.46
; Libairies necessaire : Aucune 
;***********************************************


Declare  rotate_image(id,x2,y2,degres)
Declare.l RotateImageEx2(ImageID, Angle.f)



UseJPEGImageDecoder () :UsePNGImageDecoder()
InitSprite ()

#dobro =1
#Police =1
#Sprite =1
#image1 =1
#image2 =2



; ***********************************
FontID = LoadFont ( #Police , "arial" , 50, #PB_Font_Bold )
EcranX = GetSystemMetrics_ ( #SM_CXSCREEN )
;=largeur de l'ecran
EcranY = GetSystemMetrics_ ( #SM_CYSCREEN )
;=hauteur de l'ecran
WindowID = OpenWindow (1, 0, 0, EcranX, EcranY, "hello" , #PB_Window_BorderLess |#PB_Window_ScreenCentered )

WindowID = WindowID (1)
Result = OpenWindowedScreen ( WindowID ,0,0, EcranX, EcranY, 1, 0,0)


; principe de rotation
;x1 = coordonée x du point rotationé
;Y1= coordonée y du point rotationé
; a = angle de rotation
; x1 = x * Cos(a) + Y * Sin(a);
; y1 = -x * Sin(a) + Y * Cos(a)
im$=OpenFileRequester("open jpg","c:\","*.jpg",0)
LoadImage ( #image1 , im$ ) ;<----- path of the picture

largeur = ImageWidth(#image1)
hauteur = ImageHeight(#image1)

; 
if largeur>1024 or hauteur>768
	ResizeImage(#image1,1024,768)
	largeur = 1024
	hauteur =768
Endif

; 


CreateImage ( #image2 ,largeur,hauteur )


; ******* mise en tableau de l'image **********
Global Dim tabl1(largeur ,hauteur )
StartDrawing ( ImageOutput ( #image1) )
	For Y=1 To hauteur-1
		For x=1 To largeur-1
			tabl1(x,Y)= Point (x,Y)
		Next x
	Next Y
StopDrawing ()
;*****************************************************



Resultat = InitMouse ()
TempsDepart = ElapsedMilliseconds()
Repeat
	ExamineMouse ()
	Event= WindowEvent ()
	Delay (2)
	angle_degres=angle_degres+5
	If angle_degres>360
		Event= #PB_Event_CloseWindow
		TempsEcoule = ElapsedMilliseconds()-TempsDepart
		break
	EndIf
	rotate_image(#image2,largeur, hauteur,  angle_degres)  ; rotate a Dobro
	
	; ****** **on affiche l'image ********
	StartDrawing ( ScreenOutput ())
		DrawImage ( ImageID ( #image2 ), 100, 100)
	StopDrawing ()
	; *******************************
	FlipBuffers ()
	; affiche l'ecran
	ClearScreen ( RGB (0, 0, 0)) 
	;efface l'ecran
	Event= WindowEvent ()
	;}
	
	If MouseButton (2)
		End
	EndIf
	
Until Event= #PB_Event_CloseWindow
MessageRequester("info","temps="+str(tempsecoule))

Procedure rotate_image(id,x2,y2,degres)
	; By Dobro
	; Rotate_image(id ,with,height,degres )
	Structure image
		x.l
		Y.l
	EndStructure
	Dim image.image(1)
	
	;; codé par Dobro
	;id = id picture
	;x2=Width
	;y2=Height
	;degres=rotation in degres
	
	x3=x2/2 ; le milieu x de l'image
	y3=y2/2 ; le milieu y de l'image
	StartDrawing ( ImageOutput ( id ) )
		For Y=1 To y2-1
			For x=1 To x2-1
				; ********* voici la formule de la rotation d'image *********
				image(1)\x= x3+(x-x3) * Cos (degres* #PI /180) +( Y-y3)* Sin (degres* #PI /180)
				image(1)\Y= y3-(x-x3) * Sin (degres* #PI /180) + (Y-y3)* Cos (degres* #PI /180)
				;*****************************************************
				; *** on evite que les coordonée sorte du tableau dim ****
				If image(1) \Y <0 : image(1) \Y=0 : EndIf
				If image(1)\Y>y2 : image(1) \Y =y2: EndIf
				If image(1)\x>x2 : image(1)\x=x2: EndIf
				If image(1)\x<0 : image(1)\x=0: EndIf
				; *****************************************
				Plot (x,Y,tabl1( image(1)\x,image(1)\Y)) ; on dessine l'image rotaté a l'aide du tableau de points : D
			Next x
		Next Y
	StopDrawing ()
EndProcedure

;




; EPB

[Dreamland Fantasy]

Hi there,

I've just noticed the latest comments on this thread.

I am currently working on revised versions of my image processing routines plus some new routines. One of the things that has already been addressed is support for 32 bit images with an alpha channel.

I'll post the updated version when I'm finished working on them.

Kind regards,

Francis

[IdeasVacuum]

Looking forward to the updates, your work is very good.

Last post in 2009? Dreamland must be far far away...........