![\"Draw](\"http:\/\/www.leandroascierto.com\/blog\/imagenes\/draw_selection_ex.png\")
<\/p>\nEste es una funci\u00f3n para dibujar una selecci\u00f3n al estilo Windows Vista o MSN, \u00fatil para hacer controles de usuarios o seg\u00fan la necesidad de cada uno. creo que si bien es hay unas cuantas\u00a0 Apis, la funci\u00f3n es muy r\u00e1pida en dibujar.<\/p>\n
\n<\/p>\n
\r\n\r\nOption Explicit\r\n' ---------------------------------------------------\r\n' Autor: Leandro Ascierto\r\n' ----------------------------------------------------\r\n\r\nPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long\r\nPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long\r\nPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long\r\nPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long\r\nPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long\r\nPrivate Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long\r\nPrivate Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long\r\nPrivate Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long\r\nPrivate Declare Function RoundRect Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long\r\nPrivate Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long\r\nPrivate Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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\nPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)\r\nPrivate Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long\r\n \r\nPrivate Type UcsRgbQuad\r\n R As Byte\r\n G As Byte\r\n B As Byte\r\n a As Byte\r\nEnd Type \r\n \r\nPrivate Sub DrawSelectionEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, oColorStar As Long, oColorEnd As Long) \r\n Dim DC As Long, hDCMemory As Long, hBmp As Long\r\n Dim hPen1 As Long, hPen2 As Long, hBrush As Long\r\n Dim OldhBmp As Long, OldhPen As Long, OldhBrush As Long\r\n Dim DivValue As Double\r\n Dim i As Long\r\n \r\n ' Creamos una Pluma oscura para el borde\r\n hPen1 = CreatePen(0, 1, pvAlphaBlend(vbBlack, oColorEnd, 10))\r\n \r\n ' Creamos un Pluma para un peque\u00f1o borde interior, bien claro\r\n hPen2 = CreatePen(0, 1, pvAlphaBlend(oColorStar, vbWhite, 10))\r\n \r\n ' Creamos un HDC temporal\r\n DC = GetDC(0)\r\n hDCMemory = CreateCompatibleDC(0)\r\n hBmp = CreateCompatibleBitmap(DC, 1, DestHeight)\r\n OldhBmp = SelectObject(hDCMemory, hBmp)\r\n \r\n ' Creamos un bucle haciendo un degradado\r\n For i = 1 To DestHeight\r\n DivValue = ((i * 255) \/ DestHeight)\r\n SetPixelV hDCMemory, 0, i, pvAlphaBlend(oColorEnd, oColorStar, DivValue)\r\n Next\r\n \r\n ' Creamos una brocha con el bmp\r\n hBrush = CreatePatternBrush(hBmp)\r\n \r\n ' Creamos un buffer temporal\r\n DeleteObject hBmp\r\n hBmp = CreateCompatibleBitmap(DC, DestWidth, DestHeight)\r\n Call SelectObject(hDCMemory, hBmp)\r\n \r\n ' Pintamos el destino en el buffer\r\n BitBlt hDCMemory, 0, 0, DestWidth, DestHeight, DestDC, DestX, DestY, vbSrcCopy\r\n \r\n ' Le asignamos la pluma al hdc de destino\r\n OldhPen = SelectObject(hDCMemory, hPen1)\r\n \r\n ' Pintamos un borde oscuro alrededor sin relleno\r\n RoundRect hDCMemory, 0, 0, DestWidth, DestHeight, 9, 9\r\n \r\n ' Asignamos la segunda pluma m\u00e1s clara\r\n Call SelectObject(hDCMemory, hPen2)\r\n \r\n ' Creamos y asignamos una brocha con el bmp de nuestro degradado\r\n OldhBrush = SelectObject(hDCMemory, hBrush)\r\n \r\n ' Pintamos un rect\u00e1ngulo redondeado con la pluma y la brocha\r\n RoundRect hDCMemory, 1, 1, DestWidth - 1, DestHeight - 1, 8, 8\r\n \r\n ' Pintamos el buffer en el destino\r\n BitBlt DestDC, DestX, DestY, DestWidth, DestHeight, hDCMemory, 0, 0, vbSrcCopy\r\n \r\n ' Descargamos todo\r\n SelectObject hDCMemory, OldhPen\r\n SelectObject hDCMemory, OldhBrush\r\n SelectObject hDCMemory, OldhBmp\r\n DeleteObject hPen1\r\n DeleteObject hPen2\r\n DeleteObject hBrush\r\n DeleteObject hBmp\r\n ReleaseDC 0&, DC\r\n DeleteDC hDCMemory\r\n \r\nEnd Sub \r\n \r\n' Funci\u00f3n para trasladar un color a otro en porcentaje lAlpha(0 A 255)\r\nPrivate Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long\r\n \r\n Dim clrFore As UcsRgbQuad\r\n Dim clrBack As UcsRgbQuad\r\n \r\n OleTranslateColor clrFirst, 0, VarPtr(clrFore)\r\n OleTranslateColor clrSecond, 0, VarPtr(clrBack)\r\n With clrFore\r\n .R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) \/ 255\r\n .G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) \/ 255\r\n .B = (.B * lAlpha + clrBack.B * (255 - lAlpha)) \/ 255\r\n End With\r\n \r\n CopyMemory VarPtr(pvAlphaBlend), VarPtr(clrFore), 4\r\n \r\nEnd Function\r\n \r\nPrivate Sub Form_Load()\r\n Me.ScaleMode = vbPixels\r\n Me.FontName = "Calibri"\r\n Me.FontSize = 12\r\n Me.BackColor = vbWhite\r\n Me.Width = 8500\r\n Me.Height = 8700\r\n HScroll1.Max = 255\r\n HScroll1.Value = 70\r\n HScroll1.Move 320, 210, 230, 30\r\nEnd Sub\r\n \r\n' Ejemplo de uso\r\nPrivate Sub Form_Paint()\r\n \r\n Dim i As Integer\r\n \r\n ' Colores empleados en Windows Vista, y MSN\r\n DrawSelectionEx Me.hdc, 320, 10, 100, 100, RGB(249, 253, 255), RGB(234, 247, 255)\r\n DrawSelectionEx Me.hdc, 440, 10, 100, 100, RGB(251, 251, 251), RGB(231, 231, 231)\r\n \r\n ' Con quince colores diferentes\r\n For i = 0 To 15\r\n DrawSelectionEx Me.hdc, 10, 10 + (i * 35), 300, 30, Me.BackColor, pvAlphaBlend(QBColor(i), Me.BackColor, HScroll1.Value)\r\n Next\r\n \r\n ' Utilizando el color resalte del sistema\r\n DrawSelectionEx Me.hdc, 320, 120, 220, 70, Me.BackColor, pvAlphaBlend(vbHighlight, Me.BackColor, 50)\r\n \r\n Me.CurrentX = 330\r\n Me.CurrentY = 145\r\n Me.Print "Color de selecci\u00f3n del Sistema"\r\n \r\nEnd Sub \r\n \r\nPrivate Sub HScroll1_Change()\r\n Form_Paint\r\nEnd Sub\r\n<\/pre><\/p>\n","protected":false},"excerpt":{"rendered":"Este es una funci\u00f3n para dibujar una selecci\u00f3n al estilo Windows Vista o MSN, \u00fatil para hacer controles de usuarios o seg\u00fan la necesidad de cada uno. creo que si bien es hay unas cuantas\u00a0 Apis, la funci\u00f3n es muy r\u00e1pida en dibujar. Option Explicit ‘ ————————————————— ‘ Autor: Leandro Ascierto ‘ —————————————————- Private Declare […]<\/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":[73],"class_list":["post-371","post","type-post","status-publish","format-standard","hentry","category-graficos","tag-gdi32","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\/371","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=371"}],"version-history":[{"count":2,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/371\/revisions"}],"predecessor-version":[{"id":541,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/371\/revisions\/541"}],"wp:attachment":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/media?parent=371"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/categories?post=371"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/tags?post=371"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}