(100分＋万分感谢)请问LoadPicture函数有没有替代方法。我在PB当中要用到LoadPicture，但是pb没有，有没有变通的方法

[yannankai]

picture1.picture = user_loadpicture('')

能达到这样的效果吗，我不知道VB当中的picture属性是个什么样的数据结构，我如何能得到类似的数据结构

[yannankai]

自已加把火吧！
如果没有解决方案，那位老大跟贴，那位老大就得分！

世道不行呀，快混不下去了！这种小case居然解决不了

[道素]

如果你自己做，你就要知道每种图形文件的格式
比如loadbmp文件
Option Explicit


Public Type BITMAPFILEHEADER
bfType As Integer 'must be 19778 = "BM"
bfSize As Long 'size of file in bytes LOF(%bf)
bfReserved1 As Integer 'Reserved must be set to zero
bfReserved2 As Integer 'Reserved must be set to zero
bfOffBits As Long 'the space between this struct and the begining of the actual bmp data
End Type

Public Type BITMAPINFOHEADER '40 bytes
biSize As Long 'Len(bmih)
biWidth As Long 'Width of Bitmap Image
biHeight As Long 'Height of Bitmap Image
biPlanes As Integer 'Number of Planes for Target Device,must be set to 1
biBitCount As Integer 'Number of Bits Per Pixel must be either:1(Monochrome),4(16clrs),8(256color),24(RGBQUADS=16777216 colors)
biCompression As Long 'Compression Modes can be either:BI_bitfields,BI_JPEG,BI_PNG,BI_RLE4,BI_RLE8
biSizeImage As Long 'Size in bytes of image,can be set to zero if biCompression = BI_RGB
biXPelsPerMeter As Long 'Horizonal Resolution in Pixels Per Meter
biYPelsPerMeter As Long 'Vertical Resolution in Pixels Per Meter
biClrUsed As Long 'the number of colors used by bitmap if its 0 then all colors are used
biClrImportant As Long 'the number of colors required to display this bitmap if its 0 then their all required
End Type

Public Type RGBTRIBLE
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
End Type

Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbUnused As Byte
End Type

Public Const BI_bitfields = 3& 'UNKNOWN
Public Const BI_JPEG = 4& 'UNKNOWN
Public Const BI_PNG = 5& 'UNKNOWN
Public Const BI_RGB = 0& '(uncompressed) THIS IS THE ONLY ONE SUPPORTED IN THIS MODULE
Public Const BI_RLE4 = 2& 'RLE RunLength Compression per 4bits(1/2 byte)
Public Const BI_RLE8 = 1& 'RLE RunLength Compression per 8bits(1bytes)

'1) BITMAPFILEHEADER (bmfh)
'2) BITMAPINFOHEADER (bmih)
'3) RGBQUAD aColors()
'4) BYTE aBitmapBits()
'
'bmfh,bmih,acolors,abitmapbits
Dim bmfh As BITMAPFILEHEADER
Dim bmih As BITMAPINFOHEADER
Dim aColors() As RGBTRIBLE
'Dim aColors() as RGBQUAD
Dim aBitmapBits() As Byte



Function Decompress16ColorImageData(bIn() As Byte, bRet() As Byte)

Dim I&
Dim strData$
Dim strByte$
For I = LBound(bIn) To UBound(bIn)
strByte = Hex(bIn(I))
If Len(strByte) < 2 Then strByte = "0" & strByte
strData = strData & strByte
Next
Debug.Print strData
On Error Resume Next
For I = 1 To Len(strData)
Debug.Print "COUNT " & I
ReDim Preserve bRet(1 To I)
bRet(I) = CByte("&H" & (Mid(strData, I, 1)))
Next
End Function

Function LoadBitmapImage(strPath$, picOut As PictureBox)

Dim F%
F = FreeFile
Dim cy&, cx&
Dim c&
Dim aClrTable() As RGBQUAD
Open strPath For Binary Access Read As F
Get F, , bmfh
Get F, , bmih
Select Case bmih.biBitCount
Case 1 '1bit per pixel, 8pixels per byte

'MONOCHROME, that means 8pixels per
'byte (1bit per pixel)
'we CAN load this format
'but it will be real slow
'considering that its already slow to load
'any bitmap usin VB's PSet
'
Case 4 '4bits per pixel, 2 pixel per byte

'16 Color bitmaps
'thats a little faster i guess
'since u can use the Hex$ function to parse every byte
Dim bData() As Byte
ReDim aClrTable(0 To 15) As RGBQUAD
Get F, , aClrTable
ReDim Preserve bData(1 To (bmih.biWidth / 2) * bmih.biHeight)
Get F, , bData
Decompress16ColorImageData bData, aBitmapBits
For cy = bmih.biHeight To 1 Step -1
For cx = 1 To bmih.biWidth
c = c + 1
With aClrTable(aBitmapBits(c))
picOut.PSet (cx, cy), RGB(.rgbRed, .rgbGreen, .rgbBlue)
End With
Next
Next
picOut.Refresh



Case 8 '8bits(1byte) per pixel,1 pixel per byte
'256 GrayScale/Colors
ReDim aClrTable(0 To 255) As RGBQUAD
' ReDim Preserve aColors(0 To 255) As RGBTRIBLE
Get F, , aClrTable
ReDim Preserve aBitmapBits(1 To (bmih.biWidth * bmih.biHeight))
Get F, , aBitmapBits
For cy = bmih.biHeight To 1 Step -1
For cx = 1 To bmih.biWidth
c = c + 1
With aClrTable(aBitmapBits(c))
picOut.PSet (cx, cy), RGB(.rgbRed, .rgbGreen, .rgbBlue)
End With
Next
Next
picOut.Refresh

Case 24 '3bytes per pixel,no color table is used, 1 pixel per RGBQUAD structure
Seek F, bmfh.bfOffBits + 1
picOut.AutoRedraw = True
ReDim Preserve aColors(1 To (bmih.biWidth * bmih.biHeight)) As RGBTRIBLE
Get F, , aColors
For cy = bmih.biHeight To 1 Step -1
For cx = 1 To bmih.biWidth
c = c + 1
picOut.PSet (cx, cy), RGB(aColors(c).rgbRed, aColors(c).rgbGreen, aColors(c).rgbBlue)
Next
Next
picOut.Refresh
End Select
Close F
End Function

[道素]

如果是gif
Function IsGIF(Filename As String) As Boolean
On Error Resume Next
Dim GifTest As String * 3
Open Filename For Binary Access Read As #1
Get #1, , GifTest
If UCase(GifTest) <> "GIF" Then IsGIF = False Else IsGIF = True
Close #1
End Function
Sub LoadGIF(Filename As String, ByRef pImage As ImageFile, ByRef pBox As PictureBox)
pBox.ScaleMode = vbPixels
pBox.AutoSize = True
pBox.Picture = LoadPicture(Filename)
Dim bmi As BITMAPINFO
pImage.ImageWidth = pBox.ScaleWidth 'Store our Image Width
pImage.ImageHeight = pBox.ScaleHeight 'Store Our Image Height
pImage.ImageBPP = 24 'Store our Image Bits Per Pixel Value.
'Setup our Bitmap Info Header (see LoadCustomImage)
bmi.bmiHeader.biSize = 40
bmi.bmiHeader.biWidth = pImage.ImageWidth
bmi.bmiHeader.biHeight = pImage.ImageHeight
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = pImage.ImageBPP
bmi.bmiHeader.biCompression = 0
ReDim pImage.ImageData(1 To (pImage.ImageWidth * pImage.ImageHeight) * 3) As Byte
'Get the dib bits, and store them in our data array.
GetDIBits pBox.hdc, pBox.Image, 0, pBox.ScaleHeight, pImage.ImageData(1), bmi, DIB_RGB_COLORS
'Now Flip the Image because getdibbits reads from the bottom up.
FlipImage pImage
End Sub

( ">
)(
// )
shannon--//""--
-/[e-mail]

[道素]

jpg文件

Private Function Read32(filenumber) As Long
Dim b1 As Byte, b0 As Byte, b2 As Byte, b3 As Byte
Get #filenumber, , b3
Get #filenumber, , b2
Get #filenumber, , b1
Get #filenumber, , b0
Read32 = LShift(b3, 24) + LShift(b2, 16) + LShift(b1, 8) + b0
End Function
Private Function Read16(filenumber) As Long
Dim b1 As Byte, b0 As Byte
Get #filenumber, , b1
Get #filenumber, , b0
Read16 = b0 + LShift(b1, 8)
End Function
Function IsJPEG(Filename As String) As Boolean
On Error Resume Next
Open Filename For Binary Access Read As #1
Read32 1
Read16 1
If Read32(1) <> 1246120262 Then IsJPEG = False Else IsJPEG = True
Close #1
End Function
Sub LoadJPEG(Filename As String, ByRef pImage As ImageFile, ByRef pBox As PictureBox)
pBox.ScaleMode = vbPixels
pBox.AutoSize = True
pBox.Picture = LoadPicture(Filename)
Dim bmi As BITMAPINFO
pImage.ImageWidth = pBox.ScaleWidth 'Store our Image Width
pImage.ImageHeight = pBox.ScaleHeight 'Store Our Image Height
pImage.ImageBPP = 24 'Store our Image Bits Per Pixel Value.
'Setup our Bitmap Info Header (see LoadCustomImage)
bmi.bmiHeader.biSize = 40
bmi.bmiHeader.biWidth = pImage.ImageWidth
bmi.bmiHeader.biHeight = pImage.ImageHeight
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = pImage.ImageBPP
bmi.bmiHeader.biCompression = 0
ReDim pImage.ImageData(1 To (pImage.ImageWidth * pImage.ImageHeight) * 3) As Byte
'Get the dib bits, and store them in our data array.
GetDIBits pBox.hdc, pBox.Image, 0, pBox.ScaleHeight, pImage.ImageData(1), bmi, DIB_RGB_COLORS
'Now Flip the Image because getdibbits reads from the bottom up.
FlipImage pImage
End Sub

( ">
)(
// )
shannon--//""--
-/[e-mail]

[qiangsheng]

走入歧途了，你应该查找PB里有关图像的函数，到VB版问只能让你越来越困惑。

[yannankai]

ch21st(风尘鸟)
真让我伤心，这个家伙水平这么高，什么时候我才能到他的水平呀