Brief instructions (Menu commands):
Replace background = scans the pict line by line and replaces the background up to the image (or another color)
- do this first and see if it does the complete job, there may be areas that are missed if so then use...
Fill background = crude fill routine that looks out from the point you click
- do over and over again until all areas are made transparent
Code: Select all
;vers .04
EnableExplicit
UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageEncoder()
Enumeration ; windows
#ShowWnd
EndEnumeration
Enumeration ; gadgets
#gload
#gmod
#gorigtext
#gmodtext
EndEnumeration
Enumeration ; images
#imgload
#imgmod
EndEnumeration
Enumeration 1 ; menus
#menuload
#menusave
;MenuItem(#PB_Menu_Quit,"Quit"+Chr(9)+"Cmd+Q") =-1 ; predefined Mac constant
#menurev
#menusel
#menufill
EndEnumeration
CompilerIf #PB_Compiler_OS = #PB_OS_Windows Or #PB_Compiler_OS = #PB_OS_Linux ; can't test if this works/needed on Windows/Linux
#PB_Menu_Quit=-1 ; predefined Mac constant #PB_Compiler_MacOS
CompilerEndIf
Structure oimgdata
xorig.i
yorig.i
EndStructure
Global OImg.oimgdata
Structure mimgdata
xorig.i
yorig.i
xsel.i
ysel.i
rgb.i
EndStructure
Global MImg.mimgdata
Global LoadedFile.s
Global ModFile.s
Global WantClick=0 ; waiting for mouse click on gadget (#gload)
Procedure SetUpMenus(mwnd)
If CreateMenu(mwnd, WindowID(mwnd))
;MenuTitle("");not used on Mac
;MenuItem(#PB_Menu_About,"Instructions (vers"+avers+")") ; predefined Mac constant
;MenuItem(#PB_Menu_Preferences,"Preferences") ; predefined Mac constant
MenuItem(#PB_Menu_Quit,"Quit"+Chr(9)+"Cmd+Q") ; predefined Mac constant=-1
MenuTitle("File")
MenuItem(#menuload,"Load file")
MenuItem(#menusave,"Save file"+Chr(9)+"Cmd+S")
MenuTitle("Modify")
MenuItem(#menurev,"Revert to origianl image")
MenuItem(#menusel,"replace background"+Chr(9)+"Cmd+R")
MenuItem(#menufill,"fill background"+Chr(9)+"Cmd+F")
EndIf
EndProcedure
Procedure fillbackground()
Define x,y,height,width
If StartDrawing(ImageOutput(#imgmod))
DrawingMode(#PB_2DDrawing_AlphaChannel)
MImg\rgb=Point(MImg\xsel,MImg\ysel); : Debug MImg\rgb
width=ImageWidth(#imgmod)-1
height=ImageHeight(#imgmod)-1
;go up and look left and right from origin point
x=MImg\xsel : y=MImg\ysel
While Point(x,y)=MImg\rgb And y=>0 ; go up lines from origin
While Point(x,y)=MImg\rgb And x=>0 ; look left
Plot(x,y,RGBA(0,0,0,0)) ; can be anything
x-1 : If x<0 : Break : EndIf
Wend
x+1
While (Point(x,y)=MImg\rgb Or Alpha(Point(x,y))=0) And x<=width ; look right from left edge
Plot(x,y,RGBA(0,0,0,0)) ; can be anything
x+1 : If x>width : Break : EndIf
Wend
x=MImg\xsel
y-1 : If y<0 : Break : EndIf
Wend
x=MImg\xsel : y=MImg\ysel+1
While Point(x,y)=MImg\rgb And y<=height ; go up lines from origin
While Point(x,y)=MImg\rgb And x=>0 ; look left
Plot(x,y,RGBA(0,0,0,0)) ; can be anything
x-1 : If x<0 : Break : EndIf
Wend
x+1
While (Point(x,y)=MImg\rgb Or Alpha(Point(x,y))=0) And x<=width ; look right from left edge
Plot(x,y,RGBA(0,0,0,0)) ; can be anything
x+1 : If x>width : Break : EndIf
Wend
x=MImg\xsel
y+1 : If y>height : Break : EndIf
Wend
StopDrawing()
SetGadgetState(#gmod,ImageID(#imgmod))
EndIf
EndProcedure
Procedure replacebackground()
Define x,y,height,width
If StartDrawing(ImageOutput(#imgmod))
DrawingMode(#PB_2DDrawing_AlphaChannel)
MImg\rgb=Point(MImg\xsel,MImg\ysel); : Debug MImg\rgb
width=ImageWidth(#imgmod)
height=ImageHeight(#imgmod)
; look across lines
For y=0 To height-1
;get up to non-white
x=0
While Point(x,y)=MImg\rgb And x<width-1
Plot(x,y,RGBA(255,255,255,0)) ; 255,255,255 can be anything
x+1
Wend
;take off from end of line back till non-white
If x<width
x=width-1
While Point(x,y)=MImg\rgb And x>0
Plot(x,y,RGBA(255,255,255,0))
x-1
Wend
EndIf
Next
;look up and down lines
For x=0 To width-1
y=0
While (Point(x,y)=MImg\rgb Or Alpha(Point(x,y))=0) And y<height-1
Plot(x,y,RGBA(255,255,255,0))
y+1
Wend
;take off from end of line up till non-white or not transparent
If y<height
y=height-1
While (Point(x,y)=MImg\rgb Or Alpha(Point(x,y))=0) And y>0
Plot(x,y,RGBA(255,255,255,0))
y-1
Wend
EndIf
Next
StopDrawing()
SetGadgetState(#gmod,ImageID(#imgmod))
EndIf
EndProcedure
Procedure Show()
Define w.l=440
Define h.l=400
If OpenWindow(#ShowWnd,0,0,w,h,"Housekeeping",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetUpMenus(#ShowWnd)
ExamineDesktops() ; only done once here
If LoadFont(0,"Monaco",10)
SetGadgetFont(#PB_Default, FontID(0))
EndIf
TextGadget(#gorigtext,3,4,400-4,16,"No file loaded...")
OImg\xorig=10 ; top left edge of original image
OImg\yorig=20
TextGadget(#gmodtext,3,4+16+OImg\yorig,400-4,16,"No mod file...")
MImg\xorig=10
MImg\yorig=100
ImageGadget(#gload,OImg\xorig,OImg\yorig,0,0,0) ; loaded (original image)
ImageGadget(#gmod,MImg\xorig,MImg\yorig,0,0,0) ; modified image
EndIf
EndProcedure
Procedure DoMenuEvent(mid)
Define err,w,h,filename$
Select mid
Case #PB_Menu_Quit
End
Case #menuload
LoadedFile=OpenFileRequester("load picture","","",0)
If LoadedFile
If Not LoadImage(#imgload,LoadedFile)
MessageRequester("Loading image...","Cannot load...")
Else
h=OImg\yorig+ImageHeight(#imgload)+20+ImageHeight(#imgload)+20
w=OImg\yorig+ImageWidth(#imgload)+20
If w<400 : w=400 : EndIf
ResizeWindow(#ShowWnd,#PB_Ignore,#PB_Ignore,w,h)
ResizeGadget(#gload,OImg\xorig,OImg\yorig,ImageWidth(#imgload),ImageHeight(#imgload))
SetGadgetState(#gload,ImageID(#imgload))
MImg\yorig=OImg\yorig+ImageHeight(#imgload)+20
ResizeGadget(#gmod,MImg\xorig,MImg\yorig,ImageWidth(#imgload),ImageHeight(#imgload)) ; move mod image down
If CreateImage(#imgmod,ImageWidth(#imgload),ImageHeight(#imgload),32)
If StartDrawing(ImageOutput(#imgmod))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,ImageWidth(#imgload),ImageHeight(#imgload),RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawImage(ImageID(#imgload),0,0)
StopDrawing()
EndIf
EndIf
SetGadgetState(#gmod,ImageID(#imgmod))
SetGadgetText(#gorigtext,GetFilePart(LoadedFile)+" ("+Str(ImageWidth(#imgload))+"x"+Str(ImageHeight(#imgload))+")")
ResizeGadget(#gmodtext,#PB_Ignore,OImg\yorig+ImageHeight(#imgload)+4,#PB_Ignore,#PB_Ignore)
SetGadgetText(#gmodtext,"Modified file")
ModFile=LoadedFile
EndIf
EndIf
Case #menusave
filename$ = SaveFileRequester("Save image...",ModFile,"",0)
If filename$
ModFile=filename$
err=SaveImage(#imgmod, ModFile,#PB_ImagePlugin_PNG)
If Not err
MessageRequester("Saving file...","File not saved")
EndIf
EndIf
Case #menurev ; revert image to original
;CopyImage(#imgload,#imgmod) ; don't use will not create a 32 bit image if original is not 32 bit!
;use of CreateImage() will automatically free old #imgmod image (I think)
If CreateImage(#imgmod,ImageWidth(#imgload),ImageHeight(#imgload),32)
If StartDrawing(ImageOutput(#imgmod))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0,0,ImageWidth(#imgload),ImageHeight(#imgload),RGBA(0,0,0,0))
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawImage(ImageID(#imgload),0,0)
StopDrawing()
EndIf
EndIf
SetGadgetState(#gmod,ImageID(#imgmod))
Case #menusel
WantClick=1
SetGadgetText(#gmodtext,"Click on background color to be replaced.")
Case #menufill
WantClick=2
SetGadgetText(#gmodtext,"Click on background color to be replaced.")
EndSelect
EndProcedure
Show()
DoMenuEvent(#menuload) ; take out?
; loop
Repeat
Define event,wndw
event = WaitWindowEvent()
wndw=EventWindow()
Select wndw
Case #ShowWnd
Select event
Case #PB_Event_Menu
DoMenuEvent(EventMenu())
Case #PB_Event_Gadget
Select EventGadget()
Case #gmod
If WantClick=1
SetGadgetText(#gmodtext,"Modified image")
MImg\xsel=WindowMouseX(wndw)-MImg\xorig
MImg\ysel=WindowMouseY(wndw)-MImg\yorig
wantclick=#False
replacebackground()
ElseIf WantClick=2
SetGadgetText(#gmodtext,"Modified image")
MImg\xsel=WindowMouseX(wndw)-MImg\xorig
MImg\ysel=WindowMouseY(wndw)-MImg\yorig
wantclick=#False
fillbackground()
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
EndSelect
ForEver
