FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
|||
|
|||
Convertir de VB6 a Delphi7
Hola nececito realizar un proyecto con identificación de huella, destaco que hice algo modificando un poco un ejemplo, que encontre por ahi, pero es muy lento para la identificacion. Sin embargo en encontre un ejemplo desarrollado en VB6 el cual me paso los fuentes jonas@surinf.com este si realiza la identificación muy rapido, pero yo tengo todo el proyecto realizado en Delphi7 y solo me falta este modulo. por ello solicito la buena voluntad de alguno que me pueda ayudar a convertir este mini utilidad VB6 a Delphi7. puedo publicar el codigo o embiarlo a un mail. Gracias desde ya.
Este es el codigo VB Formulario Código:
Private Sub AreaGuardar_Change() ChecaGuardar End Sub Private Sub btn_Guardar_Click() Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset conn.CursorLocation = adUseClient conn.ConnectionString = dame_cadena_conexion conn.Open rs.Open "Select * from usuarios where 1=0", conn, adOpenStatic, adLockOptimistic 'Set Resultado = BD.OpenRecordset("SELECT * FROM usuarios") 'para usar el recordset con el with tienes que usar .Fields("nombre_campo") 'la otra manera de hacerlo es con rs!nombre_campo With rs ' Resultado .AddNew .Fields("nombre") = NombreGuardar .Fields("area") = AreaGuardar .Fields("huella1") = template(1).tpt .Fields("huella2") = template(2).tpt .Fields("fecha") = Now .Update End With rs.Close MsgBox "Huellas guardadas" Imagen(1).Picture = LoadPicture() Imagen(2).Picture = LoadPicture() NombreGuardar = "" AreaGuardar = "" Set rs = Nothing conn.Close Set conn = Nothing Imagen_Click 1 End Sub Private Sub Command1_Click() Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset conn.CursorLocation = adUseClient conn.ConnectionString = dame_cadena_conexion conn.Open rs.Open "truncate table usuarios", conn, adOpenStatic, adLockOptimistic 'BD.Execute "DELETE FROM usuarios" If rs.State = adStateOpen Then rs.Close End If Set rs = Nothing conn.Close Set conn = Nothing MsgBox "Ok" End Sub Private Sub Form_Load() Dim Error As Integer 'Set BD = OpenDatabase(App.Path & "\bd.mdb") Timer1.Enabled = True ' Inicializar Error = Inicializar(Form1) End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) On Error Resume Next 'BD.Close 'Set BD = Nothing End Sub Private Sub ChecaGuardar() If Imagen(1) <> 0 And Imagen(2) <> 0 And NombreGuardar <> "" And AreaGuardar <> "" Then btn_Guardar.Enabled = True Else btn_Guardar.Enabled = False End If End Sub Private Sub Imagen_Click(Index As Integer) ImagenNumero = Index If Index = 1 Then Shape1.Left = 250 Else Shape1.Left = 2530 End If End Sub Private Sub GrFingerXCtrl1_ImageAcquired(ByVal idSensor As String, ByVal width As Long, ByVal height As Long, rawImage As Variant, ByVal res As Long) ' Capturar Imagen (Este mensaje es muy raro que se vea. Si se muestra pero muy rapido) Mensajes = "Capturando imagen..." With raw .img = rawImage .height = height .width = width .res = res End With If OptionGuardar.Value = True Then CapturaHuella False, GR_DEFAULT_CONTEXT, Form1, Form1.Imagen(ImagenNumero), ImagenNumero If EncuentraPuntos(Form1, Mensajes, Imagen(ImagenNumero), ImagenNumero) = True Then ' Aqui entra si la Imagen se detecta bien If ImagenNumero = 1 Then Imagen_Click 2 Else Imagen_Click 1 End If End If ChecaGuardar End If If OptionVerificar.Value = True Then CapturaHuella False, GR_DEFAULT_CONTEXT, Form1, Form1.Imagen(3), 3 If EncuentraPuntos(Form1, Mensajes, Imagen(3), 3) = True Then ' El numero 3 es por el Template que es el numero 3 CambiaFoco Identificar(Form1, 3, Form1.NombreVerificar, Form1.AreaVerificar) End If End If End Sub Private Sub GrFingerXCtrl1_SensorPlug(ByVal idSensor As String) ' Inicializar la Captura del dispositivo GrFingerXCtrl1.CapStartCapture (idSensor) End Sub Private Sub GrFingerXCtrl1_SensorUnplug(ByVal idSensor As String) ' Finalizar la Captura del dispositivo GrFingerXCtrl1.CapStopCapture (idSensor) End Sub Private Sub GrFingerXCtrl1_FingerDown(ByVal idSensor As String) ' Aqui detecta cuando pones el dedo (Este mensaje es muy raro que se vea. Si se muestra pero muy rapido) Detector = "Huella detectada" End Sub Private Sub GrFingerXCtrl1_FingerUp(ByVal idSensor As String) ' Aqui detecta cuando quitas el dedo Detector = "Huella removida" End Sub Private Sub NombreGuardar_Change() ChecaGuardar End Sub Private Sub OptionGuardar_Click() OcultarFrames FrameGuardar.Visible = True End Sub Private Sub OcultarFrames() FrameGuardar.Visible = False FrameVerificar.Visible = False Detector = "" Mensajes = "" Imagen(1).Picture = LoadPicture() Imagen(2).Picture = LoadPicture() Imagen(3).Picture = LoadPicture() Imagen_Click 1 End Sub Private Sub OptionVerificar_Click() OcultarFrames FrameVerificar.Visible = True End Sub Private Sub CambiaFoco(Color As Integer) If Color = 1 Then Foco.BackColor = &HFF00& Else Foco.BackColor = &HFF& End If End Sub Private Sub Timer1_Timer() Text1.Text = Format(Now, "dd/MM/yyyy hh:mm:ss") End Sub Código:
'Public BD As Database 'Public Resultado As Recordset 'hay que recordar incluir una referencia a Microsoft ActiveX Data Objects 2.8 Library 'y bajar la última actualización de MDAC (Microsoft Data Access Components) de la web de microsoft 'así como tener instalado el driver ODBC de MYSQL Public Type rawImage img As Variant width As Long height As Long res As Long End Type Public Type TTemplate tpt() As Byte Size As Long End Type Public raw As rawImage Public template(3) As TTemplate Public Function dame_cadena_conexion() As String dame_cadena_conexion = "DRIVER={MySQL ODBC 3.51 Driver};" _ & "SERVER=127.0.0.1;" _ & "DATABASE=fingerprints;" _ & "UID=root;" _ & "PWD=12345678;" _ & "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 16384 'En SERVER el nombre o la IP Pública del servidor de datos 'Si usamos la misma máquina sería localhost o 127.0.0.1 'en DATABASE el nombre de la BASE DE DATOS 'en UID el nombre del usuario 'en PWD el password 'hay que dejar las opciones porque suele funcionar mejor End Function Public Function Identificar(Formulario As Form, Numero As Integer, Nombre As Label, Area As Label) As Integer On Error Resume Next Dim ret As Integer Dim tpt() As Byte Dim Cuantos As Integer Identificar = 0 ret = Formulario.GrFingerXCtrl1.IdentifyPrepare(template(Numero).tpt, GR_DEFAULT_CONTEXT) Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset conn.CursorLocation = adUseClient conn.ConnectionString = dame_cadena_conexion conn.Open rs.Open "Select * from usuarios", conn, adOpenStatic, adLockReadOnly ' Set Resultado = BD.OpenRecordset("SELECT * FROM usuarios") rs.MoveLast 'Resultado.MoveLast Cuantos = rs.RecordCount 'Resultado.RecordCount rs.MoveFirst ' Resultado.MoveFirst For i = 1 To Cuantos ' Revisar si es la Huella1 tpt = rs!huella1 'Resultado.Fields("huella1") ret = Formulario.GrFingerXCtrl1.Identify(tpt, 0, GR_DEFAULT_CONTEXT) If ret = GR_MATCH Then Nombre = rs!Nombre 'Resultado.Fields("nombre") Area = rs!Area 'Resultado.Fields("area") Identificar = 1 Exit Function Else ' Revisar si es la Huella2 tpt = rs!huella2 'Resultado.Fields("huella2") ret = Formulario.GrFingerXCtrl1.Identify(tpt, 0, GR_DEFAULT_CONTEXT) If ret = GR_MATCH Then Nombre = rs!Nombre 'Resultado.Fields("nombre") Area = rs!Area 'Resultado.Fields("area") Identificar = 1 Exit Function Else rs.MoveNext 'Resultado.MoveNext End If End If Next i rs.Close Set rs = Nothing conn.Close Set conn = Nothing Nombre = "" Area = "" End Function Public Function Inicializar(Formulario As Form) As Integer Err = Formulario.GrFingerXCtrl1.Initialize If Err < 0 Then Inicializar = Err Exit Function End If Inicializar = Formulario.GrFingerXCtrl1.CapInitialize End Function Public Sub CapturaHuella(ByVal biometricDisplay As Boolean, ByVal context As Integer, Formulario As Form, LaImagen As Image, Numero As Integer) Dim handle As IPictureDisp Dim ret As Integer If biometricDisplay Then Formulario.GrFingerXCtrl1.biometricDisplay template(Numero).tpt, raw.img, raw.width, raw.height, raw.res, Formulario.hDC, handle, context Else Formulario.GrFingerXCtrl1.CapRawImageToHandle raw.img, raw.width, raw.height, Formulario.hDC, handle End If If Not (handle Is Nothing) Then LaImagen.Picture = handle End If End Sub Public Function EncuentraPuntos(Formulario As Form, ControlMensajes As Label, LaImagen As Image, Numero As Integer) As Boolean Dim ret As Integer template(Numero).Size = GR_MAX_SIZE_TEMPLATE ReDim Preserve template(Numero).tpt(template(Numero).Size) ret = Formulario.GrFingerXCtrl1.Extract(raw.img, raw.width, raw.height, raw.res, template(Numero).tpt, template(Numero).Size, GR_DEFAULT_CONTEXT) If ret < 0 Then template(Numero).Size = 0 ReDim Preserve template(Numero).tpt(template(Numero).Size) If ret = GR_BAD_QUALITY Then ControlMensajes = "Huella detectada pero con baja calidad. Intentalo nuevamente" LaImagen.Picture = LoadPicture() ElseIf ret = GR_MEDIUM_QUALITY Then ControlMensajes = "Huella detectada con calidad mediana" ElseIf ret = GR_HIGH_QUALITY Then ControlMensajes = "Huella detectada con buena calidad" End If If ret >= 1 Then CapturaHuella True, GR_NO_CONTEXT, Formulario, LaImagen, Numero EncuentraPuntos = True Else EncuentraPuntos = False End If End Function Última edición por dec fecha: 05-01-2008 a las 19:59:25. |
#2
|
|||
|
|||
Destaco que yo uso en mi Delphi7 los componentes MiDAC para base de datos MySQL, en todo caso solo me intereza como convertir el codigo a Delphi7. Gracias
|
#3
|
|||
|
|||
Hola! solo comentarte que es bueno que el codigo lo envuelvas en las etiquetas delphi
para una facil lectura del mismo. En la barra de botones del editor de mensajes existe un icono con un aimagen color cafe simulando el partenon griego |
#4
|
|||
|
|||
Hola
Hay un programa llamado DeLux Converter que hace la conversión de visual basic a delphi entre otos. Pero siempre tendrás que hacer alguna parte en forma manual. Saludos |
#5
|
|||
|
|||
Hola
Gracias por tu respuesta, visite la página recomendada pero el problema es que como es de paga y el demo no genera archivos *.pas no puedo saber si realmente vale la pena adquirirlo ya que es elevado su costo para mi y además de no saber si realmente me sirva. seguire esperando si alguien del foro sabe como hacerlo sin tener que usar un programa. aclaro para los demás miembros que el codigo que publico es VB y es para ver si se puede trasladar a Delphi Gracias |
#6
|
||||
|
||||
Hola,
Creo que podrías ponerte con ello y consultar en el foro las dudas que te surgan. La tarea que te traes entre manos: traducir el código que has mostrado a Delphi, es demasiado extensa, en mi opinión, como para "pedirla" en los foros. Ponte con ello, y, si encuentras algún problema, aquí habrá quien pueda y quiera echarte una mano. Pero, de plano "pedir" que te traduzcan el código... tal vez ni sea posible, porque ese código hay que situarlo en su contexto, no es sólo traducirlo, hay que "comprobarlo", por decirlo así. En fin, esta es mi opinión. |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
donde puedo comprar libros en mexico, la biblia de delphi7 y mastering delphi7? | sakuragi | Varios | 30 | 12-02-2013 18:37:51 |
Convertir un Componente para Delphi5 en Delphi7 | Roll06lm | OOP | 4 | 28-11-2007 02:18:48 |
Quickreport con delphi7 | andresenlared | Varios | 7 | 27-04-2007 15:55:01 |
TMS y Delphi7 | Troffed | Varios | 3 | 24-05-2006 11:38:56 |
DUDA con Delphi7 | (VIH)Lestat | Conexión con bases de datos | 1 | 26-06-2005 02:25:59 |
|