VB6 code To Save Bitmap File as OLE Object in Access OLE Object Field

' Module Section
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Const MAX_PATH = 260
Public Const BLOCK_SIZE = 10000
'------------------------------------------------------------
' Image Retriving and filling functions
' Function Name : FillPhoto
'   Use : Retrive Stored Photos From Access Database
'   Stores Photos : In Temporary File
'   Parameters:
'   rstMain as Recordset : The Recordset that contains Photos
'   PFName as String : Name of the Field that has the Photo
'   SizeField : Name of the Field That contains size of Photo
'============================================================
' Sub Function Name: GetPhoto
'   Use : Store Photo from a file to Access database
'   Parameters:
'   fileName as String : Name of the File that contains Photo
'   rstMain as Recordset : recordset that has to be updated
'   FieldName as string : Name of the Image Field
'   SizeField :Name of the Size field that contains photo size
'-------------------------------------------------------------
Public Sub FillPhoto(rstMain As Recordset, PFName As String, SizeField As String, picEmp As Image)
On Error GoTo Handler
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
 
    'me.imgPhoto.Visible = False
    Screen.MousePointer = vbHourglass
    DoEvents
 
    ' Get a temporary file name.
    file_name = TemporaryFileName()
 
    ' Open the file.
    file_num = FreeFile
    Open file_name For Binary As #file_num
 
    ' Copy the data into the file.
    file_length = Val(rstMain(SizeField) & "")
    num_blocks = file_length / BLOCK_SIZE
    left_over = file_length Mod BLOCK_SIZE
 
    For block_num = 1 To num_blocks
        bytes() = rstMain(PFName).GetChunk(BLOCK_SIZE)
        Put #file_num, , bytes()
    Next block_num
 
    If left_over > 0 Then
        bytes() = rstMain(PFName).GetChunk(left_over)
        Put #file_num, , bytes()
    End If
 
    Close #file_num
    If file_length <> 0 Then picEmp.Picture = LoadPicture(file_name)
 
    Screen.MousePointer = vbDefault
Exit Sub
 
Handler:
    Debug.Print Err.Description
    Resume Next
End Sub
 
Public Sub GetPhoto(filename As String, rstMain As Recordset, SizeField As String, FieldName As String)
On Error GoTo Handler
Dim file_num As String
Dim file_length As Long
Dim bytes() As Byte
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
 
    file_num = FreeFile
    Open filename For Binary Access Read As #file_num
 
    file_length = LOF(file_num)
    If file_length > 0 Then
        num_blocks = file_length / BLOCK_SIZE
        left_over = file_length Mod BLOCK_SIZE
 
        rstMain(SizeField) = file_length
 
        ReDim bytes(BLOCK_SIZE)
        For block_num = 1 To num_blocks
            Get #file_num, , bytes()
            rstMain(FieldName).AppendChunk bytes()
        Next block_num
 
        If left_over > 0 Then
            ReDim bytes(left_over)
            Get #file_num, , bytes()
            rstMain(FieldName).AppendChunk bytes()
        End If
 
        'rstEmployee.Update
        Close #file_num
    End If
Exit Sub
 
Handler:
    MsgBox Err.Description
    Resume
   Debug.Print Err.Description
End Sub
 
Public Function TemporaryFileName() As String
Dim temp_path As String
Dim temp_file As String
Dim length As Long
 
    ' Get the temporary file path.
    temp_path = VBA.Space$(MAX_PATH)
    length = GetTempPath(MAX_PATH, temp_path)
    temp_path = Left$(temp_path, length)
 
    ' Get the file name.
    temp_file = VBA.Space$(MAX_PATH)
    GetTempFileName temp_path, "per", 0, temp_file
    TemporaryFileName = Left$(temp_file, InStr(temp_file, VBA.Chr$(0)) - 1)
End Function
 
Public Sub UnRGB(ByVal color As OLE_COLOR, ByRef R As Integer, ByRef G As Integer, ByRef b As Integer)
   b = color \ 65536
   G = (color \ 256) Mod 256
   R = color Mod 256
End Sub
 
Public Sub SetBrightness(ByVal pic1 As PictureBox, ByVal pic2 As PictureBox, ByVal brightness As Single)
Dim fraction As Single
Dim X As Integer
Dim Y As Integer
Dim R As Integer
Dim G As Integer
Dim b As Integer
 
    If brightness < 0 Then
        ' Darken.
        fraction = (100 + brightness) / 100
        For Y = 0 To pic1.ScaleHeight - 1
            For X = 0 To pic1.ScaleWidth - 1
                'DoEvents
                UnRGB pic1.Point(X, Y), R, G, b
                R = R * fraction
                G = G * fraction
                b = b * fraction
                pic2.PSet (X, Y), RGB(R, G, b)
            Next X
        Next Y
    Else
        ' Brighten.
        fraction = brightness / 100
        For Y = 0 To pic1.ScaleHeight - 1
            For X = 0 To pic1.ScaleWidth - 1
                'DoEvents
                UnRGB pic1.Point(X, Y), R, G, b
                R = R + (255 - R) * fraction
                G = G + (255 - G) * fraction
                b = b + (255 - b) * fraction
                pic2.PSet (X, Y), RGB(R, G, b)
            Next X
        Next Y
    End If
    pic2.Picture = pic2.Image
End Sub
                                              

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:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172: