PureBasic Forums - English

Posted: **Tue Jun 12, 2007 4:42 pm**

Are there any other image formats that the community would like to see supported for PBXimage? So far I have:

-BMP, JPEG, PNG, TIFF, TGA, GIF, PCX, DCX, PIX, PIC, RAS, ICO

-From El_choni: ppm, pbm, pgm, xbm, IFF, wbm, wbmp

-My own format: New Image Format (NIF)

-Any format the OLE and GDI+ can load.

Planned Formats are: WPG, CUT, MNG, JNG (hopefully), and Silicon graphics

With El_choni's different decoders, so far that makes about 25-26 different formats, with 5 more in the works.

Are there any other formats out there that people would like to see supported?

Additionally, does anyone have any code to quantize/dither 24/32 BPP images down to 8BPP-256 color, or to make 8BPP 24/32 BPP, they would be willing to share for the Library? This si required to add the ability to natively save GIF, PIX, PIC, WPG, ect.

The Library is nearing the Alpha stage, with all decoders working perfectly, and encoders too. All controls included are also working without a hitch. So as soon as i get the final code together bug-free, I will release it for testing, and/or bug fixing.

Please lend suggestions and/or code you'd like to share for image manipulation, encoding/decoding, and anything else you might feel is useful.

So far, 7000 lines of code and counting...

Posted: **Tue Jun 12, 2007 6:35 pm**

That's a pretty good list so far. Personally, I'm not in need of any additional formats beyond the ones listed. I'd only like to see that TIFF is well-supported. In particular, bi-level (CCITT G4), multi-page, and old-style JPEG-in-TIFF are the formats I have to deal with on a daily basis, and the lack of PB support has made me jump through a number of hoops to get some projects working.

Thanks for all your hard work on this, and also thanks to hagibaba for his contributions.

Posted: **Tue Jun 12, 2007 10:24 pm**

for my personal use i dont think i need any more formats

thanks for your efforts!

p.s

does your code also supports encoding?

Posted: **Tue Jun 12, 2007 11:19 pm**

The Library is nearing the Alpha stage, with all decoders working perfectly, and encoders too.

It looks that way!

Russell

Posted: **Tue Jun 12, 2007 11:44 pm**

Here is a few image manipulation routines i did long time ago. They are not pretty coded and this was my first glance at image modification

Code: Select all

;/***************************************
;/*ImageModification lib                *
;/*By Daniel Middelhede            *
;/*Copyright(c) 2006 Daniel Middelhede  *
;/***************************************

  
ProcedureDLL imgm_init() ;Call this first to initialize the lib
  Structure myBITMAPINFO
    bmiHeader.BITMAPINFOHEADER
    bmiColors.RGBQUAD[1]
  EndStructure 
  
  Global version.s
  version.s="0.1 Beta"
  
  ;**********************************************
  ;initialize image plugins

  
  ProcedureReturn 1 
EndProcedure

ProcedureDLL.s imgm_Version()
  ProcedureReturn version.s
EndProcedure

;/The image effects

ProcedureDLL imgm_MirrorImageY(image)
  ; Mirrors an image around the Y-axis

  Width = ImageWidth(image)
  Height = ImageHeight(image)
  hdc = StartDrawing(ImageOutput(image))
  StretchBlt_(hdc,0,Height,Width,-Height,hdc,0,0,Width,Height, #SRCCOPY) ;
  StopDrawing()
EndProcedure

ProcedureDLL imgm_MirrorImageX(image)
  ; Mirrors an image around the X-axis
  
  Width = ImageWidth(image)
  Height = ImageHeight(image)
  hdc = StartDrawing(ImageOutput(image))
  StretchBlt_(hdc,Width,0,-Width,Height,hdc,0,0,Width,Height, #SRCCOPY) ;
  StopDrawing()
EndProcedure 

ProcedureDLL imgm_InvertColors(image)
  ;Invert the colors
  hBmp=ImageID(image)
  
  If hBmp 
    
    imageWidth=ImageWidth(image)
    imageHeight=ImageHeight(image)
    
    mem=AllocateMemory(imageWidth*imageHeight*4)
    bmi.myBITMAPINFO 
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth = imageWidth
    bmi\bmiHeader\biHeight = imageHeight
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB 
    
    hdc = StartDrawing(ImageOutput(image))
    Debug hdc
    GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
    
    *pixels.LONG = mem
    For A = 1 To imageWidth*(imageHeight)
      *pixels\l - *pixels\l - *pixels\l
      *pixels + 4
    Next A
    
  SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
  StopDrawing()
  ProcedureReturn 1
EndIf

EndProcedure

ProcedureDLL imgm_GrayImage(image) ;Grayscale!
  
  hBmp=ImageID(image)
  
  If hBmp 
    
    imageWidth=ImageWidth(image)
    imageHeight=ImageHeight(image)
    
    mem=AllocateMemory(imageWidth*imageHeight*4)
    bmi.myBITMAPINFO 
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth = imageWidth
    bmi\bmiHeader\biHeight = imageHeight
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB 
    
    hdc = StartDrawing(ImageOutput(image))
    Debug hdc
    GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
    
    *pixels.LONG = mem
    For A = 1 To imageWidth*(imageHeight)
      r=Red(*pixels\l)
      g=Green(*pixels\l)
      b=Blue(*pixels\l)
      
      average=(r+g+b)/3
      *pixels\l=RGB(average,average,average)
      
      *pixels + 4
    Next A
    
  SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
  StopDrawing()
  ProcedureReturn 1  
EndIf
  
EndProcedure

ProcedureDLL imgm_DarkenImage(image, level) ;Darken image.
  
  hBmp=ImageID(image)
  
  If hBmp 
    
    imageWidth=ImageWidth(image)
    imageHeight=ImageHeight(image)
    
    mem=AllocateMemory(imageWidth*imageHeight*4)
    bmi.myBITMAPINFO 
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth = imageWidth
    bmi\bmiHeader\biHeight = imageHeight
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB 
    
    hdc = StartDrawing(ImageOutput(image))
    Debug hdc
    GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
    
    *pixels.LONG = mem
    For A = 1 To imageWidth*(imageHeight)
      r=Red(*pixels\l)
      g=Green(*pixels\l)
      b=Blue(*pixels\l)
      
      rDark=r-level
      gDark=g-level
      bDark=b-level
      
      If rDark<0
        rDark=0
      EndIf
      If gDark<0
        gDark=0
      EndIf
      If bDark<0
        bDark=0
      EndIf
      
      
      *pixels\l=RGB(rDark,gDark,bDark)
      
      *pixels + 4
    Next A
    
  SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
  StopDrawing()
  ProcedureReturn 1  
EndIf
  
EndProcedure

ProcedureDLL imgm_LightenImage(image, level) ;Lighten image
  
  hBmp=ImageID(image)
  
  If hBmp 
    
    imageWidth=ImageWidth(image)
    imageHeight=ImageHeight(image)
    
    mem=AllocateMemory(imageWidth*imageHeight*4)
    bmi.myBITMAPINFO 
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth = imageWidth
    bmi\bmiHeader\biHeight = imageHeight
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB 
    
    hdc = StartDrawing(ImageOutput(image))
    Debug hdc
    GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
    
    *pixels.LONG = mem
    For A = 1 To imageWidth*(imageHeight)
      r=Red(*pixels\l)
      g=Green(*pixels\l)
      b=Blue(*pixels\l)
      
      rDark=r+level
      gDark=g+level
      bDark=b+level
      
      If rDark>255
        rDark=255
      EndIf
      If gDark>255
        gDark=255
      EndIf
      If bDark>255
        bDark=255
      EndIf
      
      
      *pixels\l=RGB(rDark,gDark,bDark)
      
      *pixels + 4
    Next A
    
  SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
  StopDrawing()
  ProcedureReturn 1  
EndIf
  
EndProcedure

ProcedureDLL imgm_ColorFilter(image,color,level) ;1=Red, 2=Green, 3=Blue. Level CAN be negative!
  hBmp=ImageID(image)
  
  If hBmp 
    If color=1 Or color=2 Or color=3
      If level>-255 And level<255
        
        imageWidth=ImageWidth(image)
        imageHeight=ImageHeight(image)
        
        mem=AllocateMemory(imageWidth*imageHeight*4)
        bmi.myBITMAPINFO 
        bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
        bmi\bmiHeader\biWidth = imageWidth
        bmi\bmiHeader\biHeight = imageHeight
        bmi\bmiHeader\biPlanes = 1
        bmi\bmiHeader\biBitCount = 32
        bmi\bmiHeader\biCompression = #BI_RGB 
        
        hdc = StartDrawing(ImageOutput(image))
        Debug hdc
        GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
        
        *pixels.LONG = mem
        For A = 1 To imageWidth*(imageHeight)
          
          
          r=Red(*pixels\l)
          g=Green(*pixels\l)
          b=Blue(*pixels\l)
          
          Select color
            Case 1
              r=r+level
              If r>255:r=255:ElseIf r<0:r=0:EndIf
            Case 2
              g=g+level
              If g>255:g=255:ElseIf g<0:g=0:EndIf
            Case 3
              b=b+level
              If b>255:b=255:ElseIf b<0:b=0:EndIf
          EndSelect
          
          
          ;Set the colour at the pixel
          *pixels\l=RGB(r,g,b)
          
          *pixels + 4
        Next A
        
      SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
      StopDrawing()
      ProcedureReturn 1  
    EndIf
  EndIf
EndIf

  
EndProcedure

ProcedureDLL imgm_RaspImage(image, level)
  hBmp=ImageID(image)
  
  If hBmp 
    
    imageWidth=ImageWidth(image)
    imageHeight=ImageHeight(image)
    
    mem=AllocateMemory(imageWidth*imageHeight*4)
    bmi.myBITMAPINFO 
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth = imageWidth
    bmi\bmiHeader\biHeight = imageHeight
    bmi\bmiHeader\biPlanes = 1
    bmi\bmiHeader\biBitCount = 32
    bmi\bmiHeader\biCompression = #BI_RGB 
    
    hdc = StartDrawing(ImageOutput(image))
    Debug hdc
    GetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS)
    
    *pixels.LONG = mem
    chose=1
    For A = 1 To imageWidth*(imageHeight)
    
      If i > 0
      If i<level
        *pixels\l=oldData
      EndIf
    EndIf
    
    oldData=*pixels\l
    
    If i=level
      i=0
    Else 
      i=i+1
    EndIf
       
      *pixels + 4
    Next A
    

    
    
  SetDIBits_(hdc,hBmp,0,imageHeight,mem,bmi,#DIB_RGB_COLORS) ;<> 0
  StopDrawing()
  ProcedureReturn 1  
EndIf
  
EndProcedure

Personally one should make it working with image objects instead of directly opening it, if you know what i mean..

Posted: **Wed Jun 13, 2007 3:07 am**

Thank you TheFool!!!!!!!! They work very well. In fact, they might be just what i need to learn to dither/quantize 24/32 BPP down to 8BPP in order to finish the GIF encoder.

Posted: **Wed Jun 13, 2007 9:41 am**

localmotion34 wrote:Thank you TheFool!!!!!!!!

No problem

I wanted to release them anyway, but it would be cool to have in combination with other image things.

Posted: **Thu Jun 14, 2007 12:48 am**

localmotion34 wrote:Are there any other image formats that the community would like to see supported for [...]

Please lend suggestions and/or code you'd like to share for image manipulation, encoding/decoding, and anything else you might feel is useful.

that sounds really good. thank you for your effort.

wikipedia list almost 60 different graphics formats :

http://en.wikipedia.org/wiki/Graphics_file_format

you said 'and anything else you might feel is useful'. well i have one

there's a format that interest me a lot but i'm not sure it fits your project.
but why not (?) : vectorial graphics like SVG.

ok it's a hard one, painful one because of the very big number of different commands but it's so powerful. In the SVG format, all the image is stored as XML drawing statements (line, circle, etc...).

since purebasic has a native xml command set, someone can try some funny and simple samples.

http://www.w3.org/Graphics/SVG/
http://en.wikipedia.org/wiki/Scalable_Vector_Graphics
http://en.wikipedia.org/wiki/Image:Diamond-caution.svg
http://upload.wikimedia.org/wikipedia/c ... aution.svg
http://upload.wikimedia.org/wikipedia/c ... VS_SVG.svg

a very simple one :

Code: Select all

<?xml version="1.0" encoding="utf-8"?>
<svg xmlns="http://www.w3.org/2000/svg">
  <g>
    <rect width="300" height="120" x="0" y="20" fill="green" />
    <rect width="80" height="150" x="20" y="30" fill="red" />
    <rect width="140" height="80" x="50" y="50" fill="blue" />
  </g>
</svg>

Posted: **Thu Jun 14, 2007 1:34 pm**

@localmotion34

Here is a section of one of my programs that incorporates numerous types of error diffusion dithering. It can handle normal raster dithering (i.e. from left to right) or serpentine dithering (i.e. left to right, right to left, left to right, etc.). You can also specify a dithering strength too.

Please bear in mind that it will need some modification to run independently.

Code: Select all

; Image remapping and dithering routines

;- Includes

XIncludeFile "Common.pbi"
XIncludeFile "FastImage.pbi"

;- Constants

#MaxDitherMethods = 128
#MaxDitherMatrixSize = 256

#maxDistance = $FFFFFFF

Enumeration
  #Dither_None
  #Dither_Simple
  #Dither_Atkinson
  #Dither_Burkes
  #Dither_FloydSteinberg
  #Dither_FloydSteinberg_False
  #Dither_FloydSteinberg_FanModified
  #Dither_JarvisJudiceNinke
  #Dither_Sierra_2_4A
  #Dither_Sierra2
  #Dither_Sierra3  
  #Dither_ShiauFan
  #Dither_StevensonArce
  #Dither_Stucki
EndEnumeration

;- Structures

Structure DitherMethod
  name.s
  x.w
  y.w
  matrix.f[#MaxDitherMatrixSize]
EndStructure

;- Initialise Dither Methods

Global Dim Dither.DitherMethod(#MaxDitherMethods)

Restore DitherMethods

Repeat
  Read DitherID.b
  Read Dither(DitherID)\name
  Read Dither(DitherID)\x
  Read Dither(DitherID)\y
  For entry = 0 To (Dither(DitherID)\x * Dither(DitherID)\y) - 1
    Read Dither(DitherID)\matrix[entry]
  Next
Until DitherID = #Dither_None

DataSection

; Dataset structure:
;
;   Data.b [DitherID]
;   Data.s [DitherName]
;   Data.w [Matrix X size], [Matrix Y size]
;   Data.f [Matrix data]...
;
; A DitherID of #Dither_None (i.e. zero) means the end of the dataset

DitherMethods:
Data.b #Dither_Simple
Data.s "Simple"
Data.w 2, 2
Data.f   1, 1/2
Data.f 1/2,   0

Data.b #Dither_Atkinson
Data.s "Atkinson"
Data.w 4, 3
Data.f   0,   1, 1/8, 1/8
Data.f 1/8, 1/8, 1/8,   0
Data.f   0, 1/8,   0,   0

Data.b #Dither_Burkes
Data.s "Burkes"
Data.w 5, 2
Data.f    0,    0,    1, 8/32, 4/32
Data.f 2/32, 4/32, 8/32, 4/32, 2/32

Data.b #Dither_FloydSteinberg
Data.s "Floyd-Steinberg"
Data.w 3, 2
Data.f    0,    1, 7/16
Data.f 3/16, 5/16, 1/16

Data.b #Dither_FloydSteinberg_False
Data.s "Floyd-Steinberg (False)"
Data.w 2, 2
Data.f   1, 3/8
Data.f 3/8, 2/8

Data.b #Dither_FloydSteinberg_FanModified
Data.s "Floyd-Steinberg (Fan Modified)"
Data.w 4, 2
Data.f    0,    0,    1, 7/16
Data.f 1/16, 3/16, 5/16,    0

Data.b #Dither_JarvisJudiceNinke
Data.s "Jarvis-Judice-Ninke"
Data.w 5, 3
Data.f    0,    0,    1, 7/48, 5/48
Data.f 3/48, 5/48, 7/48, 5/48, 3/48
Data.f 1/48, 3/48, 5/48, 3/48, 1/48

Data.b #Dither_Sierra_2_4A
Data.s "Sierra-2-4A"
Data.w 3, 2
Data.f   0,   1, 2/4
Data.f 1/4, 1/4,   0

Data.b #Dither_Sierra2
Data.s "Sierra2"
Data.w 5, 2
Data.f    0,    0,    1, 4/16, 3/16
Data.f 1/16, 2/16, 3/16, 2/16, 1/16

Data.b #Dither_Sierra3
Data.s "Sierra3"
Data.w 5, 3
Data.f    0,    0,    1, 5/32, 3/32
Data.f 2/32, 4/32, 5/32, 4/32, 2/32
Data.f    0, 2/32, 3/32, 2/32,    0

Data.b #Dither_ShiauFan
Data.s "Shiau-Fan"
Data.w 5, 2
Data.f    0,    0,    0,    1, 8/16
Data.f 1/16, 1/16, 2/16, 4/16,    0

Data.b #Dither_StevensonArce
Data.s "Stevenson-Arce"
Data.w 7, 4
Data.f      0,      0,      0,      1,      0, 32/200,      0
Data.f 12/200,      0, 26/200,      0, 30/200,      0, 16/200
Data.f      0, 12/200,      0, 26/200,      0, 12/200,      0
Data.f  5/200,      0, 12/200,      0, 12/200,      0,  5/200

Data.b #Dither_Stucki
Data.s "Stucki"
Data.w 5, 3
Data.f    0,    0,    1, 8/42, 4/42
Data.f 2/42, 4/42, 8/42, 4/42, 2/42
Data.f 1/42, 2/42, 4/42, 2/42, 1/42

Data.b #Dither_None
Data.s "None"
Data.w 1, 1
Data.f 1

EndDataSection


;- Procedures

Procedure Truncate(a, b)
  
  ; ***************************************************************************
  ;
  ; Function: Adds two numbers and truncates the result to a range of 0 - 255
  ;
  ; Returns:  The result of the function
  ;
  ; ***************************************************************************
  
  a + b
  
  If a > 255
    a = 255
  ElseIf a  < 0
    a = 0
  EndIf 
  
  ProcedureReturn a
  
EndProcedure

Procedure FindNearestColor(Color, PaletteNo, MaxColor)
  
  Protected i, distance, minDistance = #maxDistance
  Protected Rmean, Rdiff, Gdiff, Bdiff, bestIndex = 0
  
  For i = 0 To MaxColor -1
    Rmean = (FastRed(Color) + FastRed(Palette(PaletteNo, i))) >> 1
    Rdiff = FastRed(Color) - FastRed(Palette(PaletteNo, i))
    Gdiff = FastGreen(Color) - FastGreen(Palette(PaletteNo, i))
    Bdiff = FastBlue(Color) - FastBlue(Palette(PaletteNo, i))
    distance = (((512 + Rmean) * Rdiff * Rdiff) >> 8) + (Gdiff * Gdiff << 2) + (((767 - Rmean) * Bdiff * Bdiff) >> 8)
    If distance < minDistance
      minDistance = distance
      bestIndex = Palette(PaletteNo, i)
    EndIf
  Next
  
  ProcedureReturn bestIndex
  
EndProcedure

Procedure RemapImage(ImageNo, Mode, DitherMethod = #Dither_None, DitherValue = 100, SerpentineDither = 0)
  
  ; ***************************************************************************
  ;
  ; Function: Remaps the color of an image with optional dither
  ;
  ; Returns:  Image number of remapped image if successful, otherwise fail
  ;
  ; ***************************************************************************
  
  Protected ImageX, ImageY, DitherX, DitherY, OriginPoint = 0
  Protected x
  Protected CurrentPixel, Index, pixel
  Protected Rerror, Gerror, Berror
  Protected DitherStrength.f, DitherWeighting.f
  Protected NoofColors, ImageWidth, ImageHeight
  Protected SerpentinePhase
  
  Select Mode
    Case 0
      NoofColors = 2
    Case 1
      NoofColors = 4
    Case 2
      NoofColors = 8
    Case 4
      NoofColors = 2
    Case 5
      NoofColors = 4
    Case 8
      NoofColors = 8
    Default
      ErrorRequester("Invalid screen mode parameter passed ("+Str(Mode)+") in RemapImage().")
      ProcedureReturn #Fail
  EndSelect
  
  If DitherValue >= 0 And DitherValue <= 100
    DitherStrength = DitherValue / 100 
    
    ImageWidth = ImageWidth(ImageNo)
    ImageHeight = ImageHeight(ImageNo)
    
    MemorySize = (ImageWidth * ImageHeight) << 2
    *Memory = AllocateMemory(MemorySize) 
    CopyImageToMemory(ImageNo, *Memory) 
    
    DisableWindow(Window_Form_MainWindow, #True)
    
    ; Work out point of origin of dither matrix
    
    For DitherX = 0 To Dither(DitherMethod)\x - 1
      If Dither(DitherMethod)\matrix[DitherX] = 1
        OriginPoint = DitherX
      EndIf
    Next
    
    SerpentinePhase = 1 
    For ImageY = 0 To ImageHeight - 1
      SerpentinePhase = 1 - SerpentinePhase
      For x = 0 To ImageWidth - 1
        If SerpentineDither And SerpentinePhase
          ImageX = ImageWidth - 1 - x
        Else
          ImageX = x
        EndIf
        CurrentPixel = FastPoint(ImageX, ImageY)
        Index = FindNearestColor(CurrentPixel, Mode, NoofColors)
        FastPlot(ImageX, ImageY, Index)
        Rerror = (FastRed(CurrentPixel) - FastRed(Index)) * DitherStrength
        Gerror = (FastGreen(CurrentPixel) - FastGreen(Index)) * DitherStrength
        Berror = (FastBlue(CurrentPixel) - FastBlue(Index)) * DitherStrength
        For DitherY = 0 To Dither(DitherMethod)\y - 1
          For DitherX = 0 To Dither(DitherMethod)\x - 1
            If DitherX - OriginPoint = 0 And DitherY = 0
            Else
              DitherWeighting = Dither(DitherMethod)\matrix[DitherX + DitherY * Dither(DitherMethod)\x]
              If DitherWeighting
                If SerpentineDither And SerpentinePhase
                  If ImageX - (DitherX - OriginPoint) >= 0 And ImageX - (DitherX - OriginPoint) < ImageWidth And ImageY + DitherY < ImageHeight
                    pixel = FastPoint(ImageX - (DitherX - OriginPoint), ImageY + DitherY)
                    FastPlot(ImageX - (DitherX - OriginPoint), ImageY + DitherY, RGB(Truncate(FastRed(pixel), Rerror * DitherWeighting), Truncate(FastGreen(pixel), Gerror * DitherWeighting), Truncate(FastBlue(pixel), Berror * DitherWeighting)))
                  EndIf
                Else
                  If ImageX + (DitherX - OriginPoint) >= 0 And ImageX + (DitherX - OriginPoint) < ImageWidth And ImageY + DitherY < ImageHeight
                    pixel = FastPoint(ImageX + (DitherX - OriginPoint), ImageY + DitherY)
                    FastPlot(ImageX + (DitherX - OriginPoint), ImageY + DitherY, RGB(Truncate(FastRed(pixel), Rerror * DitherWeighting), Truncate(FastGreen(pixel), Gerror * DitherWeighting), Truncate(FastBlue(pixel), Berror * DitherWeighting)))
                  EndIf
                EndIf
              EndIf
            EndIf
          Next            
        Next
      Next
    Next
    
    DoFreeImage(#Image_Remapped)
    CreateImage(#Image_Remapped, ImageWidth, ImageHeight, 32)
    CopyMemoryToImage(*Memory, #Image_Remapped) 
    FreeMemory(*Memory) 
    DisableWindow(Window_Form_MainWindow, #False)
  Else
    ErrorRequester("Dither value out of range ("+Str(DitherValue)+") in RemapImage().")
    ProcedureReturn #Fail
  EndIf 
  ProcedureReturn #Image_Remapped 
  
EndProcedure

Kind regards,

Francis.

Posted: **Thu Jun 14, 2007 2:00 pm**

Like Flype, a very useful format will be the SVG .

Posted: **Thu Jun 14, 2007 2:22 pm**

Here are some of my image processing routines which you may find useful.

Included are:

- basic rotate functions of 90 and 180 degrees
- flip horizontal and vertical
- convert to greyscale
- invert colours
- solarise colours
- automatic level processing (sometimes called contrast stretching)
- adjust brightness
- adjust contrast
- adjust gamma

Code: Select all

; Image Processing Routines

;- Includes

XIncludeFile "Common.pbi"
XIncludeFile "FastImage.pbi"

;- Macros

Macro Normalize(Red, Green, Blue) 
  
  If Red < 0 
    
    Red = 0 
    
  ElseIf Red > 255 
    
    Red = 255 
    
  EndIf 
  
  If Green < 0 
    
    Green = 0 
    
  ElseIf Green > 255 
    
    Green = 255 
    
  EndIf 
  
  If Blue < 0 
    
    Blue = 0 
    
  ElseIf Blue > 255 
    
    Blue = 255 
    
  EndIf 
  
EndMacro 

;- Procedures

Procedure Rotate180(ImageNo.l) 
  
  Protected MemorySize, *MemoryOrigin, *MemoryTarget, Counter 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *MemoryOrigin = AllocateMemory(MemorySize) 
    *MemoryTarget = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *MemoryOrigin) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      PokeL(*MemoryTarget + MemorySize - Counter - 4, PeekL(*MemoryOrigin + Counter)) 
      
    Next 
    
    CopyMemoryToImage(*MemoryTarget, ImageNo) 
    
    FreeMemory(*MemoryOrigin) 
    FreeMemory(*MemoryTarget) 
    
  EndIf
  
EndProcedure 

Procedure RotateLeft90(ImageNo.l) 
  
  Protected MemorySizeOrigin, MemorySizeTarget, *MemoryOrigin, *MemoryTarget 
  
  Protected Origin, Target, W, H, x, y, TempImage
  
  If IsImage(ImageNo)
    
    TempImage = CreateImage(#PB_Any, ImageHeight(ImageNo), ImageWidth(ImageNo), ImageDepth(ImageNo)) 
    
    MemorySizeOrigin = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    MemorySizeTarget = (ImageWidth(TempImage) * ImageHeight(TempImage) << 2) 
    
    *MemoryOrigin = AllocateMemory(MemorySizeOrigin) 
    *MemoryTarget = AllocateMemory(MemorySizeTarget) 
    
    CopyImageToMemory(ImageNo, *MemoryOrigin) 
    
    W = ImageWidth(ImageNo) 
    H = ImageHeight(ImageNo) 
    
    For y = 0 To H - 1 
      
      For x = 0 To W - 1 
        
        Origin = (y * W + x) << 2 
        
        Target = (y + ((W - x - 1) * H)) << 2 
        
        PokeL(*MemoryTarget + Target, PeekL(*MemoryOrigin + Origin)) 
        
      Next 
      
    Next 
    
    CopyMemoryToImage(*MemoryTarget, TempImage) 
    
    DoFreeImage(ImageNo) 
    
    CopyImage(TempImage, ImageNo) 
    
    DoFreeImage(TempImage) 
    
    FreeMemory(*MemoryOrigin) 
    FreeMemory(*MemoryTarget) 
    
  EndIf 
  
EndProcedure 

Procedure RotateRight90(ImageNo.l) 
  
  Protected MemorySizeOrigin, MemorySizeTarget, *MemoryOrigin, *MemoryTarget 
  
  Protected Origin, Target, W, H, x, y, TempImage
  
  If IsImage(ImageNo)
    
    TempImage = CreateImage(#PB_Any, ImageHeight(ImageNo), ImageWidth(ImageNo), ImageDepth(ImageNo)) 
    
    MemorySizeOrigin = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    MemorySizeTarget = (ImageWidth(TempImage) * ImageHeight(TempImage) << 2) 
    
    *MemoryOrigin = AllocateMemory(MemorySizeOrigin) 
    *MemoryTarget = AllocateMemory(MemorySizeTarget) 
    
    CopyImageToMemory(ImageNo, *MemoryOrigin) 
    
    W = ImageWidth(ImageNo) 
    H = ImageHeight(ImageNo) 
    
    For y = 0 To H - 1 
      
      For x = 0 To W - 1 
        
        Origin = (y * W + x) << 2 
        
        Target = ((H - y - 1) + (x * H)) << 2 
        
        PokeL(*MemoryTarget + Target, PeekL(*MemoryOrigin + Origin)) 
        
      Next 
      
    Next 
    
    CopyMemoryToImage(*MemoryTarget, TempImage) 
    
    DoFreeImage(ImageNo) 
    
    CopyImage(TempImage, ImageNo) 
    
    DoFreeImage(TempImage) 
    
    FreeMemory(*MemoryOrigin) 
    FreeMemory(*MemoryTarget) 
    
    ProcedureReturn ImageNo
    
  EndIf
  
EndProcedure 

Procedure FlipHorizontal(ImageNo.l) 
  
  Protected MemorySize, *MemoryOrigin, *MemoryTarget 
  
  Protected Origin, Target, W, H, x, y 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *MemoryOrigin = AllocateMemory(MemorySize) 
    *MemoryTarget = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *MemoryOrigin) 
    
    W = ImageWidth(ImageNo) 
    H = ImageHeight(ImageNo)    
    
    For y = 0 To H - 1 
      
      For x = 0 To W - 1 
        
        Origin = (y * W + x) << 2 
        
        Target = ((W - x) + (y * W - 1)) << 2 
        
        PokeL(*MemoryTarget + Target, PeekL(*MemoryOrigin + Origin)) 
        
      Next 
      
    Next 
    
    CopyMemoryToImage(*MemoryTarget, ImageNo) 
    
    FreeMemory(*MemoryOrigin) 
    FreeMemory(*MemoryTarget) 
    
  EndIf
  
EndProcedure 

Procedure FlipVertical(ImageNo.l) 
  
  Protected MemorySize, *MemoryOrigin, *MemoryTarget 
  
  Protected Origin, Target, W, H, x, y 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *MemoryOrigin = AllocateMemory(MemorySize) 
    *MemoryTarget = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *MemoryOrigin) 
    
    W = ImageWidth(ImageNo) 
    H = ImageHeight(ImageNo)    
    
    For y = 0 To H - 1 
      
      For x = 0 To W - 1 
        
        Origin = (y * W + x) << 2 
        
        Target = ((H - y - 1) * W + x) << 2 
        
        PokeL(*MemoryTarget + Target, PeekL(*MemoryOrigin + Origin)) 
        
      Next 
      
    Next 
    
    CopyMemoryToImage(*MemoryTarget, ImageNo) 
    
    FreeMemory(*MemoryOrigin) 
    FreeMemory(*MemoryTarget)
    
  EndIf
  
EndProcedure 

Procedure Greyscale(ImageNo.l) 
  
  Protected MemorySize, *Memory
  
  Protected Counter, Color, Red, Green, Blue
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      Color = 0.3086 * Red(Color) + 0.6094 * Green(Color) + 0.0820 * Blue(Color)
      
      PokeL(*Memory + Counter, RGB(Color, Color, Color)) 
      
    Next 
    
    CopyMemoryToImage(*Memory, ImageNo) 
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure 

Procedure Invert(ImageNo.l) 
  
  Protected MemorySize, *Memory 
  
  Protected Counter, Color, Red, Green, Blue 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      Red = 255 - FastRed(Color) 
      Green = 255 - FastGreen(Color) 
      Blue = 255 - FastBlue(Color) 
      
      PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
      
    Next 
    
    CopyMemoryToImage(*Memory, ImageNo) 
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure 

Procedure Solarise(ImageNo.l, Threshold = 128) 
  
  Protected MemorySize, *Memory 
  
  Protected Counter, Color, Red, Green, Blue 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      If FastRed(Color) < Threshold
        Red = 255 - FastRed(Color)
      Else
        Red = FastRed(Color)
      EndIf
      If FastGreen(Color) < Threshold
        Green = 255 - FastGreen(Color) 
      Else
        Green = FastGreen(Color)
      EndIf
      If FastBlue(Color) < Threshold
        Blue = 255 - FastBlue(Color) 
      Else
        Blue = FastBlue(Color)
      EndIf
      
      PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
      
    Next 
    
    CopyMemoryToImage(*Memory, ImageNo) 
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure 

Procedure AutoProcessLevel(ImageNo.l)
  
  Protected MemorySize, *Memory
  Protected rMinimum = 256, rMaximum = 0
  Protected gMinimum = 256, gMaximum = 0
  Protected bMinimum = 256, bMaximum = 0
  
  Protected Counter, Color, Red, Green, Blue 
  
  Protected Dim r(255)
  Protected Dim g(255)
  Protected Dim b(255)
  Protected Scale.f
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4
      Color = PeekL(*Memory + Counter) 
      r(FastRed(Color)) + 1
      g(FastGreen(Color)) + 1
      b(FastBlue(Color)) + 1
    Next
    
    Target = ImageWidth(ImageNo) * ImageHeight(ImageNo) * 0.005
    
    Color = 0
    Count = 0
    Repeat
      Count + r(Color)
      Color + 1
    Until Count > Target Or Color > 255
    rMinimum = Color - 1
    Color = 255
    Count = 0
    Repeat
      Count + r(Color)
      Color - 1
    Until Count > Target Or Color < 0
    rMaximum = Color + 1
    
    Color = 0
    Count = 0
    Repeat
      Count + g(Color)
      Color + 1
    Until Count > Target Or Color > 255
    gMinimum = Color - 1
    Color = 255
    Count = 0
    Repeat
      Count + g(Color)
      Color - 1
    Until Count > Target Or Color < 0
    gMaximum = Color + 1
    
    Color = 0
    Count = 0
    Repeat
      Count + b(Color)
      Color + 1
    Until Count > Target Or Color > 255
    bMinimum = Color - 1
    Color = 255
    Count = 0
    Repeat
      Count + b(Color)
      Color - 1
    Until Count > Target Or Color < 0
    bMaximum = Color + 1
    
    AutoProcessSuccessful = #True
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      If rMaximum = rMinimum Or gMaximum = gMinimum Or bMaximum = bMinimum
        AutoProcessSuccessful = #False
      Else 
        Red = 255 * (FastRed(Color) - rMinimum) / (rMaximum - rMinimum)
        Green = 255 * (FastGreen(Color) - gMinimum) / (gMaximum - gMinimum)
        Blue = 255 * (FastBlue(Color) - bMinimum) / (bMaximum - bMinimum)
      EndIf
      
      Normalize(Red, Green, Blue) 
      
      PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
      
    Next 
    
    If AutoProcessSuccessful
      CopyMemoryToImage(*Memory, ImageNo) 
    EndIf
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure

Procedure Brightness(ImageNo.l, Brightness) 
  
  Protected MemorySize, *Memory 
  
  Protected Counter, Color, Red, Green, Blue 
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      Red = FastRed(Color) + Brightness 
      Green = FastGreen(Color) + Brightness 
      Blue = FastBlue(Color) + Brightness 
      
      Normalize(Red, Green, Blue) 
      
      PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
      
    Next 
    
    CopyMemoryToImage(*Memory, ImageNo) 
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure 

Procedure Contrast(ImageNo.l, Contrast.f) 
  
  Protected MemorySize, *Memory 
  Protected Counter, Color, Red, Green, Blue
  Protected ContrastCorrection.f = (Contrast + 255) * 259 / (255 * (259 - Contrast))
  
  If IsImage(ImageNo)
    
    MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
    
    *Memory = AllocateMemory(MemorySize) 
    
    CopyImageToMemory(ImageNo, *Memory) 
    
    For Counter = 0 To MemorySize - 1 Step 4 
      
      Color = PeekL(*Memory + Counter) 
      
      Red = (FastRed(Color)-128)*ContrastCorrection + 128
      Green = (FastGreen(Color)-128)*ContrastCorrection + 128
      Blue = (FastBlue(Color)-128)*ContrastCorrection + 128
      
      Normalize(Red, Green, Blue) 
      
      PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
      
    Next 
    
    CopyMemoryToImage(*Memory, ImageNo) 
    
    FreeMemory(*Memory) 
    
  EndIf
  
EndProcedure 

Procedure Gamma(ImageNo.l, Gamma.f) 
  
  Protected MemorySize, *Memory 
  Protected Counter, Color, Red, Green, Blue 
  Protected GammaCorrection.f = 1 / Gamma
  
  If IsImage(ImageNo)
    
    If Gamma > 0 And Gamma < 8
      
      MemorySize = (ImageWidth(ImageNo) * ImageHeight(ImageNo) << 2) 
      
      *Memory = AllocateMemory(MemorySize) 
      
      CopyImageToMemory(ImageNo, *Memory) 
      
      For Counter = 0 To MemorySize - 1 Step 4 
        
        Color = PeekL(*Memory + Counter) 
        
        Red = 255 * Pow((Red(Color) / 255), GammaCorrection)
        Green = 255 * Pow((Green(Color) / 255), GammaCorrection)
        Blue = 255 * Pow((Blue(Color) / 255), GammaCorrection)
        
        Normalize(Red, Green, Blue) 
        
        PokeL(*Memory + Counter, RGB(Red, Green, Blue)) 
        
      Next 
      
      CopyMemoryToImage(*Memory, ImageNo) 
      
      FreeMemory(*Memory) 
      
    EndIf
    
  EndIf
  
EndProcedure

Kind regards,

Francis

Posted: **Thu Jun 14, 2007 3:05 pm**

Thank you very much Dreamland. Those will help immensely!!! I need to scan over them, and if i understand these correctly, then Floyd-Steinberg might not seem so hard. That is usually always the best for GIF encoding.

Thanks again...

Posted: **Thu Jun 14, 2007 4:21 pm**

Error diffusion is actually very easy to implement.

You should read http://www.efg2.com/Lab/Library/ImagePr ... /DHALF.TXT which helped me a lot to understand how to do it.

If you have any questions please feel free to ask.

Kind regards,

Francis.

Posted: **Thu Jun 14, 2007 9:10 pm**

Here is a snippet of one of my earlier versions of the Floyd-Steinberg dither. It might be easier for you to work out what is going on rather than my newer generic version.

The actual error has already been worked out by this point as the program goes through each pixel and calls this macro to dither the error to the adjacent pixels.

Code: Select all

Macro macro_DitherFloydSteinberg
  
  ; Diffusion matrix:    *  7
  ;                   3  5  1             (1/16)
  
    If x + 1 < ImageWidth
      pixel = Point(x + 1, y)
      Plot(x + 1, y, RGB(Truncate(Red(pixel), (Rerror * 7) >> 4), Truncate(Green(pixel), (Gerror * 7) >> 4), Truncate(Blue(pixel), (Berror * 7) >> 4))) 
      If y + 1 < ImageHeight
        If x - 1 > 0
          pixel = Point(x - 1, y + 1)
          Plot(x - 1, y + 1, RGB(Truncate(Red(pixel), (Rerror * 3) >> 4), Truncate(Green(pixel), (Gerror * 3) >> 4), Truncate(Blue(pixel), (Berror * 3) >> 4)))
        EndIf
        pixel = Point(x, y + 1)
        Plot(x, y + 1, RGB(Truncate(Red(pixel), (Rerror * 5) >> 4), Truncate(Green(pixel), (Gerror * 5) >> 4), Truncate(Blue(pixel), (Berror * 5) >> 4)))
        If x + 1 < ImageWidth
          pixel = Point(x + 1, y + 1)
          Plot(x + 1, y + 1, RGB(Truncate(Red(pixel), Rerror >> 4), Truncate(Green(pixel), Gerror >> 4), Truncate(Blue(pixel), Berror >> 4)))
        EndIf
      EndIf
    EndIf
  
EndMacro

Kind regards,

Francis.

Posted: **Thu Jun 14, 2007 10:43 pm**

Localmotion, notice how i mirror around the X axis (rotating 180 degrees) Those StretchBlt are usually pretty nifty in speed.

Nice funtions, francis!
And: would you mind sharing fastimage? I can guess they use the GetDIBits and so commands.

PureBasic Forums - English

Any Other Image formats/Routines for supporting?

Any Other Image formats/Routines for supporting?

Re: Any Other Image formats/Routines for supporting?