Printable View
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
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.
the code form dilettante
Attachment 182928
i chang some code,you can test .
Thanks for the answer, I mean the geometric shape, not the specific color
What do you mean by "select?" Just draw a green outline?
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.
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.
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!
Mojtaba, shapes - just a circle, a triangle and a star?
Are the shapes the same size?
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).
Dan, out of curiosity, were are VB6 classes taught these days?
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...
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)
VB6 does not have UserForms unless you are creating Office add-in DLLs.
-----------------------------------------
Pay attention to the moving image
-----------------------------------------
Show sample tool
Had this problem still on my "stack" (because it's interesting enough)...Quote:
Originally Posted by Mojtaba
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):
HTHCode: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
Olaf
:cool: :thumb: :eek2:Quote:
Originally Posted by Schmidt
Surface color can. Color gradient changes？Quote:
Originally Posted by Schmidt
Not sure, what you mean... (can only guess, that you mean a certain Color-Tolerance)?Quote:
Originally Posted by xxdoc123
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?Quote:
Originally Posted by Schmidt
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).Quote:
Originally Posted by Brenker
Olaf
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
"Off Form" is not really different from "On Form"Quote:
Originally Posted by Mojtaba
(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
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 ?Quote:
Originally Posted by Schmidt
You could experiment a bit with the code below:Quote:
Originally Posted by Mojtaba
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)
HTHCode: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
Olaf