PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » PureBasic для Windows » Подсчёт использованных цветов в изображениии


Подсчёт использованных цветов в изображениии

Сообщений 1 страница 10 из 10

1

Код:
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()

;Fast operations for 24-bit max 8192x8192 images only
Dim Colors.a(256,256,256)

FileName$ = OpenFileRequester("Select image for calc colors.",  "", "Images|*.bmp;*.jpg;*.tga;*.png;*.tif",0)
If  LoadImage(0,  FileName$)  = 0 Or  ImageDepth(0) <>  24
  End
EndIf

StartDrawing(ImageOutput(0))
  *Color.Ascii  = DrawingBuffer()
  *Overflow = *Color  + ImageWidth(0) * ImageHeight(0)  * 3
  While *Color<*Overflow
    If  State = 0
      First   = *Color\a
      State + 1
    ElseIf  State = 1
      Second  = *Color\a
      State + 1
    Else
      Colors(First, Second, *Color\a) = #True
      State = 0
    EndIf
    *Color  = SizeOf(Ascii)
  Wend
StopDrawing()

For a = 0 To  255
  For b = 0 To  255
    For c = 0 To  255
      If  Colors(a,b,c)
        Count   + 1
      EndIf
    Next
  Next
Next

MessageRequester("Colors.", Str(Count))

Вылетает и пишет чтение с адреса 1. Где косяк? Purebasic 6.12

0

2

Нашёл.
Всё. там + sizeof(Ascii)

0

3

Код:
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()

;Fast operations for 24-bit max 8192x8192 images only
Dim Colors.a(256,256,256)

FileName$ = OpenFileRequester("Select image for calc colors.",  "", "Images|*.bmp;*.jpg;*.tga;*.png;*.tif;*.tiff",0)
If  LoadImage(0,  FileName$)  = 0 Or  ImageDepth(0) <>  24
  End
EndIf

StartDrawing(ImageOutput(0))
  *Color  = DrawingBuffer()
  *Overflow = *Color  + ImageWidth(0) * ImageHeight(0)  * 3
  While *Color<*Overflow
    Colors(PeekA(*Color), PeekA(*Color  + 1), PeekA(*Color  + 2)) = #True
    *Color  + 3
  Wend
StopDrawing()

For a = 0 To  255
  For b = 0 To  255
    For c = 0 To  255
      If  Colors(a,b,c)
        Count   + 1
      EndIf
    Next
  Next
Next

MessageRequester("Colors.", Str(Count))

0

4

Подобное реализовано в программе просмотра изображений - XnView, но например при обработке изображения 8192 на 8192 со всей палитрой цветов - 16777216 штук - та программа намертво виснет, как выяснилось - она считает, только ну очень уж медленно. Скорее всего там подсчёт по типу For x = 1 to .... и For y = 1 to ... и память начинает потребляться всё больше и больше по мере счёта в таком изображении, значит там динамический список скорее всего. На JPEG фотографиях можно получить разные результаты тремя способами счёта: XnView, онлайн сервис и моя программа - наверное по-разному сделано восстановление цвета в этих решениях JPEG декодера. Но если сделать BMP 24бит то результаты совпадут. Жаль то что размер изображения ограничен 8192 на 8192, а так - можно сравнивать качество цветопередачи разных камер при приближённх к одинаковым условиям съёмки.

0

5

Почти полностью на указателях.

Код:
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()

;Fast operations for 24-bit max 8192x8192 images only
Dim Colors.a(256,256,256)

FileName$ = OpenFileRequester("Select image for calc colors.",  "", "Images|*.bmp;*.jpg;*.tga;*.png;*.tif;*.tiff",0)
If  LoadImage(0,  FileName$)  = 0 Or  ImageDepth(0) <>  24
  End
EndIf

StartDrawing(ImageOutput(0))
  *Color  = DrawingBuffer()
  *Overflow = *Color  + ImageWidth(0) * ImageHeight(0)  * 3
  While *Color<*Overflow
    Colors(PeekA(*Color), PeekA(*Color  + 1), PeekA(*Color  + 2)) = #True
    *Color  + 3
  Wend
StopDrawing()

For *Pointer.Ascii  = @Colors() To  @Colors(255,255,255) 
  If  *Pointer\a
    Count + 1
  EndIf
Next

MessageRequester("Colors.", Str(Count))

Интересует то, что массив задаётся от 0 до указанного включительно, то есть можно применить это:

Код:
Dim Colors.a(255,255,255)

?

0

6

Такой вариант.

Код:
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()

Structure Color
  a.a
  b.a
  c.a
EndStructure

DisableDebugger

;Fast operations for 24-bit max 8192x8192 images only
Dim Colors.a(256,256,256)

FileName$ = OpenFileRequester("Select image for calc colors.",  "", "Images|*.bmp;*.jpg;*.tga;*.png;*.tif;*.tiff",0)
If  LoadImage(0,  FileName$)  = 0 Or  ImageDepth(0) <>  24
  End
EndIf

Time = ElapsedMilliseconds()
StartDrawing(ImageOutput(0))
  *Color.Color  = DrawingBuffer()
  *Overflow = *Color  + OutputWidth() * OutputHeight()  * 3
  While *Color<*Overflow
    Colors(*Color\a, *Color\b, *Color\c) = #True
    *Color  + SizeOf(Color)
  Wend
StopDrawing()

*EndArr = @Colors(255,255,255) 
For *Pointer.Ascii  = @Colors() To *EndArr
  If *Pointer\a
    Count + 1
  EndIf
Next

MessageRequester("Time "+Str(ElapsedMilliseconds()-Time), "Colors "+Count)

Сишный компиль - результат 24 мс, при размере картинки 4020 х 2450.

0

7

Я и говорю - очень быстро, а то XnView мне считало на большой картинке изо всех цветов (я хотел проверить - правильно ли записана вся палитра) так я и не дождался спустя много минут.

0

8

Приложение XnView на той же картинке посчитало примерно за секунду.

0

9

ещё версия, и она быстрей Петра и 32 бита кушает, а также считает очень близко с ирфаном
ирфан всё на лету считает, картинка загрузилась и все данные о ней уже готовы
картинки 24 и 32 png
http://forumupload.ru/uploads/0009/ae/28/416/t186831.png
http://forumupload.ru/uploads/0009/ae/28/416/t999534.png

Код:
DisableDebugger

UseJPEGImageDecoder()
UsePNGImageDecoder()
EnableExplicit


Procedure colColors()
Protected imw, imh, x, y, time, c, n
Protected Dim m.a(16777215)
LoadImage(12, "pics\palette-256х256-32.png")

 ImW=ImageWidth(12)-1
 ImH=ImageHeight(12)-1
 Time = ElapsedMilliseconds()
 StartDrawing(ImageOutput(12))
For y=0 To ImH
For x=0 To ImW
c=Point(x, y)
If m(c)=0; если ячейка пустая
m(c)=1; метим её как новый цвет
n+1
EndIf
Next
Next
StopDrawing()

Time = ElapsedMilliseconds()-Time
MessageBox_(0, ""+time+"  "+n+" "+x+" "+y, "", 0)

EndProcedure

Procedure senior()
Protected ev, eg, em, et
OpenWindow(1234, 870, 640, 400, 300, "text")

colColors()


Repeat
ev=WaitWindowEvent(111)
If GetAsyncKeyState_(#VK_ESCAPE)=32768:Break:EndIf
Until ev=#PB_Event_CloseWindow

EndProcedure

senior()

0

10

newJS. 32бит у вас не считает, там цвет 2 в 32 степени, нужен массив около 4 Гигабайтов. Что можно и сделать если такой массив объявить, тогда просто вбивать цвет как индекс массива и ставить флажок о том, что цвет уже использован. А потом надо пройтись по всему массиву и сосчитать флажки. Plot равносилен y умножить на количество по вертикали, а x - плюс смещение по горизонтали, умножение дольше сложения. Версия Петра - быстрее должна быть. Да и я переписал ещё раз по-своему, у меня этих версий несколько теперь, мне всего то надо было проверить картинку абсолютно со всеми цветами - есть ли они там, цвета 24 бит. А сколько я не тыкал в XnView, он только начинал кушать память по мере счёта, а онлайн сервис был с ограничением на размер и формат файла. А теперь получилась программа полноценная для сравнения качества камер телефонов например.
Проверил все версии у себя - версия Петра быстрее ну и моя не отстаёт особо

Код:
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
UsePNGImageDecoder()

Structure Color
  UnsignedByte.a[3]
EndStructure

Dim Colors.a(256,256,256)

If  LoadImage(0,  OpenFileRequester("Select image for calc colors.",  "", "Images|*.bmp;*.jpg;*.tga;*.png;*.tif;*.tiff",0))  = 0 Or  ImageDepth(0) <>  24
  End
EndIf

StartDrawing(ImageOutput(0))
  *Color.Color  = DrawingBuffer()
  *Overflow = *Color  + ImageWidth(0) * ImageHeight(0)  * 3
  While *Color<*Overflow
    Colors(*Color\UnsignedByte[0],*Color\UnsignedByte[1],*Color\UnsignedByte[2]) = #True
    *Color  + SizeOf(Color)
  Wend
StopDrawing()

For *Pointer.Ascii  = @Colors() To  @Colors(255,255,255) 
  If  *Pointer\a
    Count + 1
  EndIf
Next

MessageRequester("Colors.", Str(Count))

Отредактировано PSY (30.10.2024 19:10:44)

0


Вы здесь » PureBasic - форум » PureBasic для Windows » Подсчёт использованных цветов в изображениии