Transforma el formulario y se encarga de seguir el contorno de una imagen dada.

Este código va en el Formulario.

Option Explicit
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Type T_Size
        x As Long
        y As Long
End Type
Dim Mover As Boolean
Dim AuxX As Integer
Dim AuxY As Integer
Dim File As String
Dim Size As T_Size
 
Private Sub Check2_Click()
   If Check2.Value = vbChecked Then
      Command1.Visible = False
      Command2.Visible = False
      Command3.Visible = False
      Command4.Visible = False
      Command5.Visible = False
      Check1.Visible = False
      Label1.Visible = False
      Label2.Visible = False
      Label3.Visible = False
      Label4.Visible = False
      Text1.Visible = False
      Text2.Visible = False
   Else
      Command1.Visible = True
      Command2.Visible = True
      Command3.Visible = True
      Command4.Visible = True
      Command5.Visible = True
      Check1.Visible = True
      Label1.Visible = True
      Label2.Visible = True
      Label3.Visible = True
      Label4.Visible = True
      Text1.Visible = True
      Text2.Visible = True
   End If
End Sub
 
Private Sub Command1_Click()
   Dim x As Integer
   Dim y As Integer
   Dim Sx As Integer
   Dim Sy As Integer
   Dim hRgn As Long
   Dim Hrgn1 As Long
   Dim Col As Long
   Dim Ay As Integer
   Dim Sw As Integer
   Dim Step As Integer
   Dim DifY As Integer
   Dim DifX As Integer
   Dim Total As Double
   Dim C As Double
   Dim W As Double
   
   If File  "" Then
      Step = Val(Text2.Text)
      DifY = Principal.Height - Principal.ScaleHeight
      DifX = Principal.Width - Principal.ScaleWidth
      Sx = Screen.TwipsPerPixelX
      Sy = Screen.TwipsPerPixelY
      Principal.PaintPicture LoadPicture(File), 0, 0
      hRgn = CreateRectRgn(0, 0, Principal.Width / Sx, Principal.Height / Sy)
      Total = Int(((Principal.Width + Step) / Step) * ((Principal.Height + Step) / Step) + ((Principal.Width + 100) / Step) + (Principal.Height / Step))
      C = 0
      Label4.BackStyle = 1
      W = 1425
      Label4.Width = 0
      For x = 0 To Principal.Width + Step Step Step
         C = C + 1
         Ay = 0
         Sw = 0
         For y = 0 To Principal.Height + Step Step Step
               C = C + 1
            Col = Principal.Point(x, y)
            If Col  Val(Text1.Text) And Sw = 0 Then
               Hrgn1 = CreateRectRgn((x + DifX - Step / 2) / Sx, (Ay + DifY) / Sy, (x + DifX + Step / 2) / Sx, (y + DifY) / Sy)
               CombineRgn hRgn, Hrgn1, hRgn, 3
               Sw = 1
            End If
            If Col = Val(Text1.Text) And Sw = 1 Then
               Ay = y
               Sw = 0
            End If
         Next y
         Hrgn1 = CreateRectRgn((x + DifX - Step / 2) / Sx, (Ay + DifY) / Sy, (x + DifX + Step / 2) / Sx, (y + DifY) / Sy)
         CombineRgn hRgn, Hrgn1, hRgn, 3
         Label2.Caption = Int(Val(C * 100 / Total))
         Label4.Width = Val(((C * 100 / Total) * W) / 100)
         DoEvents
      Next x
      SetWindowRgn Principal.hWnd, hRgn, True
      Label2.Caption = ""
      Label4.BackStyle = 0
      Label4.Width = W
      MsgBox "Listo." & Chr(13) & "Se ha aplicado la mascara.", vbOKOnly + vbInformation, "AmA Mascaras"
   End If
End Sub
 
Private Sub Command2_Click()
   cdialog.ShowOpen
   File = cdialog.FileName
   If File  "" Then
      Principal.Cls
      Image1.Picture = LoadPicture(File)
      Size.x = Image1.Width
      If Size.x < 1515 Then Size.x = 1515
      Size.y = Image1.Height
      If Size.y < 2925 Then Size.y = 2925
      Principal.Move Principal.Left, Principal.Top, Size.x, Size.y
      Principal.PaintPicture LoadPicture(File), 0, 0
   End If
End Sub
 
Private Sub Command3_Click()
   Dim Sx As Integer
   Dim Sy As Integer
   Dim hRgn As Long
   
   Sx = Screen.TwipsPerPixelX
   Sy = Screen.TwipsPerPixelY
   hRgn = CreateRectRgn(0, 0, Principal.Width / Sx, Principal.Height / Sy)
   SetWindowRgn Principal.hWnd, hRgn, True
End Sub
 
Private Sub Command4_Click()
   End
End Sub
 
Private Sub Command5_Click()
    Principal.Cls
End Sub
 
Private Sub Form_KeyPress(KeyAscii As Integer)
   Select Case KeyAscii
   Case vbKeyA, 97:
      Command1_Click
   Case vbKeyS, 115:
      Command2_Click
   Case vbKeyD, 100:
      Command3_Click
   Case vbKeyG, 103:
      Command4_Click
   Case vbKeyF, 102:
      If Check2.Value = vbChecked Then
         Check2.Value = vbUnchecked
      Else
         Check2.Value = vbChecked
      End If
   Case vbKeyH, 104:
      Check1.Value = vbChecked
    Case vbKeyJ, 106:
      Command5_Click
   End Select
End Sub
 
Private Sub Form_Load()
   Principal.BackColor = Val(Text1.Text)
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Mover = True
   AuxX = x
   AuxY = y
   If Check1.Value = vbChecked Then
      Text1.Text = Principal.Point(x, y)
      Principal.BackColor = Val(Text1.Text)
      If File  "" Then
         Principal.PaintPicture LoadPicture(File), 0, 0
      End If
      Check1.Value = vbUnchecked
   End If
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Mover = True Then
      Principal.Left = Principal.Left + x - AuxX
      Principal.Top = Principal.Top + y - AuxY
      DoEvents
   End If
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   Mover = False
End Sub

Colaboración enviada por Manuel

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s