'-----------------------------
Public Class Form1
Dim intFila, intColum, intTotal, n As Integer
Dim intPunFila, intPunColum As Integer
Dim intAncho, intAlto, intFiguIni, intFiguFin As Integer
Dim strArraySor() As String
Dim intArraySor() As Integer
Dim TextBoxArray() As Label = Nothing
Dim LabelArray() As Label = Nothing
Dim lblArraySor() As Label = Nothing
Dim lblRespues() As Label = Nothing
Dim strBien, strMensaje As String
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim intPot As Integer
Dim intNive1 As Integer = 0
Dim intNive2 As Integer = 0
Dim intNive3 As Integer = 0
Dim strFigu As String = Nothing
Do
intFila = Val(InputBox(strMensaje & vbCrLf & "Numero de Filas....... : ", "MATRIZ DE LABELS"))
intColum = Int(1300 / 730 * intFila)
strMensaje = strMensaje & "Numero de Filas....... : " & intFila & vbCrLf
intColum = Val(InputBox(strMensaje & "Numero de Columnas : ", "MATRIZ DE LABELS", intColum))
strMensaje = strMensaje & "Numero de Columnas : " & intColum & vbCrLf
intTotal = intFila * intColum
strMensaje = strMensaje & vbCrLf & "Total Cuadros : " & intTotal & vbCrLf
intFiguIni = Val(InputBox(strMensaje & vbCrLf & "Numero de Figuras a buscar : ", "MATRIZ DE LABELS"))
If intFila = 0 Or intColum = 0 Then
strMensaje = "Datos Erroneos." & vbCrLf
ElseIf intFiguIni >= intTotal Or (intTotal Mod intFiguIni) <> 0 Then
intFiguIni = 0 : strMensaje = "No es divisible... TOTAL FIGURAS/fig a Buscar... REINICIAR" & vbCrLf
ElseIf (intTotal / intFiguIni) > 27 ^ 3 Then
strMensaje = "Combinacion MUY GRANDE (Total Cuadros/Figuras : " & (intTotal / intFiguIni) & vbCrLf & vbCrLf
Else
strMensaje = ""
End If
Loop While strMensaje <> ""
intAncho = (1300 - intColum * 2) / intColum - 3 : intAlto = (730 - intFila * 2) / intFila
ReDim LabelArray(intTotal)
ReDim TextBoxArray(intTotal)
ReDim strArraySor(intTotal)
Do
intPot = intPot + 1
strFigu &= "A"
Loop While (intTotal / intFiguIni) > 27 ^ intPot
For i = 1 To intTotal
If ((i - 1) Mod intFiguIni) = 0 Or i = 1 Then
Select Case intPot
Case 1
strFigu = Chr(65 + intFiguFin)
intFiguFin += 1
Case 2
intNive1 += 1 ': If intNive1 > 26 Then Stop
If (intNive1 Mod 27) = 0 Then intNive2 += 1 : intNive1 = 1
strFigu = Chr(65 + intNive2) & Chr(64 + intNive1)
Case 3
intNive1 += 1
If (intNive1 Mod 27) = 0 Then
intNive2 += 1 : intNive1 = 1
If (intNive2 Mod 27) = 0 Then
intNive3 += 1 : intNive2 = 1
End If
End If
strFigu = Chr(65 + intNive3) & Chr(65 + intNive2) & Chr(64 + intNive1)
End Select
End If
strArraySor(i) = strFigu
Next
Dim intRam As Integer
Dim rnd As New Random()
ReDim intArraySor(intTotal)
For i = 1 To intTotal
Do
intRam = rnd.Next(1, intTotal + 1)
For t = 1 To (i - 1)
If intRam = intArraySor(t) Or intRam = intTotal + 1 Then intRam = 0 : Exit For
Next
Loop While intRam = 0
intArraySor(i) = intRam
Next
intPunFila = 2 : intPunColum = 2
For i = 1 To intTotal
LabelArray(i) = New Label
LabelArray(i).Text = strArraySor(intArraySor(i))
LabelArray(i).Width = intAncho
LabelArray(i).Height = intAlto
LabelArray(i).TextAlign = ContentAlignment.MiddleCenter
LabelArray(i).BorderStyle = BorderStyle.FixedSingle
LabelArray(i).Font = New Font("Arial", 8, FontStyle.Bold) intPunColum = intPunColum + intAncho + 2
If (i - 1) Mod intColum = 0 Then intPunColum = 2 : intPunFila = intPunFila + intAlto + 2
If i = 1 Then intPunColum = 2 : intPunFila = 2
Me.Controls.Add(LabelArray(i))
LabelArray(i).Location = New Point(intPunColum, intPunFila)
AddHandler LabelArray(i).MouseClick, AddressOf LabelClick_MouseClick
Next
End Sub
Private Sub LabelClick_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs)
LblMuestra.Text = Mid(sender.ToString(), 35, 3) 'e.X & " : " & e.Y
LblMuestra.Height = intAlto : LblMuestra.Width = intAncho * 3
LblMuestra.Location = New Point(e.X, e.Y)
End Sub
End Class
'------------------------
Crear cuenta