Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: coco en Marzo 15, 2014, 08:00:34 pm
-
Buenas, bueno me surgio el tema de que necesito dibujar lineas en un picturebox, y deben tener shadow a sus costados.
Además, mientras hacia las pruebas, me di cuenta que es necesario alisar la linea (queda horrible si dibujas una linea a 45º).
Mas o menos la idea es:
(http://i.snag.gy/TTAir.jpg) (haganle zoom para ver el shadow que tiene y lo bien alisada que esta).
Haciendo unas simples llamadas a objeto.Line, me queda asi:
(http://i.snag.gy/vDJyH.jpg) (feisimo).
Tambien probe con el AlphaBlend de leandro, pero no me queda bien nunca. Creo que es necesario usar GDI+.
Alguien me puede dar una mano sobre como "pintar" una linea con shadow y alisarla? (nada mas que eso).
Saludos
-
Hola coco te pongo un ejemplo rapidito pero te vas a dar cuenta como armar algo lindo. tambien tene en cuenta esta api si queres dibujar muchas lineas en una sola llamada
Private Declare Function GdipDrawLines Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByRef mPoints As POINTF, ByVal mCount As Long) As Long
Option Explicit
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As Long) As Long
Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
Private Declare Function GdipDrawLine Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX1 As Single, ByVal mY1 As Single, ByVal mX2 As Single, ByVal mY2 As Single) As Long
Private Declare Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As Long, ByRef mPen As Long) As Long
Private Declare Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As Long) As Long
Private Declare Function GdipSetPenStartCap Lib "gdiplus" (ByVal pen As Long, ByVal startCap As LineCap) As Long
Private Declare Function GdipSetPenEndCap Lib "gdiplus" (ByVal pen As Long, ByVal endCap As LineCap) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Enum LineCap
LineCapFlat = &H0
LineCapSquare = &H1
LineCapRound = &H2
LineCapTriangle = &H3
LineCapNoAnchor = &H10
LineCapSquareAnchor = &H11
LineCapRoundAnchor = &H12
LineCapDiamondAnchor = &H13
LineCapArrowAnchor = &H14
End Enum
Public Enum enuNumberOfLines
FortyEightLines = &H0
TwentyFourLines = &H1
TwelveLines = &H2
EightLine = &H3
SixtLine = &H4
FourLine = &H5
End Enum
Private Const SmoothingModeAntiAlias As Long = &H4
Private Const UnitPixel As Long = &H2
Private Const PI180 = 3.14159 / 180
'Private GdipToken As Long
Private CurrentPos As Long
Private mDrawWidth As Long
Private mBackColor As OLE_COLOR
Private mForeColor As OLE_COLOR
Private mLineStart As LineCap
Private mLineEnd As LineCap
Private mTotalLines As Long
Private mNumberOfLines As enuNumberOfLines
Private mInterval As Long
Dim GdipToken As Long
Private Type POINTF
X As Single
Y As Single
End Type
Private Declare Function GdipDrawLineI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX1 As Long, ByVal mY1 As Long, ByVal mX2 As Long, ByVal mY2 As Long) As Long
Private Declare Function GdipDrawLines Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByRef mPoints As POINTF, ByVal mCount As Long) As Long
Private Sub Command1_Click()
Dim lPercent As Long
Dim hGraphics As Long
Dim hPen As Long
Dim i As Long
Dim SL As Single, ST As Single
Dim S As Single, C As Single
Dim MidSize As Single, Size As Single
If GdipCreateFromHDC(Me.hdc, hGraphics) = 0 Then
Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)
GdipCreatePen1 CombineColors(&HCCCCCC, &HCCCCCC, 100), 6, UnitPixel, hPen
'para las las terminasciones de las puntas (es a gusto)
GdipSetPenStartCap hPen, LineCapRound
GdipSetPenEndCap hPen, LineCapRound
'-------
Call GdipDrawLine(hGraphics, hPen, 10, 10, 100, 100)
GdipDeletePen hPen
GdipCreatePen1 CombineColors(vbRed, vbRed, 100), 3, UnitPixel, hPen
'para las las terminasciones de las puntas (es a gusto)
GdipSetPenStartCap hPen, LineCapRound
GdipSetPenEndCap hPen, LineCapRound
'----
Call GdipDrawLine(hGraphics, hPen, 10, 10, 100, 100)
GdipDeletePen hPen
GdipDeleteGraphics hGraphics
End If
End Sub
Private Sub Form_Load()
InitGDI
End Sub
'Función para combinar dos colores y asignar el color alpha.
Private Function CombineColors(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lPercent As Long, Optional ByVal lAlpha As Long = 255) As Long
Dim clrFore(3) As Byte
Dim clrBack(3) As Byte
Dim clrFinal(3) As Byte
OleTranslateColor clrFirst, 0, VarPtr(clrFore(0))
OleTranslateColor clrSecond, 0, VarPtr(clrBack(0))
clrFinal(0) = (clrFore(2) * lPercent + clrBack(2) * (255 - lPercent)) / 255
clrFinal(1) = (clrFore(1) * lPercent + clrBack(1) * (255 - lPercent)) / 255
clrFinal(2) = (clrFore(0) * lPercent + clrBack(0) * (255 - lPercent)) / 255
clrFinal(3) = lAlpha
CopyMemory CombineColors, clrFinal(0), 4
End Function
'Inicia GDI+
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = 1&
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
'Termina GDI+
Private Sub TerminateGDI()
Call GdiplusShutdown(GdipToken)
End Sub
Private Sub Form_Unload(Cancel As Integer)
TerminateGDI
End Sub
-
Para que quede mejor tenes que dibujar primero toda la curvatura de la sombra y despues todas las lineas, si vos ya tenes todos los valores va bien ahora si es algo que se va dibujando en tiempo real, o no va a quedar bien o tenes que redibujar el grafico completo, porque si enlasas la ultima linea se superpone la sombra
aca te paso la función como creo que seria mejor.
Option Explicit
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As Long) As Long
Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
Private Declare Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As Long, ByRef mPen As Long) As Long
Private Declare Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As Long) As Long
Private Declare Function GdipSetPenStartCap Lib "gdiplus" (ByVal pen As Long, ByVal startCap As LineCap) As Long
Private Declare Function GdipSetPenEndCap Lib "gdiplus" (ByVal pen As Long, ByVal endCap As LineCap) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GdipDrawLines Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByRef mPoints As POINTF, ByVal mCount As Long) As Long
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Enum LineCap
LineCapFlat = &H0
LineCapSquare = &H1
LineCapRound = &H2
LineCapTriangle = &H3
LineCapNoAnchor = &H10
LineCapSquareAnchor = &H11
LineCapRoundAnchor = &H12
LineCapDiamondAnchor = &H13
LineCapArrowAnchor = &H14
End Enum
Private Type POINTF
X As Single
Y As Single
End Type
Private Const SmoothingModeAntiAlias As Long = &H4
Private Const UnitPixel As Long = &H2
Private GdipToken As Long
Private Function DrawLines(ByVal hdc As Long, _
ByRef PF() As POINTF, _
Optional ByVal LineWidth As Single = 1, _
Optional ByVal ForeColor As OLE_COLOR, _
Optional ByVal ShadowColor As OLE_COLOR = &HCCCCCC)
Dim hGraphics As Long
Dim hPen As Long
If GdipCreateFromHDC(hdc, hGraphics) = 0 Then
Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)
GdipCreatePen1 ConvertColor(ShadowColor, 50), LineWidth + (LineWidth * 0.75), UnitPixel, hPen
GdipSetPenStartCap hPen, LineCapRound
GdipSetPenEndCap hPen, LineCapRound
GdipDrawLines hGraphics, hPen, PF(0), UBound(PF) + 1
GdipDeletePen hPen
GdipCreatePen1 ConvertColor(ForeColor, 100), LineWidth, UnitPixel, hPen
GdipSetPenStartCap hPen, LineCapRound
GdipSetPenEndCap hPen, LineCapRound
GdipDrawLines hGraphics, hPen, PF(0), UBound(PF) + 1
GdipDeletePen hPen
GdipDeleteGraphics hGraphics
End If
End Function
Private Sub Form_Load()
InitGDI
Me.AutoRedraw = True
Dim PF() As POINTF
ReDim PF(4)
PF(0).X = 0
PF(0).Y = 0
PF(1).X = 100
PF(1).Y = 100
PF(2).X = 200
PF(2).Y = 100
PF(3).X = 300
PF(3).Y = 50
PF(4).X = 400
PF(4).Y = 80
DrawLines Me.hdc, PF, 5, vbRed
PF(0).X = 0
PF(0).Y = 50
PF(1).X = 100
PF(1).Y = 90
PF(2).X = 200
PF(2).Y = 40
PF(3).X = 300
PF(3).Y = 130
PF(4).X = 400
PF(4).Y = 20
DrawLines Me.hdc, PF, 5, &HFF9900
End Sub
Private Sub Form_Unload(Cancel As Integer)
TerminateGDI
End Sub
Private Function ConvertColor(Color As Long, Opacity As Long) As Long
Dim BGRA(0 To 3) As Byte
BGRA(3) = CByte((Abs(Opacity) / 100) * 255)
BGRA(0) = ((Color \ &H10000) And &HFF)
BGRA(1) = ((Color \ &H100) And &HFF)
BGRA(2) = (Color And &HFF)
CopyMemory ConvertColor, BGRA(0), 4&
End Function
'Inicia GDI+
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = 1&
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
'Termina GDI+
Private Sub TerminateGDI()
Call GdiplusShutdown(GdipToken)
End Sub
-
Fantastico Lea, cuando lo termine lo subo!!! Era exactamente lo que buscaba.
PD: Disculpame si te jodi mucho.
Un saludo