我利用vb寫了個抓取mousedown至mouseup處值線上的rgb值抓取
程式,然後在output到.txt檔上,但似乎有點問題!!這隻程式會
重複的抓取線段上的rgb值一直寫入.txt,到底是哪邊出了錯呀!!
請各位先賢幫我看看吧!!
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
Dim red As Integer
Dim green As Integer
Dim blue As Integer
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
PictureIN.Picture = LoadPicture(Dir1.Path & "\" & File1.filename)
End Sub
Sub readrgbinfo(ByVal color As Long)
Dim temp As Long
  
  temp = (color And 255)
  red = temp And 255
  
  temp = Int(color / &H100)
  green = temp And 255
  
  temp = Int(color / &H10000)
  blue = temp And 255
   
End Sub
Private Sub Hbar_Change()
PictureIN.Left = Hbar.Value
End Sub
Private Sub Vbar_Change()
PictureIN.Top = Vbar.Value
End Sub
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim color As Long
Open "c:\tree\t.txt" For Output As #1
For i = y1 To y2
For j = x1 To x2
color = PictureIN.Point(j, i)
readrgbinfo (color)
Write #1, red, green, blue
Next
Next
Close #1
Command1.Caption = "Run Over"
End Sub
Private Sub Form_Load()
File1.Pattern = "*.bmp;*.jpg;*.gif"

Vbar.Max = PictureIN.Width - PictureOUT.Width
Vbar.Min = 1
Vbar.LargeChange = 100
Hbar.Max = PictureIN.Height - PictureOUT.Height
Hbar.Min = 1
Hbar.LargeChange = 100
End Sub
Private Sub PictureIN_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim color As Long
x1 = X
y1 = Y
color = PictureIN.Point(X, Y)
readrgbinfo (color)
Debug.Print color, red, green, blue
End Sub
Private Sub PictureIN_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = CStr(X) + ":" + CStr(Y)

End Sub
Private Sub PictureIN_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
x2 = X
y2 = Y
End Sub
arrow
arrow
    全站熱搜

    vbqa 發表在 痞客邦 留言(0) 人氣()