Och här är koden för de som bara vill se. Vart typ 10-15 rader till när jag gjorde att den skulle hantera 4 gråskalor. Timern är enbart till för att man ska kunna se x och y position på musen hela tiden...
Fördröjningarna med sleep och doevents var jag tvungen att lägga till för att sitens flasheditor(den man ritar i) inte klarade av om man ritade för fort.
Och jag har inte brytt mig om variabelnamn eller nåt skit alls. Skrev rubbet på runt 20 minuter bara för mitt eget höga nöjes skull..
mvh
Kod:
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Sub Command1_Click()
xx = CInt(Text1) - 3
yy = CInt(Text2) - 3
For Y = 3 To Picture1.Height - 3
For X = 3 To Picture1.Width - 3
darkness = GetDarkness(Picture1.Point(X, Y))
For p = 0 To darkness - 1
SetCursorPos xx + X, yy + Y
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, cButt, dwEI
SetCursorPos xx + X + 1, yy + Y
mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, cButt, dwEI
Sleep 3
Next p
Next X
DoEvents
Sleep 10
Next Y
End Sub
Function GetDarkness(thiscolor As Long) As Integer
Dim retvalue As Integer
retvalue = 0
If thiscolor = RGB(51, 51, 51) Then retvalue = 3
If thiscolor = RGB(102, 102, 102) Then retvalue = 2
If thiscolor = RGB(153, 153, 153) Then retvalue = 1
If thiscolor = RGB(255, 255, 255) Then retvalue = 0
GetDarkness = retvalue
End Function
Private Sub Timer1_Timer()
Dim m_point As POINTAPI
a = GetCursorPos(m_point)
Label1.Caption = "x=" & m_point.X & ", y=" & m_point.Y
End Sub
Som ni ser så antar jag att bilden enbart har 4 färger:
Kod:
Function GetDarkness(thiscolor As Long) As Integer
Dim retvalue As Integer
retvalue = 0
If thiscolor = RGB(51, 51, 51) Then retvalue = 3
If thiscolor = RGB(102, 102, 102) Then retvalue = 2
If thiscolor = RGB(153, 153, 153) Then retvalue = 1
If thiscolor = RGB(255, 255, 255) Then retvalue = 0
GetDarkness = retvalue
End Function
Jag använder paint shop pro och har sparat undan paletten så när jag vill ha en ny bild så tar jag någon svartvit eller gråskalig bild, försöker själv redigera bort överflödiga färger som inte tillför bilden något, sedan anger jag att bilden ska ha 4-färgspalett, därefter laddar jag in min sparade palett där färgerna i paletten överenstämmer med det som står i koden ovanför..
Lägligare borde vara att i VB-programmet känna av vilka fyra nyanser det finns dynamiskt så man kan ha vilka gråtoner som helst i grundbilden.. Det blir väl nästa fix...
)
