| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1341 人关注过本帖
标题:为什么错误怎么改
只看楼主 加入收藏
冷淡的柔情
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2016-12-17
结帖率:0
收藏
已结贴  问题点数:20 回复次数:1 
为什么错误怎么改
Option Explicit '用于在文件级强制对该文件中的所有变量进行显式声明.

Private Sub Command1_Click()
    Dim Bmpfile As String
    Dim BMP文件 As BMP文件类型
    Dim PIC As PictureBox
    Print openbmp(Bmpfile, BMP文件)
    Print viewbmp(BMP文件, PIC)
End Sub

'当 Option Explicit 出现在文件中时,必须使用 Dim、Private、Public 或 ReDim 语句显式声明所有变量。
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
    Text1.Text = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
    Text1.Text = File1.FileName
End Sub
Private Sub Command2_Click()
PIC.Picture = LoadPicture(Text1.Text)
End Sub

'Bmp公用函数
'BMP压缩类型,
'Public Const BI_RGB = 0     '非压缩
'Public Const BI_RLE8 = 1
'Public Const BI_RLE4 = 2
以上窗体程序Public Type BMP文件头结构类型
    文件类型标识 As String * 2      '二字节长,只能为BM
    文件长度 As Long                '文件长度,4字节
    保留字1 As Integer              '系统保留,2字节,只能为0
    保留字2 As Integer              '系统保留,2字节,只能为0
    数据起始位置 As Long            '数据起始位置,相对数据头
End Type
   
   
Public Type BMP文件颜色表类型
    蓝 As Byte
    绿 As Byte
    红 As Byte
    保留 As Byte
End Type
   
Public Type BMP文件位图信息头类型
    本结构长度 As Long              '本结构的长度,包含颜色表的
    图像宽 As Long                  '图像宽
    图像高 As Long                  '图像高
    目标设备级别 As Integer         '目标设备级别,只能为1
    色彩位数 As Integer             '每像素色彩位数,只能为1(双色),4(16色),8(256色),24(真彩) 四种
    压缩 As Long                    '是否是压缩的,必须是 0(不压缩), 1(BI_RLE8压缩类型)或2(BI_RLE4压缩类型)之一
    位图大小 As Long                '位图数据区的大小
    位图水平分辨率 As Long          '位图水平分辨率,每米像素数,好像可以为零
    位图垂直分辨率 As Long          '位图垂直分辨率,每米像素数,好像可以为零
    使用的颜色数 As Long            '位图实际使用的颜色表中的颜色数
    重要的颜色数 As Long            '位图显示过程中重要的颜色数
'    颜色表() as BMP文件颜色表类型   '颜色表,=色彩位数^2 ,色彩位数为24时,无颜色表
End Type

Public Type BMP扫描行类型
    X() As Byte
    空() As Byte
End Type

Public Type BMP文件类型
    文件标识 As BMP文件头结构类型
    位图信息 As BMP文件位图信息头类型
    颜色表() As BMP文件颜色表类型   '颜色表,=色彩位数^2 ,色彩位数为24时,无颜色表
    数据() As BMP扫描行类型         '位图数据,合并为每个像素一个long值
End Type


'BitCount=1时,8个像素占1个字节;
'BitCount=4时,2个像素占1个字节;
'BitCount=8时,1个像素占1个字节;
'BitCount=24时,1个像素占3个字节;
'规定一个扫描行所占的字节数必须是4的倍数(即以long为单位),不足的以0填充,
'一个扫描行所占的字节数计算方法:DataSizePerLine= (biWidth* biBitCount+31)/8;
' 一个扫描行所占的字节数DataSizePerLine= DataSizePerLine/4*4; // 字节数必须是4的倍数
'位图数据的大小(不压缩情况下):DataSize= DataSizePerLine* biHeight;
Public Function openbmp(Bmpfile As String, ByRef BMP文件 As BMP文件类型) As Integer
'打开BMP文件,读取数据
If Dir(Bmpfile) <> "" Then
Dim fj As Long
Dim i As Long
Dim colortmp() As Long
Dim 扫描行 As Long, 保留 As Long
With BMP文件
    fj = FreeFile()
    Open Bmpfile For Binary As #fj
        Get #fj, , .文件标识        '读文件标识
        If .文件标识.文件类型标识 = "BM" Then   '是BMP文件否
            Get #fj, , .位图信息
                ReDim .数据(.位图信息.图像高 - 1)
               
                扫描行 = (.位图信息.图像宽 * .位图信息.色彩位数) / 8
                保留 = 4 - (扫描行 Mod 4)
                For i = 0 To .位图信息.图像高 - 1
                    ReDim .数据(i).X(扫描行 - 1)
                    If 保留 > 0 And 保留 < 4 Then
                        ReDim .数据(i).空(保留 - 1)
                    End If
                Next i
            
                Select Case .位图信息.色彩位数
                    Case 1                  '2色图片
                        ReDim .颜色表(1)        '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                    Case 4                  '16色图片
                        ReDim .颜色表(15)       '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                    Case 8                  '256色图片
                        ReDim .颜色表(255)      '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                        
                    Case 24                  '真彩图片,无颜色表
                        'i = (.位图信息.图像宽 - 1) * (.位图信息.图像高 - 1)
                        'ReDim .数据(i)
                        'ReDim .数据(.位图信息.图像宽, .位图信息.图像高, 2)
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                End Select
            
        Else        '文件标识不对,打开失败
            openbmp = -2
        End If
    Close #fj
End With
Else    '文件不存在,打开失败
    openbmp = -1
End If
End Function
Public Function viewbmp(BMP文件 As BMP文件类型, PIC As PictureBox) As Integer

Dim i As Long, j As Long, k As Long, n As Byte
Dim i1 As Integer, i2 As Integer
Dim ycon() As Long


With BMP文件
PIC.Cls
If .位图信息.色彩位数 < 24 Then
    i1 = .位图信息.色彩位数 ^ 2
    ReDim ycon(i1)
    For i = 0 To i1
        ycon(i) = RGB(.颜色表(i).红, .颜色表(i).绿, .颜色表(i).蓝)
    Next i
End If
For i = 0 To .位图信息.图像高 - 1
'    For j = 1 To .位图信息.图像高
        Select Case .位图信息.色彩位数
        Case 1
            For j = 0 To (.位图信息.图像宽 / 8)
                For k = 0 To 7
                    n = 2 ^ (7 - k)
                    If j * 8 + k < .位图信息.图像宽 Then
                        i1 = .数据(i).X(j) And n / n        '第n位
                        PIC.PSet (j * 8 + k, .位图信息.图像高 - i), ycon(i1)
                    End If
                Next k
            Next j
        
        Case 4
            For j = 0 To (.位图信息.图像宽 / 2) - 1
                i1 = .数据(i).X(j) \ 16        '高位
                i2 = .数据(i).X(j) Mod 16      '低位
                PIC.PSet (j * 2, .位图信息.图像高 - i), ycon(i1)
                PIC.PSet (j * 2 + 1, .位图信息.图像高 - i), ycon(i2)
            Next j
            If j * 2 < .位图信息.图像宽 Then        '还少了一点
                i1 = .数据(i).X(j) \ 16        '高位
                PIC.PSet (j * 2, .位图信息.图像高 - i), ycon(i1)
            End If
        
        Case 8
            For j = 0 To .位图信息.图像宽 - 1
                PIC.PSet (j, .位图信息.图像高 - i), ycon(.数据(i).X(j))
            Next j
        
        Case 24
            For j = 0 To .位图信息.图像宽 - 1
                PIC.PSet (j, .位图信息.图像高 - i), RGB(.数据(i).X(j * 3 + 2), .数据(i).X(j * 3 + 1), .数据(i).X(j * 3 + 0))
            Next j
'    Next j
        End Select
Next i
End With
End Function
为什么显示变量或with未定义或者pic.cls那错误
2016-12-17 21:55
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
收藏
得分:20 
有几处错误:
1、无法正确获取文件名,应加句Bmpfile= File1.Path & "\" & File1.FileName
2、估计你在窗口里添加了名称为Pic的控件,你在Command1_Click事件又重复定义了Dim PIC As PictureBox。
3、应该进行文件过滤,加句File1.Pattern = "*.bmp",让文件控件只显示bmp文件

修改后的代码已验证,是进行图片缩小操作,全部代码如下:
程序代码:
'模块Module1的代码
'Bmp公用函数
'BMP压缩类型,
'Public Const BI_RGB = 0     '非压缩
'Public Const BI_RLE8 = 1
'Public Const BI_RLE4 = 2以上窗体程序
Public Type BMP文件头结构类型
    文件类型标识 As String * 2      '二字节长,只能为BM
    文件长度 As Long                '文件长度,4字节
    保留字1 As Integer              '系统保留,2字节,只能为0
    保留字2 As Integer              '系统保留,2字节,只能为0
    数据起始位置 As Long            '数据起始位置,相对数据头
End Type
    
    
Public Type BMP文件颜色表类型
    蓝 As Byte
    绿 As Byte
    红 As Byte
    保留 As Byte
End Type
    
Public Type BMP文件位图信息头类型
    本结构长度 As Long              '本结构的长度,包含颜色表的
    图像宽 As Long                  '图像宽
    图像高 As Long                  '图像高
    目标设备级别 As Integer         '目标设备级别,只能为1
    色彩位数 As Integer             '每像素色彩位数,只能为1(双色),4(16色),8(256色),24(真彩) 四种
    压缩 As Long                    '是否是压缩的,必须是 0(不压缩), 1(BI_RLE8压缩类型)或2(BI_RLE4压缩类型)之一
    位图大小 As Long                '位图数据区的大小
    位图水平分辨率 As Long          '位图水平分辨率,每米像素数,好像可以为零
    位图垂直分辨率 As Long          '位图垂直分辨率,每米像素数,好像可以为零
    使用的颜色数 As Long            '位图实际使用的颜色表中的颜色数
    重要的颜色数 As Long            '位图显示过程中重要的颜色数
'    颜色表() as BMP文件颜色表类型   '颜色表,=色彩位数^2 ,色彩位数为24时,无颜色表
End Type

Public Type BMP扫描行类型
    X() As Byte
    空() As Byte
End Type

Public Type BMP文件类型
    文件标识 As BMP文件头结构类型
    位图信息 As BMP文件位图信息头类型
    颜色表() As BMP文件颜色表类型   '颜色表,=色彩位数^2 ,色彩位数为24时,无颜色表
    数据() As BMP扫描行类型         '位图数据,合并为每个像素一个long值
End Type


'BitCount=1时,8个像素占1个字节;
'BitCount=4时,2个像素占1个字节;
'BitCount=8时,1个像素占1个字节;
'BitCount=24时,1个像素占3个字节;
'规定一个扫描行所占的字节数必须是4的倍数(即以long为单位),不足的以0填充,
'一个扫描行所占的字节数计算方法:DataSizePerLine= (biWidth* biBitCount+31)/8;
' 一个扫描行所占的字节数DataSizePerLine= DataSizePerLine/4*4; // 字节数必须是4的倍数
'位图数据的大小(不压缩情况下):DataSize= DataSizePerLine* biHeight;
Public Function openbmp(Bmpfile As String, ByRef BMP文件 As BMP文件类型) As Integer
'打开BMP文件,读取数据
If Dir(Bmpfile) <> "" Then
Dim fj As Long
Dim i As Long
Dim colortmp() As Long
Dim 扫描行 As Long, 保留 As Long
With BMP文件
    fj = FreeFile()
    Open Bmpfile For Binary As #fj
        Get #fj, , .文件标识        '读文件标识
        If .文件标识.文件类型标识 = "BM" Then   '是BMP文件否
            Get #fj, , .位图信息
                ReDim .数据(.位图信息.图像高 - 1)
                
                扫描行 = (.位图信息.图像宽 * .位图信息.色彩位数) / 8
                保留 = 4 - (扫描行 Mod 4)
                For i = 0 To .位图信息.图像高 - 1
                    ReDim .数据(i).X(扫描行 - 1)
                    If 保留 > 0 And 保留 < 4 Then
                        ReDim .数据(i).空(保留 - 1)
                    End If
                Next i
            
                Select Case .位图信息.色彩位数
                    Case 1                  '2色图片
                        ReDim .颜色表(1)        '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                    Case 4                  '16色图片
                        ReDim .颜色表(15)       '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                    Case 8                  '256色图片
                        ReDim .颜色表(255)      '初始化颜色表数据
                        Get #fj, , .颜色表      '读颜色表
                        
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                        
                    Case 24                  '真彩图片,无颜色表
                        'i = (.位图信息.图像宽 - 1) * (.位图信息.图像高 - 1)
                        'ReDim .数据(i)
                        'ReDim .数据(.位图信息.图像宽, .位图信息.图像高, 2)
                        For i = 0 To .位图信息.图像高 - 1
                            Get #fj, , .数据(i).X
                            Get #fj, , .数据(i).空
                        Next i
                End Select
            
        Else        '文件标识不对,打开失败
            openbmp = -2
        End If
    Close #fj
End With
Else    '文件不存在,打开失败
    openbmp = -1
End If
End Function
Public Function viewbmp(BMP文件 As BMP文件类型, Pic As PictureBox) As Integer

Dim i As Long, j As Long, k As Long, n As Byte
Dim i1 As Integer, i2 As Integer
Dim ycon() As Long


With BMP文件
Pic.Cls
If .位图信息.色彩位数 < 24 Then
    i1 = .位图信息.色彩位数 ^ 2
    ReDim ycon(i1)
    For i = 0 To i1
        ycon(i) = RGB(.颜色表(i).红, .颜色表(i).绿, .颜色表(i).蓝)
    Next i
End If
For i = 0 To .位图信息.图像高 - 1
'    For j = 1 To .位图信息.图像高
        Select Case .位图信息.色彩位数
        Case 1
            For j = 0 To (.位图信息.图像宽 / 8)
                For k = 0 To 7
                    n = 2 ^ (7 - k)
                    If j * 8 + k < .位图信息.图像宽 Then
                        i1 = .数据(i).X(j) And n / n        '第n位
                        Pic.PSet (j * 8 + k, .位图信息.图像高 - i), ycon(i1)
                    End If
                Next k
            Next j
        
        Case 4
            For j = 0 To (.位图信息.图像宽 / 2) - 1
                i1 = .数据(i).X(j) \ 16        '高位
                i2 = .数据(i).X(j) Mod 16      '低位
                Pic.PSet (j * 2, .位图信息.图像高 - i), ycon(i1)
                Pic.PSet (j * 2 + 1, .位图信息.图像高 - i), ycon(i2)
            Next j
            If j * 2 < .位图信息.图像宽 Then        '还少了一点
                i1 = .数据(i).X(j) \ 16        '高位
                Pic.PSet (j * 2, .位图信息.图像高 - i), ycon(i1)
            End If
        
        Case 8
            For j = 0 To .位图信息.图像宽 - 1
                Pic.PSet (j, .位图信息.图像高 - i), ycon(.数据(i).X(j))
            Next j
        
        Case 24
            For j = 0 To .位图信息.图像宽 - 1
                Pic.PSet (j, .位图信息.图像高 - i), RGB(.数据(i).X(j * 3 + 2), .数据(i).X(j * 3 + 1), .数据(i).X(j * 3 + 0))
            Next j
'    Next j
        End Select
Next i
End With
End Function


程序代码:
Option Explicit '用于在文件级强制对该文件中的所有变量进行显式声明.
'窗体部分代码,窗体里添加两个command控件,一个text控件,一个名为pic的picturebox控件,文件类控件各一
Private Sub Command1_Click()
    Dim Bmpfile As String
    Dim BMP文件 As BMP文件类型
    Bmpfile = File1.Path & "\" & File1.FileName
    Print openbmp(Bmpfile, BMP文件)
    Print viewbmp(BMP文件, Pic)
End Sub

'当 Option Explicit 出现在文件中时,必须使用 Dim、Private、Public 或 ReDim 语句显式声明所有变量。
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
    Text1.Text = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
    Text1.Text = File1.FileName
End Sub
Private Sub Command2_Click()
Pic.Picture = LoadPicture(File1.Path & "\" & File1.FileName)
End Sub

Private Sub Form_Load()
  File1.Pattern = "*.bmp"
End Sub


[此贴子已经被作者于2016-12-18 15:32编辑过]

2016-12-18 15:29
快速回复:为什么错误怎么改
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.021950 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved