应该用哪个API读取一个bmp文件的数据
我想读取一个bmp文件的数据. 不想用控件. 想直接用API读取bmp的所有数据到一个数组中去. 应该用哪个API呢?
[解决办法]
那就直接用Open file For Binary as #1
再用Get去读
[解决办法]
给你一个简单的读取非压缩的bmp并显示的代码，以下直接存为form.frm就可以了，需要读取压缩格式bmp的，也不复杂，bmp的压缩只有rle方式一种，很容易解码。
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "BMPView "
ClientHeight = 2385
ClientLeft = 45
ClientTop = 330
ClientWidth = 5100
LinkTopic = "Form1 "
MaxButton = 0 'False
ScaleHeight = 159
ScaleMode = 3 'Pixel
ScaleWidth = 340
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdDown
Caption = "V "
Height = 375
Left = 1260
TabIndex = 6
Top = 1920
Width = 375
End
Begin VB.CommandButton cmdUp
Caption = "^ "
Height = 375
Left = 900
TabIndex = 5
Top = 1920
Width = 375
End
Begin VB.CommandButton cmdRight
Caption = "> "
Height = 375
Left = 480
TabIndex = 4
Top = 1920
Width = 375
End
Begin VB.CommandButton cmdLeft
Caption = " < "
Height = 375
Left = 120
TabIndex = 3
Top = 1920
Width = 375
End
Begin VB.CommandButton cmdView
Caption = "View "
Height = 495
Left = 900
TabIndex = 2
Top = 1380
Width = 735
End
Begin VB.CommandButton cmdOpen
Caption = "Open "
Height = 495
Left = 120
TabIndex = 1
Top = 1380
Width = 735
End
Begin VB.PictureBox picMain
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 1200
Left = 120
ScaleHeight = 78
ScaleMode = 3 'Pixel
ScaleWidth = 326
TabIndex = 0
Top = 120
Width = 4920
End
End
Attribute VB_Name = "frmMain "
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Dim mx As Integer, my As Integer
Private Sub cmdDown_Click()
my = my + 10
Call ViewMap(mx, my)
End Sub
Private Sub cmdLeft_Click()
mx = mx - 10
Call ViewMap(mx, my)
End Sub
[解决办法]
Command1(i).Picture = LoadPicture(App.Path & "\images\run.bmp ")
[解决办法]
GetDibBits
[解决办法]
使用GetDibBits要先定义与bmp图象结构对应的结构体,分图象头,颜色表和调色板(24位位图除外),然后使用数组读出图象数据,具体方法可以查看API函数格式
[解决办法]
Option Explicit
'----------------------------------------------
'读２４位位图文件到内存数组
'调节亮度及RGB值
'作者：money
'E-Mail:2258773@163.com
'QQ:447191909
'----------------------------------------------
Dim bmpFile As BITMAPFILEHEADER
Dim bmpHead As BITMAPINFO
Dim mHdc As Long, mhDIB As Long
Dim p As Long, buff() As Byte
Dim bufLen As Long, w As Long, h As Long
'读BMP文件到数组
Private Sub OpenBMPFile(ByVal szfile As String)
DeleteObject mhDIB
DeleteDC mHdc
Open szfile For Binary As #1
Get #1, , bmpFile
Get #1, , bmpHead
bufLen = FileLen(szfile) - bmpFile.bfOffBits
ReDim buff(1 To bufLen)
Get #1, bmpFile.bfOffBits + 1, buff()
Close #1
mHdc = winapi.CreateCompatibleDC(0&)
Debug.Print mHdc
mhDIB = winapi.CreateDIBSection(mHdc, bmpHead, 0, ByVal VarPtr(p), 0, 0)
winapi.CopyMemory ByVal p, buff(1), UBound(buff())
Debug.Print mhDIB
winapi.SelectObject mHdc, mhDIB
winapi.StretchBlt Pic.hDC, 0, 0, w, h, mHdc, 0, 0, bmpHead.bmiHeader.biWidth, bmpHead.bmiHeader.biHeight, SRCCOPY
End Sub
Private Sub cmdOPEN_Click()
Dim szfile As String
With CommonDialog1
.Filter = ( "*.BMP|*.BMP ")
.ShowOpen
szfile = .FileName
End With
If Len(szfile) > 5 Then
OpenBMPFile szfile
Frame1.Enabled = True
End If
End Sub
Private Sub cmdSave_Click()
Dim szfile As String
With CommonDialog1
.Filter = ( "*.BMP|*.BMP ")
.ShowSave
szfile = .FileName
End With
If Len(szfile) > 5 Then
SaveBMPFile szfile
Frame1.Enabled = True
End If
End Sub
Private Sub Form_Load()
winapi.SetStretchBltMode Pic.hDC, 4
w = Pic.ScaleWidth
h = Pic.ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
winapi.DeleteObject mhDIB
winapi.DeleteDC mHdc
End Sub
Private Sub Pic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lColor As Long
lColor = Pic.Point(X, Y)
With Label9
.BackColor = lColor
.ForeColor = lColor Xor &HFFFFFF
.Caption = Str(lColor)
End With
End Sub
Private Sub Pic_Paint()
If mHdc <> 0 Then
winapi.StretchBlt Pic.hDC, 0, 0, w, h, mHdc, 0, 0, bmpHead.bmiHeader.biWidth, bmpHead.bmiHeader.biHeight, SRCCOPY
End If
End Sub
'亮度
Private Sub VS_Change()
Change_RGB VS.Value, VSr.Value, VSg.Value, VSb.Value
End Sub
'此涵数更改亮度，R,G,B。
Private Sub Change_RGB(ByVal Gary As Long, ByVal r As Long, ByVal g As Long, ByVal b As Long)
Dim i As Long, j As Long, l As Long
Dim m As Long, X As Long
Dim tmp() As Byte
Screen.MousePointer = 11
Label2.Caption = Str(Gary)
Label6.Caption = Str(r)
Label7.Caption = Str(g)
Label8.Caption = Str(b)
ReDim tmp(LBound(buff()) To UBound(buff()))
CopyMemory tmp(1), buff(1), UBound(buff())
m = 4 - (bmpHead.bmiHeader.biWidth Mod 4)
If m = 4 Then m = 0
For i = 1 To bmpHead.bmiHeader.biHeight
For j = 1 To bmpHead.bmiHeader.biWidth 'Step 3
'B
X = X + 1
Select Case (tmp(X) + b) + Gary
Case Is > 255
tmp(X) = 255
Case Is < 0
tmp(X) = 0
Case Else
tmp(X) = tmp(X) + b + Gary
End Select
'G
X = X + 1
Select Case (tmp(X) + g) + Gary
Case Is > 255
tmp(X) = 255
Case Is < 0
tmp(X) = 0
Case Else
tmp(X) = tmp(X) + g + Gary
End Select
'R
X = X + 1
Select Case (tmp(X) + r) + Gary
Case Is > 255
tmp(X) = 255
Case Is < 0
tmp(X) = 0
Case Else
tmp(X) = tmp(X) + r + Gary
End Select
Next
X = X + m
Next
winapi.CopyMemory ByVal p, tmp(1), UBound(buff())
Erase tmp()
winapi.StretchBlt Pic.hDC, 0, 0, w, h, mHdc, 0, 0, bmpHead.bmiHeader.biWidth, bmpHead.bmiHeader.biHeight, SRCCOPY
Screen.MousePointer = 0
End Sub
Private Sub VSb_Change()
Change_RGB VS.Value, VSr.Value, VSg.Value, VSb.Value
End Sub
Private Sub VSg_Change()
Change_RGB VS.Value, VSr.Value, VSg.Value, VSb.Value
End Sub
Private Sub VSr_Change()
Change_RGB VS.Value, VSr.Value, VSg.Value, VSb.Value
End Sub
Private Sub SaveBMPFile(ByVal szfile As String)
Dim hFile As Long
Dim tmp() As Byte
ReDim tmp(1 To UBound(buff()))
winapi.CopyMemory tmp(1), ByVal p, UBound(buff())
Open szfile For Binary As #2
Put #2, 1, bmpFile
Put #2, , bmpHead
Put #2, bmpFile.bfOffBits + 1, tmp()
Close
Erase tmp()
MsgBox "文件保存为： " & szfile, vbInformation, "保存完毕! "
End Sub
[解决办法]
我晕，上面的几位在搞竞赛么？
[解决办法]
//我晕，上面的几位在搞竞赛么？
呵呵,上面的貌似在竞赛:)
[解决办法]
来看热闹的
[解决办法]
lan po naing de guo jiao
[解决办法]
.......楼上的是什么输入法....?
[解决办法]
不明LZ在说什么
