-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathImagenesADO.bas
138 lines (128 loc) · 3.91 KB
/
ImagenesADO.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Attribute VB_Name = "ImagenesADO"
'------------------------------------------------------------------------------
' Código para grabar y leer imagenes en campos de bases ( 9/Abr/98)
' Adaptado para usarlo con ADO (11/Jul/01)
'
' Adaptado de un par de ejemplos de la ayuda de VB5
'
' ©Guillermo 'guille' Som, 1998-2001
'------------------------------------------------------------------------------
Option Explicit
Private nFile As Long
Private Chunk() As Byte
Private Const mBuffer As Long = 16384&
Public Sub LeerBinary(ADOField As ADODB.Field, unPicture As PictureBox)
' Leer la imagen del campo de la base y asignarlo al Picture
'--------------------------------------------
' Este procedimiento no es necesario usarlo
' si el Picture está ligado a un data control
'--------------------------------------------
Dim nChunks As Long
Dim nSize As Long
Dim Fragment As Long
Dim i As Long
'
' Se usa un fichero temporal para guardar la imagen
nFile = FreeFile
Open "pictemp" For Binary Access Write As nFile
'
' Calcular los trozos completos y el resto
nSize = ADOField.ActualSize
nChunks = Int(nSize / mBuffer)
Fragment = nSize Mod mBuffer
Chunk() = ADOField.GetChunk(Fragment)
Put nFile, , Chunk()
For i = 1 To nChunks
Chunk() = ADOField.GetChunk(mBuffer)
Put nFile, , Chunk()
Next
Close nFile
Erase Chunk
' Ahora se carga esa imagen en el control
unPicture.Picture = LoadPicture("pictemp")
' Ya no necesitamos el fichero, así que borrarlo
On Error Resume Next
If Len(Dir$("pictemp")) Then
Kill "pictemp"
End If
Err = 0
End Sub
Public Sub GuardarBinary(ADOField As ADODB.Field, unPicture As PictureBox)
' Guardar el contenido del Picture en el campo de la base
Dim i As Long
Dim Fragment As Long
Dim nSize As Long
Dim nChunks As Long
'
' Guardar el contenido del picture en un fichero temporal
SavePicture unPicture.Picture, "pictemp"
' Leer el fichero y guardarlo en el campo
nFile = FreeFile
Open "pictemp" For Binary Access Read As nFile
nSize = LOF(nFile) ' Longitud de los datos en el archivo
If nSize = 0 Then
Close nFile
Exit Sub
End If
'
' Calcular el número de trozos y el resto
nChunks = nSize \ mBuffer
Fragment = nSize Mod mBuffer
ReDim Chunk(Fragment)
'
Get nFile, , Chunk()
ADOField.AppendChunk Chunk()
ReDim Chunk(mBuffer)
For i = 1 To nChunks
Get nFile, , Chunk()
ADOField.AppendChunk Chunk()
Next i
Close nFile
'
' Ya no necesitamos el fichero, así que borrarlo
On Local Error Resume Next
If Len(Dir$("pictemp")) Then
Kill "pictemp"
End If
Err = 0
End Sub
Public Sub GuardarArchivo(ADOField As ADODB.Field, fichero As String)
' Guardar el contenido del Picture en el campo de la base
Dim i As Long
Dim Fragment As Long
Dim nSize As Long
Dim nChunks As Long
'
' Guardar el contenido del picture en un fichero temporal
'SavePicture unPicture.Picture, "pictemp"
' Leer el fichero y guardarlo en el campo
nFile = FreeFile
Open fichero For Binary Access Read As nFile
nSize = LOF(nFile) ' Longitud de los datos en el archivo
If nSize = 0 Then
Close nFile
Exit Sub
End If
'
' Calcular el número de trozos y el resto
nChunks = nSize \ mBuffer
Fragment = nSize Mod mBuffer
ReDim Chunk(Fragment)
'
Get nFile, , Chunk()
ADOField.AppendChunk Chunk()
ReDim Chunk(mBuffer)
For i = 1 To nChunks
Get nFile, , Chunk()
ADOField.AppendChunk Chunk()
Next i
Close nFile
'
' Ya no necesitamos el fichero, así que borrarlo
' On Local Error Resume Next
' If Len(Dir$("pictemp")) Then
' Kill "pictemp"
' End If
' Err = 0
End Sub