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