Visual Basic - colores xp

Life is soft - evento anual de software empresarial
 
Vista:

colores xp

Publicado por CharLinux (25 intervenciones) el 02/02/2005 21:27:43
HOLA ALGUNO DE USTEDES ME PODRIA DECIR COMO PUEDO HACER EN VB EL EFECTO DE ESCALA DE GRISES COMO EL QUE OCUPA WINDOWX XP AL MOMENTO DE MANDAR EL MENSAJE DE CERRAR SECION O APAGAR
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:colores xp

Publicado por Benjo (679 intervenciones) el 02/02/2005 22:52:26
'Podría ser una rutina tipo AlphaBlend
'El proyecto requiere dos PictureBox con una imagen en color y otra en Blanco y negro, un objeto Timer y un commandbutton
Const AC_SRC_OVER = &H0
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Command1_Click() : Timer1.Enabled = True:End Sub
Private Sub Form_Load()
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture1.Visible = False
End Sub
Private Sub Timer1_Timer()
Static iloop As Integer
iloop = iloop + 1
If iloop = 15 Then Timer1.Enabled = False
Dim BF As BLENDFUNCTION, lBF As Long
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = 128
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
AlphaBlend Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lBF
Picture2.Refresh
End Sub
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