{"id":383,"date":"2010-04-27T00:28:05","date_gmt":"2010-04-27T03:28:05","guid":{"rendered":"http:\/\/leandroascierto.com\/blog\/?p=383"},"modified":"2011-08-27T08:08:38","modified_gmt":"2011-08-27T11:08:38","slug":"esferas-con-gdi","status":"publish","type":"post","link":"https:\/\/leandroascierto.com\/blog\/esferas-con-gdi\/","title":{"rendered":"Esferas con GDI+"},"content":{"rendered":"

Esta es una funci\u00f3n para dibujar esferas utilizando GDI+. Existen varios dise\u00f1os, yo eleg\u00ed este, el cual est\u00e1 conformado con un color gradient central, una luz que la enfoca por encima y una sombra del mismo color que la esfera.
\nEs muy entretenido jugar con los m\u00e9todos gr\u00e1ficos de GDI+ ya que nos permite utilizar transparencias, anti-alias y muchas funciones con las cuales podr\u00edamos hacer gr\u00e1ficos tal como en Photo Shop.<\/p>\n

\n\"Esferas\"<\/p>\n

\r\n\r\nOption Explicit\r\n \r\n' ------------------------------------------------------------\r\n' Autor:    Leandro I. Ascierto\r\n' Fecha:    27 de Abril de 2010\r\n' Web:      www.leandroascierto.com.ar\r\n' ------------------------------------------------------------\r\n\r\nPrivate Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long\r\nPrivate Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long\r\nPrivate Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long\r\nPrivate Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long\r\nPrivate Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long\r\nPrivate Declare Function GdipDeleteBrush Lib "GdiPlus.dll" (ByVal mBrush As Long) As Long\r\nPrivate Declare Function GdipFillEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mBrush As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long\r\nPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)\r\nPrivate Declare Function GdipCreatePath Lib "GdiPlus.dll" (ByVal mBrushMode As Long, ByRef mPath As Long) As Long\r\nPrivate Declare Function GdipDeletePath Lib "GdiPlus.dll" (ByVal mPath As Long) As Long\r\nPrivate Declare Function GdipCreateLineBrushFromRectI Lib "GdiPlus.dll" (ByRef mRect As RECTL, ByVal mColor1 As Long, ByVal mColor2 As Long, ByVal mMode As LinearGradientMode, ByVal mWrapMode As WrapMode, ByRef mLineGradient As Long) As Long\r\nPrivate Declare Function GdipAddPathEllipseI Lib "GdiPlus.dll" (ByVal mPath As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long\r\nPrivate Declare Function GdipSetPathGradientCenterColor Lib "GdiPlus.dll" (ByVal mBrush As Long, ByVal mColors As Long) As Long\r\nPrivate Declare Function GdipSetPathGradientSurroundColorsWithCount Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mColor As Long, ByRef mCount As Long) As Long\r\nPrivate Declare Function GdipCreatePathGradientFromPath Lib "GdiPlus.dll" (ByVal mPath As Long, ByRef mPolyGradient As Long) As Long\r\nPrivate Declare Function GdipSetLinePresetBlend Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mBlend As Long, ByRef mPositions As Single, ByVal mCount As Long) As Long\r\nPrivate Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long\r\n \r\nPrivate Type RECTL\r\n    Left    As Long\r\n    Top     As Long\r\n    Width   As Long\r\n    Height  As Long\r\nEnd Type\r\n \r\nPrivate Enum LinearGradientMode\r\n    LinearGradientModeHorizontal = &H0\r\n    LinearGradientModeVertical = &H1\r\n    LinearGradientModeForwardDiagonal = &H2\r\n    LinearGradientModeBackwardDiagonal = &H3\r\nEnd Enum\r\n \r\nPrivate Enum WrapMode\r\n    WrapModeTile = &H0\r\n    WrapModeTileFlipX = &H1\r\n    WrapModeTileFlipy = &H2\r\n    WrapModeTileFlipXY = &H3\r\n    WrapModeClamp = &H4\r\nEnd Enum\r\n \r\nPrivate Type GDIPlusStartupInput\r\n    GdiPlusVersion                      As Long\r\n    DebugEventCallback                  As Long\r\n    SuppressBackgroundThread            As Long\r\n    SuppressExternalCodecs              As Long\r\nEnd Type\r\n \r\nPrivate Const SmoothingModeAntiAlias    As Long = &H4\r\nDim GdipToken As Long\r\n \r\n \r\nPrivate Sub Form_Load()\r\n    Call InitGDI\r\n    Me.AutoRedraw = True\r\n    DrawSphere Me.hdc, vbBlue, 10, 20, 150, 150\r\n    DrawSphere Me.hdc, vbGreen, 180, 20, 150, 150\r\n    DrawSphere Me.hdc, vbRed, 350, 20, 150, 150\r\n    DrawSphere Me.hdc, vbYellow, 10, 210, 150, 150\r\n    DrawSphere Me.hdc, vbBlack, 180, 210, 150, 150\r\n    DrawSphere Me.hdc, vbMagenta, 350, 210, 150, 150\r\n    DrawSphere Me.hdc, vbCyan, 10, 400, 150, 150\r\n    DrawSphere Me.hdc, vbWhite, 180, 400, 150, 150\r\n    DrawSphere Me.hdc, &H99FF&, 350, 400, 150, 150\r\nEnd Sub\r\n \r\n \r\nPrivate Sub Form_Unload(Cancel As Integer)\r\n    Call TerminateGDI\r\nEnd Sub\r\n \r\n \r\nPublic Function DrawSphere(ByVal hdc As Long, _\r\n                           ByVal lColor As Long, _\r\n                           ByVal X As Long, _\r\n                           ByVal Y As Long, _\r\n                           ByVal Width As Long, _\r\n                           ByVal Height As Long, _\r\n                           Optional ByVal bDrawShadow As Boolean = True, _\r\n                           Optional ByVal lAlpha As Long = 100) As Boolean\r\n \r\n    Dim hGraphics As Long\r\n    Dim hBrush As Long\r\n    Dim mPath As Long\r\n    Dim mRect As RECTL\r\n    Dim col(2) As Long\r\n    Dim pos(2) As Single\r\n \r\n    'crea un grafico a partir de un hdc\r\n    If GdipCreateFromHDC(hdc, hGraphics) = 0 Then\r\n \r\n        'aplica el modo antialias\r\n        Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)\r\n \r\n \r\n        ' ----------------------------- Shadow -------------------------------------\r\n        If bDrawShadow Then\r\n \r\n            Call GdipCreatePath(&H0, mPath)                                                         'Crea un Path\r\n            GdipAddPathEllipseI mPath, X, Y + Height \/ 1.1, Width, Height \/ 4                       'Dibuja un Circulo\r\n            GdipCreatePathGradientFromPath mPath, hBrush                                            'Crea una brocha a partir de el Path\r\n            \r\n            GdipSetPathGradientCenterColor hBrush, ConvertColor(lColor, lAlpha \/ 3)                 'Asigna un color central a la brocha\r\n            GdipSetPathGradientSurroundColorsWithCount hBrush, 0, 1                                 'Aplica un color Transparente al contorno de la brocha\/circulo\r\n    \r\n            Call GdipFillEllipseI(hGraphics, hBrush, X, Y + Height \/ 1.1, Width, Height \/ 4)        'dibuja la sombra en el grafico\r\n            \r\n            Call GdipDeleteBrush(hBrush)                                                            'Descarga la brocha\r\n            Call GdipDeletePath(mPath)                                                              'Descarga el Path\r\n        End If\r\n \r\n        '----------------------------- Sphere -------------------------------------\r\n               \r\n        Call GdipCreatePath(&H0, mPath)                                                              'Crea un Path\r\n        \r\n        GdipAddPathEllipseI mPath, X - (Width \/ 1.75), Y - Height \/ 2, Width * 2, Height * 2         'Dibuja un Circulo en el path\r\n        GdipCreatePathGradientFromPath mPath, hBrush                                                 'Crea una brocha a partir de el Path\r\n        GdipSetPathGradientCenterColor hBrush, ConvertColor(lColor, lAlpha)                          'Asigna el color central a la brocha\r\n        GdipSetPathGradientSurroundColorsWithCount hBrush, ConvertColor(ShiftColor(lColor, vbBlack, 100), lAlpha), 1 'Aplica un color mas opaco al gradient de la brocha\r\n        \r\n        Call GdipFillEllipseI(hGraphics, hBrush, X, Y, Width, Height)                                'Dibuja un circulo en el grafico\r\n        Call GdipDeleteBrush(hBrush)                                                                 'Descarga la brocha\r\n        Call GdipDeletePath(mPath)                                                                   'Descarga el Path\r\n        \r\n        '----------------------------- Light -------------------------------------\r\n        \r\n        mRect.Left = X + Width \/ 10\r\n        mRect.Top = Y + Height \/ 50\r\n        mRect.Width = Width - Width \/ 5\r\n        mRect.Height = Height \/ 1.5\r\n \r\n        GdipCreateLineBrushFromRectI mRect, 0, 0, LinearGradientModeVertical, WrapModeTileFlipy, hBrush 'crea una brocha de dos colores\r\n\r\n        col(0) = ConvertColor(vbWhite, lAlpha \/ 1.25)           'Primer color\r\n        col(1) = 0                                              'segundo color transparente\r\n        col(2) = 0                                              'tercer color transparente\r\n\r\n        pos(0) = 0\r\n        pos(1) = 0.6                                            'El 60% de la brocha va a ser transparente\r\n        pos(2) = 1\r\n \r\n        Call GdipSetLinePresetBlend(hBrush, col(0), pos(0), 3)  'Asigna los valores para la brocha\r\n        Call GdipFillEllipseI(hGraphics, hBrush, mRect.Left, mRect.Top, mRect.Width, mRect.Height - 1) 'dibuja un circulo aplastado semi transparente\r\n        Call GdipDeleteBrush(hBrush)                            'Elimina la brocha\r\n        \r\n        ' ------------------------------------------------------------------------\r\n\r\n        Call GdipDeleteGraphics(hGraphics)                       'Elimina el grafico.\r\n    End If\r\n \r\nEnd Function\r\n \r\n' funcion para convertir un color long a un BGRA(Blue, Green, Red, Alpha)\r\nPrivate Function ConvertColor(Color As Long, Opacity As Long) As Long\r\n    Dim BGRA(0 To 3) As Byte\r\n \r\n    BGRA(3) = CByte((Abs(Opacity) \/ 100) * 255)\r\n    BGRA(0) = ((Color \\ &H10000) And &HFF)\r\n    BGRA(1) = ((Color \\ &H100) And &HFF)\r\n    BGRA(2) = (Color And &HFF)\r\n    CopyMemory ConvertColor, BGRA(0), 4&\r\nEnd Function\r\n \r\n'Funcion para combinar dos colores\r\nPrivate Function ShiftColor(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long\r\n \r\n    Dim clrFore(3)         As Byte\r\n    Dim clrBack(3)         As Byte\r\n \r\n    OleTranslateColor clrFirst, 0, VarPtr(clrFore(0))\r\n    OleTranslateColor clrSecond, 0, VarPtr(clrBack(0))\r\n \r\n    clrFore(0) = (clrFore(0) * lAlpha + clrBack(0) * (255 - lAlpha)) \/ 255\r\n    clrFore(1) = (clrFore(1) * lAlpha + clrBack(1) * (255 - lAlpha)) \/ 255\r\n    clrFore(2) = (clrFore(2) * lAlpha + clrBack(2) * (255 - lAlpha)) \/ 255\r\n \r\n    CopyMemory ShiftColor, clrFore(0), 4\r\n \r\nEnd Function\r\n \r\n'Inicia GDI+\r\nPrivate Sub InitGDI()\r\n    Dim GdipStartupInput As GDIPlusStartupInput\r\n    GdipStartupInput.GdiPlusVersion = 1&\r\n    Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)\r\nEnd Sub\r\n \r\n'Termina GDI+\r\nPrivate Sub TerminateGDI()\r\n    Call GdiplusShutdown(GdipToken)\r\nEnd Sub\r\n \r\n<\/pre>\n<\/p>\n
\"\"<\/a><\/p>\n","protected":false},"excerpt":{"rendered":"
Esta es una funci\u00f3n para dibujar esferas utilizando GDI+. Existen varios dise\u00f1os, yo eleg\u00ed este, el cual est\u00e1 conformado con un color gradient central, una luz que la enfoca por encima y una sombra del mismo color que la esfera. Es muy entretenido jugar con los m\u00e9todos gr\u00e1ficos de GDI+ ya que nos permite utilizar […]<\/a><\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[41],"tags":[60,35],"class_list":["post-383","post","type-post","status-publish","format-standard","hentry","category-graficos","tag-gdi-plus","tag-gdi","category-41-id","post-seq-1","post-parity-odd","meta-position-corners","fix"],"_links":{"self":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/383","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/comments?post=383"}],"version-history":[{"count":4,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/383\/revisions"}],"predecessor-version":[{"id":490,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/383\/revisions\/490"}],"wp:attachment":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/media?parent=383"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/categories?post=383"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/tags?post=383"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}