form1.frm

点校正工具

    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Right$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Rtemp = Rtemp + Val("&H" & Right$(Hex(lColor), 2))
    nR = nR + 1
    End If
    x1 = x1 + 1
 
   Loop
   y1 = y1 + 1
   Loop
   
   If nR > 0 Then
   Rtemp = Rtemp / nR
   End If
   
   If Rtemp > Rda And Rtemp > 0 Then
   Rda = Rtemp
   End If
   If Rtemp < Rxiao And Rtemp > 0 Then
   Rxiao = Rtemp
   End If
   Rtemp = 0
   nR = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
    
   If Rxiao = 0 Then
   Rxiao = 255
   Rda = 255
   Else
   Rxiao = 255 - Rda + Rxiao
   End If
    
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    Rtemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Right$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Rtemp = Rtemp + Val("&H" & Right$(Hex(lColor), 2))
    n = n + 1
    End If
    x1 = x1 + 1
   Loop
   y1 = y1 + 1
   Loop
   If n > 0 Then
   Rtemp = Rtemp / n
   End If
   If Rtemp = 0 Or Rtemp <= Val(Text8.Text) Then
   Rtemp = Rxiao
   Else
   Rtemp = 255 - Rda + Rtemp
   End If
   Rtemp = 255 - ((Rtemp - Rxiao) * Val(Text9.Text))
   Text7.Text = Text7.Text & Val(Rtemp) & ","
   Rtemp = 0
   n = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
End Sub

Private Sub Command6_Click()
  Dim ifile
  Dim i As Long
  Dim tPOS As POINTAPI
  Dim lDC As Long
  Dim sTmp As String
  Dim lColor As Long
  Dim x1, y1, n, nR, nG, nB, Dhang, Dlie, Rda, Rxiao, Gda, Gxiao, Bda, Bxiao, Chang, Clie
  Dim Rtemp, Gtemp, Btemp As Long
  Dim name
  Label15.Caption = "操作提示:将生成以'文件前缀-箱体行点数-箱体列点数-校正矩阵-箱体编号.RVS’命名的校正文件,请稍后..."
  name = Text12.Text & "-" & Text10.Text & "-" & Text11.Text & "-" & jz & "-" & Text13.Text & ".RVS"
  ifile = FreeFile
  Open App.Path & "\SetData\" & name For Binary As #ifile
  Put #ifile, , CLng("&H" & "9F34DE12")
  Put #ifile, , CLng("&H" & "000000" + (Hex(Text10.Text / jz)))
  Put #ifile, , CLng("&H" & "000000" + (Hex(Text11.Text / jz)))
        
    lDC = GetWindowDC(0)
    Chang = Val(Label6.Caption)
    Clie = Val(Label5.Caption)
    Text7.Text = ""

    Rda = 0
    Rxiao = 255
    Gda = 0
    Gxiao = 255
    Bda = 0
    Bxiao = 255
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    nR = 0
    nG = 0
    nB = 0
    Rtemp = 0
    Gtemp = 0
    Btemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Right$(Hex(lColor), 2)) > Val(Text14.Text) Then
    Rtemp = Rtemp + Val("&H" & Right$(Hex(lColor), 2))
    nR = nR + 1
    End If
    If Val("&H" & Mid$(Hex(lColor), 3, 2)) > Val(Text15.Text) Then
    Gtemp = Gtemp + Val("&H" & Mid$(Hex(lColor), 3, 2))
    nG = nG + 1
    End If
    If Val("&H" & Left$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Btemp = Btemp + Val("&H" & Left$(Hex(lColor), 2))
    nB = nB + 1
    End If
    x1 = x1 + 1
 
   Loop
   y1 = y1 + 1
   Loop
   
   If nR > 0 Then
   Rtemp = Rtemp / nR
   End If
   If nG > 0 Then
   Gtemp = Gtemp / nG
   End If
   If nB > 0 Then
   Btemp = Btemp / nB
   End If
   
   If Rtemp > Rda And Rtemp > 0 Then
   Rda = Rtemp
   End If
   If Rtemp < Rxiao And Rtemp > 0 Then
   Rxiao = Rtemp
   End If
   If Gtemp > Gda And Gtemp > 0 Then
   Gda = Gtemp
   End If
   If Gtemp < Gxiao And Gtemp > 0 Then
   Gxiao = Gtemp
   End If
   If Btemp > Bda And Btemp > 0 Then
   Bda = Btemp
   End If
   If Btemp < Bxiao And Btemp > 0 Then
   Bxiao = Btemp
   End If
   Rtemp = 0
   Gtemp = 0
   Btemp = 0
   nR = 0
   nG = 0
   nB = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
    
   If Rxiao = 0 Then
   Rxiao = 255
   Rda = 255
   Else
   Rxiao = 255 - Rda + Rxiao
   End If
   If Gxiao = 0 Then
   Gxiao = 255
   Gda = 255
   Else
   Gxiao = 255 - Gda + Gxiao
   End If
   If Bxiao = 0 Then
   Bxiao = 255
   Bda = 255
   Else
   Bxiao = 255 - Bda + Bxiao
   End If
    
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    Rtemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Right$(Hex(lColor), 2)) > Val(Text14.Text) Then
    Rtemp = Rtemp + Val("&H" & Right$(Hex(lColor), 2))
    n = n + 1
    End If
    x1 = x1 + 1
   Loop
   y1 = y1 + 1
   Loop
   If n > 0 Then
   Rtemp = Rtemp / n
   End If
   If Rtemp = 0 Or Rtemp <= Val(Text14.Text) Then
   Rtemp = Rxiao
   Else
   Rtemp = 255 - Rda + Rtemp
   End If
   Rtemp = 255 - ((Rtemp - Rxiao) * Val(Text9.Text))
   Put #ifile, , CByte("&H" & Right$(Hex(Rtemp), 2))
   Rtemp = 0
   n = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
  
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    Gtemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Mid$(Hex(lColor), 3, 2)) > Val(Text15.Text) Then
    Gtemp = Gtemp + Val("&H" & Mid$(Hex(lColor), 3, 2))
    n = n + 1
    End If
    x1 = x1 + 1
   Loop
   y1 = y1 + 1
   Loop
   If n > 0 Then
   Gtemp = Gtemp / n
   End If
   If Gtemp = 0 Or Gtemp <= Val(Text15.Text) Then
   Gtemp = Gxiao
   Else
   Gtemp = 255 - Gda + Gtemp
   End If
   Gtemp = 255 - ((Gtemp - Gxiao) * Val(Text9.Text))
   Put #ifile, , CByte("&H" & Right$(Hex(Gtemp), 2))
   Gtemp = 0
   n = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop

    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    Btemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Left$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Btemp = Btemp + Val("&H" & Left$(Hex(lColor), 2))
    n = n + 1
    End If
    x1 = x1 + 1
   Loop
   y1 = y1 + 1
   Loop
   If n > 0 Then
   Btemp = Btemp / n
   End If
   If Btemp = 0 Or Btemp <= Val(Text8.Text) Then
   Btemp = Bxiao
   Else
   Btemp = 255 - Bda + Btemp
   End If
   Btemp = 255 - ((Btemp - Bxiao) * Val(Text9.Text))
   Put #ifile, , CByte("&H" & Right$(Hex(Btemp), 2))
   Btemp = 0
   n = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop

  Close #ifile
  Label15.Caption = "操作提示:校正文件" & name & "已经生成."
End Sub

Private Sub Command7_Click()
Image1.Picture = Clipboard.GetData()
Form1.Height = (Image1.Top + Image1.Height + 88) * Screen.TwipsPerPixelY
Text1.Text = Image1.Left + Form1.Left / Screen.TwipsPerPixelX
Text2.Text = Image1.Top + Image1.Left + Form1.Top / Screen.TwipsPerPixelY
Text3.Text = Image1.Width + Form1.Left / Screen.TwipsPerPixelX - 1
Text4.Text = Image1.Height + Image1.Top + Form1.Top / Screen.TwipsPerPixelY - 1
Label15.Caption = "操作提示:按需要调整各项数据后点击'生成文件',直接生成校正文件."
showxy = 1
End Sub

Private Sub Command8_Click()
    Text1.Text = Form1.Left / Screen.TwipsPerPixelX
    Text2.Text = Form1.Top / Screen.TwipsPerPixelY
    Text3.Text = Form1.Width / Screen.TwipsPerPixelX
    Text4.Text = Form1.Height / Screen.TwipsPerPixelY
End Sub

Private Sub Command9_Click()
    Text1.Text = Screen.Width / Screen.TwipsPerPixelX
    Text2.Text = Screen.Height / Screen.TwipsPerPixelY
    Text3.Text = Screen.Width
    Text4.Text = Screen.Height
End Sub

Private Sub Form_Load()

    Timer1.Interval = 100
    Timer2.Interval = 3000
    Timer3.Interval = 3000
    jz = 8
    Image1.Picture = LoadPicture
    Label15.Caption = "操作提示:请复制需要校正箱体的图片到剪切板,然后点击'粘贴图片',或者分别点击'左上'和'右下'直接选取图片."
    Form1.Height = 150 * Screen.TwipsPerPixelY
    Form1.Width = Image1.Width * Screen.TwipsPerPixelX
    Image1.Height = 432
    Image1.Width = 576
    Text1.Text = Image1.Left + Form1.Left / Screen.TwipsPerPixelX
    Text2.Text = Image1.Top + Image1.Left + Form1.Top / Screen.TwipsPerPixelY
    Text3.Text = Image1.Width + Form1.Left / Screen.TwipsPerPixelX - 1
    Text4.Text = Image1.Height + Image1.Top + Form1.Top / Screen.TwipsPerPixelY - 1
End Sub


Private Sub Label14_Click()
    Dim X, Y, n, Dhang, Dlie, Chang, Clie As Integer
    Dim Btemp As Long
    Chang = (Val(Text4.Text) - Val(Text2.Text) + 1) / Val(Text6.Text)
    Clie = (Val(Text3.Text) - Val(Text1.Text) + 1) / Val(Text5.Text)
    Text7.Text = ""
    X = 0
    Y = 0
    Dhang = 0
    Dlie = 0
   Do While Dhang < Val(Text6.Text)
      Y = Dhang * Chang
   Do While Dlie < Val(Text5.Text)
      X = Dlie * Clie
      Y = Dhang * Chang
   Do While Y < (Dhang + 1) * Chang
      X = Dlie * Clie
   Do While X < (Dlie + 1) * Clie
    
   If du(X, Y, 0) > Val(Text14.Text) Then
   Btemp = Btemp + du(X, Y, 2)
   n = n + 1
   End If
    
   X = X + 1
   Loop
   Y = Y + 1
   Loop
   
   If n > 0 Then
   Btemp = Btemp / n
   End If
   Text7.Text = Text7.Text & Val(Btemp) & ","
   Btemp = 0
   n = 0
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
End Sub

Private Sub Label14_DblClick()
  Dim i As Long
  Dim tPOS As POINTAPI
  Dim lDC As Long
  Dim sTmp As String
  Dim lColor As Long
  Dim x1, y1, n, nR, Dhang, Dlie, Rda, Rxiao, Chang, Clie
  Dim Rtemp As Long
        
    lDC = GetWindowDC(0)
    Chang = Val(Label6.Caption)
    Clie = Val(Label5.Caption)
    

    Rda = 0
    Rxiao = 255
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    nR = 0
    Rtemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Left$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Rtemp = Rtemp + Val("&H" & Left$(Hex(lColor), 2))
    nR = nR + 1
    End If
    x1 = x1 + 1
 
   Loop
   y1 = y1 + 1
   Loop
   
   If nR > 0 Then
   Rtemp = Rtemp / nR
   End If
   
   If Rtemp > Rda And Rtemp > 0 Then
   Rda = Rtemp
   End If
   If Rtemp < Rxiao And Rtemp > 0 Then
   Rxiao = Rtemp
   End If
   Rtemp = 0
   nR = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
    
   If Rxiao = 0 Then
   Rxiao = 255
   Rda = 255
   Else
   Rxiao = 255 - Rda + Rxiao
   End If
    
    x1 = Val(Text1.Text)
    y1 = Val(Text2.Text)
    n = 0
    Rtemp = 0
    Dhang = 0
    Dlie = 0
    Do While Dhang < Val(Text6.Text)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While Dlie < Val(Text5.Text)
       x1 = Val(Text1.Text) + (Dlie * Clie)
       y1 = Val(Text2.Text) + (Dhang * Chang)
    Do While y1 < Val(Text2.Text) + ((Dhang + 1) * Chang)
       x1 = Val(Text1.Text) + (Dlie * Clie)
    Do While x1 < Val(Text1.Text) + ((Dlie + 1) * Clie)
    lColor = GetPixel(lDC, x1, y1)
    If Val("&H" & Left$(Hex(lColor), 2)) > Val(Text8.Text) Then
    Rtemp = Rtemp + Val("&H" & Left$(Hex(lColor), 2))
    n = n + 1
    End If
    x1 = x1 + 1
   Loop
   y1 = y1 + 1
   Loop
   If n > 0 Then
   Rtemp = Rtemp / n
   End If
   If Rtemp = 0 Or Rtemp <= Val(Text8.Text) Then
   Rtemp = Rxiao
   Else
   Rtemp = 255 - Rda + Rtemp
   End If
   Rtemp = 255 - ((Rtemp - Rxiao) * Val(Text9.Text))
   Text7.Text = Text7.Text & Val(Rtemp) & ","
   Rtemp = 0
   n = 0
   x1 = x1 - 1
   y1 = y1 - 1
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
End Sub

Private Sub Label3_Click()
    Dim X, Y, n, Dhang, Dlie, Chang, Clie As Integer
    Dim Rtemp As Long
    Chang = (Val(Text4.Text) - Val(Text2.Text) + 1) / Val(Text6.Text)
    Clie = (Val(Text3.Text) - Val(Text1.Text) + 1) / Val(Text5.Text)
    Text7.Text = ""
    X = 0