viernes, 17 de abril de 2015

función de IDE gambas


De aquí en mas iré publicando mis análisis del código de la IDE gambas.
Sera algo asi como analisis del codigo de un experto por un novato jaja.
(tengan precaución con mis comentarios no me hago responsable de mis horrores)

' gambas class file

'by postapase

'conjunto de caracteres que no se pueden usar para un nombre de archivo
Private Const FILE_FORBIDDEN_CAR As String = "?*/~" 'declaracion de constante de tipo string

Public Sub Form_Open()
Me.Center 'centra el formulario
End

Public Function CheckFileName(sName As String, Optional sDir As String) As String
'esta función es parte de la ide de gambas 3.7 se encuentra en el modulo Project
'leer el post: http://novatocodegambas.blogspot.com/2014/05/juguemos-ser-benoit-minisini.html
'función compuesta por dos argumentos uno obligatorio que es sName y el otro opcional es decir no es obligatorio
'colocar el argumento. Esta función retorna un valor de tipo string
'partes de la función:
'Declaracion: Public Function CheckFileName
'Argumentos: (sName As String, Optional sDir As String)
'Dato que retorna o devuelve la función: As String
Dim iInd As Integer

If Not sName Then Goto VOID_NAME 'chequea si el nombre es nulo o vacio.
'salta de aqui a la Etiqueta VOID_NAME:

If String.Left$(sName) = "." Then 'chequea si el primer caracter del nombre empieza por punto
iInd = 1
Goto BAD_START 'salta de aqui a la Etiqueta BAD_START: si el if devuelve true
Endif

For iInd = 1 To String.Len(sName) 'recorre el nombre del archivo viendo si tiene un caracter ilegal

If InStr(FILE_FORBIDDEN_CAR, String.Mid$(sName, iInd, 1)) Then Goto BAD_CHAR
'salta de aqui a la Etiqueta BAD_CHAR: si el if devuelve true

Next

If Len(sDir) Then
'verifica si el archivo ya existe
If Exist(sDir &/ sName) Then Goto ALREADY_EXIST 'salta de aqui a la Etiqueta ALREADY_EXIST: si el if devuelve true
Endif

Return
'Nombre vacio"
VOID_NAME:

Return ("Please type a name.") '"Por favor, escriba un nombre."

BAD_CHAR:

Return ("This name contains a forbidden character:") & " [ " & String.Mid$(sName, iInd, 1) & " ]"
'"Este nombre contiene un carácter prohibido"

BAD_START:

Return ("The name cannot begins with a dot.") '"El nombre no puede empezar por un punto."

ALREADY_EXIST:

Return ("This name is already used. Choose another one.") '"Este nombre ya está en uso. Elija otra."

End

Public Sub Button1_Click()
' este codigo lo agregue yo para ver funcionando la funcion
Print File.Name(FileChooser1.SelectedPath)
Print FileChooser1.Dir
Print FileChooser1.SelectedPath

Message.Info(CheckFileName(File.Name(FileChooser1.SelectedPath), FileChooser1.Dir))
'muestra el mensaje con el string que retorno la funcion CheckFileName
'si sale un mensaje sin texto es que el nombre esta correcto.

End

Clase Printer








' gambas class file

'by postapase

Public Sub btnClear_Click()
TextArea1.Clear
End

Public Sub btnImprimir_Click()
Printer1.Print()
End

Public Sub Printer1_Draw()
Dim PRINT_MARGIN As Float = Paint.Width / Printer1.PaperWidth * 10
Dim Datos As String[]
Dim DatosAimprimir, Xlinea As String

Datos = Split(TextArea1.Text, gb.NewLine) 'separando cada linea por salto de linea del TextArea

For Each Xlinea In Datos
DatosAimprimir &= Trim$(Xlinea) & gb.CrLf 'agrego salto de linea entendible por la impresora
Next

Paint.DrawRichText(DatosAimprimir, PRINT_MARGIN, PRINT_MARGIN,,, Align.TopNormal)

End

Public Sub btnSalir_Click()
Me.Close
End

Public Sub Form_Open()
Me.Center
End

domingo, 12 de abril de 2015

Drag y Drop (Ej. 1)




' gambas class file

'by postapase

Public Sub Form_Open()
Me.Center
End

Public Sub Button1_Drop()
Button1.Picture = Picture[Drag.Data]
End

Public Sub Button2_MouseDrag()
If Mouse.Left Then
Button2.Drag("icon:/64/linux")
Endif
End

Public Sub Button3_MouseDrag()
If Mouse.Left Then
Button3.Drag("icon:/64/book")
Endif
End

Public Sub Button4_MouseDrag()
If Mouse.Left Then
Button4.Drag("icon:/64/gambas")
Endif
End

Public Sub Button5_MouseDrag()
If Mouse.Left Then
Button5.Drag("icon:/64/gnu")
Endif
End

Public Sub Button1_Click()
Button1.Picture = Null
End


Código fuente: ArrastrarYsoltar-0.0.1.tar.gz


Ejemplo 2:


' gambas class file

'by postapase

Public Sub Form_Open()
Me.Center
End

Public Sub Button1_Drop()
Button1.Picture = Drag.Data.Picture
End

Public Sub Button2_MouseDrag()
If Mouse.Left Then
Button2.Drag(Button2.Picture.Image)
Endif
End

Public Sub Button3_MouseDrag()
If Mouse.Left Then
Button3.Drag(Button3.Picture.Image)
Endif
End

Public Sub Button4_MouseDrag()
If Mouse.Left Then
Button4.Drag(Button4.Picture.Image)
Endif
End

Public Sub Button5_MouseDrag()
If Mouse.Left Then
Button5.Drag(Button5.Picture.Image)
Endif
End

Public Sub Button1_Click()
Button1.Picture = Null
End

martes, 7 de abril de 2015

InfoDataBasesSQL

 Programa para ver internamente las tablas maestras, las tablas creadas por el usuario, tablas tipo view y cualquier otro dato que contenga la base de datos SQLITE.



' gambas class file

'by postapase
'http://novatocodegambas.blogspot.com/
'http://tanteador-tenis-de-mesa.blogspot.com/

Public Conexion As Connection

Public RutaBD As String
Public NombreBD As String
Public NombreTabla As String


Public Sub Form_Open()
Me.Center
Me.y = 0
End

Public Sub btnAbrirDB_Click()

Dialog.Title = "Selecciona un archivo de base de datos (sqlite3)"

If Dialog.openfile() Then Return

RutaBD = File.Dir(Dialog.path)
NombreBD = File.Name(Dialog.path)
txtDirDB.Text = RutaBD & "/" & NombreBD
Me.Title = Application.Name & " - " & NombreBD
btnConectar.Enabled = True

End

Public Sub ListaTablasMaestras_Click()
Dim Xcampo As Field
Dim Xtabla As Table

ListaTablasCreadas.UnselectAll

NombreTabla = ListaTablasMaestras.Text

For Each Xtabla In Conexion.Tables
If Xtabla.Name = ListaTablasMaestras.Text Then
ListaCampos.Clear
For Each Xcampo In Xtabla.Fields
ListaCampos.Add(Xcampo.Name)
Next
Endif
Next

DataSource1.Connection = Conexion
DataSource1.Table = NombreTabla
DataSource1.Visible = True

End

Public Sub ListaTablasCreadas_Click()
Dim Xcampo As Field
Dim Xtabla As Table

ListaTablasMaestras.UnselectAll

NombreTabla = ListaTablasCreadas.Text

For Each Xtabla In Conexion.Tables
If Xtabla.Name = ListaTablasCreadas.Text Then
ListaCampos.Clear
For Each Xcampo In Xtabla.Fields
ListaCampos.Add(Xcampo.Name)
Next
Endif
Next

DataSource1.Connection = Conexion
DataSource1.Table = NombreTabla
DataSource1.Visible = True

End

Public Sub btnConectar_Click()
Dim Xtabla As Table

ListaTablasMaestras.Clear

Conexion = New Connection

Conexion.type = "sqlite"
Conexion.host = RutaBD
Conexion.name = NombreBD
Try Conexion.Open
If Error Then
Message.Error("El fichero elegido no es una base de datos sqlite")
txtDirDB.Clear
btnConectar.Enabled = False
Return
Else
btnDesconectar.Enabled = True
btnConectar.Enabled = False
btnAbrirDB.Enabled = False
DataSource1.Connection = Conexion

For Each Xtabla In Conexion.Tables
If Left$(Xtabla.Name, 7) = "sqlite_" Then
ListaTablasMaestras.Add(Xtabla.name)
Else
ListaTablasCreadas.Add(Xtabla.name)
Endif
Next
Endif

End

Public Sub btnDesconectar_Click()
If Conexion.Opened = True Then Conexion.Close
Limpiar()
btnAbrirDB.Enabled = True
End

Public Sub Form_Close()
If IsNull(Conexion) = False Then
If Conexion.Opened = True Then Conexion.Close
Endif
End

Public Sub Limpiar()
btnConectar.Enabled = True
btnDesconectar.Enabled = False
ListaTablasMaestras.Clear
ListaTablasCreadas.Clear
ListaCampos.Clear
DataSource1.Table = Null
DataSource1.Visible = False
End

Public Sub btnDesconectar2_Click()
TextArea1.Clear
TextArea1.SetFocus
End

El paquete fuente esta en el servidor farm de gambas.

Descargar base de datos sqlite de ejemplo: Cortes




sábado, 28 de marzo de 2015

ArmadoHTML

Buenas gente, aquí les traigo una pequeña idea que nos ayudara en el armado de reportes Html

solo hice lo básico pero este programa podría hacer cosas mas complejas.


' gambas class file

' by postapase

Public Sub Form_Open()
Me.Center
End

Public Sub Button1_Click()
Dim RutaArchivoX As String
Dim ArchivoX As File
Dim LineaX As String
Dim VariableX As String
Dim PrimeraLinea As Boolean = True

VariableX = txtVariable.Text & " &= "
Dialog.Path = User.Home
Dialog.Filter = ["*.html", "Documentos"]

If Dialog.OpenFile() Then Return

RutaArchivoX = Dialog.Path
txtRutaHtml.Text = Dialog.Path

ArchivoX = Open RutaArchivoX For Read

While Not Eof(ArchivoX)
Line Input #ArchivoX, LineaX

If PrimeraLinea = True Then
txtAcuerpo.Text &= txtVariable.Text & " = " & LineaX & gb.NewLine
PrimeraLinea = False
Else
txtAcuerpo.Text &= VariableX & LineaX & gb.NewLine
Endif

Wend

Close ArchivoX

End

Public Sub btnCopiar_Click()
txtAcuerpo.SelectAll
txtAcuerpo.Copy()
End

 Código fuente: http://www.gambas-es.org/download.php?id=555

lunes, 23 de marzo de 2015

TextLabel



La clase TextLabel nos permite usar texto enriquecido por medio de algunas etiquetas html.

TextLabel1.Text = "<b>Texto en negrita</b>"
TextLabel1.Text = "<i>Texto en cursiva</i>"
TextLabel1.Text = "<s>Texto tachado</s>
TextLabel1.Text = "<u>Texto subrayado</u>"

TextLabel1.Text = "<b>Texto en negrita y salto de linea</b><br>"


TextLabel1.Text = "<b><i>Texto en cursiva y en negrita</i></b>"




TextLabel1.Text = "<sub>Texto subindice</sub>Texto normal<sup>Texto superindice</sup>"

TextLabel1.Text = "<font color=\"green\">Texto de color verde</font><br>"
TextLabel1.Text &= "<font color=\"red\">Texto de color rojo</font><br>"
TextLabel1.Text &= "<font color=\"blue\">Texto de color azul</font>"



TextLabel1.Text = "<H1>Encabezado H1</H1><br><H2>Encabezado H2</H2><br><H3>Encabezado H3</H3>"


TextLabel1.Text &= "<big>Texto grande</big><br>"
TextLabel1.Text &= "<small>Texto pequeño</small><br>"
TextLabel1.Text &= "<big><big>Texto muy grande</big></big><br>"
TextLabel1.Text &= "<small><small>Texto muy pequeño</small></small><br>"

TextLabel1.Text = "<font color=\"green\">Texto de <font color=\"red\">" & VariableX & "</font> color verde</font><br>"

 TextLabel1.Text = "<b>Ultima modificación de la base de datos: <i><font color=\"red\">" & Now & "</font></i></b>"