Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Палитра файла / 13 сообщений из 13, страница 1 из 1
27.01.2010, 15:35
    #36433963
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
Может кто сталкивался с извлечением палитры(индекс и значение RGB) из графических файлов, например из TIFF.
Подскажите как достать значения палитры.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2010, 21:40
    #36434768
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
GetSystemPaletteEntries
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.01.2010, 16:21
    #36436650
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
из TIFF выдернул Colormap в виде:
128 65480 41464 35129 35342 33024 6944 33568 35872 ..... и т.д., всего 768(256*3) значений.
Подскажите, пожалуйста, в каком виде предоставлен Colormap в файле Tiff, как эти значения в RGB перевести.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.01.2010, 18:01
    #36437032
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
А попробуй wiaaut.dll покопать.
ImageFile.ARGBData ?
Vector ?
М.б. эта общая идея поможет.
Вот такой пример там в хэлпе с ходу нарыл, не то?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
Function Get4ByteHex(val)
    Dim s As String
    s = Hex(val)
    Do While Len(s) <  8 
        s = "0" & s
    Loop
    Get4ByteHex = Right(s,  8 )
End Function

Function Get1ByteHex(val)
    Dim s As String
    s = Hex(val)
    Do While Len(s) <  2 
        s = "0" & s
    Loop
    Get1ByteHex = Right(s,  2 )
End Function

Function GetAlpha(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetAlpha = CLng("&h" & Left(s,  2 ))
End Function

Function GetRed(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetRed = CLng("&h" & Mid(s,  3 ,  2 ))
End Function

Function GetGreen(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetGreen = CLng("&h" & Mid(s,  5 ,  2 ))
End Function

Function GetBlue(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetBlue = CLng("&h" & Right(s,  2 ))
End Function

Function GetARGB(a, r, g, b)
    Dim s As String
    s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
    GetARGB = CLng(s)
End Function
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 11:18
    #36438054
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
Дмитрий77А попробуй wiaaut.dll покопать.
ImageFile.ARGBData ?
Vector ?
М.б. эта общая идея поможет.
Вот такой пример там в хэлпе с ходу нарыл, не то?

Спасибо, вроде бы то.
Но всё равно непойму как получит таблицу файла в RGB.
ImageFile.ARGBData возвращает значение цвета для каждого пикселя в изображении.
Подскажите, надо пробегаться по каждому пикселу в картинке пока не заполнится таблица из 256 цветов, или как то по дугому можно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 12:00
    #36438202
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
А бес его знает. Давай разбираться. Только результаты выкладывать. Я с ней как раз игрался.
Следующий код, напр. чертит белую горизонтальную линию посередине страницы.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Private Sub Command4_Click()
Dim Img As ImageFile
Dim IP As ImageProcess
Dim v As Vector
Dim i As Long

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")

Img.LoadFile "test.tif"
MsgBox Img.PixelDepth '=1

Set v = Img.ARGBData
For i = Img.Width * Img.Height /  2  To Img.Width * Img.Height /  2  + Img.Width Step  1 
    v(i) = vbWhite '&HFFFF00FF 'opaque pink (A=255,R=255,G=0,B=255)
Next

IP.Filters.Add IP.FilterInfos("ARGB").FilterID
Set IP.Filters( 1 ).Properties("ARGBData") = v

Set Img = IP.Apply(Img)
MsgBox Img.PixelDepth '=32
Img.SaveFile "TestRez.tif"
End Sub
Т.е. получается что ImageFile.ARGBData это полный набор всех пикселей
кот. можно сохранить в объект Vector размером w * h
где w=Img.Width h=Img.Height в пикселях
v(i) задает ARGB для пикселя i
по сути те числа кот. ты привел

а тот код из хэлпа если применить к v(i) наверно и даст A,R,G,B числа

У меня проблема другая. Я работаю с ч/б tif (факсы), и если tiff resolution 200х100, то при преобразовании в любую картинку ее надо растянуть по высоте вдвое чтобы не выглядела сжатой.
А применение любого хитрого преобразования, да хоть бы вышеприведенный код, или фильтр Scale автоматически повышает Img.PixelDepth до 32, т.е. добавляет всю гамму цветов, а допустим если преобразовывать в bmp то это нехилый размер файла.
И я пока не знаю как убрать эту цветность.
М.б. вы вдруг знаете как растянуть tif избежав изменения Img.PixelDepth , кот. должно быть =1. Потому как этого ARGB мне как раз и не надо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 13:39
    #36438566
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
Dim Img    As ImageFile

    Dim IP     As ImageProcess

    Dim v      As Vector

    Dim ColMap As Vector

    Dim i      As Long

    Dim prop   As Properties

    Dim p      As Property
    Dim i_alpha As Long

    Set Img = CreateObject("WIA.ImageFile")

    Img.LoadFile "D:\~~~ÓÄÀËÈ\test_01_07.tif "

    Set v = Img.ARGBData

    Set prop = Img.Properties

    For Each p In prop

        If p.PropertyID =  320  Then 'Tag Colormap - таблица цвета
        
            Set ColMap = p.Value

        End If

    Next

    For i =  1  To ColMap.Count Step  3 
    
    List1.AddItem GetARGB(i_alpha, ColMap(i), ColMap(i +  1 ), ColMap(i +  2 ))
    
    i_alpha = i_alpha +  1 
    Next i
вот так получаю 768 значений тэга Colormap, пробую применить функции из справки(GetAlpha, GetRed ....) но получаются значения цвета отличные от тех которые я вижу, например в фотошопе.

по поводу как растянуть картинку, извини, не знаю. сам только начал с tif заморачиваться
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 15:28
    #36438988
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
в Colormap первый цвет в таблице= -12594 -22360 -772

после применения ф-ий из справки:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Function Get4ByteHex(val)
    Dim s As String
    s = Hex(val)
    Do While Len(s) <  8 
        s = "0" & s
    Loop
    Get4ByteHex = Right(s,  8 )
End Function

Function GetAlpha(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetAlpha = CLng("&h" & Left(s,  2 ))
End Function

Function GetRed(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetRed = CLng("&h" & Mid(s,  3 ,  2 ))
End Function

Function GetGreen(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetGreen = CLng("&h" & Mid(s,  5 ,  2 ))
End Function

Function GetBlue(val)
    Dim s As String
    s = Get4ByteHex(val)
    GetBlue = CLng("&h" & Right(s,  2 ))
End Function


получаю значение первого цвета = 0 168 252

в фотошопе(таблица цвета из файла) первый цвет = 206 206 206

что то никак не срастается у меня RGB этот.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 15:48
    #36439051
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
как же преобразовать то -12594 -22360 -772 к 206 206 206?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 19:08
    #36439546
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
Гуру, хотя бы направление подскажите, пожалуйста, с чего начать, чтобы получить палитру из tif.
я просто не понимаю, ведъ WIA воспринимает tif, почему тогда возвращает отрицательные значения Colormap.
Colormap же должен содержать значения в диапазоне 0-65535.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 20:13
    #36439609
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
может репетиторы есть среди участников форума?
о цене договоримся.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2010, 21:19
    #36439677
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
создал таблицу цветности руками(фотошоп+блокнот), не поленился, проблему свою решил, но не ужели никто не сталкивался с этим?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
31.01.2010, 14:13
    #36440822
timtim
timtim
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Палитра файла
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
 Dim Img    As ImageFile

    Dim v      As Vector

    Dim ColMap As Vector

    Dim i      As Long

    Dim prop   As Properties

    Dim p      As Property

    Dim retRGB As Long
    
    Set Img = CreateObject("WIA.ImageFile")

    Img.LoadFile "D:\~~~ÓÄÀËÈ\test_01_07.tif "

    Set v = Img.ARGBData

    Set prop = Img.Properties
    
    For Each p In prop

        If p.PropertyID =  320  Then 'Tag Colormap
            Set ColMap = p.Value
        End If

    Next

    For i =  1  To  256 
    
        retRGB = GetARGB(i, CLng(ColMap(i)), CLng(ColMap( 256  + i)), CLng(ColMap( 512  + i)))
    
        List1.AddItem i & " " & GetRed(retRGB) & " " & GetGreen(retRGB) & " " & GetBlue(retRGB)
   
    Next i
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Палитра файла / 13 сообщений из 13, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]