Большая картинка и PictureBox

[Tin]

Проблема такая в PB рисуется БОЛЬШАЯ картинка (больше чем 4000*4000). Проблема такая - бэйсик не дает ауторедроу для ПБ больших чем 4000*4000... А картинку из ПБ в последствиии надо сохранить...

[hCORe]

А можно код рисования в PB_Paint и в нем SavePicture?

[Tin]

Вообщем, размер ПБ допустим 300*300, но картинка в него должна нарисоваться 5000*5000, а потом сохраниться (например так: SavePicture BigPallete.Image, App.Path & "\1.bmp"). Так как SavePicture сохраняет только видимую часть, то и 1.bmp будет размером 300*300, а не 5000*5000. Если сделать ПБ изначально размером 5000*5000, то ВБ даст ошибку о том, что не может в картинке такого размера использовать AutoRedraw

[CodeName33]

Tin А откуда берётся картинка 5000х5000? открывается из другого файла и просто пересохраняется или ещё и модифицируется а потом пересохраняется?

[Tin]

Составляется из других картинок размером 300*300

[Sirik]

1. попробуй .picture=.image
2. свойство .AutoRedraw = True

[CodeName33]

Tin, Тут лучше написать функцию которая будет размножать напрямую в файл. Я так в своё время делал, когда надо было размножить маленькую какртинку до 10000х10000 чтобы использовать как текстуру потом. PB тут не подойдёт, видеопамяти не хватит. 10000х10000 - это 300метров видеопамяти надо. Поэтому я напрямую в BMP на диск размножал маленькую картинку. Исходники дома, щас приложить не могу... Может вечером если только.

[Tin]

2Sirik - не помогает
2CodeName33 - было бы не плохо...

[Sirik]

ты лучше напиши функцию, которая собирает картинку

[Tin]

В цикле от X 0 до temp.width и y так же идет рисование картинки...
Что тут непонятного...

Код: Выделить всё

BitBlt BigPallete.hDC, X * 300, Y * 300, 300, 300, Temp2.hDC, 0, 0, SRCCOPY


[alibek]

Если ты картинку через API множишь, почему бы тебе не работать с виртуальным hDC и не сохранять его сразу в файл?

[Tin]

А можно чуточку по подробнее... плз

[BV]

2 Tin

Для просмотра рисуй на малом DC только выделенный RECT, а копируй его со своего DC в памяти, ибо у PictureBox на такие рисунки памяти не хватит.

Смотри BitBlt/CreateCompatibleBitmap/CreateCompatibleDC

[CodeName33]

Tin, к сожалению исходник моей проги утерян, как и сама прога исчезла за ненадобностью. Может если будет на работе время - наклепаю по быстренькому.

[Tin]

2BV - огромное спасибо, разобрался...

Осталась только одна проблема - как сохранить картинку их Hdc в файл?

[CodeName33]

А вот и примерчик накатал. Размножает картинку прямо в файл и пямяти много не требует. Создаёт новый файл ИМЯ_СТАРОГО_ФАЙЛА.bmp

[Tin]

Конечно здорово... Но если картинки будут разные, то это усложнит данную программу....
А через АПИ на прямую никак не получится ХДС сохранить?

[CodeName33]

Tin, ну тогда остаётся по аналогии моей программы написать свой BitBlt напрямую в файл - и вопрос решится.

[Tin]

Через чур сложнй алгоритм получится...

ЗЫ Не мог бы прокоментировать строчки по бмп формату, может быть через ДиБитс получится решить проблему...

[CodeName33]

'Все структуры и обьявления в моём примере.

LW = RGBWidth(NW) 'Ширина строки картинки выровняная в 4 байта
BFH.bfType = 19778 'Тип BMP
BFH.bfOffBits = Len(BFH) + Len(bih)
BFH.bfSize = BFH.bfOffBits + LW * NH 'Размер файла - заголовки + ширина в байтах*высота
Put #F, Pos, BFH 'Пишем в файл
Pos = Pos + Len(BFH)

bih.biSize = Len(bih) 'Размер структуры
bih.biWidth = NW 'Ширина
bih.biHeight = NH 'Высота
bih.biPlanes = 1 'Это всегда 1
bih.biBitCount = 24 'Количество бит
bih.biCompression = 0 'Без сжатия
bih.biSizeImage = 0 'Всегда 0
Put #F, Pos, bih 'Пишем в файл
Pos = Pos + Len(bih)

'Дальше пишутся сами данные картинки.
'Строки в обратном порядке типа:
'строка 3: 1[BGR] 2[BGR] 3[BGR]...
'строка 2: 1[BGR] 2[BGR] 3[BGR]...
'строка 1: 1[BGR] 2[BGR] 3[BGR]...

[Tin]

Так... Вроде бы понял... Спасибо... Будем воевать дальше, если что опять спрошу что-нить

[Kovu]

Код: Выделить всё

Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (ByRef lpPictDesc As PicBmp, riid As GUID, ByVal fOwn As Long, ByRef lplpvObj As Any) As Long

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Type PicBmp
  Size As Long
  Type As PictureTypeConstants
  hBmp As Long
  hPal As Long
  Reserved As Long
End Type

Public Function GetPicture(ByVal hPic as long) As IPictureDisp 
  Dim p As PicBmp, g As GUID
 
  With p
    .hBmp = hPic
    .Size = Len(p)
    .Type = vbPicTypeBitmap
  End With
 
    With g
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
  End With
 
   OleCreatePictureIndirect p, g, 0, GetPicture
End Function

Использование:

Код: Выделить всё


SavePicture GetPicture(hBitmap), "pathtofile"

[Tin]

2Kovu - это не спасает - вылетает ошибка Out of memory, т.е. SavePicture не может сохранять большие картинки

[Tin]

И опять я со своими помидорами... Вообщем попытался я из ДС (в котором теоретически находится изображение около 5000*5000) вытащить цвет точки (через гет пиксел - он как раз их ДС вытаскивает цвет) и я получаю результат, что якобы ДС мой пустой... Чушь какая-та

[CodeName33]

Уффф... Переработал свой пример, написал функцию BitBlt в BMP файл. Вроде отсечения нормально работают, но н всякий случай проверь с разными X,Y,XSrc,YSrc. Правда не поддерживаются константы наложения, типа vbSrcCopy и т.д. но можно поработать и доделать и их...

[Tin]

Реально! Щас попробуем воплотить в жизнь! Спасибо за такое активное участие

[Tin]

А вот что из этого получилось... Правда ещё сырой вариант, но...

[CodeName33]

Tin, я тоже в своё время делал программу которая делает фотку из фоток. Только у меня 10000х10000 была, на медленных компах не открывалась даже...

[Tin]

у меня она где-то 15000*14000, только я её уменьшил для форума
У тебя нет идей, как писать избавиться от открывания картинки в ПБ и чтения его цветов, а читатать на прямую из БМП файла?

[CodeName33]

Tin, есть конечно! Я просто не знал, что тебе из BMP читать надо. Думал источником может быть любой файл изображения поддерживаемый VB.

Вот, проверь работоспособность, я не проверял, в браузере накатал. Работет только с BMP 24 Bit.

Код: Выделить всё

Public Function CreateFromBMP24(ByVal FN As String, ByRef Spr() As Byte, ByRef W As Integer, ByRef H As Integer, Optional Pos As Long = 1)
Dim F As Long, T As Long, B As Byte
Dim BFH As BITMAPFILEHEADER, bih As BITMAPINFOHEADER

F = FreeFile
Open FN For Binary Access Read As #F
  Get #F, Pos, BFH
  Get #F, Pos + Len(BFH), bih
  If Not bih.biBitCount = 24 Then GoTo Erro
  W = bih.biWidth
  H = bih.biHeight
 
  ReDim Spr(1 To RGBWidth(W), 1 To H) As Byte
  Get #F, Pos + Len(BFH) + Len(bih), Spr()
Erro:
Close #F
End Function