78 lines
1.5 KiB
Plaintext
78 lines
1.5 KiB
Plaintext
' Inicializar variables
|
|
Dim Shared As Integer ancho, alto
|
|
ancho = 208: alto = 228
|
|
Dim As Integer hist(255), idx(255)
|
|
Dim As Integer i, j, x, y, l, total, half, median
|
|
|
|
' Inicializar pantalla(doble de ancho para mostrar ambas imágenes)
|
|
Screenres ancho * 2, alto, 32
|
|
|
|
' Cargar imagen
|
|
Bload "Lena-Grey.bmp", 0
|
|
|
|
|
|
' Copiar imagen original a la mitad izquierda de la pantalla
|
|
For y = 0 To alto - 1
|
|
For x = 0 To ancho - 1
|
|
Pset (x, y), Point(x, y)
|
|
Next
|
|
Next
|
|
|
|
' Inicializar índices
|
|
For i = 0 To 255
|
|
idx(i) = i
|
|
Next
|
|
|
|
' Construir histograma
|
|
For y = 0 To alto - 1
|
|
For x = 0 To ancho - 1
|
|
l = Point(x, y) And &HFF
|
|
hist(l) += 1
|
|
Next
|
|
Next
|
|
|
|
' Ordenar histograma (simple bubble sort)
|
|
For i = 0 To 254
|
|
For j = i + 1 To 255
|
|
If hist(i) > hist(j) Then
|
|
Swap hist(i), hist(j)
|
|
Swap idx(i), idx(j)
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
' Encontrar la mediana
|
|
total = 0
|
|
For i = 0 To 255
|
|
total += hist(i)
|
|
Next
|
|
|
|
half = 0
|
|
For i = 0 To 255
|
|
half += hist(i)
|
|
If half >= total \ 2 Then
|
|
median = idx(i)
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
'Windowtitle("Histogram")
|
|
Windowtitle "Original vs Black and White"
|
|
|
|
' Mostrar versión en blanco y negro en la mitad derecha
|
|
For y = 0 To alto - 1
|
|
For x = 0 To ancho - 1
|
|
l = Point(x, y) And &HFF
|
|
If l > median Then
|
|
Pset (x + ancho, y), Rgb(255, 255, 255)
|
|
Else
|
|
Pset (x + ancho, y), Rgb(0, 0, 0)
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
' Guardar la imagen resultante (ambas imágenes juntas)
|
|
Bsave "Lena_Original_and_BW.bmp", 0
|
|
|
|
Sleep
|