VBNet - Форум - Правильно отмасштабировать Bitmap?

Вопрос: Правильно отмасштабировать Bitmap? Добавлено: 19.01.04 18:34

Автор вопроса: Павло

Никто не сталкивался с проблемой правильно отмасштабировать BitMap для ListView например? В ListView источником картинок является ImageList, который мастштабирует все картинки в один размер. Но если они не одинаковые, не иконки? Некрасиво, однако. Может есть готовый пример? Разбираться некогда...

Ответить

Ответы Всего ответов: 8

Номер ответа: 1 Автор ответа: Павло Вопросов: 8 Ответов: 24	Профиль \| \| #1	Добавлено: 19.01.04 20:50
	Спасибо - уже написал. Если интересно - могу дать функцию. Вписывает любой Image в любой указанный квадрат с рамкой Like ACDsee. Идеально для просмотра в ListView - он больше не портит картинки! Ответить

Номер ответа: 2
Автор ответа:

Chill

ICQ: 554200

Вопросов: 101
Ответов: 343

Профиль | | #2

Добавлено: 19.01.04 21:54

Выложи, пожалуйста, ее сюда или скинь мне на мыло chill_hr@mail.ru

Ответить

Номер ответа: 3 Автор ответа: shuffle Администратор ICQ: 201502381 Вопросов: 15 Ответов: 737	Профиль \| \| #3	Добавлено: 19.01.04 22:00
	Ну если можешь, дык выложи сюда, в форум... Вдруг кому-то понадобится. Ответить

Номер ответа: 4
Автор ответа:

AASoft

Вопросов: 86
Ответов: 920

Профиль | | #4

Добавлено: 20.01.04 00:39

dyk a che slozhnovo ta?????!!!?!?!

prosto smotrish sho bol`she, shirina ili vysota.

dal`she delish kakova rasmera ndao sdelat` kartinku na to che bol`she, i potom to sho poluchilos` na to che men`she umnozh`.i vse v paryadke...

Ответить

Номер ответа: 5
Автор ответа:

Павло

Вопросов: 8
Ответов: 24

Профиль | | #5

Добавлено: 20.01.04 11:38

Если будут предложения по оптимизации - с удовольствием выслушаю. Мне ей часто придется пользоваться.

Public Function createIcon(ByVal OrigImage As Image, ByVal MySide As Integer, _

ByVal BackGrColor As Color, ByVal Border As Color, Optional ByVal BorderWeight As Integer = 1) As Image

'OrigImage - исходная картинка

'MySide - сторона квадрата в пикселях

'BackGrColor - цвет фона

'Border - цвет границы

'BorderWeight - толщина границы

Dim RetBMP As Bitmap = _

New Bitmap(MySide, MySide, PixelFormat.Format24bppRgb) 'Возвращаемая картинка

Dim TempBmp As Bitmap 'Временный BitMap

Dim MyYSub As Single 'Для подсчета отношения высоты

Dim MyXSub As Single 'Для подсчета отношения ширины

Dim MyNewX As Integer 'Для подсчета новой ширины

Dim MyNewY As Integer 'Для подсчета новой высоты

Dim Ix As Integer 'Итерации по X

Dim Iy As Integer 'Итерации по Y

Dim OrigX As Integer 'Итерации внутри оригинальной картинки по X

Dim OrigY As Integer 'Итерации внутри оригинальной картинки по Y

'Проверка значений

If IsNothing(OrigImage) Or MySide = 0 Or BorderWeight < 0 Then Return Nothing : Exit Function

'Подсчет отношения

MyXSub = MySide / OrigImage.Width

MyYSub = MySide / OrigImage.Height

'В зависимости от отношения сторон по разному создается новая картинка

'Заполняется либо по вертикали, либо по горизонтали

'//// --------- По вертикали

If MyXSub < MyYSub Then

MyNewX = OrigImage.Width * MyXSub

MyNewY = OrigImage.Height * MyXSub

TempBmp = New Bitmap(OrigImage, MyNewX, MyNewY)

'Первая пустая зона

For Iy = 0 To Round((MySide - MyNewY) / 2)

For Ix = 0 To MySide - 1

'Создание рамки

If Iy < BorderWeight Or Ix >= MySide - BorderWeight Or Ix < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, BackGrColor)

End If

Ответить

Номер ответа: 6
Автор ответа:

Павло

Вопросов: 8
Ответов: 24

Профиль | | #6

Добавлено: 20.01.04 11:38

Если будут предложения по оптимизации - с удовольствием выслушаю. Мне ей часто придется пользоваться.

Public Function createIcon(ByVal OrigImage As Image, ByVal MySide As Integer, _

ByVal BackGrColor As Color, ByVal Border As Color, Optional ByVal BorderWeight As Integer = 1) As Image

'OrigImage - исходная картинка

'MySide - сторона квадрата в пикселях

'BackGrColor - цвет фона

'Border - цвет границы

'BorderWeight - толщина границы

Dim RetBMP As Bitmap = _

New Bitmap(MySide, MySide, PixelFormat.Format24bppRgb) 'Возвращаемая картинка

Dim TempBmp As Bitmap 'Временный BitMap

Dim MyYSub As Single 'Для подсчета отношения высоты

Dim MyXSub As Single 'Для подсчета отношения ширины

Dim MyNewX As Integer 'Для подсчета новой ширины

Dim MyNewY As Integer 'Для подсчета новой высоты

Dim Ix As Integer 'Итерации по X

Dim Iy As Integer 'Итерации по Y

Dim OrigX As Integer 'Итерации внутри оригинальной картинки по X

Dim OrigY As Integer 'Итерации внутри оригинальной картинки по Y

'Проверка значений

If IsNothing(OrigImage) Or MySide = 0 Or BorderWeight < 0 Then Return Nothing : Exit Function

'Подсчет отношения

MyXSub = MySide / OrigImage.Width

MyYSub = MySide / OrigImage.Height

'В зависимости от отношения сторон по разному создается новая картинка

'Заполняется либо по вертикали, либо по горизонтали

'//// --------- По вертикали

If MyXSub < MyYSub Then

MyNewX = OrigImage.Width * MyXSub

MyNewY = OrigImage.Height * MyXSub

TempBmp = New Bitmap(OrigImage, MyNewX, MyNewY)

'Первая пустая зона

For Iy = 0 To Round((MySide - MyNewY) / 2)

For Ix = 0 To MySide - 1

'Создание рамки

If Iy < BorderWeight Or Ix >= MySide - BorderWeight Or Ix < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, BackGrColor)

End If

Ответить

Номер ответа: 7
Автор ответа:

Павло

Вопросов: 8
Ответов: 24

Профиль | | #7

Добавлено: 20.01.04 11:45

'Врисовываю картинку

For Iy = Round((MySide - MyNewY) / 2) + 1 To (MySide - (MySide - MyNewY) \ 2) - 1

OrigX = 0

For Ix = 0 To MySide - 1

'Создание рамки

If Ix >= MySide - BorderWeight Or Ix < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, TempBmp.GetPixel(OrigX, OrigY))

End If

OrigX += 1

OrigY += 1

'Вторая пустая зона

For Iy = MySide - 1 To MySide - (MySide - MyNewY) \ 2 Step -1

For Ix = 0 To MySide - 1

'Создание рамки

If Iy >= MySide - BorderWeight Or Ix >= MySide - BorderWeight Or Ix < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, BackGrColor)

End If

'\\\\ --------- По вертикали

Else '//// --------- По горизонтали

MyNewX = OrigImage.Width * MyYSub

MyNewY = OrigImage.Height * MyYSub

TempBmp = New Bitmap(OrigImage, MyNewX, MyNewY)

'Первая пустая зона

For Ix = 0 To Round((MySide - MyNewX) / 2)

For Iy = 0 To MySide - 1

'Создание рамки

If Iy < BorderWeight Or Iy >= MySide - BorderWeight Or Ix < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, BackGrColor)

End If

'Врисовываю картинку

For Ix = Round((MySide - MyNewX) / 2) + 1 To (MySide - (MySide - MyNewX) \ 2) - 1

OrigY = 0

For Iy = 0 To MySide - 1

'Создание рамки

If Iy >= MySide - BorderWeight Or Iy < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, TempBmp.GetPixel(OrigX, OrigY))

End If

OrigY += 1

OrigX += 1

'Вторая пустая зона

For Ix = MySide - 1 To MySide - (MySide - MyNewX) \ 2 Step -1

For Iy = 0 To MySide - 1

'Создание рамки

If Iy >= MySide - BorderWeight Or Ix >= MySide - BorderWeight Or Iy < BorderWeight Then

RetBMP.SetPixel(Ix, Iy, Border)

Else 'Создание фона

RetBMP.SetPixel(Ix, Iy, BackGrColor)

End If

End If '\\\\ --------- По горизонтали

Ответить

Номер ответа: 8
Автор ответа:

Павло

Вопросов: 8
Ответов: 24

Профиль | | #8

Добавлено: 20.01.04 11:47

Return CType(RetBMP, Image)

End Function

Ответить

Страница: 1 |