Show 一个没有菜单的界面(ADP)

t小宝

界面布置紧凑合理，赞！
照片显示采用MSFORM2.0.Image控件，是否还要释放临时图片文件？

t小宝

回复 zhuyiwen 的帖子

朱总的代码好呀，我也曾用了类似的方法。
其实jpg图片数据也可用代码转换后，在ACCESS.image控件显示。

t小宝

回复 zhuyiwen 的帖子

1. 
   
2. 下面的代码从位图句柄获取位图数据
   
3. 
   
4. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
   
5. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
   
6. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
   
7. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
8. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
   
9. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
   
10. 
    
11. Private Type bitmap
    
12.     bmType As Long
    
13.     bmWidth As Long
    
14.     bmHeight As Long
    
15.     bmWidthBytes As Long
    
16.     bmPlanes As Integer
    
17.     bmBitsPixel As Integer
    
18.     bmBits As Long
    
19. End Type
    
20. 
    
21. Private Type BITMAPINFOHEADER
    
22.         biSize As Long
    
23.         biWidth As Long
    
24.         biHeight As Long
    
25.         biPlanes As Integer
    
26.         biBitCount As Integer
    
27.         biCompression As Long
    
28.         biSizeImage As Long
    
29.         biXPelsPerMeter As Long
    
30.         biYPelsPerMeter As Long
    
31.         biClrUsed As Long
    
32.         biClrImportant As Long
    
33. End Type
    
34. Private Type RGBQUAD
    
35.         rgbBlue As Byte
    
36.         rgbGreen As Byte
    
37.         rgbRed As Byte
    
38.         rgbReserved As Byte
    
39. End Type
    
40. 
    
41. Private Type BITMAPINFO
    
42.         bmiHeader As BITMAPINFOHEADER
    
43.         bmiColors As RGBQUAD
    
44. End Type
    
45. 
    
46. Private Const DIB_RGB_COLORS = 0
    
47. Private Const BI_RGB = 0&
    
48. 
    
49. Private Function GetPictureDataFromBitmap(hBitmap As Long, bPictureData() As Byte) As Boolean
    
50.     Dim bm As bitmap
    
51.     Dim bi24BitInfo As BITMAPINFO
    
52.     Dim hMemDc As Long
    
53.     Dim bBytes() As Byte
    
54. 
    
55.     GetObject hBitmap, Len(bm), bm
    
56.     With bi24BitInfo.bmiHeader
    
57.         .biWidth = bm.bmWidth
    
58.         .biHeight = bm.bmHeight
    
59.         .biBitCount = 24
    
60.         .biCompression = BI_RGB
    
61.         .biPlanes = 1
    
62.         .biSize = Len(bi24BitInfo.bmiHeader)
    
63.     End With
    
64.     ReDim bBytes(1 To ((bm.bmWidth * 3 + 3) \ 4) * 4 * bm.bmHeight) As Byte
    
65.     hMemDc = CreateCompatibleDC(0)
    
66.     GetDIBits hMemDc, hBitmap, 0, bm.bmHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    
67.    
    
68.     ReDim bPictureData(bi24BitInfo.bmiHeader.biSizeImage + 40)
    
69.     CopyMemory bPictureData(40), bBytes(1), bi24BitInfo.bmiHeader.biSizeImage
    
70.     CopyMemory bPictureData(0), bi24BitInfo.bmiHeader, 40
    
71. 
    
72.     DeleteDC hMemDc
    
73.     DeleteObject hBitmap
    
74. 
    
75. End Function

复制代码

6楼的代码可以获得StdPicture对象，此代码可将StdPicture对象转为access.image控件支持的位图数据，此代码结合6楼的代码如下使用即可：
Dim  bPictureData()  As  Byte
GetPictureDataFromBitmap  LoadPictureFromField(f).Handle,  bPictureData()
Me.Image1.PictureData = bPictureData()