send
Grupo de Telegram
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

PictureBox que se recorta de acuerdo al Picture que contiene

  • 0 Respuestas
  • 1318 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5283
  • Actividad:
    35%
  • Reputación 28
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Julio 26, 2010, 12:22:47 pm »
Código: Visual Basic
  1. Option Explicit
  2.  
  3. Public CalculationDone As Boolean
  4. Public TransColor As Long
  5. Public ByteCtr As Long
  6. Public RgnData() As Byte
  7.  
  8. Private Const RGN_XOR = 3
  9. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  10. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  11. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  12. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  13. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  14. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  15. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  16. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  17. Private Declare Function GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, lpRgnData As Any) As Long
  18.  
  19.  
  20. Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
  21. Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
  22. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  23.  
  24.  
  25.  
  26. Private PicInfo As BITMAP
  27.  
  28. Private Type BITMAP
  29. bmType As Long
  30. bmWidth As Long
  31. bmHeight As Long
  32. bmWidthBytes As Long
  33. bmPlanes As Integer
  34. bmBitsPixel As Integer
  35. bmBits As Long
  36. End Type
  37.  
  38. 'Calculate a Region to shape the form
  39. Public Sub CalcPic(Pic As PictureBox)
  40.  
  41. Dim rgnMain As Long
  42. Dim X As Long
  43. Dim Y As Long
  44. Dim rgnPixel As Long
  45. Dim RGBColor As Long
  46. Dim dcMain As Long
  47. Dim bmpMain As Long
  48. Dim Width As Long
  49. Dim Height As Long
  50.  
  51. Dim LastHit As Boolean
  52. Dim StartX As Long
  53. Dim StartY As Long
  54.  
  55.  
  56. 'Create A region to shape the Form
  57. Width = Pic.ScaleX(Pic.Width, vbTwips, vbPixels)
  58. Height = Pic.ScaleY(Pic.Height, vbTwips, vbPixels)
  59. 'Create a new Region
  60. rgnMain = CreateRectRgn(0, 0, Width, Height)
  61. dcMain = CreateCompatibleDC(Pic.hDC)
  62. 'Get the picture we us for this calculation
  63. bmpMain = SelectObject(dcMain, Pic.Picture.Handle)
  64.  
  65. 'Move thru it
  66. For Y = 0 To Height
  67. For X = 0 To Width
  68. RGBColor = GetPixel(dcMain, X, Y)
  69. 'Found a transparent spot
  70. 'make it also tramsparent on the region
  71. If RGBColor = TransColor And LastHit = False Then
  72. LastHit = True
  73. StartX = X
  74. StartY = Y
  75. ElseIf LastHit = True And RGBColor <> TransColor Then
  76. LastHit = False
  77. 'we found Transparent Pixels now create a region
  78. If Y > StartY Then 'We found more than one row of transparent pixels
  79. If StartX > 0 Then 'We didnt start at point 0 so create the first line
  80. rgnPixel = CreateRectRgn(StartX, StartY, Width + 1, StartY + 1) 'The first line from start to the end
  81. CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
  82. DeleteObject rgnPixel
  83. Else
  84. StartY = StartY - 1 'Tell the code to do one line more
  85. End If
  86. If Y > StartY + 1 Then
  87. rgnPixel = CreateRectRgn(0, StartY + 1, Width + 1, Y) 'Now line 2 to y
  88. CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
  89. DeleteObject rgnPixel
  90. End If
  91. rgnPixel = CreateRectRgn(0, Y, X, Y + 1) 'the last line (x because the actual pixel is not ok)
  92. CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
  93. DeleteObject rgnPixel
  94. Else 'We are still in the same line so create only the pixels we found
  95. rgnPixel = CreateRectRgn(StartX, Y, X, Y + 1)
  96. CombineRgn rgnMain, rgnMain, rgnPixel, RGN_XOR
  97. DeleteObject rgnPixel
  98. End If
  99. End If
  100. Next X
  101. Next Y
  102.  
  103. 'Remove unused
  104. SelectObject dcMain, bmpMain
  105. DeleteDC dcMain
  106. DeleteObject bmpMain
  107.  
  108. 'Get the Region Data so we can store it later
  109. If rgnMain <> 0 Then
  110. ByteCtr = GetRegionData(rgnMain, 0, ByVal 0&)
  111. If ByteCtr > 0 Then
  112. ReDim RgnData(0 To ByteCtr - 1)
  113. ByteCtr = GetRegionData(rgnMain, ByteCtr, RgnData(0))
  114. End If
  115. 'Shape the form
  116. SetWindowRgn Pic.hWnd, rgnMain, True
  117. End If
  118. CalculationDone = True
  119.  
  120. End Sub

Atención:
La imagen no puede ser de tipo Ícono o variantes
Tiene que ser una imagen completa (cuadrada)
pero con el fondo que tenga el color de Transparency
Esas partes serán recortadas
« Última modificación: Mayo 12, 2014, 03:13:25 pm por Expermicid »


 

¿Te gustó el post? COMPARTILO!