This program will change the alpha rgb of a png to the its neighbouring opaque pixels, this is to help remove "fringing" of images.... so you dont get a weird border effect when moving an image at a sub-pixel level.
For more information, please see this thread:
http://www.blitzbasic.com/Community/posts.php?topic=83402
This code was inspired by Yan's Defringe (http://yanbloke.googlepages.com/), but this one add multiple files.
To use, just select the folder where your pngs are, then select the destination folder (WARNING: It will overwrite files without asking...)
Exe and Code:
http://therevills.syntaxbomb.com/Multi-Defringe/Multi-Defringe.zip
For more information, please see this thread:
http://www.blitzbasic.com/Community/posts.php?topic=83402
This code was inspired by Yan's Defringe (http://yanbloke.googlepages.com/), but this one add multiple files.
To use, just select the folder where your pngs are, then select the destination folder (WARNING: It will overwrite files without asking...)
' Multi-Defringe ' The Revills Games ' www.therevillsgames.com SuperStrict ' dont need graphics... ' get the source folder Local testdir$ = RequestDir("Select Source folder...", CurrentDir()) If testdir = "" Then Notify "No source directory selected... ", True RuntimeError "No source directory selected... " EndIf ' get the destination folder Local savedir$ = RequestDir("Select Save folder...", CurrentDir()) If savedir= "" Then Notify "No destination directory selected... ", True RuntimeError "No destination directory selected... " EndIf ' read the souce folder Local dir%=ReadDir(testdir) If Not dir RuntimeError "failed to read current directory" Repeat Local testfile$ = NextFile(dir ) If testfile ="" Exit If testfile ="." Or testfile =".." Continue ' only load pngs If Lower(ExtractExt(testfile))<> "png" testfile = "" EndIf If testfile>"" Then Local fileok% = True Print "Loading.... "+testfile Local image:TPixmap = LoadPixmap (testdir +""+ testfile) If image = Null Print "Error loading image..."+testfile fileok = False EndIf If fileok Print "Processing..." Local w% = PixmapWidth(image) Local h% = PixmapHeight(image) Local array%[w,h] Local Tmp:TPixmap=CreatePixmap:TPixmap(w, h, PixmapFormat(image)) ' store the pixels into an array For Local x% = 0 To w - 1 For Local y% = 0 To h -1 Local argb:Int=ReadPixel(image,x,y) array[x,y] = argb Next Next ' work out the average colour For Local x%=0 To w-1 For Local y% = 0 To h -1 Local a% = (array[x,y] Shr 24) & $ff If a = 0 ' transparent Local r%, g%, b% Local no% Local pixel% ' above If y>0 Then pixel% = array[x,y-1] If ((pixel Shr 24)& $ff) <> 0 Then r = r + (pixel Shr 16)& $ff g = g + (pixel Shr 8)& $ff b = b + pixel & $ff no:+1 EndIf End If 'below If y<h-1 Then pixel% = array[x,y+1] If ((pixel Shr 24)& $ff) <> 0 Then r = r + (pixel Shr 16)& $ff g = g + (pixel Shr 8)& $ff b = b + pixel & $ff no:+1 EndIf EndIf ' left If x<w-1 Then pixel% = array[x+1,y] If ((pixel Shr 24)& $ff) <> 0 Then r = r + (pixel Shr 16)& $ff g = g + (pixel Shr 8)& $ff b = b + pixel & $ff no:+1 EndIf EndIf ' right If x>0 Then pixel% = array[x-1,y] If ((pixel Shr 24)& $ff) <> 0 Then r = r + (pixel Shr 16)& $ff g = g + (pixel Shr 8)& $ff b = b + pixel & $ff no:+1 EndIf EndIf If no > 0 r = r / no g = g / no b = b / no EndIf Local argb% =( a Shr 24 )+( r Shl 16 )+( g Shl 8 )+b array[x,y] = argb End If Next Next ' write the pixel For Local x% = 0 To w - 1 For Local y% = 0 To h -1 Local argb% = array[x,y] WritePixel(Tmp , x , y ,argb) Next Next ' save the image Local file:String=savedir +""+testfile Print "Saving.... "+testfile If file>"" SavePixmapPNG(Tmp,file, 9) EndIf EndIf Forever CloseDir dir Print "" Print "Finished..." WaitKey
Exe and Code:
http://therevills.syntaxbomb.com/Multi-Defringe/Multi-Defringe.zip