[RESUELTO]-Agregar un evento a un control en tiempo de ejecu

[bcf179e]

Hola,

He aqui una imagen con lo que yo quiero.

image1_opt.png (22.69 KiB) Visto 1818 veces

En la imagen precedente los dos LB que estan en arriba a la derecha fueron agregados en modo Diseno para poder verificar el buen funcionamiento de la macro MAJGroupes. Lo que yo quiero es lo siguiente. «Coger » un nombre del LB que esta a la izquierda y cuando hago clic en uno de los LB de la derecha que el actualiza ese LB, agregando ese nombre y tambien la BD. Cuando yo lo hago funciona con esos dos LB de la derecha.

Ahora lo que quiero es usar el boton para agregar dinamicamente LB y que estos tengan el mismo comportamiento que los que agregue en modo Diseno. O sea, necesito agregar un evento en tiempo de ejecucion.

El error que me da es el siguiente :

image2_opt.png (26.49 KiB) Visto 1818 veces

Pero el LB es agregado.

Alguien puede ayudarme por favor ???

Gracias de ante mano.

[bcf179e]

Codigo de la macro:

Código: Seleccionar todo

Sub NouveauGroupe(oEvent as object)
Dim Context as object
Dim oParent as object
Dim DB as object
Dim Conn as object
Dim Stmt as object
Dim strSQL as String
Dim ResultSet as object
Dim oForm_Liste_GROUPE As Object
Dim Groupe_ListBox As Object
Dim maFormListBox as Object
Dim nb_ctrl as Integer

	oParent = oEvent.Source.Model.Parent

	Context = CreateUnoService("com.sun.star.sdb.DatabaseContext")
	DB = Context.getByName("prueba")
	Conn = DB.getConnection("","")
	Stmt = Conn.createStatement()
	
	strSQL = "select max(""id"") from groupe"
	ResultSet = Stmt.executeQuery(strSQL)
	
	ResultSet.next
	
	qteGroupes = ResultSet.getString(1)
	
	qteGroupes = qteGroupes + 1
	
	strSQL = "insert into ""groupe"" (""id"", ""groupe"") values (" & qteGroupes & ", 'Groupe" & qteGroupes & "')" 
	Stmt.executeQuery(strSQL)

	'Creamos una nueva forma de control
	oForm_Liste_GROUPE = ThisComponent.createInstance("com.sun.star.drawing.ControlShape")
	oForm_Liste_GROUPE.Name = "Form_GROUPE" & qteGroupes
	
	'Cambiamos su tamaño y posicion
	Call CambiaTam( oForm_Liste_GROUPE, 5000, 5000 )
	Call CambiaPos( oForm_Liste_GROUPE, 3000, 10000 )
	
	'Creamos un nuevo cuadro de lista
	Groupe_ListBox = ThisComponent.createInstance("com.sun.star.form.component.ListBox")
	
	'Establecemos su nombre
	Groupe_ListBox.Name = "Groupe" & qteGroupes
	
	'Conectamos la forma con el nuevo control
	oForm_Liste_GROUPE.Control = Groupe_ListBox
	
	'Agregamos la forma a la página de dibujo para que sea visible
	thiscomponent.DrawPage.add( oForm_Liste_GROUPE )
	
	maFormListBox = ThisDataBaseDocument.FormDocuments.GetByName("Form_GROUPE1")
	
'	nb_ctrl = maFormListBox.count
'	MsgBox nb_ctrl
 '  	For i = 0 to nb_ctrl-1
  ' 		Assigner_macro_controle (maFormListBox, i)
   '	next i
End Sub

Sub Assigner_macro_controle(oForm as object, index as long)
dim oEvent as new com.sun.star.script.ScriptEventDescriptor
dim struct()
	'if (ubound(struct) > -1) then
    '	Supprimer l'assignation au script
    '  	oForm.revokeScriptEvents(index)
   	'end if

   	oEvent.ListenerType = "com.sun.star.awt.XMouseListener"
   	oEvent.EventMethod = "mousePressed"
   	oEvent.ScriptType = "StarBasic"
   	oEvent.ScriptCode = "Standard.Module1.MAJGroupes"

   	oForm.registerScriptEvent(index, oEvent)
end sub

[SLV-es]

Por favor, recorta un poco las imágenes y vuelve a subirlas, pues a ese tamaño quedan muy reducidas y no podemos ni distinguir el mensaje de error.

[bcf179e]

Hola,

Finalmente he resuelto es problema.

Aqui les dejo el codigo en espera de que sea util para alguien.

Código: Seleccionar todo

Sub NouveauGroupe1(oEvent as object)
Dim oFormGroupes as Object
Dim oFormLabels as Object
Dim oNouveauFormControl as Object
Dim oNouveauLBModel as Object
Dim Context as object
Dim DB as object
Dim Conn as object
Dim Stmt as object
Dim strSQL as String
Dim ResultSet as object
Dim nb_ctrl as Integer
Dim i as Integer
Dim maFormListBox as Object
Dim oNuevaEtiqueta As Object
Dim oNuevaEtiquetaModelo As Object
	
	
	oFormGroupes = ThisComponent.DrawPage.Forms.getByName("MesGroupes")
	oFormLabels = ThisComponent.DrawPage.Forms.getByName("MesLabels")
	
	Context = CreateUnoService("com.sun.star.sdb.DatabaseContext")
	DB = Context.getByName("prueba")
	Conn = DB.getConnection("","")
	Stmt = Conn.createStatement()
	
	strSQL = "select max(""id"") from groupe"
	ResultSet = Stmt.executeQuery(strSQL)
	
	ResultSet.next
	
	qteGroupes = ResultSet.getString(1)
	
	qteGroupes = qteGroupes + 1
	
	strSQL = "insert into ""groupe"" (""id"", ""groupe"") values (" & qteGroupes & ", 'Groupe" & qteGroupes & "')" 
	Stmt.executeQuery(strSQL)
	
	oNouveauFormControl = ThisComponent.createInstance("com.sun.star.drawing.ControlShape")
			
	Call CambiaTam( oNouveauFormControl, 5000, 5000 )
	Call CambiaPos( oNouveauFormControl, 0, 1000 )
	
		oNouveauLBModel = ThisComponent.createInstance("com.sun.star.form.component.ListBox")
	oNouveauLBModel.Name = "Groupe" & qteGroupes
	
	oNouveauFormControl.Control = oNouveauLBModel
 	oFormGroupes.insertByIndex(0, oNouveauLBModel)
	ThisComponent.DrawPage.add( oNouveauFormControl )
	
	maFormListBox = ThisComponent.DrawPage.Forms.GetByName("MesGroupes")
	
	oNuevaEtiqueta = ThisComponent.createInstance("com.sun.star.drawing.ControlShape")
 
	Call CambiaTam( oNuevaEtiqueta, 2000, 1500 )
	Call CambiaPos( oNuevaEtiqueta, 0, 500 )
 
	oNuevaEtiquetaModelo = ThisComponent.createInstance("com.sun.star.form.component.FixedText")
	oNuevaEtiquetaModelo.Name = "Groupe" & qteGroupes
	oNuevaEtiquetaModelo.Label = "Groupe" & qteGroupes
	
	oNuevaEtiqueta.Control = oNuevaEtiquetaModelo
 
	oFormLabels.insertByIndex(0, oNuevaEtiquetaModelo)
 
	ThisComponent.DrawPage.add( oNuevaEtiqueta )  
	
	Assigner_macro_controle (maFormListBox, 0)	
End Sub

Y...

Código: Seleccionar todo

Sub Assigner_macro_controle(oForm as object, index as long)
dim oEvent as new com.sun.star.script.ScriptEventDescriptor

   	oEvent.ListenerType = "com.sun.star.awt.XMouseListener"
   	oEvent.EventMethod = "mousePressed"
   	oEvent.ScriptType = "StarBasic"
   	oEvent.ScriptCode = "Standard.Module1.MAJGroupes"

   	oForm.registerScriptEvent(index, oEvent)
end sub

Gracias a todos.