Custom Region problemer!

[Richard87]

Kan noen forklare hvorfor denne koden lager et bilde som vist i vedlegget?

 

Koden skal fjerne alle rosa farger, den greier det bra pa den overste delen, men gjor noe merkelig med den nederste...

 

Noen forslag?

 

Option Explicit
Public Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32.dll" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Public Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Const RGN_XOR As Long = 3
Public Const RGN_OR As Long = 2
Public Sub SetForm()
Dim hMaster As Long, hCurrent As Long, X As Single, Y As Single, Z As Long, Color As Long
frmMain.Show
frmMain.Refresh
frmMain.ScaleMode = vbPixels
hMaster = CreateRectRgn(0, 0, frmMain.ScaleWidth, frmMain.ScaleHeight)
For Z = 0 To 1
   frmMain.picLayout(Z).ScaleMode = vbPixels
   For X = 0 To frmMain.picLayout(Z).ScaleWidth - 1
       For Y = 0 To frmMain.picLayout(Z).ScaleHeight - 1
           Color = frmMain.picLayout(Z).Point(X, Y)
           If Hex(Color) = "CC33FF" Then
               If Z = 0 Then
                   hCurrent = CreateRectRgn(X, Y, X + 1, Y + 1)
               Else
                   Y = Y + frmMain.picLayout(Z).Top
                   hCurrent = CreateRectRgn(X, Y, X + 1, Y + 1)
               End If
               CombineRgn hMaster, hCurrent, hMaster, RGN_XOR
               DeleteObject hCurrent
           End If
       Next Y
   Next X
Next Z
'hCurrent = CreateRectRgn(768, 35, 768 + 1, 35 + 1): : DeleteObject hCurrent
DoEvents
SetWindowRgn frmMain.hWnd, hMaster, True
End Sub

[aadnk]

Hmm. Jeg er redd jeg simpelthen ikke kan reprodusere problemet; koden fungerte øyensynlig utmerket (om enn nokså treg) her, i hvert fall.

 

En mulig feilkilde kan være at programmet ikke skanner pikslene nedenfor med ScaleMode ikke satt til Pixel, eller at fargen simpelthen ikke korresponderer med hva som benyttes i koden (det gjorde den for øvrig ikke på JPG-bildet, men nå er jo heller ikke JPG-komprimeringsalgoritmen kjent for å bevare fargene nøyaktig). I alle tilfeller tror jeg nok du dessverre må publisere mer av applikasjonen din før jeg eventuelt kan si hva som er galt.

 

Et alternativ kan muligens være å benytte SetLayeredWindowAttributes-APIet:

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "User32" ()

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 WM_NCLBUTTONDOWN = &HA1

Const HTCAPTION = 2

Const WS_EX_LAYERED = &H80000

Const GWL_EXSTYLE = (-20)

Const LWA_ALPHA = &H2

Const LWA_COLORKEY = &H1

 

Public Function EnableTransparent(refWnd As Long, lngColor As Long)

 

  Dim rtn As Long

   

    ' Hent original stildata og tilføy ny type

    rtn = GetWindowLong(hWnd, GWL_EXSTYLE)

    rtn = rtn Or WS_EX_LAYERED

   

    ' Sett den nye stiltypen

    SetWindowLong hWnd, GWL_EXSTYLE, rtn

   

    ' Sett hvorvidt en skal benytte fullendt gjennomsiktighet og hvilken fargenøkkel som er gjeldende

    SetLayeredWindowAttributes refWnd, lngColor, 0, LWA_COLORKEY

 

End Function

 

Private Sub Form_Load()

 

    ' Sett bakgrunnsfarge

    Me.BackColor = vbMagenta

 

    ' Kjør prosedyre

    EnableTransparent Me.hWnd, Me.BackColor

 

End Sub

[Richard87]

Ok, her er hele prosjektet... er ikke helt ferdig enda da...

 

Kan hende at du trenger Nero SDK far og fa deler av prosjektet til og virke...

 

[EDIT] Det merkelige er jo at den 'overste' linjen av det rosa feltet forsvinner, men ikke resten... er helt lost jeg ivertfall

 

Ok, din kode virker fint, men er ikke stottet pa Win9x... men,men, who cares om 9x uanset... det funker:D:D:D

 

Takk for hjelpen..

 

PS. Vis du finner ut hvorfor koden min ikke virker, vennligst si ifra, greit og vite uanz.

VB_Nero_Backup_APP.zip

Endret 30. januar 2006 av Richard87