Работа с фаилами картинок

[KyPCAHT]

Здраствуйте.
Я восновном пише на дельфе, но жизнь заставила и на басике покодить.
Задача следующая:
Есть карта в фаиле ххх.bmp, которая разбита на определенные области линией определенного цвета, изначально все
области закрашены одинаково. Задача: указать точку внутри этой области и закрасить эту область определенным
цветом, и сохранить новый вариант карты в zzz.jpg.

Как закрасить область я нашел:
Public Declare Function FloodFill Lib "gdi32" Alias "FloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As
Long, ByVal crColor As Long) As Long

ByVal hdc As Long - я не понял чей надо указывать ...

А главное: куда загружать bmp картинку и как ее потом сохранить в jpg формате....

Заранее спасибо за любую помощь

[ALX_2002]

HDC - контекст устройства или как то так он там называется
( CANVAS т.е )

А как сохранять в JPG тебе сейчас Tyomitch прорекламирует

Ты только сначала уточни - как ты собираешся делать проект

1) С формой / БЕз
2) Обычный проект / DLL / Activex

[KyPCAHT]

Мне нужен ActiveX, чтоб в ASP моно была юзать ....

[ALX_2002]

Усёк. Дело не простое, но реальное.

Значит тогда и правда придётся юзать API, чтоб быстро работало.

Попробую подумать, что можно сделать.

Быстрого ответа не обещаю. Параллельно пишу курсовую.

[tyomitch]

В GDI+ нет аналога для FloodFill, и значит, для моей обёртки придётся писать ещё одну обёртку
Если нечего будет делать в ближайшие дни - напишу , но аналогично ALX_2002, ничего не обещаю.

[tyomitch]

Вот, короче, пример: http://mix.web.ur.ru/FloodFill.zip
Заливку пришлось писать самому, т.к. прикрутить апишку FloodFill не удалось. Но ничего, вроде нормально быстро работает

[GM]

Как сохранять JPEG, можна узнать отсюда. Также вроде-бы можна сохранять с помощью GDI+, но это уже к Тёмычу.

[tyomitch]

GM, я уже дал постом выше ссылку на готовый и работающий пример, вместе с сохранением в JPEG

[KyPCAHT]

Спасиб, начинаем разбираться ....

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

Set FSO = CreateObject("Scripting.FileSystemObject")
Home = FSO.GetParentFolderName(WScript.ScriptFullName)


- этот кусок определяет католок откуда был запущен скрипт, т.е. если мне этого не надо я могу написать

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

Home="C:\RIS\TEMP"


и все будет хорошо ....

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

Set GDI = CreateObject("prjGDIplus.Global")
Set i = GDI.CreateImage(FSO.BuildPath(Home, "xxx.bmp"))


- это мы создали копию объекы ГДИ и открыли в него некую картинку

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

CreateObject("prjFloodFill.clsFloodFill").FloodFillImage i, 80, 80, 255, 65280


- это мы вызвали нашу функцию заливки. Сразу вопрос, т.е. если мне надо залить нескольуо областей, то мне надо нескольуо раз ее повторить

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

Set c = GDI.CreateBitmap(i.Width, i.Height, i.Format)


- это мы создали Bitmap таких же размеров, что и первоначальнная картинка, но еще пустой

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

GDI.CreateGraphicsFromImage(c).DrawImage i, 0, 0


- это мы скопировали изображение

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

c.SaveToJpeg FSO.BuildPath(Home, "xxx.jpg")
Set GDI = Nothing


- это мы его сохранили и уничтожили объект ГДИ, а c и i не надо что ли ничтожать?


Ребят где доку по этой ГДИ+ можно посмотреть .....

[KyPCAHT]

Пробывал сейчаз запустить, тк не получается

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

Set GDI = CreateObject("prjGDIplus.Global")
Set i = GDI.CreateImage(FSO.BuildPath("D:\Progr_Progi\#RIS\map\pic", "66a.bmp"))
CreateObject("prjFloodFill.clsFloodFill").FloodFillImage i, 166, 141, 65280, 255 
Set c = GDI.CreateBitmap(i.Width, i.Height, i.Format)
GDI.CreateGraphicsFromImage(c).DrawImage i, 0, 0
c.SaveToJpeg FSO.BuildPath("C:\", "xxx.jpg")
Set GDI = Nothing


Пишет:
Строка: 1
Символ: 1
Ошибка: Неизвестная ошибка выполнения: 'CreateObject'

Пытался из басика:

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

Private Sub Form_Load()
Set GDI = CreateObject("prjGDIplus.Global")
Set i = GDI.CreateImage(FSO.BuildPath("D:\Progr_Progi\#RIS\map\pic", "66a.bmp"))
CreateObject("prjFloodFill.clsFloodFill").FloodFillImage i, 166, 141, 65280, 255
Set c = GDI.CreateBitmap(i.Width, i.Height, i.Format)
GDI.CreateGraphicsFromImage(c).DrawImage i, 0, 0
c.SaveToJpeg FSO.BuildPath("C:\", "xxx.jpg")
Set GDI = Nothing
End Sub


Пишет:
Run-time error '32797'
Application-defined or object-defined error

Обе библиотеки зарегистрировал:
regsvr32.exe prjFloodFill.dll
regsvr32.exe GDI+.dll

[tyomitch]

странно... такая ошибка иногда вылезает, я так и не смог понять когда
Дело именно в регистрации объекта. Сейчас что-нибудь придумаю...

[KyPCAHT]

Бог с этим jpg ....
Написал такую тестовую прогу ....

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

Private Declare Function FloodFill Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.FillStyle = vbFSSolid
Picture1.FillColor = RGB(255, 255, 255)
FloodFill Picture1.hDC, x, y, Picture1.Point(x, y) '65280
End Sub


Ошибок ни каких не пишет, а закрашивать не закрашивает
Могу свою картинку выслать, давай мыло ...

Пробывал твоей функцией заливки, слегка измененной

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

Private Sub FloodFillImageARGB(ByVal Image As PictureBox, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal FillColor As Long)
'very inefficient, but as good as I can
Dim StackX As Collection, StackY As Collection
Set StackX = New Collection: Set StackY = New Collection
Dim w As Long, h As Long
w = Image.Width: h = Image.Height
StackX.Add x: StackY.Add y
While StackX.Count
    x = StackX(1): y = StackY(1)
    Image.PSet (x, y), FillColor
    StackX.Remove 1: StackY.Remove 1
    If x > 0 Then x = x - 1: GoSub Test: x = x + 1
    If x < w Then x = x + 1: GoSub Test: x = x - 1
    If y > 0 Then y = y - 1: GoSub Test: y = y + 1
    If y < h Then y = y + 1: GoSub Test: y = y - 1
Wend
Exit Sub
Test:
Select Case Image.Point(x, y)
Case crColor, FillColor:  'ignore
Case Else: If StackX.Count Then StackX.Add x, , 1: StackY.Add y, , 1 Else StackX.Add x: StackY.Add y
End Select
Return
End Sub


а вызываю так

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

FloodFillImageARGB Picture1, x, y, Picture1.Point(x, y), RGB(127, 127, 127)


Он закрашивает одну точку и все ...

[GM]

GoSub еще кто-то их юзает
Кстати Picture1.ScaleMode должно быть vbPixels.

[tyomitch]

Бог с этим jpg ....
Написал такую тестовую прогу ....

Ошибок ни каких не пишет, а закрашивать не закрашивает
Могу свою картинку выслать, давай мыло ...

Ессно, что не закрашивает - ты в качестве цвета границы передаёшь цвет самой точки. Замени Picture1.Point(x, y) на настоящий цвет твоей границы (vbBlack, если граница чёрная, и т.д.)

Пробывал твоей функцией заливки, слегка измененной

а вызываю так

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

FloodFillImageARGB Picture1, x, y, Picture1.Point(x, y), RGB(127, 127, 127)


Он закрашивает одну точку и все ...

Та же самая причина - вместо Picture1.Point(x, y) указывай цвет границы.


GM, а кто что имеет против GoSub

[KyPCAHT]

Спасибо, с этим мне стало все понятно(просто в дельфе я указывал цвет заливки и какой цвет надо заменить) ....

Другой вопрос, почему когда я сварачиваю форму и востанавливаю все мои старания по заливке становятся напрасными. И соответственно когда я делую следуюющие

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

SavePicture Picture1, "c:\xxx.bmp"


то сохраняется первоначальная картинка, без заливок .....

[tyomitch]

1. Потому что надо AutoRedraw для Picture1 установить в True
2. Потому что надо делать следующее

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

SavePicture Picture1.Image, "c:\xxx.bmp"


[GM]

GM, а кто что имеет против GoSub

Да ничего, просто давно не встречал.

[KyPCAHT]

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

Dim Image As Picture
Set Image = LoadPicture("D:\Progr_Progi\#RIS\map\pic\66a.BMP")
hdcImg = GetDC(Image.Handle)
FloodFill hdcImg, 182, 88, 8388608
Picture1.Picture = img
Picture1.Refresh


Почему в переменную hdcImg возвращается 0?
И еще мне кажется, что надо к hdcImg применить следующию функцию

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

Private Declare Function SetPixelFormat Lib "gdi32" Alias "SetPixelFormat" (ByVal hDC As Long, ByVal n As Long, pcPixelFormatDescriptor As PIXELFORMATDESCRIPTOR) As Long


Но не знаю как ей пользоваться и пока не могу найти ....

[tyomitch]

1. SetPixelFormat тут не при чём, совершенно.
2. Потому что Image.Handle - это HBITMAP, а не HWND. GetDC к нему неприменима.
Или используй PictureBox, или мою обёртку

Чтобы обёртка заработала, попробуй её разрегистрировать и перерегистрировать - может, поможет

[KyPCAHT]

1. SetPixelFormat тут не при чём, совершенно.

Тогда почему когда я заружаю картинку в объект и беру его длину и ширину, то он возвращает мне не в пикселях, а в чем-то левом?

Или используй PictureBox, или мою обёртку

А разве я могу использовать этот объект без формы(мне же ActiveX нужен), у меня не получалось, писал error 91, что ли, приду домой уточню

А дока к твоей обертке есть?

И так не поделу вопрос: Вы из какого города?

[tyomitch]

1. SetPixelFormat тут не при чём, совершенно.

Тогда почему когда я заружаю картинку в объект и беру его длину и ширину, то он возвращает мне не в пикселях, а в чем-то левом?

В хайметриках.
Чтобы было в пикселах, юзай ScaleX(Picture.Width, , vbPixels) и ScaleY(Picture.Height, , vbPixels)

Или используй PictureBox, или мою обёртку

А разве я могу использовать этот объект без формы(мне же ActiveX нужен), у меня не получалось, писал error 91, что ли, приду домой уточню

А дока к твоей обертке есть?

И так не поделу вопрос: Вы из какого города?

Без формы - нет. Поэтому моя обёртка лучше

Доку я начинал писать: http://bbs.vbstreets.ru/viewtopic.php?p=76589#76589 Оказалось, что она никому не нужна, ну я и бросил.

Про город: http://bbs.vbstreets.ru/viewtopic.php?p=57758#57758

[KyPCAHT]

Пришли современный вариант файлика GDI+.DLL, лучше на почту Mr@timus.ru

[tyomitch]

Кинул.

[KyPCAHT]

О все заработало как часы ...
Большое програмерское спасибо за помощь и ответы на глупые вопросы ...

[tyomitch]

Что, и в JPEG сохраняет?

И ещё, а сам-то ты откуда? Мыло у тебя ебургское...