Shell 19-02-2024, 01:26
Buenas!.
Y este otro ejemplo, el que mediante la pulsación del ratón se controla los segundos que tienes pulsado el ratón sobre
el área de dibujo. Luego si lo sueltas ese contador de segundos vuelve a cero. Y ademas, si quieres cerrar la ventana,
esta contará tres segundos antes de cerrarse y no dejará cerrarse sin pasar esos tres segundos.
La idea es que para que algo se ejecute "indefinidamente" necesita el apoyo de algo y un control del mismo.
![[Imagen: 5d6lw2M.png]](https://i.imgur.com/5d6lw2M.png)
Saludos
Y este otro ejemplo, el que mediante la pulsación del ratón se controla los segundos que tienes pulsado el ratón sobre
el área de dibujo. Luego si lo sueltas ese contador de segundos vuelve a cero. Y ademas, si quieres cerrar la ventana,
esta contará tres segundos antes de cerrarse y no dejará cerrarse sin pasar esos tres segundos.
La idea es que para que algo se ejecute "indefinidamente" necesita el apoyo de algo y un control del mismo.
Código:
' Gambas class file
Const VENTANA_ANCHO As Integer = 800
Const VENTANA_ALTO As Integer = 600
Private canvas As DrawingArea
Private timer1 As Timer
Private terminar As Boolean
Private pulsado As Boolean
Private cuenta As Integer
Private vigilante As Observer
Public Sub Form_Open()
vigilante = New Observer(Me) As "Vigilante"
With Me
.Background = Color.Black
.Title = "Evento MouseDown y MouseUP"
.Arrangement = Arrange.Horizontal
.Resizable = False
.AutoResize = True
End With
canvas = New DrawingArea(Me) As "Canvas"
With canvas
.W = VENTANA_ANCHO
.H = VENTANA_ALTO
.Background = Color.Black
End With
timer1 = New Timer As "Timer1"
Timer1.Delay = 1000
End
Public Sub Canvas_MouseDown()
If Not terminar Then
If Mouse.Left Then
pulsado = True
Timer1.Start
Endif
Endif
End
Public Sub Canvas_MouseUp()
If Not terminar Then
pulsado = False
cuenta = 0
Timer1.Stop
Endif
canvas.Refresh
End
Public Sub Canvas_Draw()
Dibujar
End
Public Sub Dibujar()
Dim RC As RectF
Dim mensaje As String
Paint.Font = Font["MonoSpace, 14"]
If pulsado And Not terminar Then
mensaje = "Se ha pulsado el boton izquierdo del ratón durante: " & Str(cuenta) & " segundos"
RC = Paint.TextSize(mensaje)
Else If Not pulsado And Not terminar Then
mensaje = "Se ha levantado el dedo del botón izquierdo del ratón"
RC = Paint.TextSize(mensaje)
Else If Not pulsado And terminar Then
mensaje = "Este programa se cerrará en " & Str(cuenta) & " segundos"
RC = Paint.TextSize(mensaje)
Endif
Paint.Text(mensaje, (canvas.w - RC.Width) / 2, (canvas.Height - RC.Height) / 2, RC.Width, RC.Height)
Paint.Brush = Paint.Color(Color.Green)
Paint.Fill
End
Public Sub Timer1_Timer()
If Not terminar Then
cuenta += 1
canvas.Refresh
Else If terminar And cuenta > 0 Then
cuenta -= 1
canvas.Refresh
Else If terminar And cuenta = 0 Then
Timer1.Stop
Me.Close
Endif
End
Public Sub Vigilante_Close()
If Not terminar Then
pulsado = False
terminar = True
cuenta = 4
Timer1.Start
Endif
End
Public Sub Form_Close()
If cuenta = 0 And terminar Then
Quit
Else
'Evitar el cierre del programa si no se cumplen las condiciones
Stop Event
Endif
EndSaludos
Shell 19-02-2024, 01:20
Buenas!.
¿ Se acuerdan que es un bucle ?.
- Mediante el ratón y la pulsación del botón izquierdo de este voy creando sprites/imágenes por un control DrawingArea.
Encontré dos formas de hacerlo:
- Mediante un bucle While que comprueba constantemente si se ha pulsado el botón izquierdo del ratón
Pero eso tiene un problema. Un bucle While que está constantemente comprobando y comprobando parece
algo como un bucle sin fin. Tiene que haber algo que lo frene un poco..
Primera versión, con el bucle While.
Ese bucle recibe la coordenada del ratón y en la zona de dibujar del control DrawingArea no se controla si se ha pulsado o no
el botón izquierdo del ratón. Ese DrawingArea es refrescado por un Timer.
Segunda versión. Se evita el uso del bucle while.
Tuve que añadir dos variables comunes a todo el formulario para saber en "todo" momento donde se ha hecho clic
con el ratón.
botonpulsado se produce naturalmente cuando hacemos click con el ratón en algún lugar de la ventana de dibujo.
Al usar esas variables globales (por llamarlas de alguna forma, común a toda la clase). Carece de importancia
llamar a crear el sprite en los eventos del ratón.
Uso dos:
- Uno para dibujar en el mismo lugar. MouseDown
- Para crear una estela de sprites por la zona de dibujo. MouseMove.
Voy a subiros el proyecto ejemplo. FormEjemplo1 usa el bucle While y FormEjemplo2, no.
El área de dibujo es de 1600x900. No creo que haya problema en reducirla, podéis hacerlo en las dos constantes del principio
del código.
No subo la imagen de la demo entero ya que es un poco grande. Subo una parte. Solo objetos por todos lados
creados con el ratón.
![[Imagen: nmntXnn.png]](https://i.imgur.com/nmntXnn.png)
Recordar , debéis dejar pulsado el botón izquierdo. También podéis dejado pulsado el botón y mover el ratón.
Ejecutar un form u otro. Y ojo, a más imágenes , mas se calienta la computadora.
Llevo unos días con esto que puede parecer una tontería. En realidad, queriendo controlar otras cosas.
Saludos
¿ Se acuerdan que es un bucle ?.
- Mediante el ratón y la pulsación del botón izquierdo de este voy creando sprites/imágenes por un control DrawingArea.
Encontré dos formas de hacerlo:
- Mediante un bucle While que comprueba constantemente si se ha pulsado el botón izquierdo del ratón
Pero eso tiene un problema. Un bucle While que está constantemente comprobando y comprobando parece
algo como un bucle sin fin. Tiene que haber algo que lo frene un poco..
Primera versión, con el bucle While.
Código:
Public Sub CrearSprites(ix As Integer, iy As Integer)
Dim asprite As Sprite
Dim aimage As Image
While botonpulsado
aimage = Image.Load("Imagenes/" & anomimagenes[Rand(0, anomimagenes.max)])
asprite = New Sprite([ix, iy], [Rnd(-1, 1), Rnd(-1, 1)], Rand(0, 360), Deg(Rnd(-0.1, 0.1)), aimage)
asprites.Add(asprite)
Wait 0.01 'Obligatorio dentro del bucle. Cada Sprite se crea según este tiempo, no lo que diga el reloj
Wend
EndEse bucle recibe la coordenada del ratón y en la zona de dibujar del control DrawingArea no se controla si se ha pulsado o no
el botón izquierdo del ratón. Ese DrawingArea es refrescado por un Timer.
Código:
Public Sub Ventana_Draw()
Dim asprite As Sprite
For Each asprite In asprites
asprite.Dibujar()
asprite.Update()
asprite.vel = colisionBordes([VENTANA_ANCHO, VENTANA_ALTO], asprite)
Next
EndSegunda versión. Se evita el uso del bucle while.
Código:
Public Sub CrearSprites(ix As Integer, iy As Integer)
Dim asprite As Sprite
Dim aimage As Image
aimage = Image.Load("Imagenes/" & anomimagenes[Rand(0, anomimagenes.max)])
asprite = New Sprite([ix, iy], [Rnd(-1, 1), Rnd(-1, 1)], Rand(0, 360), Deg(Rnd(-0.1, 0.1)), aimage)
asprites.Add(asprite)
EndTuve que añadir dos variables comunes a todo el formulario para saber en "todo" momento donde se ha hecho clic
con el ratón.
Código:
Public Sub Ventana_Draw()
Dim asprite As Sprite
If botonpulsado Then CrearSprites(mx, my)
For Each asprite In asprites
asprite.Dibujar()
asprite.Update()
asprite.vel = colisionBordes([VENTANA_ANCHO, VENTANA_ALTO], asprite)
Next
Endbotonpulsado se produce naturalmente cuando hacemos click con el ratón en algún lugar de la ventana de dibujo.
Al usar esas variables globales (por llamarlas de alguna forma, común a toda la clase). Carece de importancia
llamar a crear el sprite en los eventos del ratón.
Uso dos:
- Uno para dibujar en el mismo lugar. MouseDown
- Para crear una estela de sprites por la zona de dibujo. MouseMove.
Código:
Public Sub Ventana_MouseDown()
If Mouse.Left Then
botonpulsado = True
mx = Mouse.X
my = Mouse.Y
'CrearSprites(mx, my)
Endif
End
Public Sub Ventana_MouseMove()
mx = Mouse.X
my = Mouse.Y
'If Mouse.Left Then CrearSprites(mx, my)
EndVoy a subiros el proyecto ejemplo. FormEjemplo1 usa el bucle While y FormEjemplo2, no.
El área de dibujo es de 1600x900. No creo que haya problema en reducirla, podéis hacerlo en las dos constantes del principio
del código.
No subo la imagen de la demo entero ya que es un poco grande. Subo una parte. Solo objetos por todos lados
creados con el ratón.
Recordar , debéis dejar pulsado el botón izquierdo. También podéis dejado pulsado el botón y mover el ratón.
Ejecutar un form u otro. Y ojo, a más imágenes , mas se calienta la computadora.
Llevo unos días con esto que puede parecer una tontería. En realidad, queriendo controlar otras cosas.
Saludos
Archivos adjuntos
tincho 19-02-2024, 00:15
Hola, hace unos días que vengo con esta función que intenta listar los programas por defecto dedicados a una tares determinada.
Hice la función porque en algunas ocasiones cuando en gambas enviaba una orden de abrir un directorio sucedía otra cosa distinta a abrir el directorio en el gestor de archivos.
Así que les acerco la funcion por si tal vez les resulta de utilidad.
Para llamar la función hay dos parámetros que se le deben pasar, mas bien uno solo, el segundo es opcional pero en ocasiones es necesario si se desea filtrar aplicaciones que no pintan nada en el asunto.
Por ejemplo yo tenia que abrir un directorio en el gestor de archivos y aparecía EasyTag, el programa de edición de metadatos de los mp3.
Hice la función porque en algunas ocasiones cuando en gambas enviaba una orden de abrir un directorio sucedía otra cosa distinta a abrir el directorio en el gestor de archivos.
Así que les acerco la funcion por si tal vez les resulta de utilidad.
Código:
'' This function list all the .desktop applications in the directory /usr/share/applications which are asociated to al the mimetypes in the frirst argument and optionally is possible filter by category.
Static Public Function DeskApp2(aMimeType As String[], Optional aCategories As String[]) As DesktopFile[]
Dim oTemp As DesktopFile[]
Dim oDsk As New DesktopFile[]
Dim oDsk2 As New DesktopFile[]
Dim dsk As DesktopFile
Dim sDef As String
Dim ad As New String[]
Dim sMime As String
Dim sApps As String
Dim xapp As DesktopFile
Dim mk As String
Dim sKat As String
Dim sl As String
Dim sApp As String
If aMimeType.Count Then
For Each mk In aMimeType
oTemp = DesktopFile.FromMime(mk)
For Each dsk In oTemp
If aCategories.Count Then
For Each sKat In aCategories
If dsk.Categories.Exist(sKat) Then
oDsk.Add(dsk)
Break
Endif
Next
Else
Endif
Next
Next
Endif
Select Desktop.Type
Case "KDE"
sDef = User.Home &/ ".config/kde-mimeapps.list"
Case "LXQT"
sDef = User.Home &/ ".config/lxqt-mimeapps.list"
Case "GNOME", "MATE", "ENLIGHTENMENT", "WINDOWMAKER", "XFCE"
sDef = User.Home &/ ".config/mimeapps.list"
End Select
If Exist(sDef) Then
Select Stat(sDef).Type
Case gb.File, gb.Link
ad = Split(File.Load(sDef), "\n")
If ad.Count > 0 Then
For Each sl In ad
If InStr(sl, "=") > 0 Then
sMime = Split(sl, "=")[0]
sApps = Split(sl, "=")[1]
If InStr(sApps, ";") Then
For Each sApp In Split(sApps, ";")
If sApp <> "" Then
For Each xapp In oDsk
If File.Name(xapp.Path) = sApp Then
oDsk2.Add(xapp)
Endif
Next
Endif
Next
Endif
Endif
Next
Endif
End Select
For Each xapp In oDsk
If Not oDsk2.Exist(xapp) Then
oDsk2.Add(xapp)
Endif
Next
Else
oDsk2 = oDsk
Endif
Return oDsk2
EndPara llamar la función hay dos parámetros que se le deben pasar, mas bien uno solo, el segundo es opcional pero en ocasiones es necesario si se desea filtrar aplicaciones que no pintan nada en el asunto.
Por ejemplo yo tenia que abrir un directorio en el gestor de archivos y aparecía EasyTag, el programa de edición de metadatos de los mp3.
Código:
o = System.DeskApp2(["text/plain"], ["TextEditor"]) ' Con esto llamo la funcion, le paso los parametros en forma de 2 String[] y luego con la lista de objetos puedo obtener los datos
Print o[0].ProgramName
Print o[0].Name
Bienvenido, Invitado
Últimos temas
Ordenar en un TableView
Foro: GeneralÚltimo mensaje por: guizans, Ayer, 23:26
Respuestas: 4 - Vistas: 131
Odio a gb.Report
Foro: GeneralÚltimo mensaje por: guizans, 02-11-2025, 13:36
Respuestas: 9 - Vistas: 1,571
Reportes de Gambas
Foro: Aplicaciones/Fragmentos de CódigoÚltimo mensaje por: Alberto59, 27-10-2025, 16:34
Respuestas: 2 - Vistas: 1,336
FACTURA POR REPORT GAMBAS...
Foro: Aplicaciones/Fragmentos de CódigoÚltimo mensaje por: Alberto59, 27-10-2025, 15:03
Respuestas: 0 - Vistas: 88
Ordenando las carpetas
Foro: Programación en otros lenguajesÚltimo mensaje por: tercoide, 22-10-2025, 15:57
Respuestas: 0 - Vistas: 117