form1.frm

点校正工具

    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
   Rtemp = Rtemp + du(X, Y, 0)
   n = n + 1
   End If
    
   X = X + 1
   Loop
   Y = Y + 1
   Loop
   
   If n > 0 Then
   Rtemp = Rtemp / n
   End If
   Text7.Text = Text7.Text & Val(Rtemp) & ","
   Rtemp = 0
   n = 0
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
End Sub

Private Sub Label3_DblClick()
    Dim X, Y, n, Dhang, Dlie, Chang, Clie, Rda, Rxiao As Integer
    Dim Rtemp As Long
    X = 0
    Y = 0
    Do While Y < Val(Text5.Text)
       X = 0
    Do While X < Val(Text6.Text)
    
     
   If zhi(X, Y, 0, 2) > zhi(X, Y, 0, 0) And zhi(X, Y, 0, 2) > 0 Then
   zhi(X, Y, 0, 5) = zhi(X, Y, 0, 2)
   End If
   If zhi(X, Y, 0, 2) < zhi(X, Y, 0, 1) And zhi(X, Y, 0, 2) > 0 Then
   zhi(X, Y, 0, 6) = zhi(X, Y, 0, 2)
   End If
 
       
   If zhi(X, Y, 0, 6) = 0 Then
   zhi(X, Y, 0, 6) = 255
   zhi(X, Y, 0, 5) = 255
   Else
   zhi(X, Y, 0, 6) = 255 - zhi(X, Y, 0, 5) + zhi(X, Y, 0, 6)
   End If
        
   If zhi(X, Y, 0, 2) = 0 Or zhi(X, Y, 0, 2) <= Val(Text14.Text) Then
   zhi(X, Y, 0, 2) = zhi(X, Y, 0, 6)
   Else
   zhi(X, Y, 0, 2) = 255 - zhi(X, Y, 0, 5) + zhi(X, Y, 0, 6)
   End If
   zhi(X, Y, 0, 2) = 255 - ((zhi(X, Y, 0, 2) - zhi(X, Y, 0, 6)) * Val(Text16.Text))
   Text7.Text = Text7.Text & Val(zhi(X, Y, 0, 2)) & ","
  X = X + 1
  Loop
  Y = Y + 1
  Loop
End Sub


Private Sub Label4_Click()
    Dim X, Y, n, Dhang, Dlie, Chang, Clie As Integer
    Dim Gtemp 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
   Gtemp = Gtemp + du(X, Y, 1)
   n = n + 1
   End If
    
   X = X + 1
   Loop
   Y = Y + 1
   Loop
   
   If n > 0 Then
   Gtemp = Gtemp / n
   End If
   Text7.Text = Text7.Text & Val(Gtemp) & ","
   Gtemp = 0
   n = 0
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop
End Sub

Private Sub Label4_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" & Mid$(Hex(lColor), 3, 2)) > Val(Text15.Text) Then
    Rtemp = Rtemp + Val("&H" & Mid$(Hex(lColor), 3, 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" & Mid$(Hex(lColor), 3, 2)) > Val(Text15.Text) Then
    Rtemp = Rtemp + Val("&H" & Mid$(Hex(lColor), 3, 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(Text15.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 Option1_Click()
jz = 1
Command7_Click
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
  Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
  Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
  Label15.Caption = "操作提示:你选择的校正矩阵是单点校正."
End Sub

Private Sub Option2_Click()
jz = 2
Command7_Click
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
  Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
  Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
  Label15.Caption = "操作提示:你选择的校正矩阵是2x2模块."
End Sub

Private Sub Option3_Click()
jz = 4
Command7_Click
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
  Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
  Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
  Label15.Caption = "操作提示:你选择的校正矩阵是4x4模块."
End Sub

Private Sub Option4_Click()
jz = 8
Command7_Click
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
  Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
  Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
  Label15.Caption = "操作提示:你选择的校正矩阵是8x8模块."
End Sub

Private Sub test_Click()
    Dim lDC As Long
    Dim lColor As Long
    Dim X, Y, nR, nG, nB, Dhang, Dlie, Chang, Clie As Integer
    Dim Rtemp, Gtemp, Btemp As Long
    
    lDC = GetWindowDC(0)
    Chang = (Val(Text3.Text) - Val(Text1.Text) + 1) / Text5.Text
    Clie = (Val(Text4.Text) - Val(Text2.Text) + 1) / Text6.Text

    X = 0
    Y = 0
    ReDim du(Val(Text4.Text) - Val(Text2.Text), Val(Text3.Text) - Val(Text1.Text), 2)
    ReDim zhi(Val(Text6.Text) - 1, Val(Text5.Text) - 1, 2, 9) '行；列；红绿蓝；原最大值.最小值.平均值.加权平均值.算术平均值，校正后最大值.最小值.平均值.加权平均值.算术平均值
    Do While Y < Val(Text4.Text) - Val(Text2.Text)
    X = 0
    Do While X < Val(Text3.Text) - Val(Text1.Text)
    lColor = GetPixel(lDC, X + Val(Text1.Text), Y + Val(Text2.Text))
    du(Y, X, 0) = Val("&H" & Right$(Hex(lColor), 2))
    du(Y, X, 1) = Val("&H" & Mid$(Hex(lColor), 3, 2))
    du(Y, X, 2) = Val("&H" & Left$(Hex(lColor), 2))
    X = X + 1
    Loop
    Y = Y + 1
    Loop
  
    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
       zhi(Dhang, Dlie, 0, 1) = 255
       zhi(Dhang, Dlie, 1, 1) = 255
       zhi(Dhang, Dlie, 2, 1) = 255
    Do While Y < (Dhang + 1) * Chang
       X = Dlie * Clie
    Do While X < (Dlie + 1) * Clie

   
    If du(Y, X, 0) > Val(Text14.Text) Then
    Rtemp = Rtemp + du(Y, X, 0)
    If du(Y, X, 0) > zhi(Dhang, Dlie, 0, 0) And du(Y, X, 0) > 0 Then
    zhi(Dhang, Dlie, 0, 0) = du(Y, X, 0)
    End If
    If du(Y, X, 0) < zhi(Dhang, Dlie, 0, 1) And du(Y, X, 0) > 0 Then
    zhi(Dhang, Dlie, 0, 1) = du(Y, X, 0)
    Else
    zhi(Dhang, Dlie, 0, 1) = 0
    End If
    nR = nR + 1
    Else
    zhi(Dhang, Dlie, 0, 1) = 0
    End If
    
    If du(Y, X, 1) > Val(Text15.Text) Then
    Gtemp = Gtemp + du(Y, X, 1)
    If du(Y, X, 1) > zhi(Dhang, Dlie, 1, 0) And du(Y, X, 1) > 0 Then
    zhi(Dhang, Dlie, 1, 0) = du(Y, X, 1)
    End If
    If du(Y, X, 1) < zhi(Dhang, Dlie, 1, 1) And du(Y, X, 1) > 0 Then
    zhi(Dhang, Dlie, 1, 1) = du(Y, X, 1)
    Else
    zhi(Dhang, Dlie, 1, 1) = 0
    End If
    nG = nG + 1
    Else
    zhi(Dhang, Dlie, 1, 1) = 0
    End If

    If du(Y, X, 2) > Val(Text8.Text) Then
    Btemp = Btemp + du(Y, X, 2)
    If du(Y, X, 2) > zhi(Dhang, Dlie, 2, 0) And du(Y, X, 2) > 0 Then
    zhi(Dhang, Dlie, 2, 0) = du(Y, X, 2)
    End If
    If du(Y, X, 2) < zhi(Dhang, Dlie, 2, 1) And du(Y, X, 2) > 0 Then
    zhi(Dhang, Dlie, 2, 1) = du(Y, X, 2)
    Else
    zhi(Dhang, Dlie, 2, 1) = 0
    End If
    nB = nB + 1
    Else
    zhi(Dhang, Dlie, 2, 1) = 0
    End If
    
    X = X + 1
    Loop
    Y = Y + 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
   
   zhi(Dhang, Dlie, 0, 2) = Rtemp
   zhi(Dhang, Dlie, 1, 2) = Gtemp
   zhi(Dhang, Dlie, 2, 2) = Btemp
   
   Text7.Text = Text7.Text & "红大" & zhi(Dhang, Dlie, 0, 0) & "小" & zhi(Dhang, Dlie, 0, 1) & "均" & zhi(Dhang, Dlie, 0, 2)
   Text7.Text = Text7.Text & "绿大" & zhi(Dhang, Dlie, 1, 0) & "小" & zhi(Dhang, Dlie, 1, 1) & "均" & zhi(Dhang, Dlie, 1, 2)
   Text7.Text = Text7.Text & "蓝大" & zhi(Dhang, Dlie, 2, 0) & "小" & zhi(Dhang, Dlie, 2, 1) & "均" & zhi(Dhang, Dlie, 2, 2) & vbCrLf

   Rtemp = 0
   Gtemp = 0
   Btemp = 0
   nR = 0
   nG = 0
   nB = 0
   Dlie = Dlie + 1
   Loop
   Dhang = Dhang + 1
   Dlie = 0
   Loop

End Sub

Private Sub Text1_LostFocus()
If (1024 < Val(Text1.Text) Or Val(Text1.Text) < 0) Or IsNumeric(Text1.Text) <> True Then
Text1.Text = 0
End If
End Sub

Private Sub Text10_Change()
If Text10.Text <> "" And IsNumeric(Text10.Text) Then
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
Command7_Click
End If
End Sub

Private Sub Text10_LostFocus()
If (256 < Val(Text10.Text) Or Val(Text10.Text) < 1) Or IsNumeric(Text10.Text) <> True Then
Text10.Text = 64
End If
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
End Sub

Private Sub Text11_Change()
If Text11.Text <> "" And IsNumeric(Text11.Text) Then
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
Command7_Click
End If
End Sub

Private Sub Text11_LostFocus()
If (256 < Val(Text11.Text) Or Val(Text11.Text) < 1) Or IsNumeric(Text11.Text) <> True Then
Text11.Text = 48
End If
Text5.Text = Text10.Text / jz
Text6.Text = Text11.Text / jz
End Sub


Private Sub Text14_Change()
showxy = 1
End Sub

Private Sub Text14_LostFocus()
If (255 < Val(Text14.Text) Or Val(Text14.Text) < 0) Or IsNumeric(Text14.Text) <> True Then
Text14.Text = 192
End If
End Sub

Private Sub Text15_Change()
showxy = 1
End Sub

Private Sub Text15_LostFocus()
If (255 < Val(Text15.Text) Or Val(Text15.Text) < 0) Or IsNumeric(Text15.Text) <> True Then
Text15.Text = 192
End If
End Sub

Private Sub Text2_LostFocus()
If (1024 < Val(Text2.Text) Or Val(Text2.Text) < 0) Or IsNumeric(Text2.Text) <> True Then
Text2.Text = 0
End If
End Sub

Private Sub Text3_LostFocus()
If (1024 < Val(Text3.Text) Or Val(Text3.Text) < 0) Or IsNumeric(Text3.Text) <> True Then
Text3.Text = 0
End If
End Sub


Private Sub Text4_LostFocus()
If (1024 < Val(Text4.Text) Or Val(Text4.Text) < 0) Or IsNumeric(Text4.Text) <> True Then
Text4.Text = 0
End If
End Sub

Private Sub Text8_Change()
showxy = 1
End Sub

Private Sub Text8_LostFocus()
If (255 < Val(Text8.Text) Or Val(Text8.Text) < 0) Or IsNumeric(Text8.Text) <> True Then
Text8.Text = 192
End If
End Sub

Private Sub Text9_LostFocus()
If (255 < Val(Text9.Text) Or Val(Text9.Text) < 0) Or IsNumeric(Text9.Text) <> True Then
Text9.Text = 2
End If
End Sub

Private Sub Timer1_Timer()
    Dim tPOS As POINTAPI
    Dim sTmp As String
    Dim lColor As Long
    Dim lDC As Long
    Dim n As Integer
    
    lDC = GetWindowDC(0)
    Call GetCursorPos(tPOS)
    lColor = GetPixel(lDC, tPOS.X, tPOS.Y)
    sTmp = Right$("000000" & Hex(lColor), 6)
    Label3.Caption = "红色:" & Right$(sTmp, 2) & "-" & Val("&H" & Right$(sTmp, 2))
    Label3.ForeColor = RGB(Val("&H" & Right$(sTmp, 2)), 0, 0)
    Label4.Caption = "绿色:" & Mid$(sTmp, 3, 2) & "-" & Val("&H" & Mid$(sTmp, 3, 2))
    Label4.ForeColor = RGB(0, Val("&H" & Mid$(sTmp, 3, 2)), 0)
    Label14.Caption = "蓝色:" & Left$(sTmp, 2) & "-" & Val("&H" & Left$(sTmp, 2))
    Label14.ForeColor = RGB(0, 0, Val("&H" & Left$(sTmp, 2)))
    Label17.ForeColor = RGB(Val("&H" & Right$(sTmp, 2)), Val("&H" & Mid$(sTmp, 3, 2)), Val("&H" & Left$(sTmp, 2)))
    If showxy = 1 Then
    n = 0
    Do While n <= Val(Text6.Text)
    Form1.Line (Image1.Left, Image1.Top + ((Val(Text4.Text) - Val(Text2.Text) + 1) / Val(Text6.Text)) * n)-Step(Image1.Width, 0), RGB(Text14.Text, Text15.Text, Text8.Text)
    n = n + 1
    Loop
    n = 0
    Do While n <= Val(Text5.Text)
    Form1.Line (Image1.Left + ((Val(Text3.Text) - Val(Text1.Text)) / Text5.Text) * n, Image1.Top + 1)-Step(0, Image1.Height), RGB(Text14.Text, Text15.Text, Text8.Text)
    n = n + 1
    Loop
    End If
    showxy = 0
End Sub

Private Sub Timer2_Timer()
    Dim tPOS As POINTAPI
    Dim lDC As Long

    lDC = GetWindowDC(0)
    Call GetCursorPos(tPOS)
    Text1.Text = tPOS.X
    Text2.Text = tPOS.Y
    Timer2.Enabled = False
    Label15.Caption = "操作提示:现在可以选择图片的右下点了."
  Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
  Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
End Sub

Private Sub Timer3_Timer()
    Dim tPOS As POINTAPI
    Dim lDC As Long
    
    lDC = GetWindowDC(0)
    Call GetCursorPos(tPOS)
    Text3.Text = tPOS.X
    Text4.Text = tPOS.Y
    Timer3.Enabled = False
    Label15.Caption = "操作提示:按需要调整各项数据后点击'生成文件',直接在C盘生成校正文件."
    Label5.Caption = Str((Text3.Text - Text1.Text + 1) / Text5.Text)
    Label6.Caption = Str((Text4.Text - Text2.Text + 1) / Text6.Text)
End Sub