Visual Basic - RE:Usercontrol transparente (ruri)

Life is soft - evento anual de software empresarial
 
Vista:

RE:Usercontrol transparente (ruri)

Publicado por Kulber (11 intervenciones) el 21/08/2004 11:20:09
No, no quiero crear una region, sino hacer transparente un usercontrol despues de escribir un texto, pero no lo hace si el texto supera un numero de caracteres. Ademas, no quiero usar la API ya que no todo el mundo usa Win2000 o WinXP. Yo, por ejemplo, uso WinMe.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Usercontrol transparente (ruri)

Publicado por ruri (583 intervenciones) el 22/08/2004 19:25:49
Kulber:
Lamento no serte de ayuda,pero hasta donde sé WinMe no soporta regiones transparentes (generalmente se hacen con un AlphaBlend) Si la región no es muy grande, podés imitarlo creando un bitmap al estilo AlphaBlend. Superponiendo el primer plano y el fondo mezclandolos Pixel a Pixel. Antiguamente lo hacía de esta manera:

Public Function AlphaBlendEx(ByVal SourceConstantAlpha As Long, _
ByVal hdcDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, _
ByVal HdcSource As Long, ByVal XSource As Long, ByVal YSource As Long, ByVal WidthSource As Long, ByVal HeightSource As Long) As Boolean

Dim OldStretchMode As Long, f As Boolean
OldStretchMode = GetStretchBltMode(HdcSource)
SetStretchBltMode HdcSource, HALFTONE

Dim k As Long, j As Long, xRed As Long, xBlue As Long, xGreen As Long, ConstantAlpha As Single
Dim correc As Long, D As Long, lngColor As Long, xColor As Long
Dim hHdc As Long, hBmp As Long, hOldBmp As Long, oldSbm As Long
correc = -(15 / 128 ^ 2) * SourceConstantAlpha ^ 2 + (30 / 128) * SourceConstantAlpha
lngColor = vbMagenta

On Error Resume Next '255 -
ConstantAlpha = ((SourceConstantAlpha + correc) / 255)
hHdc = CreateCompatibleDC(HdcSource)
hBmp = CreateCompatibleBitmap(HdcSource, WidthDest, HeightDest)
hOldBmp = SelectObject(hHdc, hBmp)
oldSbm = GetStretchBltMode(hHdc)
SetStretchBltMode hHdc, HALFTONE
f = (StretchBlt(hHdc, 0, 0, WidthDest, HeightDest, HdcSource, XSource, YSource, WidthSource, HeightSource, vbSrcCopy) <> 0)
If f = False Then GoTo Salida
Dim dRed As Long, dGreen As Long, dBlue As Long, oRed As Long, oGreen As Long, oBlue As Long
For k = 0 To WidthDest
For j = 0 To HeightDest
xColor = GetPixel(hdcDest, k + XDest, j + YDest)
lngColor = GetPixel(hHdc, k, j)
SetPixel hdcDest, k + XDest, j + YDest, _
RGB(CompensarByte((lngColor And &HFF) * ConstantAlpha + (1 - ConstantAlpha) * (xColor And &HFF)), _
CompensarByte(((lngColor \ &H100) And &HFF) * ConstantAlpha + (1 - ConstantAlpha) * ((xColor \ &H100) And &HFF)), _
CompensarByte(((lngColor \ &H10000) And &HFF) * ConstantAlpha + (1 - ConstantAlpha) * ((xColor \ &H10000) And &HFF)))
Next j
Next k
SetStretchBltMode hHdc, oldSbm
SelectObject hHdc, hOldBmp
DeleteObject hBmp
DeleteDC hHdc
f = True
Salida:
SetStretchBltMode HdcSource, OldStretchMode
AlphaBlendEx = f
Exit Function
Salida2:
SetStretchBltMode HdcSource, OldStretchMode
AlphaBlendEx = AlphaBlendEx(SourceConstantAlpha, HdcSource, XSource, YSource, WidthSource, HeightSource, hdcDest, XDest, YDest, WidthDest, HeightDest, True)
End Function

Private Function CompensarByte(ByVal lByte As Long) As Byte
'lByte = Abs(lByte)
If lByte > 255 Then
lByte = 255
ElseIf lByte < 0 Then
lByte = 0
End If
CompensarByte = lByte
End Function

Si querés ensayarlo vas a tener que buscar las declaraciones del Api en el APIViever (Visor del Api) Está en los complementos. No te las envío, pues este código forma parte de una dll mucho más grande y tengo todas las declaraciones mezcladas. Este código no efectúa lo que vos querés, pero lo imita.

Espero haberte sido útil. Ruri
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar