Results 1 to 4 of 4

Thread: how load image,draw circle area crop ,then crop and save

  1. #1

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    591

    how load image,draw circle area crop ,then crop and save

    hi,i am looking for any sample about load a image then draw a circle area with mouse for crop and then save that circle area as png or jpg,i know i can do that with cairo or wia but i found jst sample about crop or save any body can help about do that with cairo or wia,i dont know how can crop circle with wia (maybe need mask effecr idk) and save it or how can do that all of theme with cairo

    for example i found these :
    https://www.cairographics.org/samples/
    https://www.vbforums.com/showthread....From-A-Picture

    i need a simple sample

  2. #2
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,891

    Re: how load image,draw circle area crop ,then crop and save

    It's pretty straightforward to do with Cairo. This example requires:

    • a reference to RC6.dll
    • a menu called mnuFileSave
    • an image called orig.jpg in the app.path folder



    Code:
    Option Explicit
    
    ' Cairo surface of an image and selected ellipse
    Private mo_Srf As cCairoSurface
    
    ' Start point of user-defined rectangular area for our ellipse
    Private m_X1 As Long
    Private m_Y1 As Long
    ' Endpoint of user-defined rectangular area for our ellipse
    Private m_X2 As Long
    Private m_Y2 As Long
    
    Private Sub Form_Load()
       Me.ScaleMode = vbPixels ' When dealing with images, it's easiest to work in pixels.
       
       ' Load an image into our image list for later drawing in the Redraw method
       Cairo.ImageList.AddImage "main", App.Path & "\orig.jpg"
    End Sub
    
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
       If Button = vbLeftButton Then
          ' Set start point of user-defined rectangular area/selection
          m_X1 = X
          m_Y1 = Y
       End If
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
       If Button = vbLeftButton Then
          ' Set end point of user-defined rectangular area/selection
          m_X2 = X
          m_Y2 = Y
          
          Redraw
       End If
    End Sub
    
    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
       If Button = vbLeftButton Then
          ' Set end point of user-defined rectangular area/selection
          m_X2 = X
          m_Y2 = Y
          
          Redraw
       End If
    End Sub
    
    Private Sub Form_Resize()
       ' Resize our Cairo surface to match the size of the form
       Set mo_Srf = Cairo.CreateSurface(Me.ScaleWidth, Me.ScaleHeight)
       Redraw
    End Sub
    
    Sub Redraw()
       With mo_Srf.CreateContext
          .RenderSurfaceContent "main", 0, 0, Me.ScaleWidth, Me.ScaleHeight, , , True   ' Render the full original image first (maintaining aspect ratio with the final "True" parameter)
       
          If m_X2 > 0 And m_Y2 > 0 Then
             ' We have a selection rectangle, so we will draw an ellipse, "erasing" everything outside it. The "erase" operation will just be a white fill for this demo
             
             .Rectangle 0, 0, Me.ScaleWidth, Me.ScaleHeight  ' Create a rectangular path over the whole image - this will be our white fill/erase area
             
             .Ellipse m_X1 + (m_X2 - m_X1) / 2, _
                      m_Y1 + (m_Y2 - m_Y1) / 2, _
                      m_X2 - m_X1, _
                      m_Y2 - m_Y1 ' Draw an ellipse within the bounds of the user-drawn rectangular area.
                                          ' Note that the RC6 Ellipse method takes the center point of the ellipse for the first 2 parameters, then the width & height of the ellipse for the next 2 parameters.
          
             .FillRule = CAIRO_FILL_RULE_EVEN_ODD   ' Set the fill rule to EVEN/ODD so that we are filling between the ellipse and the rectangle
             .SetSourceColor vbWhite ' Change the fill colour to white
             .Fill ' And fill in our path with the selected colour
          End If
       End With
          
       Set Me.Picture = mo_Srf.Picture
    End Sub
    
    Private Sub mnuFileSave_Click()
       ' Crop the image to the user-defined rectangular area and save it (overwriting any existing file of the same name)
       mo_Srf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToJpgFile App.Path & "\crop.jpg"
    End Sub
    Note that the above example is very basic. For example, it doesn't handle things like automatically resizing the selection rectangle when you resize the form, but it should be OK for demonstrating the basic process.

    Example Original Image:

    Name:  2022-11-01_9-27-53.jpg
Views: 452
Size:  53.2 KB

    Example Selection:

    Name:  2022-11-01_9-28-18.jpg
Views: 452
Size:  25.8 KB

    Example Exported/Cropped Image:

    Name:  crop.jpg
Views: 484
Size:  47.9 KB
    Last edited by jpbro; Nov 1st, 2022 at 08:40 AM.

  3. #3

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    591

    Re: how load image,draw circle area crop ,then crop and save

    thanks but there is a small problem about crop process,i need crop with circle area without background white color like as png and save it.
    my another problem is i wanna save that circle area with gray percent (for example between 0 to 100 percent about gray mode).

  4. #4

    Thread Starter
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    591

    Re: how load image,draw circle area crop ,then crop and save

    i changed to this for crop with export png without background color and gray effect export :


    Name:  shot.jpg
Views: 476
Size:  22.4 KB

    better size :



    Code:
    Option Explicit
    Private mo_Srf As cCairoSurface
    Private m_X1 As Long
    Private m_Y1 As Long
    Private m_X2 As Long
    Private m_Y2 As Long
    Dim ExpSrf As cCairoSurface
    
    Private Sub Form_Load()
        Me.ScaleMode = vbPixels
        Cairo.ImageList.AddImage "main", App.Path & "\1.png"
    End Sub
    
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbLeftButton Then
            m_X1 = X
            m_Y1 = Y
        End If
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbLeftButton Then
            m_X2 = X
            m_Y2 = Y
            
            Redraw
        End If
    End Sub
    
    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If Button = vbLeftButton Then
            m_X2 = X
            m_Y2 = Y
            
            Redraw
        End If
    End Sub
    
    Private Sub Form_Resize()
        Set mo_Srf = Cairo.CreateSurface(Me.ScaleWidth, Me.ScaleHeight)
        Redraw
    End Sub
    
    Sub Redraw()
        
        
        With mo_Srf.CreateContext
            
            .RenderSurfaceContent "main", 0, 0, Me.ScaleWidth, Me.ScaleHeight, , , True
            
            If m_X2 > 0 And m_Y2 > 0 Then
                
                .Rectangle 0, 0, Me.ScaleWidth, Me.ScaleHeight
                
                .Ellipse m_X1 + (m_X2 - m_X1) / 2, _
                m_Y1 + (m_Y2 - m_Y1) / 2, _
                m_X2 - m_X1, _
                m_Y2 - m_Y1
                
                .FillRule = CAIRO_FILL_RULE_EVEN_ODD
                
                .SetSourceColor vbWhite, 0.6
       
                .Fill
    
            End If
        End With
        
        With Cairo.CreateSurface(Me.ScaleWidth, Me.ScaleHeight).CreateContext
            .Ellipse m_X1 + (m_X2 - m_X1) / 2, m_Y1 + (m_Y2 - m_Y1) / 2, m_X2 - m_X1, m_Y2 - m_Y1
            
            .Clip
            .RenderSurfaceContent "main", 0, 0, Me.ScaleWidth, Me.ScaleHeight
            
            .ResetClip
            Set ExpSrf = Cairo.CreateSurface(mo_Srf.Width, mo_Srf.Height)
            
            Dim cc As cCairoContext
            Set cc = ExpSrf.CreateContext
            
            cc.RenderSurfaceContent .Surface, 0, 0, , , , , True
            
           '****************************************************
            ' for convert to gray ( maybe better idea?)
            cc.Operator = CAIRO_OPERATOR_HSL_COLOR
            cc.Ellipse m_X1 + (m_X2 - m_X1) / 2, m_Y1 + (m_Y2 - m_Y1) / 2, m_X2 - m_X1, m_Y2 - m_Y1
            cc.Fill , Cairo.CreateSolidPatternLng(RGB(1, 1, 1), 1)
            '****************************************************
        End With
        
        Set Me.Picture = mo_Srf.Picture
    End Sub
    
    Private Sub Form_Terminate()
        If Forms.Count = 0 Then New_c.CleanupRichClientDll
    End Sub
    
    Private Sub mnuFileSave_Click()
        ExpSrf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToPngFile App.Path & "\Export.png"
    End Sub
    but maybe better idea for export with gray color percent idea?
    here was been my idea :

    Code:
           '****************************************************
            ' for convert to gray ( maybe better idea?)
            cc.Operator = CAIRO_OPERATOR_HSL_COLOR
            cc.Ellipse m_X1 + (m_X2 - m_X1) / 2, m_Y1 + (m_Y2 - m_Y1) / 2, m_X2 - m_X1, m_Y2 - m_Y1
            cc.Fill , Cairo.CreateSolidPatternLng(RGB(1, 1, 1), 1)
            '****************************************************

    + my another question , i tested these codes but jst png and jpg exported,svg and pdf not worked why?
    Code:
        ExpSrf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToPngFile App.Path & "\Export.png"
        ExpSrf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToJpgFile App.Path & "\Export.jpg", 100
        ExpSrf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToSVGFile App.Path & "\Export.svg"
        ExpSrf.CropSurface(m_X1, m_Y1, m_X2 - m_X1, m_Y2 - m_Y1).WriteContentToPDFFile App.Path & "\Export.pdf"
    Last edited by Black_Storm; Nov 1st, 2022 at 05:20 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width