Re: Imagen con contorno

Programación General > Visual Basic 6.0 e inferiores

(1/3) > >>

chiaravel:
Hola a Todos.

Es posible en Visual Basic, insertar una imagen pero que el contorno no sea cuadrado ?

Quiero lograr hacer un mapa con varias provincias pero resulta que los controles image tienen un contorno cuadrado y cuando programo el evento MOUSE_OVER en vez de activarse dentro del contorno de la imagen, se activa dentro del contorno del objeto image.

Alguien sabe como solucionar esto ?, ya que si intercalo y superpongo varios de estos controles para que el usuario se desplaze a traves del mapa y se pinte la provincia en donde se encuentra, muchas veces se termina activando el evento del control equivocado.

Please !!!, alguna sujerencia

Muchas Gracias

Brroz:
Podrías probar comprobando el color del punto sobre el que se desplaza o hace click el mouse... En vez de usar muchos controles image, podrías crear una sola imagen con todas las provincias, cada una de un color, luego utilizando la función 'Point' puedes comprobar el color del componente para identificar la provincia.

Algo asi... A ver si te sirve de algo.

acalanto:
La solución propuesta de los colores es válida siempre y cuando dos provincias contiguas no tengan el mismo color (no podrías saber en cual de ellas estás).

La solución pasa por que controles dentro de que polígono se encuentra el cursor.

Supongo que conoces las coordenadas (x,y) del contorno de cada provincia que representes en el mapa. Si es así te puedes crear una estructura de datos más o menos de esta forma

type poligono
x as double
y as double
end type

type provincias
id as integer
nombre as string
items as integer
contorno() as poligono
end type

public mymap() as provincias

'Carga los datos

redim mymap(1 to totalprovincias)

'Empiezas a llenar la estructura (esto lo puedes tener en un fichero con el mismo formato.

'ALAVA
mymap(1).id=1
mymap(1).nombre="Alava"
mymap(1).items=10
redim mymap(1).contorno(1 to 10)
'coordenadas del polígono ALAVA
mymap(1).contorno(1).x=1000
mymap(1).contorno(1).y=2000
mymap(1).contorno(2).x)=1200
......
......
mymap(1).contorno(10).x=9600
mymap(1).contorno(10).y)=12300

'BADAJOZ
mymap(2).id=2
mymap(2).nombre="Badajóz"
mymap(2).items=6
redim mymap(2).contorno(1 to 6)
'coordenadas del polígono BADAJOZ
mymap(2).contorno(1).x=500
mymap(2).contorno(1).y=600
mymap(2).contorno(2).x)=560
......
......
mymap(2).contorno(6).x=450
mymap(2).contorno(6).y)=320

'ASI HASTA TENER TODAS LAS COORDENADAS EN LA ESTRUCTURA

Una vez tienes dibujado sobre un objeto PICTURE las provincias con sus colores, datos etc etc.. y escalado a la misma escala que las coordenadas grabadas, deberás de controlar el paso del mouse y cada vez que se mueva llamar a una función parecida a está.
si la función te devuelve <> 0, este será el ID de la provincia y a partir de aqui lo que quieras hacer. Si es =0, el cursor no esta dentro de ninguna provincia.
Puede resultar un poco complejo pero desde luego es la solución más elegante y profesional.

NOTA: LAS COORDENADAS DE LOS POLIGONOS DEBEN DE ESTAR ORDENADAS EN SENTIDO DE LAS AGUJAS DEL RELOJ.

Public Function IdxProvincia(x as double, y as double)

'la x y la y son las coordenadas del ratón sobre el objeto picture

dim i as integer
dim p as integer
dim IN as boolean

for i=1 to total provincias
IN=true
for p=1 to mymap(i).items -1
'verificar si el cursor se encuentra siempre
'a la derecha de todos los segmentos del polígono
if disr(mymap(i).contorno(p).x,mymap(i).contorno(p).y,mymap(i).contorno(p+1).x,mymap(i).contorno(p+1).y, x, y) < 0 then IN=FALSE
next p
if IN=true then IdxProvincia=i:exit function
next i
'El cursor no está dentro de ningún contorno
idxProvincia=0
end function

'=================================================================
'ESTA FUNCION CALCULA LA DISTANCIA DE UN PUNTO A UNA RECTA DADA
'===================================================================
Private Function Disr(x1 As Double, y1 As Double, x2 As Double, y2 As Double, XP As Double, YP As Double) As Double

'Variables temporales
Dim Ap As Double
Dim a As Double
Dim b As Double
Dim c As Double

On Error Resume Next

'Calcular los parámetros de la ecuación
'de la recta enviada.
Ap = (y1 - y2)
a = -Ap
b = (x1 - x2)
c = -((y1 * b) - (x1 * Ap))

'Calcular la distancia del punto a la recta
If Sqr((a ^ 2) + (b ^ 2)) = 0 Then
Disr = 0
Else
Disr = ((a * XP) + (b * YP) + c) / Sqr((a ^ 2) + (b ^ 2))
End If

End Function

chiaravel:
Quiero Agradecer tanto a Brroz como a Acalanto por las ayudas.

La ayuda de Brroz la descarto ya que mi mapa contiene provincias del mismo color, pero igual es interesante para aprender el uso del point.

La ayuda de Acalanto me sorprendio por la dedicacion que le puso y el tiempo que le debe haber llevado, por eso te doy las gracias.

La voy a probar y te cuento, ya que no poseo muchos conocimientos de geometria y tendre que copiar textualmente las ecuaciones para ver si funcionan.

Nuevamente Muchas Gracias a los 2.

PD : Se aceptan mas sujerencias.

:gracias:

Navegación

[0] Índice de Mensajes

[#] Página Siguiente

Ir a la versión completa