One way you could use this would be with FindImagePos> rather than GetPixelColor> when waiting for a certain color to display on screen or in an area of the screen. GetPixelColor can check about 25 locations per second. FindImagePos> will discover many locations in a fraction of a second.
Code: Select all
//Color for one pixel bmp file
Let>vColor=16777215
GoSub>VBScript
ColorToRGB>vColor,vRed,vGrn,vBlu
VBEval>chr(%vRed%),vRed
VBRun>Ascii2Hex,%vRed%
VBEval>hex_var,hRED
VBEval>chr(%vGrn%),vGrn
VBRun>Ascii2Hex,%vGrn%
VBEval>hex_var,hGRN
VBEval>chr(%vBlu%),vBlu
VBRun>Ascii2Hex,%vBlu%
VBEval>hex_var,hBLU
Let>Slash=/
LabelToVar>BMP_DATA,NewBMP
Let>IncludeVar=ExportData>DOT.BMP_DATA,%temp_dir%%vColor%_Dot.bmp%crlf%%slash%*%crlf%DOT.BMP_DATA:%crlf%%NewBMP%*%slash%
IncludeFromVar>IncludeVar
/*
BMP_DATA:
424D3A000000000000003600000028000000010000000100000001002000000000000400000000000000000000000000000000000000%hBLU%%hGRN%%hRED%FF
*/
SRT>VBScript
VBSTART
dim ascii_var
dim hex_var
Function Hex2Ascii(strHex)
Dim I
For I = 1 To Len(strHex) Step 2
Hex2Ascii = Hex2Ascii & Chr(Eval("&H" & Mid(strHex, I, 2)))
Next
ascii_var = Hex2Ascii
End Function
Function Ascii2Hex(strAscii)
Dim I
For I = 1 To Len(strAscii) Step 1
'Ascii2Hex = Ascii2Hex & Hex(ASCb(Mid(strAscii, I, 1)))
TestValue = Len (Hex(ASC(Mid(strAscii, I, 1))))
If TestValue = 1 then
Ascii2Hex = Ascii2Hex & 0 & Hex(ASC(Mid(strAscii, I, 1)))
Else
Ascii2Hex = Ascii2Hex & Hex(ASC(Mid(strAscii, I, 1)))
End if
'msgbox Hex(ASCw(Mid(strAscii, I, 1)))
Next
hex_var = Ascii2Hex
End Function
VBEND
/*
VBRun>Ascii2Hex,%ascii_string%
VBEval>hex_var,hex_string
VBRun>Hex2Ascii,%hex_string%
VBEval>ascii_var,ascii_string
*/
END>VBScript
Here is the process in a subroutine that can be inserted into a script then used like a function.
Code: Select all
//Usage:
//GoSub>MakeOnePixelBMP,Color number
SRT>MakeOnePixelBMP
If>OnePixFileCount={"OnePixFileCount"}
Let>OnePixFileCount=1
Let>NextCount=2
Else
Add>OnePixFileCount,1
Add>NextCount,1
EndIf
Let>vColor=MakeOnePixelBMP_var_1
CreateDir>%temp_dir%OnePixelBMPs
GoSub>VBScript
ColorToRGB>vColor,cRed,cGrn,cBlu
VBEval>chr(%cRed%),vRed
VBRun>Ascii2Hex,vRed
VBEval>hex_var,hRED
VBEval>chr(%cGrn%),vGrn
VBRun>Ascii2Hex,vGrn
VBEval>hex_var,hGRN
VBEval>chr(%cBlu%),vBlu
VBRun>Ascii2Hex,vBlu
VBEval>hex_var,hBLU
Let>Slash=/
Let>Percent=%
LabelToVar>Create_BMP_DATA,NewBMP
GoSub>BMPSub%OnePixFileCount%
SRT>BMPSub1
IncludeFromVar>NewBMP
END>BMPSub1
/*
Create_BMP_DATA:
%slash%*
BMP_DATA_%Percent%OnePixFileCount%Percent%:
424D3A000000000000003600000028000000010000000100000001002000000000000400000000000000000000000000000000000000%Percent%hBLU%Percent%%Percent%hGRN%Percent%%Percent%hRED%Percent%FF
*%slash%
ExportData>BMP_DATA_%Percent%OnePixFileCount%Percent%,%temp_dir%OnePixelBMPs\%Percent%vColor%Percent%_Dot.bmp
SRT>BMPSub%NextCount%
IncludeFromVar>NewBMP
END>BMPSub%NextCount%
*/
SRT>VBScript
VBSTART
dim ascii_var
dim hex_var
Function Hex2Ascii(strHex)
Dim I
For I = 1 To Len(strHex) Step 2
Hex2Ascii = Hex2Ascii & Chr(Eval("&H" & Mid(strHex, I, 2)))
Next
ascii_var = Hex2Ascii
End Function
Function Ascii2Hex(strAscii)
Dim I
For I = 1 To Len(strAscii) Step 1
'Ascii2Hex = Ascii2Hex & Hex(ASCb(Mid(strAscii, I, 1)))
TestValue = Len (Hex(ASC(Mid(strAscii, I, 1))))
If TestValue = 1 then
Ascii2Hex = Ascii2Hex & 0 & Hex(ASC(Mid(strAscii, I, 1)))
Else
Ascii2Hex = Ascii2Hex & Hex(ASC(Mid(strAscii, I, 1)))
End if
'msgbox Hex(ASCw(Mid(strAscii, I, 1)))
Next
hex_var = Ascii2Hex
End Function
VBEND
END>VBScript
END>MakeOnePixelBMP
Here is an example using the subroutine. The example opens the Macro Scheduler forum, then does a search for "FindImagePos".
Code: Select all
GoSub>MakeOnePixelBMP,300144
GoSub>MakeOnePixelBMP,25555
Let>WorkingWindow=Index page :: Macro Scheduler Forums - Macro Recorder and Windows Automation Software :: Macro Recorder and Windows Automation Tools - Mozilla Firefox
IfWindowOpen>WorkingWindow
SetFocus>WorkingWindow
Else
ExecuteFile>https://www.mjtnet.com/forum
WaitWindowOpen>WorkingWindow
EndIf
Let>ReTries=0
Label>ReTry1
FindImagePos>%temp_dir%OnePixelBMPs\300144_Dot.bmp,WINDOW:Index page :: Macro Scheduler Forums - Macro Recorder and Windows Automation Software :: Macro Recorder and Windows Automation Tools - Mozilla Firefox,0,1,XArr,YArr,NumFound,EXACT
If>NumFound>0
Let>Arr_Count=%NumFound%-1
Let>Xpos=XArr_%Arr_Count%
Let>Ypos=YArr_%Arr_Count%
Add>Ypos,30
MouseMove>Xpos,Ypos
LClick
PutClipBoard>FindImagePos
Press Ctrl
Send>v
Release Ctrl
Add>Xpos,120
MouseMove>Xpos,Ypos
LClick
Else
Add>ReTries,1
If>ReTries>20
MDL>%WorkingWindow%%crlf%%crlf%Not Found%crlf%Program closing
EndIf
Wait>1
Goto>ReTry1
Endif
Timer>TotalTime
//Usage:
//GoSub>MakeOnePixelBMP,Color number
SRT>MakeOnePixelBMP
If>OnePixFileCount={"OnePixFileCount"}
Let>OnePixFileCount=1
Let>NextCount=2
Else
Add>OnePixFileCount,1
Add>NextCount,1
EndIf
Let>vColor=MakeOnePixelBMP_var_1
CreateDir>%temp_dir%OnePixelBMPs
GoSub>VBScript
ColorToRGB>vColor,cRed,cGrn,cBlu
VBEval>chr(%cRed%),vRed
VBRun>Ascii2Hex,vRed
VBEval>hex_var,hRED
VBEval>chr(%cGrn%),vGrn
VBRun>Ascii2Hex,vGrn
VBEval>hex_var,hGRN
VBEval>chr(%cBlu%),vBlu
VBRun>Ascii2Hex,vBlu
VBEval>hex_var,hBLU
Let>Slash=/
Let>Percent=%
LabelToVar>Create_BMP_DATA,NewBMP
GoSub>BMPSub%OnePixFileCount%
SRT>BMPSub1
IncludeFromVar>NewBMP
END>BMPSub1
/*
Create_BMP_DATA:
%slash%*
BMP_DATA_%Percent%OnePixFileCount%Percent%:
424D3A000000000000003600000028000000010000000100000001002000000000000400000000000000000000000000000000000000%Percent%hBLU%Percent%%Percent%hGRN%Percent%%Percent%hRED%Percent%FF
*%slash%
ExportData>BMP_DATA_%Percent%OnePixFileCount%Percent%,%temp_dir%OnePixelBMPs\%Percent%vColor%Percent%_Dot.bmp
SRT>BMPSub%NextCount%
IncludeFromVar>NewBMP
END>BMPSub%NextCount%
*/
SRT>VBScript
VBSTART
dim ascii_var
dim hex_var
Function Hex2Ascii(strHex)
Dim I
For I = 1 To Len(strHex) Step 2
Hex2Ascii = Hex2Ascii & Chr(Eval("&H" & Mid(strHex, I, 2)))
Next
ascii_var = Hex2Ascii
End Function
Function Ascii2Hex(strAscii)
Dim I
For I = 1 To Len(strAscii) Step 1
'Ascii2Hex = Ascii2Hex & Hex(ASCb(Mid(strAscii, I, 1)))
TestValue = Len (Hex(ASC(Mid(strAscii, I, 1))))
If TestValue = 1 then
Ascii2Hex = Ascii2Hex & 0 & Hex(ASC(Mid(strAscii, I, 1)))
Else
Ascii2Hex = Ascii2Hex & Hex(ASC(Mid(strAscii, I, 1)))
End if
'msgbox Hex(ASCw(Mid(strAscii, I, 1)))
Next
hex_var = Ascii2Hex
End Function
VBEND
END>VBScript
END>MakeOnePixelBMP