Три сетки, большие языковые модели, сгенерировали практически одинаковые результаты. Создав при этом три разных кода. Claude Sonnet 4.0 Gemini 2,5 Pro Kini 2.0. Но фильтр Cartoon, видимо в данном горизонте доступа может быть только таким. Картинки могут казаться разными, в особенности от Кини 2.0, может выделятся. Но этот вид зависит от настроек фильтра. Черного осадка, пуха, или пепла, выразительно, может не быть, но фон останется тем же, что и на других изображениях созданных иными фильтрами. И при изменении настроек фильтра в соответствующем коде, пусть и скорее встроенных в тело кода, чем нет, эксплицитных, "пепел" может появиться. Но в фильтре Cartoon, может быть важен и фон. Слово, скорее, американское. И мультфильмы, так названы по материалу, картону на котором, кроме прочего, изначально производились. Затем смысл окончательно мигрировал, и среди значений и синонимов слова не найти «картона». Но при переводе с русского на английский, что в русском языке произошло именно от английского, слово в словаре, встречается, все ещё, как обозначение картона. Возможно это обстоятельство, некоей семантической близости слова мультфильм и картон, в английском, косвенно повлияло на именно такую реализацию фильтра тремя цифровыми сетями, моделями, в добавок, может быть к не слишком разработанному для сетей характеру языка VB, для создания графических фильтров.
Какие ограничения. Запрос: "Следует создать код графического фильтра Cartoon для изображений в PictureBox1. Язык VB. Option Strict On. Шаблон проекта Windows Forms Network 8 Для Рабочего стола, GUI. Следует избегать ошибок переполнения арифметической операции, нахождения индекса вне границ массива и отсутствия ссылки на объект. Использовать нижеследующую схему загрузки:
Try
' Загружаем изображение из PictureBox1 в объект Bitmap
Dim sourceImage As Bitmap = CType(PictureBox1.Image, Bitmap)
' Применяем фильтр Cartoon к изображению.
Dim Cartoon As Bitmap = CartoonFilter(sourceImage)
' Отображаем результат в PictureBox
PictureBox1.Image = Cartoon
' копировать в буфер обмена
Clipboard.SetImage(PictureBox1.Image)
'освобождаем ресурсы
sourceImage.Dispose()
Catch ex As Exception
MessageBox.Show(ex.Message, "Ошибка", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try"
Кроме перечисленных ограничений в запросе, следуют, возможные, по убыванию: браузер Bing. VPN. Характеристики машины. Иначе говоря, видимо, скорее всего, общие базы данных с пределами по времени, что ограничивались языком и шаблоном проекта могли повлиять на такой расклад. Но схемы кодов разные. Тем не менее, суть дела одна и та же. Целевая функция выполняется, но с одним и тем же результатом. Прекрасное фото хамелеона, мол, обезображено трижды разными способами, но одинаковым образом. И в этом, что то есть, во всяком случае, может быть. Если ни очевидный предел языка VB для данной технологической связности.
Де, совокупный ИИ, мол, подвергся деменции.
Коды удалось инсталлировать вместе и целиком.
Kini 2.0
"Imports System.Drawing
Imports System.Drawing.Imaging
Public Class Form1
'=====================================================================
' КНОПКА «Применить фильтр Cartoon»
'=====================================================================
Private Sub btnCartoon_Click(sender As Object, e As EventArgs) Handles btnCartoon.Click
If PictureBox1.Image Is Nothing Then
MessageBox.Show("Изображение не загружено!", "Ошибка",
MessageBoxButtons.OK, MessageBoxIcon.Warning)
Return
End If
Try
' Загружаем изображение из PictureBox1 в объект Bitmap
Using sourceImage As Bitmap = CType(PictureBox1.Image.Clone(), Bitmap)
' Применяем фильтр Cartoon к изображению
Using cartoonImage As Bitmap = CartoonFilter(sourceImage)
' Отображаем результат в PictureBox
PictureBox1.Image?.Dispose()
PictureBox1.Image = CType(cartoonImage.Clone(), Bitmap)
' Копируем в буфер обмена
Clipboard.SetImage(PictureBox1.Image)
End Using
End Using
Catch ex As Exception
MessageBox.Show(ex.Message, "Ошибка",
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
End Sub
'=====================================================================
' CARTOON FILTER
'=====================================================================
Private Shared Function CartoonFilter(src As Bitmap) As Bitmap
' --- 1. Безопасные размеры ---
Dim w As Integer = src.Width
Dim h As Integer = src.Height
If w <= 0 OrElse h <= 0 Then Throw New ArgumentException("Неверный размер изображения")
' --- 2. Буферы ---
Dim result As New Bitmap(w, h, PixelFormat.Format32bppArgb)
Dim srcLock As BitmapData = src.LockBits(New Rectangle(0, 0, w, h),
ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim resLock As BitmapData = result.LockBits(New Rectangle(0, 0, w, h),
ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
Dim bytes As Integer = Math.Abs(srcLock.Stride) * h
Dim srcPixels(bytes - 1) As Byte
Dim dstPixels(bytes - 1) As Byte
Marshal.Copy(srcLock.Scan0, srcPixels, 0, srcPixels.Length)
src.UnlockBits(srcLock)
' --- 3. Размытие по Гауссу (вручную, 5×5 ядро) ---
Dim gaussKernel As Double(,) =
{
{1, 4, 6, 4, 1},
{4, 16, 24, 16, 4},
{6, 24, 36, 24, 6},
{4, 16, 24, 16, 4},
{1, 4, 6, 4, 1}
}
Dim weight As Double = 256.0R ' сумма всех коэффициентов = 256
Dim rBlur(w - 1, h - 1) As Integer
Dim gBlur(w - 1, h - 1) As Integer
Dim bBlur(w - 1, h - 1) As Integer
For y As Integer = 2 To h - 3
For x As Integer = 2 To w - 3
Dim r As Double = 0, g As Double = 0, b As Double = 0
For fy As Integer = -2 To 2
For fx As Integer = -2 To 2
Dim px As Integer = (x + fx) * 4 + (y + fy) * srcLock.Stride
Dim coef As Double = gaussKernel(fx + 2, fy + 2)
b += srcPixels(px) * coef
g += srcPixels(px + 1) * coef
r += srcPixels(px + 2) * coef
Next
Next
rBlur(x, y) = CInt(r / weight)
gBlur(x, y) = CInt(g / weight)
bBlur(x, y) = CInt(b / weight)
Next
Next
' --- 4. Постеризация + контуры ---
Dim levels As Integer = 6 ' количество цветовых уровней
Dim levelStep As Integer = 255 \ (levels - 1)
For y As Integer = 0 To h - 1
For x As Integer = 0 To w - 1
Dim idx As Integer = x * 4 + y * srcLock.Stride
' Безопасное чтение
Dim b As Byte = srcPixels(idx)
Dim g As Byte = srcPixels(idx + 1)
Dim r As Byte = srcPixels(idx + 2)
' Постеризация
Dim pr As Byte = CByte((r \ levelStep) * levelStep)
Dim pg As Byte = CByte((g \ levelStep) * levelStep)
Dim pb As Byte = CByte((b \ levelStep) * levelStep)
' Контуры (Unsharp Mask)
Dim edge As Integer = 0
If x >= 2 AndAlso x < w - 2 AndAlso y >= 2 AndAlso y < h - 2 Then
edge = CInt(
Math.Abs(r - rBlur(x, y)) +
Math.Abs(g - gBlur(x, y)) +
Math.Abs(b - bBlur(x, y)))
edge = Math.Min(edge, 255)
End If
Dim invEdge As Integer = 255 - edge
dstPixels(idx) = CByte(Math.Min(255, (pb * invEdge + edge * 0) \ 255))
dstPixels(idx + 1) = CByte(Math.Min(255, (pg * invEdge + edge * 0) \ 255))
dstPixels(idx + 2) = CByte(Math.Min(255, (pr * invEdge + edge * 0) \ 255))
dstPixels(idx + 3) = 255 ' Alpha
Next
Next
Marshal.Copy(dstPixels, 0, resLock.Scan0, dstPixels.Length)
result.UnlockBits(resLock)
Return result
End Function
End Class
Claude Sonnet 4.
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Windows.Forms
Public Class Form1
Private Sub ApplyCartoonFilter()
Try
' Проверяем, что изображение загружено
If PictureBox1.Image Is Nothing Then
MessageBox.Show("Сначала загрузите изображение", "Предупреждение", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Return
End If
' Загружаем изображение из PictureBox1 в объект Bitmap
Dim sourceImage As Bitmap = CType(PictureBox1.Image, Bitmap)
' Применяем фильтр Cartoon к изображению
Dim Cartoon As Bitmap = CartoonFilter(sourceImage)
' Отображаем результат в PictureBox
PictureBox1.Image = Cartoon
' копировать в буфер обмена
Clipboard.SetImage(PictureBox1.Image)
' освобождаем ресурсы
sourceImage.Dispose()
Catch ex As Exception
MessageBox.Show(ex.Message, "Ошибка", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
End Sub
Private Function CartoonFilter(sourceImage As Bitmap) As Bitmap
Try
' Создаем новый bitmap для результата
Dim result As New Bitmap(sourceImage.Width, sourceImage.Height, PixelFormat.Format24bppRgb)
' Блокируем биты для быстрого доступа
Dim sourceData As BitmapData = sourceImage.LockBits(New Rectangle(0, 0, sourceImage.Width, sourceImage.Height), ImageLockMode.ReadOnly, PixelFormat.Format24bppRgb)
Dim resultData As BitmapData = result.LockBits(New Rectangle(0, 0, result.Width, result.Height), ImageLockMode.WriteOnly, PixelFormat.Format24bppRgb)
Try
' Получаем указатели на данные
Dim sourcePtr As IntPtr = sourceData.Scan0
Dim resultPtr As IntPtr = resultData.Scan0
' Вычисляем размер данных
Dim bytes As Integer = Math.Abs(sourceData.Stride) * sourceImage.Height
' Создаем массивы для хранения данных пикселей
Dim sourceValues(bytes - 1) As Byte
Dim resultValues(bytes - 1) As Byte
' Копируем данные из памяти в массивы
Runtime.InteropServices.Marshal.Copy(sourcePtr, sourceValues, 0, bytes)
' Применяем cartoon эффект
For y As Integer = 1 To sourceImage.Height - 2
For x As Integer = 1 To sourceImage.Width - 2
' Вычисляем индекс текущего пикселя
Dim currentIndex As Integer = (y * sourceData.Stride) + (x * 3)
' Проверяем границы массива
If currentIndex >= 0 AndAlso currentIndex + 2 < sourceValues.Length Then
' Получаем значения цветов текущего пикселя
Dim b As Integer = CInt(sourceValues(currentIndex))
Dim g As Integer = CInt(sourceValues(currentIndex + 1))
Dim r As Integer = CInt(sourceValues(currentIndex + 2))
' Применяем квантование цветов (уменьшаем количество цветов)
Dim levels As Integer = 8
Dim factor As Double = 255.0 / (levels - 1)
r = CInt(Math.Round(r / factor) * factor)
g = CInt(Math.Round(g / factor) * factor)
b = CInt(Math.Round(b / factor) * factor)
' Применяем сглаживание (билатеральный фильтр упрощенный)
Dim smoothR As Integer = 0
Dim smoothG As Integer = 0
Dim smoothB As Integer = 0
Dim count As Integer = 0
' Обрабатываем окрестность 3x3
For dy As Integer = -1 To 1
For dx As Integer = -1 To 1
Dim neighborY As Integer = y + dy
Dim neighborX As Integer = x + dx
' Проверяем границы изображения
If neighborY >= 0 AndAlso neighborY < sourceImage.Height AndAlso
neighborX >= 0 AndAlso neighborX < sourceImage.Width Then
Dim neighborIndex As Integer = (neighborY * sourceData.Stride) + (neighborX * 3)
' Проверяем границы массива
If neighborIndex >= 0 AndAlso neighborIndex + 2 < sourceValues.Length Then
smoothB += CInt(sourceValues(neighborIndex))
smoothG += CInt(sourceValues(neighborIndex + 1))
smoothR += CInt(sourceValues(neighborIndex + 2))
count += 1
End If
End If
Next
Next
' Вычисляем средние значения
If count > 0 Then
smoothR = CInt(smoothR / count)
smoothG = CInt(smoothG / count)
smoothB = CInt(smoothB / count)
End If
' Смешиваем квантованные и сглаженные цвета
Dim mixFactor As Double = 0.7
r = CInt(r * mixFactor + smoothR * (1 - mixFactor))
g = CInt(g * mixFactor + smoothG * (1 - mixFactor))
b = CInt(b * mixFactor + smoothB * (1 - mixFactor))
' Применяем детектор краев (упрощенный)
Dim edgeThreshold As Integer = 50
Dim isEdge As Boolean = False
' Проверяем соседние пиксели на наличие резких переходов
For dy As Integer = -1 To 1
For dx As Integer = -1 To 1
If dx = 0 AndAlso dy = 0 Then Continue For
Dim neighborY As Integer = y + dy
Dim neighborX As Integer = x + dx
If neighborY >= 0 AndAlso neighborY < sourceImage.Height AndAlso
neighborX >= 0 AndAlso neighborX < sourceImage.Width Then
Dim neighborIndex As Integer = (neighborY * sourceData.Stride) + (neighborX * 3)
If neighborIndex >= 0 AndAlso neighborIndex + 2 < sourceValues.Length Then
Dim diffR As Integer = Math.Abs(r - CInt(sourceValues(neighborIndex + 2)))
Dim diffG As Integer = Math.Abs(g - CInt(sourceValues(neighborIndex + 1)))
Dim diffB As Integer = Math.Abs(b - CInt(sourceValues(neighborIndex)))
If diffR > edgeThreshold OrElse diffG > edgeThreshold OrElse diffB > edgeThreshold Then
isEdge = True
Exit For
End If
End If
End If
Next
If isEdge Then Exit For
Next
' Если это край, делаем его темнее
If isEdge Then
r = CInt(r * 0.3)
g = CInt(g * 0.3)
b = CInt(b * 0.3)
End If
' Ограничиваем значения в диапазоне 0-255
r = Math.Max(0, Math.Min(255, r))
g = Math.Max(0, Math.Min(255, g))
b = Math.Max(0, Math.Min(255, b))
' Записываем результат
resultValues(currentIndex) = CByte(b)
resultValues(currentIndex + 1) = CByte(g)
resultValues(currentIndex + 2) = CByte(r)
End If
Next
Next
' Копируем обработанные данные обратно в bitmap
Runtime.InteropServices.Marshal.Copy(resultValues, 0, resultPtr, bytes)
Finally
' Разблокируем биты
sourceImage.UnlockBits(sourceData)
result.UnlockBits(resultData)
End Try
Return result
Catch ex As Exception
Throw New Exception("Ошибка применения фильтра Cartoon: " & ex.Message)
End Try
End Function
' Пример использования - можно вызвать из кнопки
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ApplyCartoonFilter()
End Sub
' Метод для загрузки изображения
Private Sub LoadImage_Click(sender As Object, e As EventArgs) Handles LoadImage.Click
Using openFileDialog As New OpenFileDialog()
openFileDialog.Filter = "Image Files|*.jpg;*.jpeg;*.png;*.bmp;*.gif"
openFileDialog.Title = "Выберите изображение"
If openFileDialog.ShowDialog() = DialogResult.OK Then
Try
PictureBox1.Image = Image.FromFile(openFileDialog.FileName)
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
Catch ex As Exception
MessageBox.Show("Ошибка загрузки изображения: " & ex.Message, "Ошибка", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
End Using
End Sub
End Class
Gemini 2.5. Pro
Конечно, вот полный и готовый к использованию код для создания графического фильтра "Cartoon" на VB.NET для проекта Windows Forms (.NET 8) с соблюдением всех ваших требований.
Код использует высокопроизводительный метод LockBits для прямого доступа к памяти изображения, что значительно быстрее, чем GetPixel и SetPixel. Это также позволяет нам лучше контролировать данные и избегать ошибок.
Шаг 1: Дизайн формы
Создайте новый проект "Приложение Windows Forms" (.NET 8).
На главную форму Form1 добавьте следующие элементы:
PictureBox с именем PictureBox1.
Button с именем ButtonCartoon и текстом "Cartoon Фильтр".
Button с именем ButtonLoad и текстом "Загрузить изображение".
ШаG 2: Код для формы (Form1.vb)
Скопируйте и вставьте этот код в редактор кода для Form1.vb.
Generated vb
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Public Class Form1
' Option Strict On включен в свойствах проекта по умолчанию для .NET 8
' --- Обработчик для кнопки загрузки изображения ---
Private Sub ButtonLoad_Click(sender As Object, e As EventArgs) Handles ButtonLoad.Click
Using ofd As New OpenFileDialog()
ofd.Filter = "Файлы изображений|*.jpg;*.jpeg;*.png;*.bmp;*.gif"
ofd.Title = "Выберите изображение"
If ofd.ShowDialog() = DialogResult.OK Then
Try
' Удаляем предыдущее изображение, если оно есть, чтобы освободить ресурсы
If PictureBox1.Image IsNot Nothing Then
PictureBox1.Image.Dispose()
End If
PictureBox1.Image = New Bitmap(ofd.FileName)
Catch ex As Exception
MessageBox.Show("Не удалось загрузить файл изображения." & vbCrLf & ex.Message,
"Ошибка загрузки", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
End Using
End Sub
' --- Обработчик для кнопки применения фильтра Cartoon ---
Private Sub ButtonCartoon_Click(sender As Object, e As EventArgs) Handles ButtonCartoon.Click
' Проверяем, есть ли изображение в PictureBox1
If PictureBox1.Image Is Nothing Then
MessageBox.Show("Сначала загрузите изображение.", "Нет изображения", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return
End If
Try
' Загружаем изображение из PictureBox1 в объект Bitmap
' Создаем клон, чтобы исходное изображение в PictureBox не было заблокировано или изменено
Dim sourceImage As Bitmap = CType(PictureBox1.Image.Clone(), Bitmap)
' Применяем фильтр Cartoon к изображению.
Dim cartoonImage As Bitmap = CartoonFilter(sourceImage)
' Отображаем результат в PictureBox (сначала освобождаем старое изображение)
If PictureBox1.Image IsNot Nothing Then
PictureBox1.Image.Dispose()
End If
PictureBox1.Image = cartoonImage
' Копируем результат в буфер обмена
Clipboard.SetImage(PictureBox1.Image)
MessageBox.Show("Фильтр 'Cartoon' применен, и результат скопирован в буфер обмена.", "Готово", MessageBoxButtons.OK, MessageBoxIcon.Information)
' Освобождаем исходное изображение (клон), т.к. оно больше не нужно
sourceImage.Dispose()
Catch ex As Exception
MessageBox.Show(ex.Message, "Ошибка", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
End Sub
''' <summary>
''' Применяет к изображению фильтр "Cartoon", состоящий из двух эффектов: выделение контуров и постеризация (упрощение цветов).
''' </summary>
''' <param name="sourceBitmap">Исходное изображение Bitmap.</param>
''' <param name="edgeThreshold">Порог для определения контура (0-255). Чем выше значение, тем менее чувствителен детектор краев.</param>
''' <param name="posterizeLevels">Количество уровней для постеризации цвета. Меньшее значение дает более "плоский" вид.</param>
''' <returns>Новое изображение Bitmap с примененным фильтром или Nothing в случае ошибки.</returns>
Public Function CartoonFilter(ByVal sourceBitmap As Bitmap,
Optional ByVal edgeThreshold As Integer = 90,
Optional ByVal posterizeLevels As Integer = 7) As Bitmap
' 1. ПРОВЕРКА ВХОДНЫХ ДАННЫХ
If sourceBitmap Is Nothing Then
' Избегаем NullReferenceException
Return Nothing
End If
' Создаем новое изображение для результата
Dim resultBitmap As New Bitmap(sourceBitmap.Width, sourceBitmap.Height, sourceBitmap.PixelFormat)
Dim width As Integer = sourceBitmap.Width
Dim height As Integer = sourceBitmap.Height
' Используем LockBits для высокопроизводительного доступа к данным пикселей
Dim rect As New Rectangle(0, 0, width, height)
Dim sourceData As BitmapData = Nothing
Dim resultData As BitmapData = Nothing
Try
' 2. БЛОКИРОВКА БИТОВ ИЗОБРАЖЕНИЙ В ПАМЯТИ
sourceData = sourceBitmap.LockBits(rect, ImageLockMode.ReadOnly, sourceBitmap.PixelFormat)
resultData = resultBitmap.LockBits(rect, ImageLockMode.WriteOnly, resultBitmap.PixelFormat)
Dim bpp As Integer = Image.GetPixelFormatSize(sourceBitmap.PixelFormat) \ 8
If bpp < 3 Then
' Фильтр предназначен для цветных изображений (RGB/ARGB)
sourceBitmap.UnlockBits(sourceData)
resultBitmap.UnlockBits(resultData)
resultBitmap.Dispose()
' Возвращаем клон оригинала, т.к. не можем обработать
Return CType(sourceBitmap.Clone(), Bitmap)
End If
Dim stride As Integer = sourceData.Stride
Dim totalBytes As Integer = Math.Abs(stride) * height
Dim sourceBytes(totalBytes - 1) As Byte
Dim resultBytes(totalBytes - 1) As Byte
Marshal.Copy(sourceData.Scan0, sourceBytes, 0, totalBytes)
' --- ЭТАП I: ОПРЕДЕЛЕНИЕ КОНТУРОВ (ИСПОЛЬЗУЯ ОПЕРАТОР СОБЕЛЯ) ---
Dim isEdge(width - 1, height - 1) As Boolean
Dim gx As Long, gy As Long
' Проходим по изображению, пропуская края (1 пиксель), чтобы избежать выхода за границы массива
For y As Integer = 1 To height - 2
For x As Integer = 1 To width - 2
' Преобразуем 3x3 область в оттенки серого на лету для расчета градиента
Dim p00 As Integer = CInt(sourceBytes((y - 1) * stride + (x - 1) * bpp) * 0.114 + sourceBytes((y - 1) * stride + (x - 1) * bpp + 1) * 0.587 + sourceBytes((y - 1) * stride + (x - 1) * bpp + 2) * 0.299)
Dim p01 As Integer = CInt(sourceBytes((y - 1) * stride + x * bpp) * 0.114 + sourceBytes((y - 1) * stride + x * bpp + 1) * 0.587 + sourceBytes((y - 1) * stride + x * bpp + 2) * 0.299)
Dim p02 As Integer = CInt(sourceBytes((y - 1) * stride + (x + 1) * bpp) * 0.114 + sourceBytes((y - 1) * stride + (x + 1) * bpp + 1) * 0.587 + sourceBytes((y - 1) * stride + (x + 1) * bpp + 2) * 0.299)
Dim p10 As Integer = CInt(sourceBytes(y * stride + (x - 1) * bpp) * 0.114 + sourceBytes(y * stride + (x - 1) * bpp + 1) * 0.587 + sourceBytes(y * stride + (x - 1) * bpp + 2) * 0.299)
Dim p12 As Integer = CInt(sourceBytes(y * stride + (x + 1) * bpp) * 0.114 + sourceBytes(y * stride + (x + 1) * bpp + 1) * 0.587 + sourceBytes(y * stride + (x + 1) * bpp + 2) * 0.299)
Dim p20 As Integer = CInt(sourceBytes((y + 1) * stride + (x - 1) * bpp) * 0.114 + sourceBytes((y + 1) * stride + (x - 1) * bpp + 1) * 0.587 + sourceBytes((y + 1) * stride + (x - 1) * bpp + 2) * 0.299)
Dim p21 As Integer = CInt(sourceBytes((y + 1) * stride + x * bpp) * 0.114 + sourceBytes((y + 1) * stride + x * bpp + 1) * 0.587 + sourceBytes((y + 1) * stride + x * bpp + 2) * 0.299)
Dim p22 As Integer = CInt(sourceBytes((y + 1) * stride + (x + 1) * bpp) * 0.114 + sourceBytes((y + 1) * stride + (x + 1) * bpp + 1) * 0.587 + sourceBytes((y + 1) * stride + (x + 1) * bpp + 2) * 0.299)
' Ядро Собеля по X. Используем Long для избежания переполнения
gx = CLng(p02) + 2 * CLng(p12) + CLng(p22) - (CLng(p00) + 2 * CLng(p10) + CLng(p20))
' Ядро Собеля по Y
gy = CLng(p00) + 2 * CLng(p01) + CLng(p02) - (CLng(p20) + 2 * CLng(p21) + CLng(p22))
' Величина градиента
Dim magnitude As Integer = CInt(Math.Min(255, Math.Sqrt(gx * gx + gy * gy)))
If magnitude > edgeThreshold Then
isEdge(x, y) = True
End If
Next
Next
' --- ЭТАП II: ПОСТЕРИЗАЦИЯ ЦВЕТА И СОЗДАНИЕ ИТОГОВОГО ИЗОБРАЖЕНИЯ ---
' Фактор для постеризации. Проверка деления на ноль.
Dim factor As Double = If(posterizeLevels > 1, 255.0 / (posterizeLevels - 1), 255.0)
For y As Integer = 0 To height - 1
For x As Integer = 0 To width - 1
Dim offset As Integer = y * stride + x * bpp
If isEdge(x, y) Then
' Если пиксель - это контур, делаем его черным
resultBytes(offset) = 0 ' Blue
resultBytes(offset + 1) = 0 ' Green
resultBytes(offset + 2) = 0 ' Red
Else
' Иначе применяем постеризацию
Dim b As Byte = sourceBytes(offset)
Dim g As Byte = sourceBytes(offset + 1)
Dim r As Byte = sourceBytes(offset + 2)
' Формула постеризации для каждого канала
resultBytes(offset) = CByte(Math.Min(255, CInt(Math.Round(b / factor) * factor)))
resultBytes(offset + 1) = CByte(Math.Min(255, CInt(Math.Round(g / factor) * factor)))
resultBytes(offset + 2) = CByte(Math.Min(255, CInt(Math.Round(r / factor) * factor)))
End If
' Копируем альфа-канал, если он есть (bpp = 4)
If bpp = 4 Then
resultBytes(offset + 3) = sourceBytes(offset + 3)
End If
Next
Next
' 3. КОПИРОВАНИЕ ОБРАБОТАННЫХ БАЙТОВ ОБРАТНО В ИЗОБРАЖЕНИЕ
Marshal.Copy(resultBytes, 0, resultData.Scan0, totalBytes)
Finally
' 4. ОБЯЗАТЕЛЬНОЕ ОСВОБОЖДЕНИЕ РЕСУРСОВ
' Гарантирует, что UnlockBits будет вызван даже в случае ошибки
If sourceData IsNot Nothing Then
sourceBitmap.UnlockBits(sourceData)
End If
If resultData IsNot Nothing Then
resultBitmap.UnlockBits(resultData)
End If
End Try
Return resultBitmap
End Function
End Class
Как это работает:
Загрузка и подготовка: Код в кнопке ButtonCartoon_Click безопасно получает изображение из PictureBox1, создавая его клон. Это важно, чтобы не изменять оригинал и избежать проблем с блокировкой ресурсов.
Функция CartoonFilter:
Проверка на Nothing: Первая же строка функции проверяет, не передали ли ей пустой объект, что предотвращает NullReferenceException.
LockBits: Мы "замораживаем" исходное и новое изображения в памяти и получаем прямые указатели на их данные (Scan0). Это самый быстрый способ работы с пикселями в .NET.
Try...Finally: Весь код обработки находится в блоке Try. Блок Finally гарантирует, что UnlockBits будет вызван в любом случае (даже при ошибке), предотвращая утечки памяти и блокировку файлов.
Этап 1: Детектор контуров (оператор Собеля):
Алгоритм проходит по каждому пикселю и анализирует его 3x3 окружение.
Для анализа он "на лету" преобразует цвета в оттенки серого.
Вычисляется градиент (резкость перепада яркости) по осям X и Y.
Если общая величина градиента превышает заданный порог (edgeThreshold), пиксель помечается как "контур" в специальном двумерном массиве isEdge.
Использование типа Long для промежуточных вычислений (gx, gy) предотвращает арифметическое переполнение.
Этап 2: Постеризация и сборка:
Алгоритм снова проходит по всем пикселям.
Если пиксель помечен как "контур" (isEdge(x, y) = True), он закрашивается черным цветом.
Если это не контур, его цвет упрощается (постеризуется). Например, если уровней (posterizeLevels) 7, то все 256 значений для красного, зеленого и синего каналов будут "округлены" до одного из 7 возможных значений. Это создает эффект больших областей с плоским, однородным цветом, как в мультфильмах.
Запись результата: Обработанный массив байтов копируется обратно в resultBitmap.
Отображение и очистка: Новое изображение отображается в PictureBox1, старое корректно освобождается с помощью Dispose(), чтобы не было утечек памяти. Результат также копируется в буфер обмена".
"Хорошо. Может быть". Пишет стандартно СТЛА в таких случаях, в ответ. Коль скоро, ошибок нет и целевая функция, мол, выполняется. Но это не фильтр картон. Ни в смысле иллюзии теперь картона, словно материала, выбранного для рисования изображения, ни, тем более, в смысле мультипликационного вида фигур и красок. Адобе Фотошоп еще далеко до окончательно кончины. Да и зачем она. Не желайте другим, что не хотели бы себе. Дело в том, что Адобе таким же образом получит доступ к тем средствам, к которым получат доступ практически все. И за счёт разницы во времени разработки, труженики этой компании, все еще, какое то время смогут обгонять. И да, за деньги. Но просматривается горизонт, пусть и не всегда четко, словно в указанном случае, когда это не понадобиться никому, кроме этой компании. И что? Почему бы такой не превратиться в забытый сайт, в сети, без проблем? Короче, пусть бы, пока, и только в уме, не реализовать то, что разрешает проблему известного напряжения от обвинений, кроме прочего, в паразитизме, которое испытывают все идеологи, не только этой компании?
"СТЛА"
Караваев В.Г.