Quote:
> Is there a way to use some kind of imagemaps (like in web pages) in VB6. So
> an area on an image (picturebox or image control) corresponds to some VB
> code. These areas are not just simple rectangles or circles but must be
> freehand selected.
> Plz help !!!
Yes there is, it involves using a second image to detect the various shapes.
Here is an example, add a PictureBox to a new form and paste in the following
code. Moving your mouse over the shapes changes the Caption. The caption,
and simple squares and circles were used for demo purposes, but you can use the
same principle for your irregular shapes. To see the underlying mask, hold down
the mouse button....
HTH
LFS
Option Explicit
Private Mask As PictureBox
Private Detection As New Collection
Private Sub Form_Load()
' Form set up
ScaleMode = vbPixels
AutoRedraw = True
Move Left, Top, 2200, 2640
' Mask setup
Set Mask = Picture1
With Mask
.Visible = False
.BorderStyle = vbBSNone
.Move 0, 0, 200, 200
.AutoRedraw = True
.ScaleMode = vbPixels
End With
DrawShape1 False, Me, vbBlack
DrawShape1 True, Me, vbWhite
DrawShape1 True, Mask, vbBlue
DrawShape2 False, Me, vbBlack
DrawShape2 True, Me, vbWhite
DrawShape2 True, Mask, vbRed
Detection.Add "SHAPE 1", CStr(vbBlue)
Detection.Add "SHAPE 2", CStr(vbRed)
End Sub
Private Sub DrawShape1(Fill As Boolean, Target, Color As Long)
Target.FillStyle = vbFSTransparent
Target.FillColor = Color
If Fill Then
Target.Line (11, 11)-(29, 29), Color, BF
Target.Line (61, 11)-(79, 29), Color, BF
Target.FillStyle = vbFSSolid
Target.Circle (45, 40), 24, Color
Else
Target.Line (10, 10)-(30, 30), Color, B
Target.Line (60, 10)-(80, 30), Color, B
Target.Circle (45, 40), 25, Color
End If
End Sub
Private Sub DrawShape2(Fill As Boolean, Target, Color As Long)
Target.FillStyle = vbFSTransparent
Target.FillColor = Color
If Fill Then
Target.Line (11, 91)-(79, 119), Color, BF
Target.FillStyle = vbFSSolid
Target.Circle (45, 80), 24, Color
Else
Target.Line (10, 90)-(80, 120), Color, B
Target.Circle (45, 80), 25, Color
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Mask.Visible = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Detect As String
On Error Resume Next
Detect = Detection(CStr(Mask.Point(X, Y)))
If Caption <> Detect Then Caption = Detect
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Mask.Visible = False
End Sub