Ресайз GIF-a

Язык Visual Basic на платформе .NET.

Модераторы: Ramzes, Sebas

natcap
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 234
Зарегистрирован: 25.06.2003 (Ср) 13:15
Откуда: Москва

Ресайз GIF-a

Сообщение natcap » 14.04.2011 (Чт) 1:18

Добрый день.
Делаю ресайз картинок
С JPG и PNG проблем нет:
Код: Выделить всё
            Dim myThumbnail As New Bitmap(FilePath)
            Dim w = myThumbnail .Width
            Dim h = myThumbnail .Height
            Dim kf = Math.Min(Math.Min(ThumbnailWidth / w, ThumbnailHeight / h), 1)
            Dim newW As Integer = w * kf, newH As Integer = h * kf

            Dim b As System.Drawing.Bitmap
            Dim g As System.Drawing.Graphics
            b = New System.Drawing.Bitmap(newW, newH, Imaging.PixelFormat.Format32bppRgb)
            g = System.Drawing.Graphics.FromImage(b)
            g.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
            g.DrawImage(myThumbnail, 0, 0, newW, newH)
            g.Dispose()
            myThumbnail = b
            myThumbnail.Save(SavePath, ImgFormat)


для GIF если делать так же то получаю все в крапочку...
Понимаю, что надо самой высчитывать палитру и подставлять ее..
Но вот как эту палитру получить...
Пытаюсь делать вот по этому примеру http://support.microsoft.com/kb/319061/en-us/ но с переводом на VB.Net тоже как-то не клеится :(

Помогите советами плиз :)
Медленно переезжаю с 6.0 на 2008 .... задавая тонны глупых вопросов :)

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Re: Ресайз GIF-a

Сообщение Admiralisimys » 16.04.2011 (Сб) 1:48

natcap вот пример ftp://ftp.charlespetzold.com/ProgWinVB/Images%20and%20Bitmaps/ImageScaleIsotropic/ImageScaleIsotropic.vb
При загрузки с GIF работает так же, как и при исходных JPG: никакой "крапочки" не отображается.
Или "крапочка" только после сохранения появляется?

natcap
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 234
Зарегистрирован: 25.06.2003 (Ср) 13:15
Откуда: Москва

Re: Ресайз GIF-a

Сообщение natcap » 16.04.2011 (Сб) 7:53

при сохранении в формат GIF, т.к. палитру формирует система, и формирует ее очень криво, т.е. надо высчитывать палитру самостоятельно, но я математику себе это плохо представляю.

Как мне она представляется, сначала можно получить словарь всех цветов с кол-вом их повторов
потом, если словарь выйдет длиннее 256 надо его как-то сокращать, видимо начиная с цветов имющих меньшее вхождения, находить самый приближенный к остальным цвет - убирать и т.д...

в общем бред, кошмар и караул :(
Медленно переезжаю с 6.0 на 2008 .... задавая тонны глупых вопросов :)

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Re: Ресайз GIF-a

Сообщение Admiralisimys » 16.04.2011 (Сб) 12:05

Понятно natcap.
Остаётся попиксельная обработка. Есть пример (C#)
http://www.gotdotnet.ru/blogs/karevn/6568/
и мой порт на VB.NET
Код: Выделить всё
Imports System
Imports System.Drawing
Imports System.Drawing.Imaging
Class MyApp
    Shared Sub Main()
        Dim MyBitmap As New Bitmap(64, 64)

        'MyBitmap.SetPixel(10, 10, Color.Violet)

        If (MyBitmap.PixelFormat = MyBitmap.PixelFormat Or PixelFormat.Indexed) Then Return

        Dim bData As BitmapData = MyBitmap.LockBits(New Rectangle(Point.Empty.X, Point.Empty.Y, MyBitmap.Width, MyBitmap.Height), Imaging.ImageLockMode.WriteOnly, MyBitmap.PixelFormat)
        Dim bmpPtr As IntPtr = bData.Scan0

        Dim isAlpha As Boolean = (MyBitmap.PixelFormat = (MyBitmap.PixelFormat Or PixelFormat.Alpha))
        Dim byteCount As Integer = If(isAlpha, 4, 3) * MyBitmap.Width * MyBitmap.Height

        Dim byteCells() As Byte = New Byte(byteCount - 1) {}

        System.Runtime.InteropServices.Marshal.Copy(bmpPtr, byteCells, 0, byteCells.Length)

        SetPixelEx(byteCells, 10, 10, MyBitmap.Width, Color.Blue, isAlpha)

        System.Runtime.InteropServices.Marshal.Copy(byteCells, 0, bmpPtr, byteCells.Length)

        MyBitmap.UnlockBits(bData)

        MyBitmap.Save("1.bmp")
        MyBitmap.Dispose()
    End Sub

    Shared Sub SetPixelEx(ByVal byteCells() As Byte, ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal Cl As Color, ByVal isAlpha As Boolean)
        Dim pos As Integer = ((y * w + x) * If(isAlpha, 4, 3))
        byteCells(pos) = Cl.B
        byteCells(pos + 1) = Cl.G
        byteCells(pos + 2) = Cl.R
        If isAlpha Then byteCells(pos + 3) = Cl.A '255
    End Sub

End Class

Но для гифов индексных не подойдёт (от ворот поворот на строчки If (MyBitmap.PixelFormat = MyBitmap.PixelFormat Or PixelFormat.Indexed) Then Return), а если её закомментировать то прога свалится с исключением на строчке System.Runtime.InteropServices.Marshal.Copy(bmpPtr, byteCells, 0, byteCells.Length)
Тут действительно нужно пересчитать ещё раз математику, я бы сконцентрировался на том, что предлагает support.microsoft.com

natcap
Бывалый
Бывалый
Аватара пользователя
 
Сообщения: 234
Зарегистрирован: 25.06.2003 (Ср) 13:15
Откуда: Москва

Re: Ресайз GIF-a

Сообщение natcap » 16.04.2011 (Сб) 12:18

я картинку перед ресайзом привожу к 32bpp
т.е. мне надо 32bpp привести к indexed , в msdn откопала такое http://msdn.microsoft.com/en-us/library/aa479306.aspx но оно больше напоминает мысли вслух а не решение проблемы ...
Медленно переезжаю с 6.0 на 2008 .... задавая тонны глупых вопросов :)


Вернуться в Visual Basic .NET

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3

    TopList