Hola a todos:
Esta pregunta parece obvia y simple, pero me está volviendo loco..
Tengo un proyecto con 14 Forms, en el principal (Main) tengo un PictureBox donde se grafican lineas, círculos,etc.
Hasta aquí todo correcto, pero este PictureBox, contiene imágenes, TextBox, y ListBox.
Todo funciona OK, pero he tenido que poner 30 Labels que necesito en tiempo de diseño, por que si pongo solo una, por ejemplo Label1 con índice 0 Label1(0), y luego cargo mas en tiempo de ejecución con un For-Next, Load Label1(i), etc, me sale un error "Uso no válido de la propiedad" y no me explico por que.
En el resto de los Foms si me deja hacerlo, y no me lo explico.
Alguna ayuda?
Gracias.
No queda claro, cual pueda ser el problema, la información proporcionada es insuficiente.
A primera instancia pùdiera ser que ya tuvieras el label1(1) en el formulario, pero el mensaje del error (y el nº) sería uno distinto...
¿¿¿Puedes poner el código de la función donde lo cargas (y así se pueda ver exactamente sobre qué linea recáe el error)???
Hola NEBIRE:
Gracias por responder.
El código donde lo cargo, es simplemente
For i = 1 to N
Load Label1(i)
Next
Pero es que el error no está en el código, este label, y varios mas, están dentro de un PictureBox llamado "picContenedor", que ademas tiene varios Image, TextBox, otros PictureBox, ListBox,Shapes, Lines, etc.
Resumiendo, en este "picContenedor" es donde se dibujan una serie de planos de partes de estructuras metálicas, que algunos parámetros de dibujo dependen de otros Foms que calculan y devuelven datos para dibujar los planos.
Debido a la complejidad de todo esto, es imposible que adjunte código, por que lo que yo creo es que ese PictureBox "picContenedor" que utilizo esta corrupto y por eso no me deja utilizar Load ni para Labels, Image, Textbox ni nada.
Pero todos los demás Forms (13 en total), que algunos también tienen PictureBox si me permiten utilizar Load.
Quiero hacer una prueba de copiar todo el contenido de este "picContenedor" en otro nuevo llamado por ejemplo pic, luego borrar "picContenedor" y renombrar pic por "picContenedor"
De esta forma al menos podría verificar si el problema es de "picContenedor" o de alguno de los elemento contenidos en el.
Pero no veo ninguna forma de seleccionar todo el contenido de "picContenedor" copiarlo y pegarlo en el nuevo pic, en tiempo de diseño.
Alguna idea?
Un saludo.
Ya, pero es que ese mensaje de errror, no se puede generar así como así...
VB6, tiene un límite de controles gráficos que se pueden cargar en un solo formulario... tal como señalas que tienes muchos objetos... solo puedo asumir que el problema esté por ahí...
Prueba antes de cargar con load... un msgbox que indique cuantos controles tienes cargados...
Private Sub Form_Load()
With Label1(0)
.BackStyle = 1 ' opaco
.BackColor = vbBlack
.ForeColor = vbWhite
End With
For k = 1 To 9
Load Label1(k)
With Label1(k)
Call .Move(k * 60, k * 60)
.Visible = True
End With
Next
Call MsgBox(CStr(Me.Controls.Count))
End Sub
y repite lo mismo, justo antes de que se origine el error, aver si viendo la diferencia de controles entre el antes y el después queda claro algo más...
Haz copia del formulario antes de nada (y su *.frx asociado)...
Una forma de reproducir dicho picturebox, es crear un nuevo proyecto vacío... y 'copiar el picturebox' y pegarlo al formulario de ese nuevo proyecto (si lo pegas en el mismo formulario-proyecto, corres el riesgo de que se las colecciones de controles aumenten su índice, pero pegado a un nuevo proyecto, cada control se mantiene con su índice (y tabindex) correctamente...
Si la copia resultó sin problemas, crea otro nuevo proyecto ahora corta el picturebox y pégalo allí... guarda cambios en los 3 proyectos, y luego la copia que pegaste en el proyecto nuevo previo, muévelo al proyecto original... y vuelve a guardar cambios... si sigue dando problemas sin más detalles será difícil saber qué es...
No puedes dar al menos el nº de error?... aquí tengo la ayuda en ingés, y no aparece ningún texto similar (traducido)...
De todos modos, por lo que me cuentas, creo que estás cometiendo un grave error al querer manipular gráficos complejos con controles de usuario... dichos controles realmente ni lo son, no poseen un handle propio, si no el del contenedor y sobrecargas innecesariamente el contenedor... aunque este tipo de 'controles' son muy livianos, precisamente por no tener un manejador propio...
Lo adecuado es tener un 'hiddenSurface', una clase que alberga un objeto bitmap, donde vas dibujando con las API de GDI32 y luego tras el dibujado lo vuelcas como gráfico al picturebox... allí si que no importa si luego tienes unos pocos controles line, o label, pero 4, 8, 12, 20, pero ya, no 150...
Hola de nuevo:
He copiado el Picture, y lo he pegado en un único Form en un proyecto nuevo.
desde el Form_Load con esto:
n=Me.Controls.Count, me dice que tiene 246 objetos,.
Este picture ocupa todo el ancho del Form y el alto menos 100.
He puesto un label nuevo "Label1" con indice 0
En en un Sub MouseDown del picture copiado, he puesto:
For i =1 to 60
Load Label1(i)
Next
Y lo carga sin problemas, por lo tanto no es el Picture el que genera el error, y me preguntas por el nº de error... no hay nº de error, simplemente el mensaje dice
"Uso no válido de la propiedad" si mas.
Me sugieres esto:
Lo adecuado es tener un 'hiddenSurface', una clase que alberga un objeto bitmap, donde vas dibujando con las API de GDI32 y luego tras el dibujado lo vuelcas como gráfico al picturebox...
Esto no se lo que es, pero no tengo problemas de memoria ni de velocidad, ten en cuenta que todo se dibuja en tiempo real en el Picture, utilizando solo Picture.Line, y Picture.Circle, solo dibujo rectángulos con y sin fill, líneas y arcos, y sitúo objetos Image, Picture con Bitmap cargados en diseño, Label, Textbox y algunos Shapes y Lines creados en tiempo de diseño, que sitúo con sus coordenadas, y los hago visibles o no.
Luego el proceso de dibujado es muy complejo, hace cientos de operaciones de trigonometría, pero todo va muy rápido.
No creo que pueda averiguar donde está el problema, por eso decidí, crear en tiempo de diseño, 30 TextBox, 40 Labels, que son el máximo de textos o parámetros que puede necesitar el programa.
De nuevo gracias por tu interés y ayuda, alguna idea que pueda comprobar?.
Un saludo.
Para que te hagas una idea, he subido un pequeño vídeo, una imagen vale mas que mil palabras. Este es ellink:
https://youtu.be/fwodS_yRjTk
Un saludo.
Un poco más tarde miro el vídeo, ahora tengo solo justo un ratito libre...
Bien... ya me has contestado...
Todo apunta a que el problema es el que asumía... 246 controles en el form... luego en efecto la causa es alcanzar el límite de controles para el formulario...
pero, vamos ahora a encasillarlo exactamente...
En la función que te origina el error, coloca algo de código similar a esto:
private function tufuncionCargandocontroles
On local error goto CuentameLosControles
'... aquí tu código...
Exit function ' ó Sub
CuentameLosControles:
Call MsgBox(CStr(Me.Controls.Count))
End function
Lós métodos gráficos, circle, line, no son problema, pero ojo, no confundas los métodos gráficos con los 'controles de usuario': line, shape, label, image y frame, todos ellos son 'irreales', pero ocupan puesto como control de usuario...
A la noche que llegue a casa, miro el vídeo y te pongo un ejemplo de operativo...
Al final se me hizo muy tarde...
He visto el vídeo, y aunque sirve para hacerse una ídea d elo que estás haciendo, no aporta detalles sobre el problema. Quiero decir que no recala en ningún momento en el error que reportas.
Te decía que cuando debes utilizar gráficos a mansalva, los gráficos conviene que sean 'dibujados', es decir métodos y no 'controles'. Los controles ocupan espacio de memoria, pero más alla de eso, el uso indiscriminado puede hacerlo lento y caer en el error que te sugrge. estoy convencido que has alcanzado el límite máximo de controles que s epermite para un formulario (ahora mismo no recuerdo cual es, ya que es algo que uno nunca considera que se va a dar y lo acaba olvidando (el valor exacto)).
Para usar métodos gráficos, lo más adecuado es recurrir a las API gráficas que proveen GDI32 o al menos simplemente GDI, indistintamente de que uno se provea sus propios métodos cuando se quiera hacer algo específico que no esté prtevisto, o que no satisfaga por algna razón.
El inconveniente de usar las API, es que evidentemente se necesita aprender a conocerlo y eso lleva su tiempo. Especialmente si uno nunca se ha acercado a usar APIs, puede sonarle a chino, la forma de funcionar y no entender ciertos detalles por que se alejan (de alguna manera), de la forma relativamente sencilla (y a veces tortuosa) en que funcionan las cosas en VB6.
Otro forma, es que sin salirse de vb6, cree uno mismo determinada funcionalidad, por ejemplo crear un control de usuario transparente, que provea no solo funcionalidad gráfica, sino también alguna colección, para almacenar métodos gráficos, entonces de ese modo, un solo control, podría tener por ejemplo 200 métodos gráficos, usando un único control de usuario... y por ejemplo, el control podría contener dibujado toda esa escalera sobre sí, podrías tener luego otro control (otra instancia del mismo control), para la leyenda, o bien otros métodos gráficos en el mismo control...
Asumo que básicamente operas en un entorno 2D... aunque se puede hacer también un entorno 3D, e incluso ir más alla, con raytracing y tal... se sale de la envergadura de ayuda para unos foros, aunque siempre se puede dar orientación si la precisas...
...si el fin de semana saco un poquito de tiempo libre, veo de hacer un control así, bueno me conozco, y al final sé que aunque tenga tiempo libre surgirá algo, así que aprovecho ahora y en un momento te doy alguna orientación que puede servirte de guía...
La colección podría almacenar una estructura (o clase) con los siguientes tipos (así a bote pronto):
Private ColGrPaths As New Collection
private p_NumGrPaths As long
' El texto o una polilínea requerirá otro desarrollo, porque el uno exige un string, y el otro múltiples puntos...
Public Type DatosGraficos
Orden As Byte ' punto, línea, rectángulo, círculo, arco, polígono, elipse...
SubOrden As Byte ' si línea, si círculo ó elipse, si arco...
Activo As Byte ' Se dibuja si tiene valor 255, si no se omite (cuando se pide dibujar todo).
X As Long ' cordenadas
Y As Long ' "
Ancho As Long ' medidas (radio en caso de círculo polígono, etc...)
Alto As Long ' " (aristas en caso de polígono, etc...)
Color As Long ' Color con que se dibuja. Un flag determina si se usa el color por defecto, del control o se delega en el que aquí se designe.
Grosor As Byte ' Grueso de línea " " "
FlagABC As Byte ' Modificador de acciones
Flags As Long ' por ejemplo rellenar interior (casos de círculo, elipse, polígono, etc)
FlagXYZ As Long ' modificadores de posicionado, desplazamiento y escala...
End Type
' Dibuja toda la colección almacenada de métodos gráficos... (solo los que estén activos).
Public Sub PathDibujarTodo(Optional ByVal Actualizar As Boolean = True)
Call PathsDibujar(0, ColGrPaths.Count - 1, Actualizar)
End Sub
' Dibuja de un plumazo todas las órdenes gráficas reclamadas y (si se reclama) acto seguido actualiza la imagen. Si cantidad es un valor negativo, dibuja en orden inverso. Si Cantidad excede el límite se ignora.
Public Sub PathsDibujar(ByVal Desde As Long, ByVal Cantidad As Long, Optional ByVal Actualizar As Boolean = True)
Dim k As Long, Final As Long
If (EnRango(Desde) = True) Then ' se exige que desde sea un valor 'dentro' de la colección.
If Cantidad = 0 Then Exit Sub ' nada que dibujar... caso típico que el valor sea el resultado de una expresión.
Final = (Desde + Cantidad)
If (Cantidad > 0) Then
If (Final >= ColGrPaths.Count) Then Final = ColGrPaths.Count - 1
For k = Desde To Final
If (ColGrPaths(k).Activo And c_Activo) Then
Dibujar (ColGrPaths(k))
End If
Next
Else
Final = -Final
For k = Final To Desde Step -1
If (ColGrPaths(k).Activo And c_Activo) Then
Dibujar (ColGrPaths(k))
End If
Next
End If
If (Actualizar = True) Then
Call GrEndPath ' actualiza la imagen
End If
End If
End Sub
'...
Dibujar sería una función que simplemente recibe el objeto y mediante un 'select case' invoca a la función específica que se encarga de dibujar la orden específica...
Nota como esta función también es pública, para permitir dibujar una orden que no conste en la colección, peor que a cierto momento pueda interesar.
Lógicamente también podrán invocarse externamente los métodos gráficos, sin necesidad de que existan como un 'objeto'...
Public Sub DibujarOrden(ByRef dg As DatosGraficos)
With dg
Select Case .Orden
Case ORDEN_GRAFICA_LINEA ' 0 más arriba las que sean más frecuentes de ser dibujadas
Call Me.GrLinea(.X, .Y, .X + .Ancho, .Y + .Alto, .Color, .Grosor)
Case ORDEN_GRAFICA_RECTANGULO
Case ORDEN_GRAFICA_CIRCULO
Case ORDEN_GRAFICA_POLIGONO
' ...
Case Else ' orden desconocida...
End Select
End With
End Sub
Y algunas funciones... en este ejemplo, varias funciones que definen un objeto sin ambigüedad, finalmente invocan al mismo (privado)...
Public Sub GrLinea(Optional ByVal X1 As Variant, Optional ByVal Y1 As Variant, Optional ByVal X2 As Variant, Optional ByVal Y2 As Variant, Optional ByVal Color As Variant, Optional ByVal Ancho As Byte = 1, Optional ByVal AbsolutoOrigen As Boolean = True, Optional ByVal AbsolutoDestino As Boolean = True)
Call LinRectCaja(X1, Y1, X2, Y2, Color, Ancho, AbsolutoOrigen, AbsolutoDestino)
End Sub
Public Sub GrRectangulo(Optional ByVal X1 As Variant, Optional ByVal Y1 As Variant, Optional ByVal X2 As Variant, Optional ByVal Y2 As Variant, Optional ByVal Color As Variant, Optional ByVal Ancho As Byte = 1, Optional ModoFusion As DrawModeConstants = vbCopyPen, Optional ByVal AbsolutoOrigen As Boolean = True, Optional ByVal AbsolutoDestino As Boolean = True)
Call LinRectCaja(X1, Y1, X2, Y2, Color, Ancho, AbsolutoOrigen, AbsolutoDestino, ModoFusion, True)
End Sub
Public Sub GrCaja(Optional ByVal X1 As Variant, Optional ByVal Y1 As Variant, Optional ByVal X2 As Variant, Optional ByVal Y2 As Variant, Optional ByVal Color As Variant, Optional ModoFusion As DrawModeConstants = vbCopyPen, Optional ByVal AbsolutoOrigen As Boolean = True, Optional ByVal AbsolutoDestino As Boolean = True)
Call LinRectCaja(X1, Y1, X2, Y2, Color, , AbsolutoOrigen, AbsolutoDestino, ModoFusion, True, True)
End Sub
' Resume las 3 funciones previas en una sola.
Private Sub LinRectCaja(Optional ByVal X1 As Variant, Optional ByVal Y1 As Variant, Optional ByVal X2 As Variant, Optional ByVal Y2 As Variant, Optional ByVal Color As Variant, Optional ByVal Ancho As Byte = 1, Optional ByVal AbsolutoOrigen As Boolean = True, Optional ByVal AbsolutoDestino As Boolean = True, Optional ModoFusion As DrawModeConstants = vbCopyPen, Optional ByVal Box As Boolean = False, Optional ByVal Relleno As Boolean = False)
Dim AnchoPrevio As Integer
Dim ModoFusionPrevio As DrawModeConstants
With PicMask ' es un objeto oculto, puede ser incluso un picturebox...(no visible)
AnchoPrevio = .DrawWidth: .DrawWidth = Ancho
ModoFusionPrevio = .DrawMode: .DrawMode = ModoFusion
' si se omiten ambos (x1 y x2), se trazará una línea de currentX a 0
If (IsMissing(X1) = True) Then
X1 = .CurrentX
ElseIf (IsMissing(X2) = True) Then
X2 = .CurrentX
End If
' si se omiten ambos (y1 e y2), se trazará una línea de currentY a 0
If (IsMissing(Y1) = True) Then
Y1 = .CurrentY
ElseIf (IsMissing(Y2) = True) Then
Y2 = .CurrentY
End If
'
If (Relleno = True) Then ' exige Boxed también
If (IsMissing(Color) = True) Then Color = .FillColor
If (AbsolutoOrigen = True) Then
If (AbsolutoDestino = True) Then
PicMask.Line (X1, Y1)-(X2, Y2), Color, BF
Else
PicMask.Line (X1, Y1)-Step(X2, Y2), Color, BF
End If
Else
If (AbsolutoDestino = True) Then
PicMask.Line Step(X1, Y1)-(X2, Y2), Color, BF
Else
PicMask.Line Step(X1, Y1)-Step(X2, Y2), Color, BF
End If
End If
ElseIf (Box = True) Then
If (IsMissing(Color) = True) Then Color = .ForeColor
If (AbsolutoOrigen = True) Then
If (AbsolutoDestino = True) Then
PicMask.Line (X1, Y1)-(X2, Y2), Color, B
Else
PicMask.Line (X1, Y1)-Step(X2, Y2), Color, B
End If
Else
If (AbsolutoDestino = True) Then
PicMask.Line Step(X1, Y1)-(X2, Y2), Color, B
Else
PicMask.Line Step(X1, Y1)-Step(X2, Y2), Color, B
End If
End If
Else
If (IsMissing(Color) = True) Then Color = .ForeColor
If (AbsolutoOrigen = True) Then
If (AbsolutoDestino = True) Then
PicMask.Line (X1, Y1)-(X2, Y2), Color
Else
PicMask.Line (X1, Y1)-Step(X2, Y2), Color
End If
Else
If (AbsolutoDestino = True) Then
PicMask.Line Step(X1, Y1)-(X2, Y2), Color
Else
PicMask.Line Step(X1, Y1)-Step(X2, Y2), Color
End If
End If
End If
.DrawWidth = AnchoPrevio
.DrawMode = ModoFusionPrevio
End With
End Sub
También puede suceder
CurrentX y CurrentY se guardan como propiedades que no aparecen en el visor de propiedades (deben retirarse, para estar disponibles solo en tiempo de ejecución), es adecuado, para trazar por ejemplo polilíneas... Una polilínea, sería simplemente una colección de puntos, + 1 orden gráfica que defina el primer punto, el color, ancho, etc...
Esto te permite obtener donde terminó de dibujar un objeto para (por ejemplo) seguir dibujando en un punto específico, algo que
' Devuelve o establece las coordenadas verticales para el siguiente método Print o Draw.
Public Property Get CurrentY() As Single
CurrentY = UserControl.CurrentY
End Property
Public Property Let CurrentY(ByVal Y As Single)
UserControl.CurrentY = Y
End Property
' Devuelve o establece las coordenadas horizontales para el siguiente método Print o Draw.
Public Property Get CurrentX() As Single
CurrentX = UserControl.CurrentX
End Property
Public Property Let CurrentX(ByVal X As Single)
UserControl.CurrentX = X
End Property
Como hablamos de una colección lógicamente hacen falta dos cosas para ello, además operaciones en la colección: añadir, eliminar, vaciar...
Aquí un ejemplo para añadir:
' Añade los datos de una orden gráfica en la posición indicada y devuelve el valor de dicha posición. Si el índice está fuera de rango, lo añade al final.
' OJO: No verifica si la orden existe o no, al dibujar, si no existe, o un parámetro no es válido, se ignora... y continúa con el siguiente.
' Puede ser mejor desde aquí señalar que es erróneo... o devolver false, y el index devolverlo por referencia.
' DibujarAhora: fuerza a dibujar ahora mismo la orden gráfica, aunque en general es mejor almacenarlas y luego dibujarlas.
Public Function PathsAñadirIndex(ByRef Graf As DatosGraficos, Optional ByVal Index As Long = -1, Optional ByVal DibujarAhora As Boolean = False) As Long
If ((Index < 0) Or (Index > ColGrPaths.Count)) Then
Index = (ColGrPaths.Count + 1) ' en ambos casos se añade al final
End If
Call ColGrPaths.Add(Graf, , Index)
If (DibujarAhora = True) Then
Call Me.DibujarOrden(Graf)
RaiseEvent Actualizado
End If
PathsAñadirIndex = Index
End Function
También es adecuado contar con otras operaciones menos frecuentes, pero igualmente útiles...
Aquí remplazar (una existente por otra que se entrega), y una que intercambia el orden de dos (el orden almacenado supone el orden en que se dibujan).
' Remplaza un ítem gráfico (orden), que consta en la colección por otra orden procedente del exterior. Devuelve True, si el íitem existe.
Public Function PathsRemplazar(ByVal Index As Long, ByRef Graf As DatosGraficos) As Boolean
If (EnRango(Index) = True) Then
Call ColGrPaths.Add(Graf, , Index)
Call ColGrPaths.Remove(Index + 1)
PathsRemplazar = True
End If
End Function
' Intercambia dos ítems (órdenes gráficas), de posición entre sí. Devuelve True, si ambos ítems existen.
Public Function PathsIntercambiar(ByVal Index As Long, ByVal PorIndex As Long) As Boolean
Dim g As DatosGraficos
If (EnRango(Index) = True) Then
If (EnRango(PorIndex) = True) Then
With ColGrPaths
g = .Item(Index)
.Item(Index) = .Item(PorIndex)
.Item(PorIndex) = g
End With
PathsIntercambiar = True
End If
End If
End Function
También puede suceder que uno no quiera dibujar en orden todo, sino solo ciertas órdenes... puede construirse funciones que recorriendo la colección solo dibuje determinadas funciones, si es complicado y exige ciertos condicioonantes muy variables, se puede reclamar una enumeración de la colección y entonces en la entrega evaluar si debe o no dibujarse:
' Enumera los ítems de la colección (por evento) desde el índice indicado hasta el final, en la dirección señalada. Es posible cancelar cuando se desee. Cuando llega al último ítem, lo indica expresamente.
Public Function PathsEnumerar(ByVal DesdeIndex As Long, Optional ByVal HaciaAtras As Boolean = False) As Boolean
Dim k As Long, Cancelar As Boolean, Final As Long
Dim dir As Long
Dim g As DatosGraficos
If (EnRango(DesdeIndex) = True) Then
' Con solo esto, podemos recorrer la colección enambas direcciones, el bucle apenas sufre cambios.
If (HaciaAtras = False) Then ' desde index hasta el final.
Final = (ColGrPaths.Count - 1): dir = 1
Else ' desde index hasta el 1º
Final = 2: dir = -1
End If
' si el index es el final, no entra en el bucle
Do While (DesdeIndex <> Final)
g = ColGrPaths.Item(DesdeIndex)
RaiseEvent Listado(DesdeIndex, g, Cancelar, False)
If (Cancelar = True) Then Exit Do
DesdeIndex = (DesdeIndex + dir)
Loop
' aunque se salga del Do...Loop, sabemos si se canceló porque el índice no llegó a sumar hasta el final.
' luego lo enviamos ahora, y ahora da igual que cancele, ya no hay más...
If (DesdeIndex = Final) Then
g = ColGrPaths.Item(Final)
RaiseEvent Listado(Final, g, False, True) ' indicamos que es el final...
End If
PathsEnumerar = True ' también podría devolver el nº de ítems enviados.
End If
End Function
Se ha mostrado algún evento... el control puede proveer algunos eventos, como cuando termina de redibujartodo, por si se precisa hacer algo desde fuera, como activar algún botón, etc...
' Ocurre cada vez que se actualiza la Imagen.
Public Event Redibujado()
' Ocurre cada vez que se actualiza la imagen, cuando se reclama dibujar una sola orden gráfica.
Public Event Actualizado()
' Ocurre cuando se reclama una peración de Listar Paths (órdenes gráficas), adecuado cuando se deban modificar, algunos ítems.
Public Event Listado(ByVal Indice As Long, ByRef Grafico As DatosGraficos, ByRef Cancelar As Boolean, ByVal Final As Boolean)
Con el valor activo, puedes desactivar que un método gráfico no se dibuje la próxima vez, etc...
Como ves, un control así permite almacenar muchos métodos gráficos contiene todos los datos precisos para dibujar, pero no alcanza ni sobrepasa límites impuestos, además permite aislar adecuadamente unos gráficos de otros, por ejemplo un único control podría contener todos los métodos gráficos para dibujar la escalera... añadiendo además por ejemplo una función GrEscala(byval Escala as single), podría tomar toda la colección de métoso y rescalar su 'ancho y alto' o sólo a aqellos métodos que sean de cierto tipo... igualmente moverlos todos de sitio sería desplazar el control, pero mover a determinados objetos de sitio, podría hacer otra función que recorra la colección para añadir restar a las cordenadas un valor específico...
...y fíjate que sin embargo todo ese código, está en VB6 "puro", sin APIs, recurriendo a las APIs, sería más potente... (gráficamente VB6 es bastante pobre, no es esforzaron demasiado durante el diseño de VB, de dotarle de buneas funcionalidades) pero asumo que no dominas el mundo de las API.
Hola NEBIRE:
Tu explicación es simplemente magistral, y ojala yo supiera hacer lo que me sugieres, de todas formas he copiado y salvado todo el código por que voy a hacer pruebas a ver que consigo y de paso aprendo, pero para este proyecto esta solución es impracticable por que nada del código que tengo me serviría, pero al menos ya se cual es el problema, estoy reduciendo algunos objetos, pasándolos a nuevos Forms, pero como ya no necesito añadir mas objetos y como está el programa funciona perfecto, incluso en PC's con poca memoria, pues se queda así.
Pero has mencionado esto que si me sería muy interesante:
Citar
por ejemplo crear un control de usuario transparente, que provea no solo funcionalidad gráfica, sino también alguna colección, para almacenar métodos gráficos, entonces de ese modo, un solo control, podría tener por ejemplo 200 métodos gráficos, usando un único control de usuario... y por ejemplo, el control podría contener dibujado toda esa escalera sobre sí, podrías tener luego otro control (otra instancia del mismo control), para la leyenda, o bien otros métodos gráficos en el mismo control...
Como se hace un control de usuario transparente, que sería el que tendría el Picture que tengo donde se dibuja todo, y entonces sería reemplazar en todo el código en nombre del Picture.
No se si esto sería abusar de tu generosidad y empeño que has puesto en ayudarme, o en su caso algún link?.
Yo voy a buscar a ver si encuentro algo por donde empezar.
Muchísimas gracias por tu ayuda.
Un saludo.
Cita de: Fran1946 en 5 Julio 2018, 14:01 PM
... Como se hace un control de usuario transparente, que sería el que tendría el Picture que tengo donde se dibuja todo, y entonces sería reemplazar en todo el código en nombre del Picture. ...
No es difícil, son solo un cúmulo de condiciones concretas que como mínimo hay que mantener inalterables o bien, los cambios que se hagan deben ser consecuentes...
Mañana que tengo un poco más de tiempo libre, te hago uno con la funcionalidad mínima y adecuada al caso, del que partir...
Pues de nuevo...
Muchísimas gracias, tu ayuda esta siendo inestimable.
Estoy depurando muchas cosas que tenía mal o que se podían implementar mejor.
Un saludo.
Saque un tiempo el fin de semana para hacer un sencillo ejemplo de prueba, pero me faltó tiempo para probarlo y subirlo...
Aunque se puede hablar largo y variado sobre la trnasparencia, vamos a ir al grano...
En los controles d eusuario de VB6, hay dos formas de dibujar:
A - La primera es usar el evento paint del propio usercontrol... cuando una parte dle control queda expuesta y luego liberada, salta un evento paint, que da la ocasión de redibujar el control. Así que en éste caso todo lo que se deba dibujar debe estar dentro de ese evento.
B - Un defecto del método propio, es que en generla se procede a dibujar por completo el control aunque solo hay sido expuesta una pequeña área. VB6, provee un método alternativo.
Cuando se pone la propiedad Autoredraw a TRUE, una vez pintado, VB6, hace una especie de 'capura' del gráfico, luego cuando se tapa y expone, VB6, solo pega parcialmente el área recién descubierta en vez de redibujar todo.
Naturalmente cuando haya que hacer cambios, hay que redibujar el control al completo por lo general...
Es importante saber que si se pone Autoredraw a TRUE, el evento paint, no salta, porque VB6 se encarga de repintar el área que lo precise, sin embargo o mejor dicho queda a cargo del programador actualizar convenientemente el gráfico cuando convenga...
Aclarado el tema, podemos crear una función llamada por ejemplo "Redibujar", si autoredraw está a false, saltará el evento paint, allí simplemente innnvocamos a esta función y listo. Y si Autoredraw está a TRUE, simplemente desde nuestro código debemos invocar dicha función cuando necesitemos actualizar el gráfico...
Vamos a lo primero, algunas propiedades para controlar y que sirvan de ejemplo...
' OK: Devuelve o establece si el color del fondo del display es transparente y deja ver lo que hay bajo él.
' En la sección de declaraciones:
Private p_Transparente As Boolean
Private p_ColorTapiz As Long
Private p_ColorTinta As Long
Public Property Get Transparente() As Boolean
Transparente = p_Transparente
End Property
Public Property Let Transparente(ByVal X As Boolean)
If (X <> p_Transparente) Then
p_Transparente = X
Call Redibujar
PropertyChanged "Transparente"
End If
End Property
' Devuelve o establece el color del fondo del control.
' Todo lo que se pinte de este color será transparente.
' No hay problema en delegar la propiedad en Usercontrol.Backcolor
Public Property Get ColorTapiz() As OLE_COLOR
ColorTapiz = p_ColorTapiz
End Property
Public Property Let ColorTapiz(ByVal X As OLE_COLOR)
If (X <> p_ColorTapiz) Then
p_ColorTapiz = X
Call Redibujar
PropertyChanged "ColorTapiz"
End If
End Property
' Devuelve o establece el color de la tinta del control. Por defecto, lo que se dibue se hará con este color.
' puede delegarle la propiedad en Usercontrol.Forecolor sin problemas...
Public Property Get ColorTinta() As OLE_COLOR
ColorTinta = p_ColorTinta
End Property
Public Property Let ColorTinta(ByVal X As OLE_COLOR)
If (X <> p_ColorTinta) Then
p_ColorTinta = X 'UserControl.ForeColor = X
Call Redibujar
PropertyChanged "ColorTinta"
End If
End Property
Añade tus funciones gráficas, en general pinta con el 'ColorTinta', digamos que es el color por defecto para pintar...
Es útil disponer también de una propiedad: "ColorPreset". que no es otra cosa que un array de colores...
Si son fijos los estableces en código, si son elegibles por el usuario, que el mismo los pueda remplazar, aunque siempre conviene que existan por defecto... en generla basta con 16 colores, digamos 15 para el array + el 'color Tinta' (el valor por defecto).
La ventaja de un color preset, es que si tiene spongamos 300 líneas que dibujar y 35 de ellas tienen un color morado y decides cambiarlo a amarillo, en vez de recordar que líneas son es preferible asignar un color preset a cada línea, luego cuando se queira cambiar el color, la propiedad detecta que ha cambiado y al dibujar lo hará con el nuevo color... sin tener que recorrer las 300 líneas para asignarle un nuevo color... así pasamos por ejemplo de la estructura:
public type DatosLinea
X1 as integer
Y1 as integer
X2 as integer
Y2 as integer
Color as long
end type
Es preferible usar una estructura ligeramente diferente...
public type DatosLinea
X1 as integer
Y1 as integer
X2 as integer
Y2 as integer
IndexColor as Integer
end type
IndexColor apunta a un índice en el array de ColorPreset, así cambiar el color a 52 líneas no exige más que cambiar el color al índice concreto, y no a todas las 52 lineas recorriendo las 300... Una vez hecho el cambio, al dibujar sería algo como:
For k = 0 to p_NumLineas
with ColLineas(k) ' una colección o array de 'DatosLinea'
UserControl.Line (.x1, .y1)-(.x2, .y2), p_ColorPreset(.IndexColor), BF
end with
Next
La propiedad ColorPreset, requiere dos parámetros, el índice y el color que se asigna a dicho índice:
' en las declaraciones:
private p_ColorPreset(-1 to 15) as long ' el valor del índice -1, refleja el ColorTinta
public property get ColorPreset(byval Indice as byte) as OLE_Color
ColorPreset = p_ColorPreset(indice)
end property
' Como indice está declarado como byte, el índice -1 no puede ser alterado externamente
Public property let ColorPreset(byval Indice as byte, byval X as OLE_Color)
if (indice > 15) then err.raise 381 ' indice de array fuera de rango.
If (p_ColorPreset(Indice) <> X) then
p_ColorPreset(Indice) = X
Call Redibujar
PropertyChanged "ColorPreset"
end if
end property
Esto sin embargo es mejorable en dos aspectos.
Lo primero es que al poner dos parámetros en una propiedad, ya no puede aparecer en la "ventana de propiedades" durante el diseño y por tanto durante diseño, la aplicación cliente, no podrá poner reasignar colores salvoque se añada una página d epropiedades, que es complicarlo solo para esto.
Hay una técnica muy sencilla, que admeás puede también aplicarse a otros objetos que posena índice y varia spropiedades... y consiste en desdoblar la propiedad en dos...
por un lado el índice y por otro el color, como se muestra a continuación:
' en las declaraciones:
private p_IndexPreset as byte
private p_ColorPreset(-1 to 15) as long ' el valor del índice -1, refleja el ColorTinta
' Esta propiedad refleja en diseño el índice al que se aplica el colorPreset...
public property get IndexPreset() as byte
IndexPreset = p_IndexPreset
end property
' Como indice está declarado como byte, el índice -1 no puede ser alterado externamente
Public property let IndexPreset(byval X as byte)
if (x > 15) then err.raise 381 ' indice de array fuera de rango.
If (p_IndexPreset <> X) then
p_IndexPreset(Indice) = X
' no necesita guardarse esta propiedad, puede ser 0 cada vez... que se carguen las propiedades.
end if
end property
public property get ColorPreset() as OLE_Color
ColorPreset = p_ColorPreset(p_IndexPreset)
end property
' Como indice está declarado como byte, el índice -1 no puede ser alterado externamente
Public property let ColorPreset(byval X as OLE_Color)
If (p_ColorPreset(p_IndexPreset) <> X) then
p_ColorPreset(p_IndexPreset) = X
Call Redibujar
PropertyChanged "ColorPreset"
end if
end property
Ahora ya aparece esa propiedad en la 'ventana de propiedades', para cambiar un color del array, basta cambiar el array y luego asignar un color...
Antes decía que tenía dos carencias, una ya ha quedado subsanada, la otra es que anque tenemos 16 colores, no necesariamente deben estar todos en uso, sin embargo al cambiar un color del preset, forzamos un redibujado... algo caro si resulta que nada está dibujado con ese color.
Algo más optimo es mantener un array paralelo que lleve la cuenta de 'objetos' que usan cada color...
Cuando se añade un nuevo 'objeto gráfico', se añade 1 a la cuenta, si se elimina (o se cambia de índice asignado de color), se resta 1 para ese índice (y se suma uno al otro si cambió de índice).
Entonces ahora la última propiedad puede mejorarse así:
private p_CuentaObjColor(0 to 15) as integer
public property get ColorPreset() as OLE_Color
ColorPreset = p_ColorPreset(p_IndexPreset)
end property
' Como indice está declarado como byte, el índice -1 no puede ser alterado externamente
Public property let ColorPreset(byval X as OLE_Color)
If (p_ColorPreset(p_IndexPreset) <> X) then
p_ColorPreset(p_IndexPreset) = X
if (p_CuentaObjColor(p_indexPreset)>0) then
Call Redibujar
end if
PropertyChanged "ColorPreset"
end if
end property
Ahora es más eficiente, al coste de mantener convenientemente actualizado el array con la cuenta de objetos que mantienen tal o cual color...
Claramente si el número de líneas a dibujar son pocas, redibujarlo todo cada vez, no sea pesado y a cambio uno se olvida de la complejidad añadida por la eficiencia, en cambio sin son algunas miles d elínea sa dibujar... redibujarlas todas cuando ningún objeto utiliza dicho color, no es ideal... En fin uno debe decidir que conviene mas dado el caso de que vaya a usarse muchas o pocos objetos gráficos...
Todo lo previo es para optimizar operaciones, ahora veremos unamanera de reutilizar el mismo control para 3 tareas diferentes...
- Polilínea: Son varios puntos conectados entre sí, formando un único objeto gráfico, más o menos complejo...
Se dibuja una línea de un punto a otro, si uno no está activo se pasa al siguiente (es decir el que noes
´te activo se ignora).
- Múltiples líneas inconexas entre sí. Es decir cada línea tiene dos puntos que definen su inicio y su fin.
Cad alínea comienza en un índice par como X1,Y1 y termina en el siguiente punto delarray (punto impar), como X2, Y2.
- Poligonos: Cada polígono se compone de varios vértices. realmente también puede considerarse múltples polilíneas, ya que ser polígono, exige que la última línea del polígono se conecte a la primera.
Un poligono dibuja de un punto a otro, hasta encontrar uno no activo, momento en que se considera que acaba e polígono (o polilínea en múltiples polilineas).
Todo ello soportado con una misma y única colección o array (luego un par de párrafos al respecto).
Aquí, código para dar salida a todas esas ideas...
' en las declaraciones:
Public Type PuntoPolilinea
X As Single
Y As Single
Activo As Byte ' Valor 255 = activo, se dibuja, otro valor no se dibuja
' (interesa un byte mejor que Boolean, porque incluso puede usarse como cuenta y al alcanzar el valor 255 será 'dibujable', en cualquier caso, un boolean en vb6 ocupa 2 bytes).
End Type
' Comportamiento del control a la hora de dibujar.
Public Enum ModosDeDibujado
DIBUJA_INCONEXA = 0 ' De un punto par al siguiente impar, del impar salta (sin dibujar) al siguiente par.
DIBUJA_POLILINEA = 1 ' Se comporta como una línea continua de un punto (activo) a otro.
DIBUJA_POLIGONOS = 2 ' Se comporta como si fueran polígonos, cada polígono termina cuando un punto está desactivado.
End Enum
Private p_Polilinea As ModosDeDibujado ' Se comporta de diferentes maneras...
Private p_ptActual As Integer ' para señalar valores dado su índice.
' Permite dibujar desde un punto a otro específico...
Private p_ptInicio As Integer ' Punto desde el que se empieza a dibujar.
Private p_ptFinal As Integer ' Punto donde se termina de dibujar (si circular hasta el sigiente).
Private p_ptEvento As Integer ' dispara un evento al dibujar dicho punto, para tener ocasión de asignar color, ancho paqra la siguiente línea (o para el resto), incluso para poder cambiar el índice de otro punto para evento...
' en las propiedades:
' Devuelve o establece un valor que determina si los puntos se comportan como una polílínea, como líneas inconexas o como polígonos (o múltiples polilíneas). Actuando como líneas inconexas cada línea queda definidar por un punto par y el siguiente.
' OJO: Dado que como múltiples líneas, cada línea(inconexa) requiere dos puntos, queda definida por un punto par y el siguiente impar,
' luego definir como punto inicial (para empezar a dibujar) uno impar, haría una conexión errónea (conectando el punto final de una línea con el punto inicial de otra), para todas ellas.
Public Property Get ModoDibujo() As ModosDeDibujado
ModoDibujo = p_Polilinea
End Property
' La idea es que el control se utilice para una sola cosa durante su tiempo de ejecución.
Public Property Let ModoDibujo(ByVal X As ModosDeDibujado)
If (X <> p_Polilinea) Then
If (p_Polilinea = DIBUJA_POLIGONOS) Then
p_Polilinea = X
Call AjustarArray
If (X = DIBUJA_INCONEXA) Then
' Garantiza la integridad de dibujar líneas como se definieron.
If (p_ptInicio And 1) Then ' si es impar, se resta uno,
p_ptInicio = (p_ptInicio - 1) ' para apuntar al punto inicial de la línea.
End If
End If
If (p_Autodibujar = True) Then
Call Redibujar
End If
Else
p_Polilinea = DIBUJA_POLIGONOS
' no se debe redibujar, sin cargar primero los puntos.
End If
PropertyChanged "ModoDibujo"
End If
End Property
Los campos para otras propiedades:
- p_ptActual: Sirve para usar la misma técnica anterior y poder asignar línea durante diseño, sobre la ventana d epropiedades... va bien cuando son pocas, si son muchas es preferible usar un fichero externo y proveer una función de carga d elos datos...
- p_ptInicio, p_ptFinal... aunque se comentan brevemente en su declaración, sirven para dibujar en un bucle... por defecto una vale 0 y la otra el último punto del array/colección, pero en la práctica, puede ser usado como separador de objetos, por ejemplo podrías tener olilíneas entre el indice 0 y el 60, línea ssueltas entre el índice 61 y 130 y poligonos (de pocos lados cada uno) entre el punto índice 131 y el 540, y otro objeto más complejo entre el índice 541 y el 650 (por ejemplo)... así si precisas redibujar solo las líneas, estbalece inicio y fin a los valores 61 y 130 respectivamente y luego con polilinea = DIBUJA_INCONEXA, si está establecda una propiedad AutoRedibujar , ya haría el redibujado, y si no puede crearse una función publica que admita dichos parámetros...
Ahora la función de dibujado que aplica las diferentes formas de dibujado:
' redibuja toda la figura desde el punto inicial hasta el final (perop uede hacerse pública y admitir los parámetros antedichos más arriba, para ser invocada también desde fuera...
Private Sub DibujarMiContenido()
Dim k As Integer, j As Integer, i As Integer, n As Integer
Dim X1 As Single, X2 As Single, Y1 As Single, Y2 As Single
Dim kol As Long, Ancho As Byte
Dim pts() As PuntoPolilinea
If (p_NumPuntos > 1) Then
' para permitir (durante evento de punto), dibujar con coloy ancho distintos sin alterar el valor 'general'.
kol = p_ColorTinta ' UserControl.ForeColor
Ancho = UserControl.DrawWidth
If (p_ptInicio < p_ptFinal) Then
i = p_ptInicio: j = p_ptFinal: n = 1
Else
j = p_ptInicio: i = p_ptFinal: n = -1
End If
' 2 arrays, uno mantiene los puntos originales para no perse rprecisión por escalados contínuos, el otro
' mantiene los valores escalados...
If (p_AutoEscalado = True) Then
pts = s_Escala
Else
pts = p_Puntos
End If
If (p_Polilinea = DIBUJA_POLILINEA) Then
' Dibuja como una polílinea. Líneas conexas entre puntos activos...
' Donde cada línea queda definida entre un par de puntos activos.
' Los puntos pueden estar activos individualmente.
If (p_NumPtActivos = 0) Then Exit Sub
With pts(p_ptInicio)
X1 = .X: Y1 = .Y
End With
For k = i + n To j Step n
With pts(k)
If (.Activo = 255) Then
X2 = .X: Y2 = .Y
If (k = p_ptEvento) Then
' El cliente tiene con éste evento oportunidad de dibujar algo en ese momento, cambiar valor de puntos
' cambiar color para dibujar, el ancho, e incluso definir otro momento de evento como éste para hacer más cambios.
RaiseEvent DibujandoPuntoSel(p_ptEvento, kol, Ancho)
End If
UserControl.Line (X1, Y1)-(X2, Y2), kol
X1 = X2: Y1 = Y2
End If
End With
Next
If (p_Circular = True) Then
With pts(i)
X2 = .X: Y2 = .Y
UserControl.Line (X1, Y1)-(X2, Y2), kol
End With
End If
ElseIf (p_Polilinea = DIBUJA_INCONEXA) Then
' Dibuja como múltiples líneas inconexas entre sí...
' Donde cada línea queda definida por un par de puntos par-impar.
' La línea está 'activa' si el primero lo está (obviando el estado del 2º).
If (i And 1) Then i = (i - 1)
For k = i To j Step (n * 2)
With pts(k)
If (.Activo = 255) Then
X1 = .X: Y1 = .Y
' Como múltiples líneas se ignora el estado activo del segundo punto.
With pts(k + n)
X2 = .X: Y2 = .Y
End With
' Igualmente: éste punto debiera ser par, o modificarse como está comentado
If (k = p_ptEvento) Then ' or ((k+n) = p_ptEvento) then
' El cliente tiene con éste evento oportunidad de dibujar algo en ese momento, cambiar valor de puntos
' cambiar color para dibujar, el ancho, e incluso definir otro momento de evento como éste para hacer más cambios.
RaiseEvent DibujandoPuntoSel(p_ptEvento, kol, Ancho)
End If
UserControl.Line (X1, Y1)-(X2, Y2), kol
End If
End With
Next
Else ' poligonos...
' polígonos solo se dibuja en orden hacia arriba...
Do While (i < j)
With pts(i)
X1 = .X: Y1 = .Y
End With
' un polígono acaba cuando encuentra un punto 'no activo'
Do While pts(i).Activo = True
i = (i + 1)
With pts(i)
X2 = .X: Y2 = .Y
' Igualmente: éste punto debiera ser par, o modificarse como está comentado
If (i = p_ptEvento) Then ' or ((k+n) = p_ptEvento) then
' El cliente tiene con éste evento oportunidad de dibujar algo en ese momento, cambiar valor de puntos
' cambiar color para dibujar, el ancho, e incluso definir otro momento de evento como éste para hacer más cambios.
RaiseEvent DibujandoPuntoSel(p_ptEvento, kol, Ancho)
End If
UserControl.Line (X1, Y1)-(X2, Y2), kol
End With
X1 = X2: Y1 = Y2
Loop
i = (i + 1)
Loop
End If
' restaura el ancho de dibujado...
UserControl.DrawWidth = Ancho
End If
End Sub
El campo "p_ptEvento" da pie a otra propiedad... por eejmplo dado un indice que se debe dibujar con un color o ancho distintos, alllegar aél se lanza el evento, y se responde cambiando el color y/o el ancho de dibujado de la línea y/o también el próximo punto donde parar...
en este ejemplo de función no he hecho uso del array ColorPreset, ya puse un ejemplo muy simple más arriba de como usarlo, aquí se ha puesto para el caso, p_ColorTinta, ya que la estructura definida algo más arriba, no aloja un color, si no otro campo interesante "Activo", para señalar qué hacer o para que sirve o como funcionar con dicho punto de formas diversas...
Y como ya me he extendido más d elo que pretendía, finalmente podrmeos dibujar con transparencia...
Respeta lo que en esta función aparece y lo que modifiques que sea en una función aparte o bien enciam o debajo de la función usada para todo el dibujado...
' Con AutoRedraw=True, nunca se invoca este método,
' se puede solucionar así...
' Private Sub UserControl_Paint()
' call Redibujar
' end sub
' siempre conviene tener una funcion externa que redibuje todo...
public sub Refresh
call Redibujar
end sub
' pero si se pone a False, no requiere invocarse otro método.
Private Sub Redibujar()
With UserControl
.BackStyle = 1
.DrawMode = vbCopyPen
.FillStyle = vbFSTransparent
' Color del fondo...
'.Cls ' aplicando el color al usercontrol.backcolor, pero como no delegamos en usercontrol.backcolor...
' pintmaos el fondo 'a mano'.
UserControl.Line (0, 0)-(.Width, .Height), p_ColorTapiz, BF ' "B"oxed y "F"illed
'Call DibujarFondo ' dibujamos si hay alguna imagen de fondo con algo transparente o no, quizás una cuadrícula
Call DibujarMiContenido ' dibujamos el valor
Call DibujarRelieve ' dibujamos el borde. Si el borde va ser sencillo, mejor delegar en el usercontrol.BorderStyle, pero si redondeamos esquinas, o se da un margen mayor, etc... viene bien dibujarlo después del resto.
If (p_Transparente = True) Then
.MaskColor = p_ColorTapiz
.BackStyle = 0
Set .MaskPicture = .Image
End If
If (p_Activo = False) Then ' usercontrol.Enabled
Call DibujarEstadoDisabled
End If
End With
'RaiseEvent Pintado
End Sub
pongo alguna imagen... y como ya se me hace tarde para más, mañana (o pasado, si no tengo tiempo mañana) comprimo el proyecto de ejemplo y lo subo a alguna página de descarga... comentaré alguna cosa más antes...
(https://i.imgur.com/VOFePwL.png)
(https://i.imgur.com/Ds52Rp4.png)
(https://i.imgur.com/aQsFFIl.png)
Perfecto, me espero a que subas todo esto.
Muchas gracias.
Un saludo.
Copiado todo este código
Espero a lo que subas.
Muchas gracias de nuevo.
Un saludo.