Re: PostgreSQL + VB6 + Crystal Reports 8

Ahi va,..... este es el codigo que envio algun miembro de la lista y funciona perfectamente bien; espero les sirva algual que ami

************************************************************************************
Este es el sub de visual basic donde cargo la imagen usando un objeto
tipo Imagen edit. Les repito he cargado imagenes muy grandes en forma
muy rápida y para guardarlas es igual de facil y rápido:
lA ESTRUCTURA DE LA TABLA es:
CREATE TABLE "public"."imagenes" (
"id_estado" CHAR(2) DEFAULT 'SA'::bpchar NOT NULL,
"co_empresa" NUMERIC(6,0) NOT NULL,
"co_filial" NUMERIC(6,0) NOT NULL,
"co_activo" VARCHAR(60) NOT NULL,
"nb_imagen" VARCHAR(255) NOT NULL,
"id_usuario" VARCHAR(15) NOT NULL,
"imagen" "public"."lo",
"sq_serialcolum" SERIAL,
CONSTRAINT "imagenes_sq_serialcolum_key" UNIQUE("sq_serialcolum"),
CONSTRAINT "imagenes_fk_activos" FOREIGN KEY ("co_empresa",
"co_filial",
"co_activo")
REFERENCES "public"."activos"("co_empresa", "co_filial",
"nu_activo_fijo")
ON DELETE CASCADE
ON UPDATE CASCADE
NOT DEFERRABLE
) WITH OIDS;
CREATE INDEX "pk_imagenes" ON "public"."imagenes"
USING btree ("co_empresa", "co_filial", "co_activo", "sq_serialcolum");
El Sub que carga la imagen es este:

Private Sub Carga_Foto(codigo)
On Error GoTo ControlError
Dim chunk() As Byte
Dim fd As Integer
Dim flen As Long
Dim pat As String
Dim OUTPUT_FILE_PATH As String
pat = app.Path + "\imagenes\"
OUTPUT_FILE_PATH = pat & "foto.jpg"
picImagen.ClearDisplay
frmFichaActivos.MousePointer = vbHourglass
Select Case paso
Case "Fotografias"
StatusBar1.Panels(1).Text = "Cargando Fotografías...espere un
momento por favor"
stSQL = "select imagen from imagenes where "
stSQL = stSQL & " sq_serialcolum = " & codigo
Case "Factura"
StatusBar1.Panels(1).Text = "Cargando Factura...espere un momento
por favor"
stSQL = "select imagen from samafact where sq_serialcolum = " &
codigo
Case "Documentos"
StatusBar1.Panels(1).Text = "Cargando Documentos...espere un
momento
por favor"
stSQL = "select imagen from samaimdo where sq_serialcolum = " &
codigo
Case "Planos"
StatusBar1.Panels(1).Text = "Cargando Planos...espere un momento
por favor"
stSQL = "select imagen from samaplac where sq_serialcolum = " &
codigo
End Select
Call AbreRS(2, 1, RsGenerico, (stSQL))
If Not RsGenerico.EOF Then
flen = RsGenerico!imagen.ActualSize
fd = FreeFile
Open OUTPUT_FILE_PATH For Binary Access Write As fd
ReDim chunk(1 To flen)
chunk() = RsGenerico!imagen.GetChunk(flen)
Put fd, , chunk()
Close
picImagen.Enabled = True
picImagen.Image = OUTPUT_FILE_PATH
picImagen.Display
btnDelete.Enabled = True
btn_zoom_mas.Enabled = True
btn_zoom_menos.Enabled = True
btn_atributos.Enabled = True
btnImprimirImg.Enabled = True
Else
Set RsGenerico = Nothing
btnDelete.Enabled = False
btn_zoom_mas.Enabled = False
btn_zoom_menos.Enabled = False
btn_atributos.Enabled = False
btnImprimirImg.Enabled = False
End If
StatusBar1.Panels(1).Text = MSGLISTO
frmFichaActivos.MousePointer = vbDefault
Exit Sub
ControlError:
Select Case Err.Number
Case 55
Case Else
End Select
Resume
End Sub

El sub que guarda la imagen es este:
Private Sub btnOk_Click()
Dim chunk() As Byte
Dim fd As Integer
Dim flen As Long
Dim cmd As ADODB.Command
Dim co_empresa As ADODB.Parameter
Dim co_filial As ADODB.Parameter
Dim co_activo As ADODB.Parameter
Dim nb_imagen As ADODB.Parameter
Dim id_usuario As ADODB.Parameter
Dim imagen As ADODB.Parameter
INPUT_FILE_PATH = CommonDialog1.FileName
flagAgregar = True: flagBorrar = False
Set c = New oculta
c.InhabilitaSmart Me
btnAdd.Enabled = False
frmFichaActivos.MousePointer = vbHourglass
btnCancelar.Enabled = False
Set cmd = New ADODB.Command
cmd.ActiveConnection = BaseRemota
Select Case paso
Case "Fotografias"
StatusBar1.Panels(1).Text = "Guardando Fotografía... espere un
momento por favor"
cmd.CommandText = "insert into imagenes
(co_empresa,co_filial,co_activo, nb_imagen,id_usuario,imagen)
values ( ?,?,?,?,?,?)"
Case "Factura"
StatusBar1.Panels(1).Text = "Guardando Factura... espere un
momento
por favor"
cmd.CommandText = "insert into samafact
(co_empresa,co_filial,co_activo, nb_imagen,id_usuario,imagen)
values ( ?,?,?,?,?,?)"
Case "Documentos"
StatusBar1.Panels(1).Text = "Guardando Documentos... espere un
momento por favor"
cmd.CommandText = "insert into samaimdo
(co_empresa,co_filial,co_activo, nb_imagen,id_usuario,imagen)
values ( ?,?,?,?,?,?)"
Case "Planos"
StatusBar1.Panels(1).Text = "Guardando Planos... espere un momento
por favor"
cmd.CommandText = "insert into samaplac
(co_empresa,co_filial,co_activo, nb_imagen,id_usuario,imagen)
values ( ?,?,?,?,?,?)"
End Select
cmd.CommandType = adCmdText
Set co_empresa = cmd.CreateParameter("co_empresa", adInteger,
adParamInput) co_empresa.Value = UserCia
cmd.Parameters.Append co_empresa
Set co_filial = cmd.CreateParameter("co_filial", adInteger,
adParamInput) co_filial.Value = UserSede
cmd.Parameters.Append co_filial
Set co_activo = cmd.CreateParameter("co_activo", adLongVarChar,
adParamInput, 60)
co_activo.Value = Trim(txt_nu_activo_fijo.Text)
cmd.Parameters.Append co_activo
Set nb_imagen = cmd.CreateParameter("nb_imagen", adLongVarChar,
adParamInput, 60)
nb_imagen.Value = UCase(Trim(txt_nb_imagen.Text))
cmd.Parameters.Append nb_imagen
Set id_usuario = cmd.CreateParameter("id_usuario", adLongVarChar,
adParamInput, 25)
id_usuario.Value = UserID
cmd.Parameters.Append id_usuario
'
fd = FreeFile
Open INPUT_FILE_PATH For Binary Access Read As fd
flen = LOF(fd)
If flen = 0 Then
Close
MsgBox "error"
FlagErr = True
End
Else
FlagErr = False
End If
Set imagen = cmd.CreateParameter("imagen", _
adLongVarBinary, _
adParamInput, flen)
ReDim chunk(1 To flen)
Get fd, , chunk()
imagen.AppendChunk chunk()
cmd.Parameters.Append imagen
Set RsGenerico = cmd.Execute
Close
Call inserta_imagen
btnAdd.Enabled = True
Set RsGenerico = Nothing
frmFichaActivos.MousePointer = vbDefault
End Sub

*******************************************************************************************

Rotvic Celaya Rosas <torvictor1(at)gmail(dot)com> escribió: Yo estoy utilizando visual basic con postgres tambien, y me he encontrado con el mismo problema, les agradeceria me enviaran el codigo tambien, ando buscando rutinas en visual basic para el manejo de imagenes, pero en crystal se me dificulta un poco

---------------------------------

Correo Yahoo!
Comprueba qué es nuevo, aquí
http://correo.yahoo.es