Any Other Image formats/Routines for supporting?
-
localmotion34
- Enthusiast

- Posts: 665
- Joined: Fri Sep 12, 2003 10:40 pm
- Location: Tallahassee, Florida
Any Other Image formats/Routines for supporting?
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...
-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...
Code: Select all
!.WHILE status != dwPassedOut
! Invoke AllocateDrink, dwBeerAmount
!MOV Mug, Beer
!Invoke Drink, Mug, dwBeerAmount
!.endw
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.
Thanks for all your hard work on this, and also thanks to hagibaba for his contributions.
It looks that way!The Library is nearing the Alpha stage, with all decoders working perfectly, and encoders too.
Russell
*** Diapers and politicians need to be changed...for the same reason! ***
*** Make every vote equal: Abolish the Electoral College ***
*** www.au.org ***
*** Make every vote equal: Abolish the Electoral College ***
*** www.au.org ***
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
Personally one should make it working with image objects instead of directly opening it, if you know what i mean..
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..
Last edited by thefool on Mon Oct 04, 2010 5:54 pm, edited 1 time in total.
-
localmotion34
- Enthusiast

- Posts: 665
- Joined: Fri Sep 12, 2003 10:40 pm
- Location: Tallahassee, Florida
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.
Code: Select all
!.WHILE status != dwPassedOut
! Invoke AllocateDrink, dwBeerAmount
!MOV Mug, Beer
!Invoke Drink, Mug, dwBeerAmount
!.endw
Re: Any Other Image formats/Routines for supporting?
that sounds really good. thank you for your effort.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.
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>No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
- Dreamland Fantasy
- Enthusiast

- Posts: 335
- Joined: Fri Jun 11, 2004 9:35 pm
- Location: Glasgow, UK
- Contact:
@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.
Kind regards,
Francis.
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
EndProcedureFrancis.
- Dreamland Fantasy
- Enthusiast

- Posts: 335
- Joined: Fri Jun 11, 2004 9:35 pm
- Location: Glasgow, UK
- Contact:
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
Kind regards,
Francis
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 Francis
-
localmotion34
- Enthusiast

- Posts: 665
- Joined: Fri Sep 12, 2003 10:40 pm
- Location: Tallahassee, Florida
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...
Thanks again...
Code: Select all
!.WHILE status != dwPassedOut
! Invoke AllocateDrink, dwBeerAmount
!MOV Mug, Beer
!Invoke Drink, Mug, dwBeerAmount
!.endw
- Dreamland Fantasy
- Enthusiast

- Posts: 335
- Joined: Fri Jun 11, 2004 9:35 pm
- Location: Glasgow, UK
- Contact:
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.
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.
- Dreamland Fantasy
- Enthusiast

- Posts: 335
- Joined: Fri Jun 11, 2004 9:35 pm
- Location: Glasgow, UK
- Contact:
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.
Kind regards,
Francis.
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
EndMacroFrancis.

