hvordan få GetPixel til og fungere i VB6

[Richard87]

eg har et alvorligt problem med GetPixel, som Altid uansetthva:(

her e koden:

Public Sub PaintForm(ByVal sFrm As Form, frmBackColor As Long)
Dim iX, iY As Long
Dim tempX, tempY
Dim CustRgn As Long
Dim MainRgn As Long
Dim lNumber, lNumber2 As Long
Dim meDC As Long
Dim lColor As Long
sFrm.Show ' Vis form'en
sFrm.ScaleMode = 3 'Pixel...
iX = CLng(sFrm.ScaleX(sFrm.Width)) 'Finn bredden i Pixels..
iY = CLng(sFrm.ScaleY(sFrm.Height)) ' Fin Høyden i Pixels..

MainRgn = CreateRectRgn(0, 0, iX, iY)
meDC = CreateCompatibleDC(sFrm.hdc)

'Gå gjennom alle pixlene på skjermen...
For tempX = 0 To iX
   For tempY = 0 To iY
       lColor = GetPixel(meDC, tempX, tempY)
       Debug.Print lColor
   Next tempY
Next tempX
End Sub

lColor e altid CLR_INVALID(-1)...

[aadnk]

Feilmeldingen gir absolutt mening - du har jo ikke gitt Device Context-en noe å verken lese eller skrive til.

 

Men hva er det du egentlig skal få til? Ønsker du å lese av alle pikslene på formen:

 

Public Sub PaintForm(ByVal sFrm As Form, frmBackColor As Long)

   Dim lColor As Long
   
   sFrm.Show ' Vis form'en
   sFrm.ScaleMode = 3 'Pixel...
   
   ' Du har allerede spesifisert ScaleMode til pixels, og da er det ikke nødvendig å konvertere noe
   iX = sFrm.ScaleWidth
   iY = sFrm.ScaleHeight
   
   'Gå gjennom alle pikslene på skjermen...
   For tempX = 0 To iX
      For tempY = 0 To iY
          lColor = GetPixel(sFrm.hdc, tempX, tempY)
          ' Kanskje skal du deretter skrive en farge til formen her, avhengig av lColor?
      Next
   Next

End Sub

 

Eller er det noe annet du pønsker på?

[Richard87]

Eg vil sletta visse pixler som ikkje har ønska verdi, sånn at eg kan "skinna" min egen form...

 

[EDIT]

Eg få ennå CLR_INVALID ???

Endret 14. februar 2005 av Richard87

[aadnk]

Da må sannsynligvis også AutoRedraw være satt til True:

 

Public Sub PaintForm(sFrm As Form, frmBackColor As Long)

  Dim lColor As Long
  Dim iX As Long, iY As Long
  Dim tempX As Long, tempY As Long
  
  sFrm.Show ' Vis form'en
  sFrm.ScaleMode = 3 'Pixel...
  sFrm.AutoRedraw = True
  
  ' Du har allerede spesifisert ScaleMode til pixels, og da er det ikke nødvendig å konvertere noe
  iX = sFrm.ScaleWidth
  iY = sFrm.ScaleHeight
  
  'Gå gjennom alle pikslene på skjermen...
  For tempX = 0 To iX
     For tempY = 0 To iY
         lColor = GetPixel(sFrm.hdc, tempX, tempY)
         ' Kanskje skal du deretter skrive en farge til formen her, avhengig av lColor?
     Next
  Next

End Sub

 

Dersom du ønsker å skape gjennomsiktighet, kan følgende gjøres:

 

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000

Private Sub Form_Load()

   Dim Ret As Long

   ' Sett bakgrunnsfargen til hvit
   Me.BackColor = vbWhite

   Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
   Ret = Ret Or WS_EX_LAYERED
   SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret

   SetLayeredWindowAttributes Me.hWnd, vbWhite, 0, LWA_COLORKEY
   
End Sub

[Richard87]

OK, eg vil ikkje at heila vinduet ska forsvinna, bare deler av det...

 

dette har eg komt opp med te nå..:

Public Sub PaintForm(ByVal sFrm As Form, frmBackColor As Long)

   Dim lColor As Long
   Dim hObject As Long
   Dim hMain As Long
   Dim lRet As Long
   sFrm.Show ' Vis form'en
   sFrm.ScaleMode = 3 'Pixel...
   sFrm.AutoRedraw = True
   iX = sFrm.ScaleWidth 'Antall Pixler vertikalt
   iY = sFrm.ScaleHeight ' Antall pixler horisontalt..
   
   hMain = CreateRectRgn(0, 0, iX, iW)
   
   For tempX = 0 To iX
       For tempY = 0 To iY
           lColor = GetPixel(sFrm.hdc, tempX, tempY)
           If lColor = frmBackColor Then
               hObject = CreateRectRgn(tempX, tempY, tempX + 1, tempY + 1)
               lRet = CombineRgn(hMain, hMain, hObject, RGN_XOR)
               DeleteObject hObject
           End If
       Next
   Next
   SetWindowRgn sFrm.hwnd, hMain, True
End Sub

men ingenting virker som det skal...

programmet fjerner "borderen" te høyre og bunnen, men ingenting av det kvita...???

sånn blir funksjonen kalt op:

Private Sub Form_Load()
Me.BackColor = vbWhite
PaintForm Me, vbWhite
End Sub

på formen ligger det en svart farget shape....