"farveprøve-indsamler"

Hej stry.

Indsæt en timer med et interval på 1 på en normal form, og indsæt derefter følgende kode for formen:

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Sub Timer1_Timer()
  Dim pXY As POINTAPI, DesktopDC As Long, pFarve As Long
  GetCursorPos pXY
 
  DesktopDC = GetDC(0)
 
  pFarve = GetPixel(DesktopDC, pXY.X, pXY.Y)
  Me.BackColor = pFarve
 
  ReleaseDC 0, DesktopDC
End Sub

Så burde det funke :)
-Sion

Det ser meget lovende ud, men kan "vi" udvide den således at hvis man klikker et sted på skærmen så fastholdes den pågældende farve?

Du må undskylde den lange svartid, men jeg var lige væk fra computeren... Jeg har udvidet koden lidt, så museklik bliver registeret.

Option Explicit

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal VKey As Long) As Integer

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal wi As Long, ByVal ht As Long, ByVal wFlags As Long) As Long
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const wFlags = SWP_NOMOVE Or SWP_NOSIZE
Dim lResult As Long

Private Sub Form_Load()
  KeepOnTop Me
End Sub

Private Sub Timer1_Timer()
  Dim pXY As POINTAPI, DesktopDC As Long, pFarve As Long
  GetCursorPos pXY
 
  DesktopDC = GetDC(0)
 
  If CBool(GetAsyncKeyState(vbLeftButton)) = True Then  'Venstreklik
    pFarve = GetPixel(DesktopDC, pXY.X, pXY.Y)
    Me.BackColor = pFarve
  ElseIf CBool(GetAsyncKeyState(vbMiddleButton)) = True Then 'Middelklik
    'evt. kode
  ElseIf CBool(GetAsyncKeyState(vbRightButton)) = True Then 'Højreklik
    'evt. kode
  Else
    'evt. kode
  End If
 
  ReleaseDC 0, DesktopDC
End Sub

Sub KeepOnTop(frmTarget As Form)
  lResult = SetWindowPos(frmTarget.hwnd, HWND_TOPMOST, 0, 0, 0, 0, wFlags)
    'Window will stay on top
  DoEvents
End Sub

Sub RemoveOnTop(frmTarget As Form)
  lResult = SetWindowPos(frmTarget.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, wFlags)
    'Window will not stay on top
  DoEvents
End Sub

Dog er museikonet stadig det normale, og brugeren er derfor måske ikke opmærksom på at når han/hun klikker med musen bliver farven fanget - jeg kikker lige på noget med at ændre cursor'ens ikon, og vender så tilbage til dig...

>>Sion
Det bliver virkelig godt det her :-D
Og hvis vi får ikonet med bliver det perfekt!
Mange tak for hjælpen foreløbig.

Jaah, jeg har kikket lidt på det at skifte museikonet vha. API, og jeg har også fundet nogle kald der kan ordne det, men det virker af en eller anden grund ikke helt ordentligt. Kun nogle gange bliver cursoreren ændret og/eller ændret tilbage til den originale...
Men måske skulle vi prøve at lave det hele på en lidt anden, og simplere, måde?
Vi kan tage et skærmbillede, og lægge det ind som baggrund på formen som så skal fylde hele skærmen - det vil bevirke at formen ikke ses. Jeg skal lige spise, men bagefter kan jeg lave det og så kan du jo selv vælge hvilken løsning du vil bruge :)

Istedet for at sidde og bikse med koden, har jeg zippet to eksempler til dig. De er begge fra planet-source-code.com, og kan hentes på følgende addresse:
http://80.62.178.58/icysoft/screencapture.zip

Hej Sion
Tusind tak for hjælpen,
her er dine meget velfortjente point :-))

Det var så lidt ;)