PureBasic Forums - English

Posted: **Thu May 09, 2013 11:03 am**

Hello,

I want sale little objects like pin's, key ring, etc...

But when i have numerous objects, it's too long to catch one photo by object

So i have thinking, to catch one photo of several objects, and find a software or a PB code for cut each object in a little image.
Like the foreground is for example blanc, it's perhaps easy to detect it and cut around each object and put the cutting in an image ???

Somebody know a freeware or a begin of PB code for do this style of job ?

Thanks and good day

Posted: **Thu May 09, 2013 12:56 pm**

Posted: **Thu May 09, 2013 2:15 pm**

Thanks BorisTheOld to your answer

I have search with GIMP v2.6.11 and that's true there are an option to automatic cute a picture.
I have try several things but not found how create one picture by object, are you sure GIMP can do that ????

Original picture :

Pin's.jpg

to that :

Pin's 1.jpg

Pin's 2.jpg

Pin's 3.jpg

Posted: **Thu May 09, 2013 2:31 pm**

Hi KCC

Have you tried FastStone Capture.

It is a utility which does not need installing.

It has a nice free-hand tool for clipping the 'cuties'

Try it. http://www.faststone.org/FSCaptureDetail.htm

Posted: **Thu May 09, 2013 3:44 pm**

Thanks DAVIDO

I try it now and see, if i can create automaticaly, all the pictures of the objects in one click

Posted: **Thu May 09, 2013 4:07 pm**

For manually extracting parts of a big image, I can also recommend Faststone Capture. I've bought the program myself, and did never regret it. However, for this job the freeware version should be sufficient. The last freeware version was FastStone Capture 5.3.

For doing this task (semi-)automatically, I think an image analysis software such as Pixcavator is needed, see e.g. here or here.

Posted: **Thu May 09, 2013 4:44 pm**

Kwaï chang caïne wrote:I have search with GIMP v2.6.11 and that's true there are an option to automatic cute a picture.
I have try several things but not found how create one picture by object, are you sure GIMP can do that ????

Yes!

1) Tools > use an appropriate selection tool to select the part of the image that you need

2) Edit > Cut

3) Edit > Paste As > New Image

You can then use various tools to manipulate the image, change the background colour, etc, etc. It's really easy.

Posted: **Thu May 09, 2013 6:46 pm**

Thanks Little john.
I have try also your link PIXCAVATOR.
At the beginning I thought this software can easily cut my pin's.
But in fact no, there are too much color in my pin's

It's a pity, the software not give the choice of the color of background

So even after several try, the result is not really perfect

So again thanks to your link, I did not know this style of soft exist

In fact, this morning i not thought it's so difficult for a software to detect several object in the same foreground....
Apparently it's much more difficult i think

Finally, i believe the best method is to put the object on a grid, for example a little bit like this

Posted: **Thu May 09, 2013 9:48 pm**

Hi KCC, If you arrange the image in a grid, then the X/Y positions for each square are known and you can use the PB GrabImage() function to extract to individual images automatically.

Posted: **Fri May 10, 2013 6:58 am**

Yes you have right, finally it's surelly the best and simple method....

I have thinking also, but i don't know anything to graphical programming

Believe you, it's possible to draw two invisibles lines, one horizontal, the other vertical, that i move left to right and another up to down, a little bit like the scanner

I put the color of the pixels under the two lines in an array
When the color of all the pixel under the two lines is like the foreground, it's the end of the object
So at this moment i create a new image and put the color of the array to her

After i begin at the actual position of the two lines for find the second object, etc ....
Obviously, this method only works if the object is in a perfect square, and not mixing like the image above, even if the square is not tracing like this :

I have also another idea, perhaps it's possible to draw a grid under the image, but a grid with possibility to move all the lines ???
I can move manually all this vertical and horizontal lines, like that, if the lines is all at the right place....push a button and PB can cut all the pictures, because he know the X and Y positions of all the squares of the grid.. and name it "Image1.jpg", "Image2.jpg", "Image3.jpg"

Posted: **Fri May 10, 2013 10:02 am**

Somebody know a freeware or a begin of PB code for do this style of job ?

Here is something fast an dirty to begin:

Code: Select all

;by einander 
;PB 5.11 - tested on win x86
;  
EnableExplicit
Define Ev,Wi,He,Result,Path$
Global _Img,_Canv,_Var$,_Selection,_InnerRgn
Global _Drawing,GMX.L,GMY.L  
UseJPEGImageDecoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
#PatImg$ ="Windows or OS/2 Bitmap (*.bmp)|*.bmp"+
          "|JPEG File Interchange Format (*.jpeg,*.jpg,*.jfif)|*.jpeg;*.jpg;*.jfif"+
          "|Portable Network Graphics (*.png)|*.png"+
          "|Tagged Image File (*.tif,*.tiff)|*.tif;*.tiff"+
          "|All Supported Files|*.bmp;*.jpeg;*.jpg;*.jfif;*.png;*.tif;*.tiff"+
          "|All Files (*.*)|*.*"
;
Structure RgnBrush
  X.I
  Y.I
  RGB.L
EndStructure
;
Dim LP.Point(0)
;
Macro MMx  :  WindowMouseX(EventWindow())  : EndMacro
;
Macro MMy  :  WindowMouseY(EventWindow())  : EndMacro
;
Macro MMk
  Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro
;
Macro StopDraw
  If _DrawING 
    StopDrawing()
    _Drawing=0  
  EndIf 
EndMacro
;
Macro CLS(RGB=0,Win=0)
  Drawin(Win)
  Box(0,0,OutputWidth(),OutputHeight(),RGB)
EndMacro
;
Macro DrawFast(Img,BKG=-1) 
  StopDraw  
  _DrawING=StartDrawing(ImageOutput(Img))
  If BKG>-1:Box(0,0,OutputWidth(),OutputHeight(),Bkg):EndIf 
EndMacro 
;
; 
Procedure.F MaxF(A.F,B.F) ; comparar
  If A>B:ProcedureReturn A:EndIf 
  ProcedureReturn B
EndProcedure
;
Procedure CenterBoxes(X,Y,W1,H1,W2,H2,*P.Point) ;Out *P.Point to Center box 
  *P\X=X+(W1-W2)/2
  *P\Y=Y+(H1-H2)/2
EndProcedure 
;
Procedure ResizeFit(Img,NewWi,NewHe,Force=0,FreeImg=0,*P.Point=0) ;- RET New Image = Img proportionally Resized To Fit inside newwi,newhe 
  Static NewImg
  Protected Wi2=ImageWidth(Img),He2=ImageHeight(Img)
  If FreeImg And  IsImage(NewImg) :FreeImage(NewImg) :EndIf
  NewImg=GrabImage(Img,-1,0,0,Wi2,He2)
  If Force Or Wi2>NewWi Or He2>NewHe
    Protected Mx.F=MaxF(Wi2/NewWi,He2/NewHe)
    Wi2/Mx  : He2/Mx
    ResizeImage(NewImg,Wi2,He2)
  EndIf
  If *P.Point ; ret *P para centrar NewImg en Img
    CenterBoxes(0,0,NewWi,NewHe,ImageWidth(NewImg),ImageHeight(NewImg),*P)
  EndIf
  ProcedureReturn NewImg
EndProcedure 
;
Procedure$ SaveImg(Img,DefaultFile$="",Title.S="Save Image") ; Save Image 
  Protected Pattern$ ="Windows Or OS/2 Bitmap (*.Bmp)|*.Bmp"
  Pattern$+"|JPEG File Interchange Format (*.Jfif,*.Jpeg,*.Jpg)|*.Jpeg;*.jpg;*.jfif"
  Pattern$+"|Portable Network Graphics (*.png)|*.png"
  Pattern$+"|Tagged Image File (*.tif,*.tiff)|*.tif;*.tiff"
  Protected File$=SaveFileRequester("Please Choose The File Name To Save", DefaultFile$, Pattern$, 0)
  If File$
    If SelectedFilePattern()=0
      If LCase(GetExtensionPart(File$))<>"bmp" :  File$+".bmp"  :EndIf
      SaveImage(Img,File$,#PB_ImagePlugin_BMP, 0, 32)
      ProcedureReturn "Saved "+File$
    ElseIf SelectedFilePattern()=1 
      If LCase(GetExtensionPart(File$))<>"jpg"  :  File$+".jpg" :EndIf
      SaveImage(Img,File$,#PB_ImagePlugin_JPEG,10)
      ProcedureReturn "Saved "+File$
    ElseIf SelectedFilePattern()=2 
      If  LCase(GetExtensionPart(File$))<>"png"  :  File$+".png"  :EndIf
      SaveImage(Img,File$,#PB_ImagePlugin_PNG)
      ProcedureReturn "Saved "+File$
    EndIf 
  Else
    ProcedureReturn ("File Not Saved")
  EndIf    
EndProcedure
;
Procedure LeeImage(DefaultFile$="*.*",Title.S="Load Image") ; Load Image - Ret ImageNum StandardFile$ = "i:\" ; set initial File+path to Display
  Protected File$,Result
  If DefaultFile$="*.*" Or Right(DefaultFile$,1)="\": File$ = OpenFileRequester("Choose Image To load", DefaultFile$, #PatImg$,4) 
  Else:File$=DefaultFile$
  EndIf
  If File$
    Protected Img=LoadImage(-1, File$)
    _Var$=File$  ; para retorno
    ProcedureReturn Img
  Else
    Result=MessageRequester("", "Image Not loaded."+#CRLF$+"Continue?",  #PB_MessageRequester_YesNo)
    If Result=#PB_MessageRequester_No 
      End
    EndIf
  EndIf
EndProcedure
;
Procedure GMX(Gad) ;- GMX(gad) ; HACE GMX, GMY  : GetGadgetMouse x, y
  Protected P.Point
  GetCursorPos_(P)
  ScreenToClient_( GadgetID(Gad), @P) 
  CopyMemory(@P\X,@GMX,16)
  If GMX<0 Or GMX>=GadgetWidth(Gad)  :ProcedureReturn -1 :EndIf
  If GMY<0 Or GMY>=GadgetHeight(Gad) :ProcedureReturn -1 :EndIf
EndProcedure    
;
Procedure Menu1(Wn)
  Protected Menu= CreateMenu(-1, WindowID(Wn))
  MenuItem( 1, "&Load Image")
  ProcedureReturn Menu
EndProcedure 
;
Procedure Menu2(Wn)
  Protected Menu= CreateMenu(-1, WindowID(Wn))
  MenuItem( 3, "Save Selection As...")
  ProcedureReturn Menu
EndProcedure 
;
Procedure DrawCanvas(Canvas,RGB=-1)
  If _Drawing:StopDrawing():EndIf
  _DrawING=StartDrawing(CanvasOutput(Canvas))
  If RGB>-1
    Box(0,0,OutputWidth(),OutputHeight(),RGB)
  EndIf
EndProcedure
;
Macro Drawin(Win=0,RGB=-1) 
  StopDraw  
  _DrawING=StartDrawing(WindowOutput(Win))
  If RGB>-1
    Box(0,0,OutputWidth(),OutputHeight(),RGB)
  EndIf
EndMacro 
;
Procedure  GetInnerRgn(*Rc.RECT,Array Lp.Point(1))
  ; Select region with Mouse inside *rc; out contour in LP.Point()
  Protected Pt.Point,Count
  Dim LP.Point(0)
  Gmx(_Canv)
  LP(0)\X=Gmx : LP(0)\Y=Gmy
  While MMk=1
    Gmx(_Canv)
    WaitWindowEvent()
    If #WM_MOUSEMOVE   
      DrawCanvas(_Canv)
      Count+1
      ReDim LP.Point(Count)
      LP(Count)\X=GMx : LP(Count)\Y=GMy
      LineXY(LP(Count-1)\X,LP(Count-1)\Y,LP(Count)\X,LP(Count)\Y,#White) 
    EndIf
    StopDraw
  Wend
  DrawCanvas(_Canv)
  If MMk=0
    LineXY(LP(Count)\X,LP(Count)\Y,LP(0)\X,LP(0)\Y,#White)
    StopDraw
  EndIf
  ProcedureReturn CreatePolygonRgn_(@LP(),Count,#WINDING)   ; try #ALTERNATE,#WINDING <<<<<<<<
EndProcedure
;
Procedure InDraw(X,Y) ; check for Point() inside Drawing area
  If X>=0 And Y>=0 And X<OutputWidth() And Y<OutputHeight()
    ProcedureReturn #True
  EndIf
EndProcedure
;
Procedure GetRgnBrush(Rgn,Array Arr.Rgnbrush(1),*Rc.Rect) ; store in Arr() positions and Colors From Rgn
  Protected X,Y,N,Rwi,Rhe,I
  GetRgnBox_(Rgn,*Rc)
  Rwi=*Rc\Right-*Rc\Left
  Rhe=*Rc\Bottom-*Rc\Top
  Dim Arr(Rwi*Rhe)
  DrawCanvas(_Canv)
  For X=*Rc\Left To *Rc\Right-1
    For Y=*Rc\Top To *Rc\Bottom-1
      If PtInRegion_(Rgn,X,Y) And InDraw(X,Y)
        Arr(N)\X=X
        Arr(N)\Y=Y
        N+1
      EndIf
    Next
  Next
  If N>0:ReDim Arr(N-1)
    Drawfast(_Img)
    For I=0 To N-1
      Arr(I)\RGB=Point(Arr(I)\X,Arr(I)\Y)
    Next
  EndIf
EndProcedure
;
Procedure ProcessRegion(Array Lp.Point(1))
  Static InnerRC,OuterRgn,TmpRgn,Pulsed
  Dim Rgnbrush.Rgnbrush(0)
  Protected Rc.Rect,I,Firstx,Firsty
  Protected Offx=10,Offy=10 ; Choose here your preferred  Margins <<<<<<<<<<<<<<<<<<<<<<
  GetWindowRect_(GadgetID(_Canv),@Rc)
  With Outer
    DrawCanvas(_Canv)
    Select MMk
      Case 0 : Pulsed=0
      Case 1
        If Pulsed=0
          If _InnerRgn :  Gmx(_Canv)
          Else ; if _InnerRgn don't exist, try to Create it
            OuterRgn=CreateRectRgn_(0,0,OutputWidth(),OutputHeight())
            _InnerRgn=GetInnerRgn(@Rc,LP())
            GetRgnbrush(_InnerRgn,RgnBrush(),@Rc)  
            SortStructuredArray(Rgnbrush(),#PB_Sort_Ascending,OffsetOf(Rgnbrush\X),#PB_Sort_Integer)
            Firstx=Rgnbrush(0)\X-Offx 
            SortStructuredArray(Rgnbrush(),#PB_Sort_Ascending,OffsetOf(Rgnbrush\Y),#PB_Sort_Integer)
            Firsty=Rgnbrush(0)\Y-Offy
            Drawin()
            For I=0 To ArraySize(Rgnbrush())
              Plot(Rgnbrush(I)\X-Firstx,Rgnbrush(I)\Y-Firsty,Rgnbrush(I)\RGB)  
            Next
            If IsImage(_Selection):FreeImage(_Selection):EndIf
            _Selection=GrabDrawingImage(-1,0,0,Rc\Right-Rc\Left+Offx*2,Rc\Bottom-Rc\Top+Offy*2)
            DrawCanvas(_Canv)
          EndIf
          Pulsed=#True
        EndIf
      Case 2
        DeleteObject_(TmpRgn)
        DeleteObject_(_InnerRgn ) 
        DeleteObject_(OuterRgn)
        Cls()
        _InnerRgn=0
        StopDraw
        SetGadgetAttribute(_Canv,#PB_Canvas_Image,ImageID(_Img))
    EndSelect 
  EndWith
EndProcedure 
;<<<<<<<<<<<<<<<<<<
OpenWindow(0,0,0,800,600 ,"Test Window",#PB_Window_SystemMenu|#PB_Window_Maximize)
Wi=WindowWidth(0):He=WindowHeight(0)
ResizeWindow(0,Wi/2,0,Wi/2-20,He)
Define Menu2=Menu2(0)
Define Testwin=OpenWindow(-1,0,0,Wi/2-15,He,"Define Region -  Right mouse button to undefine",#PB_Window_SystemMenu)
SetWindowColor(0,$22)
SetWindowColor(Testwin,$22)
Define Menu1=Menu1(Testwin)
Define Outer.RECT 
_Canv=CanvasGadget(-1,0,0,1,1,#PB_Canvas_Keyboard)
Repeat
  EV=WaitWindowEvent(1)
  If EV= #WM_KEYDOWN And EventwParam()=27:End:EndIf
  Select Ev
    Case #PB_Event_Gadget
      Select EventGadget()
        Case _Canv
          ProcessRegion(Lp())
      EndSelect
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          Repeat
            If IsImage(_Img):FreeImage(_Img):EndIf
            _Img=LeeImage("e:\Graficos\")
            If _Img=0
              MessageRequester("",_Var$+#CRLF$+"Image Error",0)
              Result=MessageRequester("", "Image Not loaded."+#CRLF$+"Continue?",  #PB_MessageRequester_YesNo)
              If Result=#PB_MessageRequester_No 
                End
              EndIf
            EndIf  
          Until _Img
          Path$=GetPathPart(_Var$)
          _Img=Resizefit(_Img,Wi/2,He)
          ResizeGadget(_Canv,0,0,ImageWidth(_Img),ImageHeight(_Img))
          SetGadgetAttribute(_Canv,#PB_Canvas_Image,ImageID(_Img))
          DeleteObject_(_InnerRgn ) 
          _InnerRgn=0
          Cls($22)  
        Case 3  ; save Selection
          If IsImage(_Selection)
            SaveImg(_Selection,Path$) 
          Else
            Result=MessageRequester("", "Nothing to save."+#CRLF$+"Continue?",  #PB_MessageRequester_YesNo)
            If Result=#PB_MessageRequester_No 
              End
            EndIf
          EndIf
      EndSelect
  EndSelect
Until EV= #PB_Event_CloseWindow
End

Saving the selection as Jpeg fails. Bmp and Png seems to work Ok.
Cheers!

Posted: **Fri May 10, 2013 11:00 am**

Waoooouuuhh !!!! Thanks a lot deer Einander !!!

All this works only for the little KCC, one thousand of thanks

It's really a good begining .....thanks to you, i have the manual cute

In fact, your begining is already better that when i have coding in all a month and produce my final version

The magician wrote:Here is something fast an dirty

My dream....can coding dirty like you a day

Have a very good day, mister MAGIC

Posted: **Sat May 11, 2013 11:41 am**

KCC: You are welcome!
I said fast and dirty because this code was not made from scratch, but is a revamp of a 7 years old useless code: http://www.purebasic.fr/english/viewtop ... 5&p=151389

I discovered a hidden utility thanks to your talent for the Coding Questions

Posted: **Sat May 11, 2013 11:55 am**

einander wrote:KCC: You are welcome!
I said fast and dirty because this code was not made from scratch, but is a revamp of a 7 years old useless code: http://www.purebasic.fr/english/viewtop ... 5&p=151389

I discovered a hidden utility thanks to your talent for the Coding Questions

Impressive!

Posted: **Sat May 11, 2013 12:04 pm**

Like El_Choni, i'm always impressive when i see all your code in all different ways (Audio, Picture, ....)

thanks to your talent for the Coding Questions

Yes you have right

In this forum, i'm the champion of stranges questions

In fact, i have create a dream team with all the very good programmer and friends of this splendid forum and also french forum.....
I have the questions and the problems ....and all of you, have the solutions

Again thanks for your precious sharing and also thanks for all the other members who try to help me

PureBasic Forums - English

Automatical cut pictures

Automatical cut pictures

Re: Automatical cute pictures

Re: Automatical cute pictures

Re: Automatical cute pictures

Re: Automatical cute pictures

Re: Automatical cut pictures

Re: Automatical cute pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures

Re: Automatical cut pictures