seduerey
11-11-2003, 19:58:31
bien, he intentado probar las coolforms, pero no han acabado de funcionarme correctamente, y me han pasado un codigo en Visual Basic que hace llamadas a las apis de windows, y me gustaria saber si es posible realizarlo análogamente en Delphi, y que tipos son los que deberia usar...
Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)
'Variable Declaration
Dim hRgn As Long, tRgn As Long
Dim X As Integer, Y As Integer, X0 As Integer
Dim hDC As Long, BM As BITMAP
'Create a new memory DC, where we will scan the picture
hDC = CreateCompatibleDC(0)
If hDC Then
'Let the new DC select the Picture
SelectObject hDC, cPicture
'Get the Picture dimensions and create a new rectangular
'region
GetObject cPicture, Len(BM), BM
hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
'Start scanning the picture from top to bottom
For Y = 0 To BM.bmHeight
For X = 0 To BM.bmWidth
'Scan a line of non transparent pixels
While X <= BM.bmWidth And GetPixel(hDC, X, Y) <> cTransparent
X = X + 1
Wend
'Mark the start of a line of transparent pixels
X0 = X
'Scan a line of transparent pixels
While X <= BM.bmWidth And GetPixel(hDC, X, Y) = cTransparent
X = X + 1
Wend
'Create a new Region that corresponds to the row of
'Transparent pixels and then remove it from the main
'Region
If X0 < X Then
tRgn = CreateRectRgn(X0, Y, X, Y + 1)
CombineRgn hRgn, hRgn, tRgn, 4
'Free the memory used by the new temporary Region
DeleteObject tRgn
End If
Next X
Next Y
'Return the memory address to the shaped region
GetBitmapRegion = hRgn
'Free memory by deleting the Picture
DeleteObject SelectObject(hDC, cPicture)
End If
'Free memory by deleting the created DC
DeleteDC hDC
End Function
Se que os parecerá extraño, es para lograr que se vea la parte de detrás de un formulario, para que haya partes "transparentes" en todas las plataformas Win32, tal y como hace el Nero 6, por ejemplo
Gracias de antemano
Public Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)
'Variable Declaration
Dim hRgn As Long, tRgn As Long
Dim X As Integer, Y As Integer, X0 As Integer
Dim hDC As Long, BM As BITMAP
'Create a new memory DC, where we will scan the picture
hDC = CreateCompatibleDC(0)
If hDC Then
'Let the new DC select the Picture
SelectObject hDC, cPicture
'Get the Picture dimensions and create a new rectangular
'region
GetObject cPicture, Len(BM), BM
hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
'Start scanning the picture from top to bottom
For Y = 0 To BM.bmHeight
For X = 0 To BM.bmWidth
'Scan a line of non transparent pixels
While X <= BM.bmWidth And GetPixel(hDC, X, Y) <> cTransparent
X = X + 1
Wend
'Mark the start of a line of transparent pixels
X0 = X
'Scan a line of transparent pixels
While X <= BM.bmWidth And GetPixel(hDC, X, Y) = cTransparent
X = X + 1
Wend
'Create a new Region that corresponds to the row of
'Transparent pixels and then remove it from the main
'Region
If X0 < X Then
tRgn = CreateRectRgn(X0, Y, X, Y + 1)
CombineRgn hRgn, hRgn, tRgn, 4
'Free the memory used by the new temporary Region
DeleteObject tRgn
End If
Next X
Next Y
'Return the memory address to the shaped region
GetBitmapRegion = hRgn
'Free memory by deleting the Picture
DeleteObject SelectObject(hDC, cPicture)
End If
'Free memory by deleting the created DC
DeleteDC hDC
End Function
Se que os parecerá extraño, es para lograr que se vea la parte de detrás de un formulario, para que haya partes "transparentes" en todas las plataformas Win32, tal y como hace el Nero 6, por ejemplo
Gracias de antemano