ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Палитра файла
13 сообщений из 13, страница 1 из 1
Палитра файла
    #36433963
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
Может кто сталкивался с извлечением палитры(индекс и значение RGB) из графических файлов, например из TIFF.
Подскажите как достать значения палитры.
...
Рейтинг: 0 / 0
27.01.2010, 15:35
| Ответить | Цитировать | Написать  
Палитра файла
    #36434768
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
GetSystemPaletteEntries
...
Рейтинг: 0 / 0
27.01.2010, 21:40
| Ответить | Цитировать | Написать  
Палитра файла
    #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, 16:21
| Ответить | Цитировать | Написать  
Палитра файла
    #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
28.01.2010, 18:01
| Ответить | Цитировать | Написать  
Палитра файла
    #36438054
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
Дмитрий77А попробуй wiaaut.dll покопать.
ImageFile.ARGBData ?
Vector ?
М.б. эта общая идея поможет.
Вот такой пример там в хэлпе с ходу нарыл, не то?

Спасибо, вроде бы то.
Но всё равно непойму как получит таблицу файла в RGB.
ImageFile.ARGBData возвращает значение цвета для каждого пикселя в изображении.
Подскажите, надо пробегаться по каждому пикселу в картинке пока не заполнится таблица из 256 цветов, или как то по дугому можно.
...
Рейтинг: 0 / 0
29.01.2010, 11:18
| Ответить | Цитировать | Написать  
Палитра файла
    #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, 12:00
| Ответить | Цитировать | Написать  
Палитра файла
    #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, 13:39
| Ответить | Цитировать | Написать  
Палитра файла
    #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:28
| Ответить | Цитировать | Написать  
Палитра файла
    #36439051
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
как же преобразовать то -12594 -22360 -772 к 206 206 206?
...
Рейтинг: 0 / 0
29.01.2010, 15:48
| Ответить | Цитировать | Написать  
Палитра файла
    #36439546
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
Гуру, хотя бы направление подскажите, пожалуйста, с чего начать, чтобы получить палитру из tif.
я просто не понимаю, ведъ WIA воспринимает tif, почему тогда возвращает отрицательные значения Colormap.
Colormap же должен содержать значения в диапазоне 0-65535.
...
Рейтинг: 0 / 0
29.01.2010, 19:08
| Ответить | Цитировать | Написать  
Палитра файла
    #36439609
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
может репетиторы есть среди участников форума?
о цене договоримся.
...
Рейтинг: 0 / 0
29.01.2010, 20:13
| Ответить | Цитировать | Написать  
Палитра файла
    #36439677
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
timtim
Участник
создал таблицу цветности руками(фотошоп+блокнот), не поленился, проблему свою решил, но не ужели никто не сталкивался с этим?
...
Рейтинг: 0 / 0
29.01.2010, 21:19
| Ответить | Цитировать | Написать  
Палитра файла
    #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
31.01.2010, 14:13
| Ответить | Цитировать | Написать  
13 сообщений из 13, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Палитра файла
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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