📄 grvbrepos.frm
字号:
VERSION 5.00
Begin VB.Form frmRePos
BorderStyle = 4 'Fixed ToolWindow
Caption = "重新定位"
ClientHeight = 7200
ClientLeft = 2355
ClientTop = 2205
ClientWidth = 11760
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
MousePointer = 2 'Cross
ScaleHeight = 7200
ScaleWidth = 11760
ShowInTaskbar = 0 'False
Begin VB.CommandButton btnWritePos
Caption = "Write Position to File"
Height = 255
Left = 9600
TabIndex = 12
Top = 6840
Width = 2175
End
Begin VB.CommandButton btnCalcRePos
Caption = "Calc Position"
Height = 255
Left = 9600
TabIndex = 11
Top = 6480
Width = 2175
End
Begin VB.CommandButton btnShowPos
Caption = "Show Position"
Height = 255
Left = 9600
TabIndex = 10
Top = 6120
Width = 2175
End
Begin VB.ListBox RPList
Height = 5820
ItemData = "GRVBRePos.frx":0000
Left = 9600
List = "GRVBRePos.frx":0007
TabIndex = 9
Top = 0
Width = 2175
End
Begin VB.CommandButton btnReturn
Caption = "复位"
Height = 255
Left = 5280
Style = 1 'Graphical
TabIndex = 8
Top = 6960
Width = 1815
End
Begin VB.OptionButton Opt
Caption = "4"
Height = 255
Index = 6
Left = 2880
Style = 1 'Graphical
TabIndex = 7
Top = 6960
Width = 255
End
Begin VB.OptionButton Opt
Caption = "3"
Height = 255
Index = 5
Left = 2640
Style = 1 'Graphical
TabIndex = 6
Top = 6960
Width = 255
End
Begin VB.OptionButton Opt
Caption = "2"
Height = 255
Index = 4
Left = 2400
Style = 1 'Graphical
TabIndex = 5
Top = 6960
Width = 255
End
Begin VB.OptionButton Opt
Caption = "1"
Height = 255
Index = 3
Left = 2160
Style = 1 'Graphical
TabIndex = 4
Top = 6960
Width = 255
End
Begin VB.OptionButton Opt
Caption = "None"
Height = 255
Index = 2
Left = 1200
Style = 1 'Graphical
TabIndex = 3
Top = 6960
Width = 615
End
Begin VB.OptionButton Opt
Caption = "White"
Height = 255
Index = 1
Left = 600
Style = 1 'Graphical
TabIndex = 2
Top = 6960
Width = 615
End
Begin VB.OptionButton Opt
Caption = "Black"
Height = 255
Index = 0
Left = 0
Style = 1 'Graphical
TabIndex = 1
Top = 6960
Value = -1 'True
Width = 615
End
Begin VB.Label labelMPos
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "0-0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 7560
TabIndex = 0
Top = 6960
Width = 2055
End
Begin VB.Image CapImage
Appearance = 0 'Flat
Height = 7200
Left = 0
MousePointer = 2 'Cross
Top = 0
Width = 9600
End
End
Attribute VB_Name = "frmRePos"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub btnReturn_Click()
frmRePos.Cls
Opt(0).Value = True
End Sub
Private Sub CapImage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
labelMPos.Caption = str$(Int(X * kX) + 1) & " - " & str$(Int(Y * kY) + 1)
End Sub
Private Sub CapImage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i, j As Integer
frmRePos.DrawStyle = 0
Select Case optIndex
Case 0
RPos.cB.X = Int(X * kX) + 1
RPos.cB.Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 2
frmRePos.Line (Int(X - 6 / kX) + CapImage.Left, Int(Y - 6 / kY) + CapImage.Top)- _
(Int(X + 6 / kX) + CapImage.Left, Int(Y + 6 / kY) + CapImage.Top), vbWhite, B
Case 1
RPos.cW.X = Int(X * kX) + 1
RPos.cW.Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 2
frmRePos.Line (Int(X - 6 / kX) + CapImage.Left, Int(Y - 6 / kY) + CapImage.Top)- _
(Int(X + 6 / kX) + CapImage.Left, Int(Y + 6 / kY) + CapImage.Top), vbBlack, B
Case 2
RPos.cN.X = Int(X * kX) + 1
RPos.cN.Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 2
frmRePos.Line (Int(X - 6 / kX) + CapImage.Left, Int(Y - 6 / kY) + CapImage.Top)- _
(Int(X + 6 / kX) + CapImage.Left, Int(Y + 6 / kY) + CapImage.Top), vbGreen, B
Case 3
RPos.p(1, 1).X = Int(X * kX) + 1
RPos.p(1, 1).Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 0
frmRePos.Circle ((Int(X) + CapImage.Left), (Int(Y) + CapImage.Top)), 20, vbRed
Case 4
RPos.p(13, 1).X = Int(X * kX) + 1
RPos.p(13, 1).Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 0
frmRePos.Circle ((Int(X) + CapImage.Left), (Int(Y) + CapImage.Top)), 20, vbRed
Case 5
RPos.p(13, 13).X = Int(X * kX) + 1
RPos.p(13, 13).Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 0
frmRePos.Circle ((Int(X) + CapImage.Left), (Int(Y) + CapImage.Top)), 20, vbRed
Case 6
RPos.p(1, 13).X = Int(X * kX) + 1
RPos.p(1, 13).Y = Int(Y * kY) + 1
frmRePos.DrawStyle = 0
frmRePos.Circle ((Int(X) + CapImage.Left), (Int(Y) + CapImage.Top)), 20, vbRed
End Select
If optIndex = 12 _
Then
frmRePos.DrawStyle = 2
frmRePos.Line (Int(RPos.p(1, 1).X / kX) + CapImage.Left, _
Int(RPos.p(1, 1).Y / kY) + CapImage.Top)- _
(Int(RPos.p(13, 1).X / kX) + CapImage.Left, _
Int(RPos.p(13, 1).Y / kY) + CapImage.Top), vbWhite
frmRePos.Line (Int(RPos.p(13, 1).X / kX) + CapImage.Left, _
Int(RPos.p(13, 1).Y / kY) + CapImage.Top)- _
(Int(RPos.p(13, 13).X / kX) + CapImage.Left, _
Int(RPos.p(13, 13).Y / kY) + CapImage.Top), vbWhite
frmRePos.Line (Int(RPos.p(13, 13).X / kX) + CapImage.Left, _
Int(RPos.p(13, 13).Y / kY) + CapImage.Top)- _
(Int(RPos.p(1, 13).X / kX) + CapImage.Left, _
Int(RPos.p(1, 13).Y / kY) + CapImage.Top), vbWhite
frmRePos.Line (Int(RPos.p(1, 1).X / kX) + CapImage.Left, _
Int(RPos.p(1, 1).Y / kY) + CapImage.Top)- _
(Int(RPos.p(1, 13).X / kX) + CapImage.Left, _
Int(RPos.p(1, 13).Y / kY) + CapImage.Top), vbWhite
End If
If (optIndex = 6) Then
Opt(0).Value = True
Else
Opt(optIndex + 1).Value = True
End If
End Sub
Private Sub btnShowPos_Click()
Show_RPos
End Sub
Private Sub btnCalcRePos_Click()
toSaveBMP = True
ProcessImage
toSaveBMP = False
CalcRePos
End Sub
Private Sub btnWritePos_Click()
WritePos
Read_Pos False
End Sub
Private Sub Form_Load()
frmRePos.CapImage.Picture = LoadPicture("f:\output.bmp", vbLPCustome, vbLPColor, 640, 480)
frmRePos.CapImage.Width = 9600
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmRePos.Hide
GRVBMain.Enabled = True
End Sub
Private Sub Opt_Click(Index As Integer)
labelMPos.Caption = str$(Index)
optIndex = Index
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -