Проба пера - VB6 на нейросети Qwen2.5-Plus

Option Explicit
'
' Объявление API функции BitBlt для копирования изображений
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
' Константа для режима копирования изображения
Private Const SRCCOPY = &HCC0020
'
' Объявление динамического массива PictureBox-ов
Dim picDest() As PictureBox ' Динамический массив PictureBox-ов
Dim picIndex As Integer ' Индекс для массива PictureBox-ов
Dim maxFormWidth As Integer ' Максимальная ширина формы frmDest
Dim maxFormHeight As Integer ' Максимальная высота формы frmDest
Dim i As Integer
'
Private Sub Form_Load()
    ' Инициализация индекса
    picIndex = 0
    maxFormWidth = 0
    maxFormHeight = 0
End Sub
'
'=============================================================================
' Сперва рисуем линии
Private Sub Command1_Click()
    Randomize ' Инициализация генератора случайных чисел
    DrawRandomLines
End Sub
'
Private Sub DrawRandomLines()
    Dim lastX As Integer, lastY As Integer
    Dim newX As Integer, newY As Integer
    '
    ' Очищаем ListBox-ы перед новой генерацией
    lstVerX.Clear
    lstHorY.Clear
    '
    ' Добавляем начальные границы
    lastX = 0
    lastY = 0
    '
    ' Генерация вертикальных линий
    Do While lastX + 50 <= picSource.ScaleWidth
        newX = lastX + Int((500 - 50 + 1) * Rnd + 50) ' Случайное значение от 50 до 500
        If newX > picSource.ScaleWidth Then Exit Do
        lstVerX.AddItem newX ' Добавляем координату X в ListBox
        lastX = newX
    Loop
    '
    ' Генерация горизонтальных линий
    Do While lastY + 50 <= picSource.ScaleHeight
        newY = lastY + Int((500 - 50 + 1) * Rnd + 50) ' Случайное значение от 50 до 500
        If newY > picSource.ScaleHeight Then Exit Do
        lstHorY.AddItem newY ' Добавляем координату Y в ListBox
        lastY = newY
    Loop
    '
    ' Рисуем линии
    picSource.Cls ' Очищаем PictureBox перед рисованием
    '
    ' Рисуем вертикальные линии
    For i = 0 To lstVerX.ListCount - 1
        picSource.Line (lstVerX.List(i), 0)-(lstVerX.List(i), picSource.ScaleHeight), vbRed
    Next i
    '
    ' Рисуем горизонтальные линии
    For i = 0 To lstHorY.ListCount - 1
        picSource.Line (0, lstHorY.List(i))-(picSource.ScaleWidth, lstHorY.List(i)), vbRed
    Next i
    '
End Sub
'=============================================================================
'
Private Sub Command2_Click()
    CropAndCreatePictures
End Sub
'
' Делим рисунок на блоки, ограниченные линиями и загружаем эти блоки в создаваемые picturebox-ы
Private Sub CropAndCreatePictures()
    Dim verXCount As Integer
    Dim horYCount As Integer
    Dim i As Integer, j As Integer
    Dim startX As Integer, endX As Integer
    Dim startY As Integer, endY As Integer
    Dim width As Integer, height As Integer
    Dim currentX As Integer, currentY As Integer
    Dim rowHeight As Integer ' Высота текущего ряда
    '
    ' Очищаем ListBox-ы перед новой обработкой
    lstHeight.Clear
    lstWidth.Clear
    '
    ' Получаем количество вертикальных и горизонтальных линий
    verXCount = lstVerX.ListCount
    horYCount = lstHorY.ListCount
    '
    ' Если нет ни одной координаты, выходим
    If verXCount < 2 Or horYCount < 2 Then Exit Sub
    '
    ' Убедимся, что форма frmDest загружена
    If frmDest Is Nothing Then Load frmDest
    frmDest.Show ' Показываем форму, если она еще не видна
    '
    ' Инициализация начальных координат
    currentX = 0
    currentY = 0
    rowHeight = 0
    '
    ' Цикл по всем прямоугольникам, ограниченным линиями
    For i = 0 To verXCount - 2
        startX = lstVerX.List(i)
        endX = lstVerX.List(i + 1)
        width = endX - startX
        For j = 0 To horYCount - 2
            startY = lstHorY.List(j)
            endY = lstHorY.List(j + 1)
            height = endY - startY
            '
            ' Создаем новый PictureBox на форме frmDest
            CreatePictureBoxOnForm frmDest, width, height, startX, startY, width, height, currentX, currentY
            ' Обновляем максимальную ширину формы
            If currentX + width > maxFormWidth Then maxFormWidth = currentX + width
            '
            ' Обновляем высоту текущего ряда
            If height > rowHeight Then rowHeight = height
            '
            ' Добавляем отступ и сдвигаем по горизонтали
            currentX = currentX + width + 3 ' Отступ 3 пикселя
        Next j
        ' Переход на следующую строку
        currentY = currentY + rowHeight + 3 ' Отступ 3 пикселя между строками
        currentX = 0 ' Сбрасываем горизонтальную позицию
        rowHeight = 0 ' Сбрасываем высоту строки
    Next i
    '
    ' Устанавливаем размер формы frmDest
    AdjustFormSize frmDest, maxFormWidth, maxFormHeight
    '
End Sub
'
' Функция для создания PictureBox на форме frmDest
Private Sub CreatePictureBoxOnForm(ByRef destForm As Form, ByVal w As Integer, ByVal h As Integer, ByVal srcX As Integer, ByVal srcY As Integer, ByVal destWidth As Integer, ByVal destHeight As Integer, ByVal leftPos As Integer, ByVal topPos As Integer)
    '
    ' Увеличиваем индекс для массива PictureBox-ов
    picIndex = picIndex + 1
    '
    'ЗДЕСЬ ПИШЕТ "Subscript out of range"
    '
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    ' Реорганизуем массив, если достигнут его текущий предел
    If picIndex > UBound(picDest) Then
        ReDim Preserve picDest(picIndex) ' Увеличиваем размер массива
    End If
    '
    ' Динамическое создание нового PictureBox
    Load picDest(picIndex)
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    '
    ' Настройка свойств нового PictureBox
    With picDest(picIndex)
        .Visible = True
        .width = w * Screen.TwipsPerPixelX ' Преобразование пикселей в твипы
        .height = h * Screen.TwipsPerPixelY ' Преобразование пикселей в твипы
        .BorderStyle = 0 ' Без рамки
        .Left = destForm.ScaleX(leftPos, vbPixels, vbTwips) ' Располагаем относительно формы
        .Top = destForm.ScaleY(topPos, vbPixels, vbTwips)
        .Container = destForm ' Размещаем PictureBox на указанной форме
    End With
    '
    ' Копирование части изображения с помощью BitBlt
    Call BitBlt(picDest(picIndex).hDC, 0, 0, destWidth, destHeight, picSource.hDC, srcX, srcY, SRCCOPY)
    '
    ' Записываем размеры в ListBox-ы
    lstWidth.AddItem destWidth
    lstHeight.AddItem destHeight
    '
End Sub
'
Private Sub AdjustFormSize(ByRef destForm As Form, ByVal totalWidth As Integer, ByVal totalHeight As Integer)
    ' Преобразуем пиксели в твипы для установки размера формы
    destForm.width = destForm.ScaleX(totalWidth, vbPixels, vbTwips) + 300 ' Добавляем небольшой запас
    destForm.height = destForm.ScaleY(totalHeight, vbPixels, vbTwips) + 300 ' Добавляем небольшой запас
End Sub
'
Private Sub Form_Resize()
    If frmMain.WindowState <> vbMinimized Then
        picSource.Move 0, 0, frmMain.ScaleWidth, frmMain.ScaleHeight
    End If
    picSource.Refresh
End Sub

Load picDest(picIndex)