Results 1 to 26 of 26

Thread: How Recognize geometric shapes

  1. #1

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    How Recognize geometric shapes

    Hi friends, I want to select the shape of the circle in each part of the page
    Location of the figure x,y
    Both inside the form and outside the form
    Please help me how to do this
    For example, in the photo, a circle with a green line is selected
    -----------------------------------------
    Pay attention to the moving image
    -----------------------------------------

    Show sample tool
    Attached Images Attached Images  
    Last edited by Mojtaba; Nov 28th, 2021 at 07:35 PM.

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,532

    Re: How to select shapes

    How are the shapes drawn, especially in the case of the shape not being inside the form?

    Since you haven't provided any code then I guess I'll not answer with code because I can't.
    But in cases where I've had such code, and drawn the shapes within a form, I keep track of the location of shapes drawn in z-order. I traverse the list from top to bottom and if the mouse click falls in the bounds of a bounding box around the shape, I then check to see if the relative position within the box is not a transparent pixel of the shape.
    If it isn't transparent, then it is the shaped clicked on.
    "Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930

  3. #3
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    600

    Re: How to select shapes

    the code form dilettante

    Orange to Mono Edge.zip

    i chang some code,you can test .

  4. #4

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    Re: How to select shapes

    Thanks for the answer, I mean the geometric shape, not the specific color

  5. #5
    PowerPoster
    Join Date
    Feb 2006
    Posts
    23,658

    Re: How Recognize geometric shapes

    What do you mean by "select?" Just draw a green outline?

  6. #6

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    Re: How Recognize geometric shapes

    Suppose a shape outside the format, such as a desktop background, has different shapes. Now, I just select the shapes that are circular by clicking the mouse.

  7. #7
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    614

    Re: How Recognize geometric shapes

    I think hough transform is the way to go
    Hough Transform https://youtu.be/ao0Qqw0CRoc
    Hough Transform Line detection https://youtu.be/4zHbI-fFIlI
    Generalized Hough Transform https://youtu.be/IrF-jWvTDMQ
    Hough Transform Demo https://youtu.be/ebfi7qOFLuo

    Attached old line detection project done in 2014 or earlier.
    Draw something with mouse in the top left box.
    I actually don't know how useful it will be, but you brought it to mind.
    Attached Files Attached Files

  8. #8
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    8,084

    Re: How Recognize geometric shapes

    What do you want such a function to return? If we give it your picture, do you want it to return that there are 5 circles, 1 star, and 1 triangle?

    Are you drawing the individual shapes on some canvas? If so, why not just keep track of what you've drawn?

    Do you want it to scan from-left-to-right each pixel row until it detects a color change and then tell you what the shape is and the X,Y of the centroid? And then continue on for shape #2 thru shape #7, and then tell you that there are no more? Even defining the centroid can be a bit tricky ... mid-way from top-to-bottom and left-to-right? Or do we want some center-of-pressure type calculation based on all the pixels? Those two things will not be the same. Would we want an exact pixel location for the centroid, or would we want a floating point answer?

    Are we talking about a shape you've clicked on? If that's the case, it'd be nice to know that. So, in that case, do you just want to know the shape (out of a limited set of shapes) that you clicked on? If that's the case, is the canvas always white? And also, if this is the case, do you want to draw that "selected" green line around it? When you click another, does the selected line on the first one disappear, or do both become selected?

    Too many questions!
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  9. #9
    Hyperactive Member
    Join Date
    Jul 2020
    Posts
    364

    Re: How Recognize geometric shapes

    Mojtaba, shapes - just a circle, a triangle and a star?
    Are the shapes the same size?

  10. #10
    Member
    Join Date
    May 2021
    Posts
    32

    Re: How Recognize geometric shapes

    This is bizarre - I was helping someone else on a very similar 'problem' just this morning.

    I've been helping out on some Office/VBA forums by answering questions, etc., and was this morning asked on a VB-specific Discord server how to select a shape from a group of shapes referenced in a listbox - such that when OP clicks on one of the shapes in that listbox, the colour of that shape should be recoloured according to some kind of rule (that I never got to the bottom of).

    I had assumed that OP meant shapes on an Excel worksheet, but had to ask anyway - no, they weren't on a worksheet. They were on a userform... which is very odd because we don't have the shape control in VBA. Thought he must have mistaken VBA for the VB.Net peeps, so asked if he was using Visual Studio - he showed me a picture of his IDE. It was VB6. Turns out he is in a VB6 class at the moment, and they are now coming up to an exam period, so everyone is brushing up on their skills I guess. Someone else on the Discord server who answers questions was approached yesterday with a question about changing a shapes/form's backcolor to red and then having to select it - also VB6.

    I mention this because if OP here is in the same class/college (?), then assuming the same difficulty of the class of person/people we had helped, I suspect that the the exercise is to work out what shape the control is (Shape1.Shape = ?) and then get its .Left, .Top coordinates... It could be entirely unrelated, but I just thought I'd share the observation. (whatever the case, the replies above are great - I always learn new things at VBForums).

  11. #11
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    8,084

    Re: How Recognize geometric shapes

    Dan, out of curiosity, were are VB6 classes taught these days?
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  12. #12
    Member
    Join Date
    May 2021
    Posts
    32

    Re: How Recognize geometric shapes

    I was wondering the same thing. I wanted to ask OP, but he has been a bit quiet today since it became apparent I wasn't just going to do his assignment for him...! :-)
    My reason for being curious was because the guy had been complaining how the lecturer always insists in his/her(?) classes that the students use VB6 - I'm wondering "where are they getting the licenses for this?!?" I hadn't heard of any VB6 courses until this past week or so when these queries started coming up...

  13. #13
    Lively Member
    Join Date
    Jun 2016
    Posts
    106

    Re: How Recognize geometric shapes

    Hi @Mojtaba ,
    you want create clickabe regions in Userform in Vb6.0 project (question) like Skinned userform
    i an only can provide now some help with tips

    -Aforge.net Library
    -OpenCV Intel Image Proccessing Libraries
    -Object Recognition
    -Object Detection
    -Features Extraction
    -Edge Detection
    -Contouring
    -form Regions ( VB6.0) (Edite: forms in Vb6.0 or userforms in MsOffice)
    Last edited by xman2000; Nov 29th, 2021 at 01:47 AM.

  14. #14
    PowerPoster
    Join Date
    Feb 2006
    Posts
    23,658

    Re: How Recognize geometric shapes

    VB6 does not have UserForms unless you are creating Office add-in DLLs.

  15. #15

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    Re: How Recognize geometric shapes

    -----------------------------------------
    Pay attention to the moving image
    -----------------------------------------

    Show sample tool
    Last edited by Mojtaba; Nov 28th, 2021 at 07:36 PM.

  16. #16
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,171

    Re: How Recognize geometric shapes

    Quote Originally Posted by Mojtaba View Post
    Hi friends, I want to select the shape of the circle in each part of the page
    Location of the figure x,y
    Had this problem still on my "stack" (because it's interesting enough)...

    Whilst Reexre brought up a professional algo in post 7 already -
    below is a somewhat simpler approach with a modified "FloodFill"-routine
    (which gobbles up all the found Pixel-Coords in a Dictionary-Object, not changing any Pixels in the underlying Surface).

    The algo can Select and quite reliably make distinctions between the following Shape-Types:
    - Rectangle
    - Square
    - Ellipse
    - Circle
    - Triangle
    - Star

    Here is the Demo-Code for an empty Form (requires a Reference to the RC6-library):
    Code:
    Option Explicit 'Demo needs a RC6-Project-Reference
    
    Private CC As cCairoContext
    
    Private Sub Form_Load()
      ScaleMode = vbPixels: AutoRedraw = True
      Set CC = Cairo.CreateSurface(640, 480).CreateContext
          CC.Paint 1, Cairo.CreateCheckerPattern
          CC.Rectangle 80, 50, 32, 32
          CC.Rectangle 280, 40, 25, 50
          CC.Ellipse 150, 150, 32, 32 'Circle
          CC.DrawRegularPolygon 250, 150, 25, 5, splSmall, 7
          CC.DrawRegularPolygon 50, 150, 25, 3, splSmall, 11
          CC.Ellipse 190, 60, 40, 25 'Ellipse
          
          CC.Fill , Cairo.CreateSolidPatternLng(vbRed)
      Set Picture = CC.Surface.Picture
    End Sub
    
    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Dim Pxl() As Long, Coords As cSortedDictionary
      CC.Surface.BindToArrayLong Pxl
        Set Coords = FloodFillGetCoords(Pxl, X, Y)
      CC.Surface.ReleaseArrayLong Pxl
      
      AnalyzeCoords Coords
    End Sub
    
    Private Sub AnalyzeCoords(Coords As cSortedDictionary)
      Dim XY, xMin&, xMax&, yMin&, yMax&, dx&, dy&
      XY = Coords.ItemByIndex(0) 'get the first coord from the Dictionary
      xMin = XY(0): xMax = XY(0) 'and init the Min-Max-Coords...
      yMin = XY(1): yMax = XY(1)
      For Each XY In Coords 'before determining the final Min/Max in a loop
        If XY(0) < xMin Then xMin = XY(0)
        If XY(0) > xMax Then xMax = XY(0)
        If XY(1) < yMin Then yMin = XY(1)
        If XY(1) > yMax Then yMax = XY(1)
      Next
      
      Cls 'draw the current selection (according to the found min-max-points)
        Line (xMin - 1, yMin - 1)-(xMax + 1, yMax + 1), vbGreen, B
      Refresh
      
      'now the Area-Analysis
      dx = xMax - xMin + 1: dy = yMax - yMin + 1
      Select Case Coords.Count / (dx * dy) 'compare ratio of found Pixels (as percentage of the Rect-Area)
        Case 0.9 To 1.1: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Square", "Rectangle") & " " & Format(Coords.Count / (dx * dy), "Percent")
        Case 0.7 To 0.9: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Circle", "Ellipse") & " " & Format(Coords.Count / (dx * dy), "Percent")
        Case 0.5 To 0.7: Caption = "Triangle " & Format(Coords.Count / (dx * dy), "Percent")
        Case Else:       Caption = "Star-Shaped " & Format(Coords.Count / (dx * dy), "Percent")
      End Select
    End Sub
    
    Private Function FloodFillGetCoords(Pxl() As Long, ByVal X&, ByVal Y&) As cSortedDictionary
      Set FloodFillGetCoords = New_c.SortedDictionary
      Dim S As cArrayList, Color As Long, XY
      Set S = New_c.ArrayList(vbVariant)
          S.Push Array(X, Y) 'push the Entry-Point-Coords
          Color = Pxl(X, Y)  'and set the Color to search for
          
      Do While S.Count 'as long as there's something in the Stack, keep looping
         XY = S.Pop: X = XY(0): Y = XY(1) 'pop the current x/y coords
         
         If X >= 0 And X <= UBound(Pxl, 1) And Y >= 0 And Y <= UBound(Pxl, 2) Then 'ArrayBounds-check
            If Pxl(X, Y) = Color And Not FloodFillGetCoords.Exists(X & "," & Y) Then 'Color- and Exists-Test
               FloodFillGetCoords.Add X & "," & Y, XY 'point found at x,y, add it to the Dictionary
               S.Push Array(X, Y + 1) 'push additional check-coords around the current Point
               S.Push Array(X, Y - 1)
               S.Push Array(X + 1, Y)
               S.Push Array(X - 1, Y)
            End If
         End If
      Loop
    End Function
    HTH

    Olaf

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

    Re: How Recognize geometric shapes

    Quote Originally Posted by Schmidt View Post
    Here is the Demo-Code for an empty Form (requires a Reference to the RC6-library):

  18. #18
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    600

    Re: How Recognize geometric shapes

    Quote Originally Posted by Schmidt View Post
    Had this problem still on my "stack" (because it's interesting enough)...

    Whilst Reexre brought up a professional algo in post 7 already -
    below is a somewhat simpler approach with a modified "FloodFill"-routine
    (which gobbles up all the found Pixel-Coords in a Dictionary-Object, not changing any Pixels in the underlying Surface).

    The algo can Select and quite reliably make distinctions between the following Shape-Types:
    - Rectangle
    - Square
    - Ellipse
    - Circle
    - Triangle
    - Star

    Here is the Demo-Code for an empty Form (requires a Reference to the RC6-library):
    Code:
    Option Explicit 'Demo needs a RC6-Project-Reference
    
    Private CC As cCairoContext
    
    Private Sub Form_Load()
      ScaleMode = vbPixels: AutoRedraw = True
      Set CC = Cairo.CreateSurface(640, 480).CreateContext
          CC.Paint 1, Cairo.CreateCheckerPattern
          CC.Rectangle 80, 50, 32, 32
          CC.Rectangle 280, 40, 25, 50
          CC.Ellipse 150, 150, 32, 32 'Circle
          CC.DrawRegularPolygon 250, 150, 25, 5, splSmall, 7
          CC.DrawRegularPolygon 50, 150, 25, 3, splSmall, 11
          CC.Ellipse 190, 60, 40, 25 'Ellipse
          
          CC.Fill , Cairo.CreateSolidPatternLng(vbRed)
      Set Picture = CC.Surface.Picture
    End Sub
    
    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Dim Pxl() As Long, Coords As cSortedDictionary
      CC.Surface.BindToArrayLong Pxl
        Set Coords = FloodFillGetCoords(Pxl, X, Y)
      CC.Surface.ReleaseArrayLong Pxl
      
      AnalyzeCoords Coords
    End Sub
    
    Private Sub AnalyzeCoords(Coords As cSortedDictionary)
      Dim XY, xMin&, xMax&, yMin&, yMax&, dx&, dy&
      XY = Coords.ItemByIndex(0) 'get the first coord from the Dictionary
      xMin = XY(0): xMax = XY(0) 'and init the Min-Max-Coords...
      yMin = XY(1): yMax = XY(1)
      For Each XY In Coords 'before determining the final Min/Max in a loop
        If XY(0) < xMin Then xMin = XY(0)
        If XY(0) > xMax Then xMax = XY(0)
        If XY(1) < yMin Then yMin = XY(1)
        If XY(1) > yMax Then yMax = XY(1)
      Next
      
      Cls 'draw the current selection (according to the found min-max-points)
        Line (xMin - 1, yMin - 1)-(xMax + 1, yMax + 1), vbGreen, B
      Refresh
      
      'now the Area-Analysis
      dx = xMax - xMin + 1: dy = yMax - yMin + 1
      Select Case Coords.Count / (dx * dy) 'compare ratio of found Pixels (as percentage of the Rect-Area)
        Case 0.9 To 1.1: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Square", "Rectangle") & " " & Format(Coords.Count / (dx * dy), "Percent")
        Case 0.7 To 0.9: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Circle", "Ellipse") & " " & Format(Coords.Count / (dx * dy), "Percent")
        Case 0.5 To 0.7: Caption = "Triangle " & Format(Coords.Count / (dx * dy), "Percent")
        Case Else:       Caption = "Star-Shaped " & Format(Coords.Count / (dx * dy), "Percent")
      End Select
    End Sub
    
    Private Function FloodFillGetCoords(Pxl() As Long, ByVal X&, ByVal Y&) As cSortedDictionary
      Set FloodFillGetCoords = New_c.SortedDictionary
      Dim S As cArrayList, Color As Long, XY
      Set S = New_c.ArrayList(vbVariant)
          S.Push Array(X, Y) 'push the Entry-Point-Coords
          Color = Pxl(X, Y)  'and set the Color to search for
          
      Do While S.Count 'as long as there's something in the Stack, keep looping
         XY = S.Pop: X = XY(0): Y = XY(1) 'pop the current x/y coords
         
         If X >= 0 And X <= UBound(Pxl, 1) And Y >= 0 And Y <= UBound(Pxl, 2) Then 'ArrayBounds-check
            If Pxl(X, Y) = Color And Not FloodFillGetCoords.Exists(X & "," & Y) Then 'Color- and Exists-Test
               FloodFillGetCoords.Add X & "," & Y, XY 'point found at x,y, add it to the Dictionary
               S.Push Array(X, Y + 1) 'push additional check-coords around the current Point
               S.Push Array(X, Y - 1)
               S.Push Array(X + 1, Y)
               S.Push Array(X - 1, Y)
            End If
         End If
      Loop
    End Function
    HTH

    Olaf
    Surface color can. Color gradient changes?

  19. #19
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,171

    Re: How Recognize geometric shapes

    Quote Originally Posted by xxdoc123 View Post
    Surface color can. Color gradient changes?
    Not sure, what you mean... (can only guess, that you mean a certain Color-Tolerance)?

    As it currrently is, he FloodFill-based algo has a single If condition (related to the Color-Matching):
    If Pxl(X, Y) = Color ...
    which compares the 32Bit Long-Value (including AlphaChannel-Byte) exactly.

    If you want a higher "Color-Range-tolerance" on that comparison,
    then replace the expression with a little boolean-returning SubRoutine like:
    Function ColorMatchUnsharp(ByVal PxlArrColor&, ByVal CompareColor&, ByVal PercFactor As Double) As Boolean

    ...wherein you then split both Colors into their BGRA-Components,
    comparing each channel separately (using a certain percentage-based interval).

    HTH

    Olaf

  20. #20
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    600

    Re: How Recognize geometric shapes

    Quote Originally Posted by Schmidt View Post
    Not sure, what you mean... (can only guess, that you mean a certain Color-Tolerance)?

    As it currrently is, he FloodFill-based algo has a single If condition (related to the Color-Matching):
    If Pxl(X, Y) = Color ...
    which compares the 32Bit Long-Value (including AlphaChannel-Byte) exactly.

    If you want a higher "Color-Range-tolerance" on that comparison,
    then replace the expression with a little boolean-returning SubRoutine like:
    Function ColorMatchUnsharp(ByVal PxlArrColor&, ByVal CompareColor&, ByVal PercFactor As Double) As Boolean

    ...wherein you then split both Colors into their BGRA-Components,
    comparing each channel separately (using a certain percentage-based interval).

    HTH

    Olaf
    yes.your are right, I found that a lot of image processing uses opencv, how does vb6 do it?

  21. #21
    Hyperactive Member
    Join Date
    Sep 2014
    Posts
    362

    Re: How Recognize geometric shapes

    What about convert it to HSL, so that the color comparison with range tolerance would be more controllable? Just a thought.

  22. #22
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,171

    Re: How Recognize geometric shapes

    Quote Originally Posted by Brenker View Post
    What about convert it to HSL, so that the color comparison with range tolerance would be more controllable? Just a thought.
    Sure, that'd be one way to implement color-range-tolerance (but it should also include the luminance-value with a certain percentage).

    Olaf

  23. #23

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    Re: How Recognize geometric shapes

    Olaf Thanks for the reply
    You are a professional programmer especially in the field of RC6 (vbrichclient)
    I need something like off-form bug detection like opencv

    sample tool

  24. #24
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,171

    Re: How Recognize geometric shapes

    Quote Originally Posted by Mojtaba View Post
    I need something like off-form bug detection like opencv
    "Off Form" is not really different from "On Form"
    (if you load a ScreenShot-Bitmap onto your Form - or into a Cairo-Surface).

    Not sure though, what you mean with "bug detection" now (I thought you wanted "circle-detection").

    As for OpenCV... that's a quite large library/tool-set, one will have to learn first...
    The last time I've played around with that monster for a little while, was about a decade ago or so -
    cannot really help you with that in case you want to go there.

    If you're serious about OpenCV, then I suggest you open a new thread
    (a few Members here have a bit of recent OpenCV-experience, IIRC).

    Olaf

  25. #25

    Thread Starter
    Lively Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    84

    Re: How Recognize geometric shapes

    Yes, I mean exactly the circle. Now, whether inside the form or outside the form, assume the desktop wallpaper with the mouse. Click on it to identify the circle. Show me the location of x, y

    Quote Originally Posted by Schmidt View Post
    "Off Form" is not really different from "On Form"
    (if you load a ScreenShot-Bitmap onto your Form - or into a Cairo-Surface).

    Olaf
    How do I change the Cairo-Surface to background ?
    Last edited by Mojtaba; Dec 8th, 2021 at 04:41 AM.

  26. #26
    PowerPoster
    Join Date
    Jun 2013
    Posts
    6,171

    Re: How Recognize geometric shapes

    Quote Originally Posted by Mojtaba View Post
    Yes, I mean exactly the circle. Now, whether inside the form or outside the form, assume the desktop wallpaper with the mouse. Click on it to identify the circle. Show me the location of x, y



    How do I change the Cairo-Surface to background ?
    You could experiment a bit with the code below:
    It will start the Form minimized - and then waits until you click somewhere else with the Left-MouseButton.

    What it then does is, to cut-out a 256x256 CairoSurface around the current Screen-MousePosition
    (for later analysis... the MouseCoord is then always directly in the center of that area at 128,128)

    Code:
    Option Explicit
    
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    
    Private SnapShotArea As cCairoSurface, WithEvents KeyWatcher As cKeyWatcher
     
    Private Sub Form_Load()
      Set KeyWatcher = New_c.KeyWatcher("1", False, True)
      Me.WindowState = vbMinimized 'let's start minimized, to allow unhindered Clicking
    End Sub
     
    Private Sub KeyWatcher_VKeyUp(ByVal vKey As Integer, ByVal MapIdx As Long)
      Set SnapShotArea = GetScreenShotSurface
      If SnapShotArea Is Nothing Then Exit Sub
     
      With SnapShotArea.CreateContext 'this block is optional (just showing a red circle, where the MouseClick happened)
        .Arc SnapShotArea.Width \ 2, SnapShotArea.Height \ 2, 5 'the MouseClick-Pos is always directly in the center
        .Fill , Cairo.CreateSolidPatternLng(vbRed)
      End With
      
      Set Me.Picture = SnapShotArea.Picture
          Me.WindowState = vbNormal
          Me.SetFocus
    End Sub
    
    Function GetScreenShotSurface(Optional ByVal SquareSizeAroundMousePos& = 256) As cCairoSurface
      Dim Srf As cCairoSurface, x&, y&, T#
      Cairo.GetMouseCursorPos x, y 'get the current Screen-MouseCoords first
     
      Set Srf = Cairo.CreateSurface(New_c.Displays(1).AbsoluteRight, New_c.Displays(1).AbsoluteBottom)
      New_c.Clipboard.Clear
      New_c.Clipboard.SetImageSurface Nothing
        keybd_event vbKeySnapshot, 0, 0, 0
        T = New_c.HPTimer: Do Until New_c.HPTimer - T > 0.15: DoEvents: Loop 'wait a bit, until it's sitting in the ClipBoard
        If New_c.Clipboard.GetImageSurface Is Nothing Then Exit Function
        Srf.CreateContext.RenderSurfaceContent New_c.Clipboard.GetImageSurface, 0, 0, Srf.Width, Srf.Height
      Set GetScreenShotSurface = Srf.CropSurface(x - SquareSizeAroundMousePos \ 2 + 1, y - SquareSizeAroundMousePos \ 2 + 1, SquareSizeAroundMousePos, SquareSizeAroundMousePos)
    End Function
    HTH

    Olaf

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