vb关于图象线性放大的问题,麻烦帮我修改下啊 简化点就好 谢谢了
Dim pic(5000, 5000, 3) As ByteDim pix As Byte
Dim pic1(9000, 9000, 3) As Byte
Dim w As Long
Dim h As Long
Private Sub Command1_Click() '读图象
CommonDialog1.Filter = "pictures(*.bmp) ¦*.bmp "
CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Binary As #1
Get #1, 19, w: Get #1, 23, h: Seek #1, 55
For j = h - 1 To 0 Step -1
For i = 0 To w - 1
For k = 2 To 0 Step -1
Get #1, , pic(i, j, k)
Next k
Next i
If w * 3 Mod 4 <> 0 Then
For k = 1 To 4 - ((w * 3) Mod 4)
Get #1, , pix
Next k
End If
Next j
Close #1
End Sub
Private Sub Command2_Click() '显示图象
For j = 0 To h - 1
For i = 0 To w - 1
Picture1.PSet (i, j), RGB(pic(i, j, 0), pic(i, j, 1), pic(i, j, 2))
Next i
Next j
End Sub
Private Sub Command3_Click() '放大图象,n是放大倍数
Picture1.Cls
n = Val(Text1.Text)
For i = 0 To h * n - 1 Step n
For j = 0 To w * n - 1 Step n
For l = 0 To n - 1
pic1(j + l, i / n, 0) = (pic(j / n, i / n, 0) * l / n + pic(j / n + 1, i / n, 0) * (1 - l / n))
pic1(j + l, i / n, 1) = (pic(j / n, i / n, 1) * l / n + pic(j / n + 1, i / n, 1) * (1 - l / n))
pic1(j + l, i / n, 2) = (pic(j / n, i / n, 2) * l / n + pic(j / n + 1, i / n, 2) * (1 - l / n))
Picture1.PSet (j + l, i), RGB(pic(j / n, i / n, 0) * l / n + pic(j / n + 1, i / n, 0) * (1 - l / n), pic(j / n, i / n, 1) * l / n + pic(j / n + 1, i / n, 1) * (1 - l / n), pic(j / n, i / n, 2) * l / n + pic(j / n + 1, i / n, 2) * (1 - l / n))
Next l
Next j
Next i
For i = 0 To w * n - 1
For j = 0 To h * n - 1 Step n
For l = 0 To n - 1
rr = pic1(i, j / n, 0) * l / n + pic1(i, j / n + 1, 0) * (1 - l / n)
gg = pic1(i, j / n, 1) * l / n + pic1(i, j / n + 1, 1) * (1 - l / n)
bb = pic1(i, j / n, 2) * l / n + pic1(i, j / n + 1, 2) * (1 - l / n)
Picture1.PSet (i, j + l), RGB(rr, gg, bb)
Next l
Next j
Next i
End Sub --------------------编程问答-------------------- 不用重复提问,前面已经回答了
http://topic.csdn.net/u/20071108/10/a704ad0a-dd5b-49b1-a11f-7fb4943d2b92.html --------------------编程问答-------------------- http://blog.yesky.com/Blog/wallescai
慢慢看,对楼主有帮助。
补充:VB , 多媒体