Хочу чтоб в turbo pascal можно было загрузить jpg картинку. Т. к. TP под DOS, то напрямую не как. Когда то, я писал на нем (на TP) граф. редактор. И там я использовал такой принцип: сохранял свою картинку в txt файле, где были записаны координаты всех точек (640*480) картинки и их цвет. Потом я писал цикл в TP где эти точки все выводил. Ну а теперь пришла в голову такая мысль: написать на PB программку которая берет изображение и записывает в файл цвета всех точек. Вопросов появилось два:
1) Как узнать в PB цвет точки на определенном изображении?
2) Т. К. в TP в режиме "detect" всего 15 цветов, как найти для цвета точки с изображения самый подходящий из этих 15-ти?
Если подскажите другой более простой принцип загрузки в TP изображений буду очень благодарен! Заранее спасибо.
Программа для вставки в turbo pascal jpg картинок
Сообщений 1 страница 19 из 19
Поделиться108.10.2011 16:38:47
Поделиться208.10.2011 17:28:40
1 вопрос в справке нашел, остался второй
Поделиться308.10.2011 17:58:10
Можно сделать так:
UseJPEGImageDecoder() ; Поддержка загрузки JPG UsePNGImageDecoder() ; и PNG рисунков. If LoadImage(0,"Image.jpg")=0 MessageRequester("", "Нет рисунка!", 48) End EndIf If CreateFile(0, "ResultImage.bin")=0 MessageRequester("", "Не удалось создать файл!", 48) End EndIf Width = ImageWidth(0) Height = ImageHeight(0) WriteWord(0, Width) WriteWord(0, Height) Width-1 : Height-1 If StartDrawing(ImageOutput(0)) ; Разложение рисунка на точки и запись в файл. For x=0 To Width For y=0 To Height Color = Point(x, y) Byte.c = (Red(Color)/32) | (Green(Color)/32) | (Blue(Color)/32) WriteByte(0, Byte) Next y Next x StopDrawing() EndIf CloseFile(0) MessageRequester("", "Завершено", 64)
В файле будет в 1 и 2 байте - ширина рисунка, в 3 и 4 - высота, а остальные данные, цвет точек рисунка.
Поделиться408.10.2011 21:33:09
Byte.c = (Red(Color)/32) | (Green(Color)/32) | (Blue(Color)/32)
Пётр, а зачем на 32 делить? Не пнял если честно.
Поделиться508.10.2011 23:48:15
Спасибо за ответ, я не понял смысл программы, программа записывает в файл байты, которые отображаются квадратами в блокноте. Вопрос в том, как это читать и зачем это нужно?
Поделиться609.10.2011 00:09:14
отображаются квадратами в блокноте
А причем здесь вообще блокнот?
Ведь эти данные будет обрабатывать программа и они сейчас представлены в довольно удобном виде для разворота картинки на экране.
Вопрос в том, как это читать и зачем это нужно?
Читать в проге на паскале и с помощью двух вложенных циклов разворачивать картинку на экране.
Поделиться709.10.2011 03:24:52
Читать в проге на паскале и с помощью двух вложенных циклов разворачивать картинку на экране.
Я понимаю что это форум pb а не tp, но мне кажется вы и в tp разбираетесь, поэтому спрошу, а что именно считать? В них же цвет не записан.
Поделиться809.10.2011 13:18:59
По моему из кода должно быть понятно как воссоздать картинку.
Алгоритм примерно такой:
ReadFile(0, "image.bin") Width = ReadWord(0)-1 Height = ReadWord(0)-1 For x=0 To Width For y=0 To Height Plot(x, y,ReadAsciiCharacter(0)) Next y Next x CloseFile(0)
Поделиться909.10.2011 21:00:20
Пётр, это код PB, но я же пишу это для TP. Я не понимаю как считать это дело из TP. Он же всего 15 цветов поддерживает( Но у меня тут появилась такая идея:записывать в файл цвета точки Rgb, rGb и rgB, а в TP смотреть что из этого больше, и в зависимости от этого определять цвет точки.
Поделиться1009.10.2011 21:25:00
Пётр, это код PB, но я же пишу это для TP
Это алгоритм построения картинки.
Перепиши его на TP и будет то, что нужно.
Но у меня тут появилась такая идея:записывать в файл цвета точки
В файле и так уже цвета точек.
Поделиться1109.10.2011 22:32:52
В файле и так уже цвета точек.
Желательно чтоб они были цифрой, а не квадратом, потому что я в TP тот еще программист и мои знания ограничиваются самоучителем для начинающих. Кстати я уже начал делать свой вариант. Спасибо за ответы. 3-ий мне помог.
Поделиться1210.10.2011 00:02:37
чтоб они были цифрой, а не квадратом
Так они там не буквами и не треугольником.
Там значения от 0 до 15, обозначающие цвет точек.
Поделиться1310.10.2011 03:37:13
UseJPEGImageDecoder() ; Поддержка загрузки JPG UsePNGImageDecoder() ; и PNG рисунков. file1$=OpenFileRequester("Откиыть jpg","","",0) file2$=SaveFileRequester("Сохранить","","",0) If LoadImage(0,file1$)=0 MessageRequester("", "Нет рисунка!", 48) End EndIf ResizeImage( 0, 640, 480) If CreateFile(0, file2$)=0 MessageRequester("", "Не удалось создать файл!", 48) End EndIf If StartDrawing(ImageOutput(0)) ; Разложение рисунка на точки и запись в файл. For x=0 To 639 For y=0 To 479 Color = Point(x, y) R=(Red(Color)) G=(Green(Color)) B=(Blue(Color)) If R<168 And g<168 And b<168 col.s="0" EndIf If R<168 And g<168 And b>=168 col.s="1" EndIf If R<168 And g>=168 And b<168 col.s="2" EndIf If R<168 And g>=168 And b>=168 col.s="3" EndIf If R>=168 And g<168 And b<168 col.s="4" EndIf If R>=168 And g<168 And b>=168 col.s="5" EndIf If R>=168 And g<168 And b<168 col.s="6" EndIf If R>=168 And g>=168 And b>=168 col.s="7" EndIf If R<168 And g<168 And b<168 col.s="8" EndIf If R<168 And g<168 And b>=168 col.s="9" EndIf If R<168 And g>=168 And b<168 col.s="10" EndIf If R<168 And g>=168 And b>=168 col.s="11" EndIf If R>=168 And g<168 And b<168 col.s="12" EndIf If R>=168 And g<168 And b>=168 col.s="13" EndIf If R>=126 And g>=168 And b<168 col.s="14" EndIf If R>=126 And g>=126 And b>=168 col.s="15" EndIf pisat.s=Str(r)+"."+Str(g)+"."+Str(b) If col="" MessageRequester("Цвет не найден", pisat) EndIf WriteStringN(0,col) Next y Next x StopDrawing() EndIf CloseFile(0) MessageRequester("", "Завершено", 64)
Не стол усложнять задачу и сделал по свойму.
Поделиться1415.10.2011 16:58:38
OpenWindow(1,0,0,100,110,"Введите X и Y",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) StringGadget(2,10,10,80,30,"x") StringGadget(3,10,40,80,30,"y") ButtonGadget(4,10,70,80,30,">>") Repeat event=WindowEvent() If event=#PB_Event_Gadget If EventGadget()=4 xx=Val(GetGadgetText(2)) yy=Val(GetGadgetText(3)) CloseWindow(1) Break EndIf EndIf Until EventGadget()=400 UseJPEGImageDecoder() ; Поддержка загрузки JPG UsePNGImageDecoder() ; и PNG рисунков. file1$=OpenFileRequester("Откиыть jpg","","",0) file2$=SaveFileRequester("Сохранить","","",0) If LoadImage(0,file1$)=0 MessageRequester("", "Нет рисунка!", 48) End EndIf If yy=0 : yy=xx*(ImageHeight(0)/ImageWidth(0)):EndIf ResizeImage( 0, xx, yy) If CreateFile(0, file2$)=0 MessageRequester("", "Не удалось создать файл!", 48) End EndIf WriteStringN(0,Str(xx)) WriteStringN(0,Str(yy)) If StartDrawing(ImageOutput(0)) ; Разложение рисунка на точки и запись в файл. For x=0 To xx-1 For y=0 To yy-1 Color = Point(x, y) R=(Red(Color)) G=(Green(Color)) B=(Blue(Color)) If R<168 And g<168 And b<168 col.s="0" EndIf If R<168 And g<168 And b>=168 col.s="1" EndIf If R<168 And g>=168 And b<168 col.s="2" EndIf If R<168 And g>=168 And b>=168 col.s="3" EndIf If R>=168 And g<168 And b<168 col.s="4" EndIf If R>=168 And g<168 And b>=168 col.s="5" EndIf If R>=168 And g<168 And b<168 col.s="6" EndIf If R>=168 And g>=168 And b>=168 col.s="7" EndIf If R<168 And g<168 And b<168 col.s="8" EndIf If R<168 And g<168 And b>=168 col.s="9" EndIf If R<168 And g>=168 And b<168 col.s="10" EndIf If R<168 And g>=168 And b>=168 col.s="11" EndIf If R>=168 And g<168 And b<168 col.s="12" EndIf If R>=168 And g<168 And b>=168 col.s="13" EndIf If R>=126 And g>=168 And b<168 col.s="14" EndIf If R>=126 And g>=126 And b>=168 col.s="15" EndIf pisat.s=Str(r)+"."+Str(g)+"."+Str(b) If col="" MessageRequester("Цвет не найден", pisat) EndIf WriteStringN(0,col) Next y Next x StopDrawing() EndIf CloseFile(0) MessageRequester("", "Завершено", 64)
Еще один вопрос, вот код и вылетает ошибка на строку StartDrawing что #image не инициализирован. Подскажите пожалуйста, в чем дело?
Поделиться1515.10.2011 20:11:11
Еще один вопрос, вот код и вылетает ошибка на строку StartDrawing что #image не инициализирован.
Эта ошибка появляется если не задать x и y в окне.
Поделиться1615.10.2011 21:54:52
Да, но при не заполнение Y-ка ошибка вылетать не должна т. к. есть штука:
If yy=0 : yy=xx*(ImageHeight(0)/ImageWidth(0)):EndIf
Но все равно вылетает.
Поделиться1715.10.2011 23:54:06
Да, но при не заполнение Y-ка ошибка вылетать не должна т. к. есть штука:
Если заполнить только X, то программа не вылетает и работает нормально без ошибок.
Поделиться1816.10.2011 00:35:33
Странно, а какая у вас версия PB?
Поделиться1916.10.2011 11:11:07
4.51.